diff --git a/.gitignore b/.gitignore index 0abd155..5caa5ba 100644 --- a/.gitignore +++ b/.gitignore @@ -11,12 +11,14 @@ *.mod *.o *.con +*.pyc NAM_data/raw/*/ +NAM_data/raw/2017* CALPUFF_OUT/CALMET/*/ CALPUFF_OUT/CALPUFF/*/ -vis/*/ - +vis/*/** +CALPUFF_SRC/*/** CALPUFF_INP/terrel.inp CALPUFF_INP/ctgproc.inp CALPUFF_INP/makegeo.inp @@ -32,11 +34,19 @@ VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/*/*.png VIZ_SITE_CODE/public_html/UNRESP_VIZ/*/*.jpg VIZ_SITE_CODE/public_html/UNRESP_VIZ/*/*google_conc*.html VIZ_SITE_CODE/public_html/UNRESP_VIZ/2018/ +VIZ_SITE_CODE/public_html/UNRESP_VIZ/*/*.gif + grabAQfiles.sh Python/__pycache__/ +Python/*.pyc +Python/*/*.pyc +Python/*/__pycache__/ +Python/analysis_tools/*.txt CALPUFF_EXE/*.exe CALPUFF_EXE/libraries/lib* CALPUFF_EXE/libraries/*.so CALPUFF_EXE/libraries/*main + +update_site_code.sh diff --git a/Analysis/Figures/ElPanama/ElPanamascatterbyhour.png b/Analysis/Figures/ElPanama/ElPanamascatterbyhour.png new file mode 100644 index 0000000..5fa8a7d Binary files /dev/null and b/Analysis/Figures/ElPanama/ElPanamascatterbyhour.png differ diff --git a/Analysis/Figures/ElPanama/TimeSeries_Normalised.png b/Analysis/Figures/ElPanama/TimeSeries_Normalised.png new file mode 100644 index 0000000..9febf7c Binary files /dev/null and b/Analysis/Figures/ElPanama/TimeSeries_Normalised.png differ diff --git a/Analysis/Figures/ElPanama/clock_scatter/ElPanamanormalised_clock_scatter.png b/Analysis/Figures/ElPanama/clock_scatter/ElPanamanormalised_clock_scatter.png new file mode 100644 index 0000000..d5f7ca0 Binary files /dev/null and b/Analysis/Figures/ElPanama/clock_scatter/ElPanamanormalised_clock_scatter.png differ diff --git a/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day.png b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day.png new file mode 100644 index 0000000..cb399cd Binary files /dev/null and b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day.png differ diff --git a/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day0.png b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day0.png new file mode 100644 index 0000000..cb399cd Binary files /dev/null and b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day0.png differ diff --git a/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day1.png b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day1.png new file mode 100644 index 0000000..f1da645 Binary files /dev/null and b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day1.png differ diff --git a/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day_then_normalised.png b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day_then_normalised.png new file mode 100644 index 0000000..3ee4ec1 Binary files /dev/null and b/Analysis/Figures/ElPanama/composite_day/ElPanamaComposite_day_then_normalised.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_March2017_Obs.png b/Analysis/Figures/ElPanama/scatters/ElPanama_March2017_Obs.png new file mode 100644 index 0000000..3896af3 Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_March2017_Obs.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision.png b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision.png new file mode 100644 index 0000000..860b177 Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust.png b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust.png new file mode 100644 index 0000000..c78950c Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust_nam.png b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust_nam.png new file mode 100644 index 0000000..d225684 Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust_nam.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust_obs.png b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust_obs.png new file mode 100644 index 0000000..4c45439 Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_raw_comparision_yadjust_obs.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_ecmwf.png b/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_ecmwf.png new file mode 100644 index 0000000..2e14dce Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_ecmwf.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_nam.png b/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_nam.png new file mode 100644 index 0000000..e1e1973 Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_nam.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_obs.png b/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_obs.png new file mode 100644 index 0000000..7c1bf03 Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_smooth_comparision_yadjust_obs.png differ diff --git a/Analysis/Figures/ElPanama/scatters/ElPanama_smoothed_comparision.png b/Analysis/Figures/ElPanama/scatters/ElPanama_smoothed_comparision.png new file mode 100644 index 0000000..471e5ac Binary files /dev/null and b/Analysis/Figures/ElPanama/scatters/ElPanama_smoothed_comparision.png differ diff --git a/Analysis/Figures/ElPanama/std/ECMWFstd.png b/Analysis/Figures/ElPanama/std/ECMWFstd.png new file mode 100644 index 0000000..6291964 Binary files /dev/null and b/Analysis/Figures/ElPanama/std/ECMWFstd.png differ diff --git a/Analysis/Figures/ElPanama/std/NAMstd.png b/Analysis/Figures/ElPanama/std/NAMstd.png new file mode 100644 index 0000000..3b91734 Binary files /dev/null and b/Analysis/Figures/ElPanama/std/NAMstd.png differ diff --git a/Analysis/Figures/ElPanama/std/Obsstd.png b/Analysis/Figures/ElPanama/std/Obsstd.png new file mode 100644 index 0000000..f8cba4b Binary files /dev/null and b/Analysis/Figures/ElPanama/std/Obsstd.png differ diff --git a/Analysis/Figures/ElPanama/std/std_normalised_adjusted.png b/Analysis/Figures/ElPanama/std/std_normalised_adjusted.png new file mode 100644 index 0000000..3b00b2f Binary files /dev/null and b/Analysis/Figures/ElPanama/std/std_normalised_adjusted.png differ diff --git a/Analysis/Figures/Pacaya/Pacayascatterbyhour.png b/Analysis/Figures/Pacaya/Pacayascatterbyhour.png new file mode 100644 index 0000000..ef66c7d Binary files /dev/null and b/Analysis/Figures/Pacaya/Pacayascatterbyhour.png differ diff --git a/Analysis/Figures/Pacaya/Timeseries_Normalised.png b/Analysis/Figures/Pacaya/Timeseries_Normalised.png new file mode 100644 index 0000000..d04dd42 Binary files /dev/null and b/Analysis/Figures/Pacaya/Timeseries_Normalised.png differ diff --git a/Analysis/Figures/Pacaya/clock_scatter/Pacayanormalised_clock_scatter.png b/Analysis/Figures/Pacaya/clock_scatter/Pacayanormalised_clock_scatter.png new file mode 100644 index 0000000..5ff5e40 Binary files /dev/null and b/Analysis/Figures/Pacaya/clock_scatter/Pacayanormalised_clock_scatter.png differ diff --git a/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day.png b/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day.png new file mode 100644 index 0000000..118199b Binary files /dev/null and b/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day.png differ diff --git a/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day0.png b/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day0.png new file mode 100644 index 0000000..118199b Binary files /dev/null and b/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day0.png differ diff --git a/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day1.png b/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day1.png new file mode 100644 index 0000000..7808610 Binary files /dev/null and b/Analysis/Figures/Pacaya/composite_day/PacayaComposite_day1.png differ diff --git a/Analysis/Figures/Pacaya/scatters/Pacaya_March2017_Obs.png b/Analysis/Figures/Pacaya/scatters/Pacaya_March2017_Obs.png new file mode 100644 index 0000000..aa6261e Binary files /dev/null and b/Analysis/Figures/Pacaya/scatters/Pacaya_March2017_Obs.png differ diff --git a/Analysis/Figures/Pacaya/scatters/Pacaya_raw_comparision.png b/Analysis/Figures/Pacaya/scatters/Pacaya_raw_comparision.png new file mode 100644 index 0000000..f972a0e Binary files /dev/null and b/Analysis/Figures/Pacaya/scatters/Pacaya_raw_comparision.png differ diff --git a/Analysis/Figures/Pacaya/scatters/Pacaya_raw_comparision_yadjust_obs.png b/Analysis/Figures/Pacaya/scatters/Pacaya_raw_comparision_yadjust_obs.png new file mode 100644 index 0000000..8e382f7 Binary files /dev/null and b/Analysis/Figures/Pacaya/scatters/Pacaya_raw_comparision_yadjust_obs.png differ diff --git a/Analysis/Figures/Pacaya/scatters/Pacaya_smoothed_comparision.png b/Analysis/Figures/Pacaya/scatters/Pacaya_smoothed_comparision.png new file mode 100644 index 0000000..64ea6a8 Binary files /dev/null and b/Analysis/Figures/Pacaya/scatters/Pacaya_smoothed_comparision.png differ diff --git a/Analysis/Figures/Pacaya/scatters/Pacaya_smoothed_comparision_yadjust_obs.png b/Analysis/Figures/Pacaya/scatters/Pacaya_smoothed_comparision_yadjust_obs.png new file mode 100644 index 0000000..d562284 Binary files /dev/null and b/Analysis/Figures/Pacaya/scatters/Pacaya_smoothed_comparision_yadjust_obs.png differ diff --git a/Analysis/README.md b/Analysis/README.md new file mode 100644 index 0000000..2e95c99 --- /dev/null +++ b/Analysis/README.md @@ -0,0 +1,61 @@ +# Analysis Tools + +:warning: This README is incomplete :warning: + +These tools can be used to aid in writing further analysis tools and transparency in model configuration. They will not be available in release archives + +## Overview + +As part of developing this tool, the CALPUFF model was forced with NAM and ECMWF data, the results showed large discrepancies. An experiment was set up (IMO) to compare identical CALPUFF runs over a 1 month period with known observations, and evaluate if the one meteological dataset is inferior. An overview of the results will be hosted in the wiki. + +Summary of meteological data: + +### NAM + +* Resolution: + * Spatial - + * Temporal - +* available to non academic: yes + + +### ECMWF + +* Resolution: + * Spatial - + * Temporal - +* available to non-academic: **no** + +## Description of Analysis + +1. Extract Observational data +2. Fill in missing values with ML alogrithm , but keep raw incomplete data set +3. Extract model data, nearest point and surrounding points (mean, min max) accept that the model accuracy is not such that the exact station point will be well defined. +4. Collate data sets and perform statistical analysis +5. Plot obervations vs model data + +### Other possible steps: + +* calculate: daily/hourly/month max, min, mean (for area around station), see if it's comparable to data +* calculate other useful statistics e.g. RMS and std to see variability and error +* Normalise the data sets to see if there's any peak correleation. + +### Dec 2019 + +* Normalise data,? +* Composite days? +* Scatter plot peak location data? +* Rough estimates of PBL heights between NAM and EMCWF? Afternoon (only) estimates from HOROWORTZ 1964 would be possible vertical profile of theta is 1.5 that of the surface level (), gribs contain the required vars +* Compiled metseries tool to generate rose plot! + +# Normalised Plots: + +[Stats.py](Stats.py) plots normalised time series (scaled by max/min), the results are plotted for [ElPanama](TimeSeries_Data/ElPanama/Timeseries_Normalised) and [Pacaya](TimeSeries_Data/Pacaya/Timeseries_Normalised). + +Note that ElPanama is only to March 25th as Timeseries incomplete for Observation + +* The models still perform poorly although ECMWF looks marginally better +* Statistics are in Stats_Normalised.html + +## Acknowledgements + +Sara Barsotti diff --git a/Analysis/Stats.html b/Analysis/Stats.html new file mode 100644 index 0000000..01b4b93 --- /dev/null +++ b/Analysis/Stats.html @@ -0,0 +1,328 @@ +Pandas Profiling Report

Overview

Dataset info

Number of variables11
Number of observations744
Missing cells458 (5.6%)
Duplicate rows0 (0.0%)
Total size in memory64.1 KiB
Average record size in memory88.2 B

Variables types

Numeric6
Categorical0
Boolean0
Date1
URL0
Text (Unique)0
Rejected4
Unsupported0

Warnings

ECMWF_area is highly skewed (γ1 = 22.03329012) Skewed
ECMWF_area has 150 (20.2%) zeros Zeros
ECMWF_max is highly correlated with ECMWF_area (ρ = 0.9946261381) Rejected
ECMWF_min has 492 (66.1%) zeros Zeros
ECMWF_raw is highly correlated with ECMWF_max (ρ = 0.9814667048) Rejected
ElPanama_raw is highly correlated with ElPanama_KNN (ρ = 1) Rejected
NAM_area has 451 (60.6%) zeros Zeros
NAM_area has 26 (3.5%) missing values Missing
NAM_max is highly correlated with NAM_area (ρ = 0.9559986529) Rejected
NAM_min has 560 (75.3%) zeros Zeros
NAM_min has 26 (3.5%) missing values Missing
NAM_raw has 509 (68.4%) zeros Zeros
NAM_raw has 26 (3.5%) missing values Missing

Variables

ECMWF_area
Numeric

Distinct count595
Unique (%)80.0%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
Mean378.8552205
Minimum0
Maximum66671.88766
Zeros (%)20.2%
Mini histogram

Quantile statistics

Minimum0
5-th percentile0
Q10.4438702239
Median25.68653429
Q3310.0319021
95-th percentile1505.674934
Maximum66671.88766
Range66671.88766
Interquartile range309.5880318

Descriptive statistics

Standard deviation2671.126821
Coef of variation7.050521351
Kurtosis525.9092705
Mean378.8552205
MAD505.7148334
Skewness22.03329012
Sum281868.2841
Variance7134918.495
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
Histogram
Histogram with variable size bins (bins=[0.00000000e+00 9.45986267e-05 1.26644954e-02 2.06452115e+00 5.14974463e+00 ... 6.50967746e+01 6.61206339e+02 1.84078543e+03 3.21727965e+03 6.66718877e+04], "bayesian blocks" binning strategy used)
ValueCountFrequency (%) 
0 150 20.2%
 
37.63467028 1 0.1%
 
5.566779874 1 0.1%
 
27368.96552 1 0.1%
 
3.652271537 1 0.1%
 
308.2202497 1 0.1%
 
253.0417947 1 0.1%
 
33.13419816 1 0.1%
 
97.84460515 1 0.1%
 
765.1935922 1 0.1%
 
Other values (585) 585 78.6%
 

Minimum 5 values

ValueCountFrequency (%) 
0 150 20.2%
 
0.0001891972533 1 0.1%
 
0.0007669054567 1 0.1%
 
0.001780154667 1 0.1%
 
0.002483007333 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
66671.88766 1 0.1%
 
27368.96552 1 0.1%
 
3266.580413 1 0.1%
 
3167.978892 1 0.1%
 
3149.608914 1 0.1%
 

ECMWF_max
Highly correlated

This variable is highly correlated with ECMWF_area and should be ignored for analysis

Correlation0.9946261381

ECMWF_min
Numeric

Distinct count253
Unique (%)34.0%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
Mean25.54502088
Minimum0
Maximum1990.1183
Zeros (%)66.1%
Mini histogram

Quantile statistics

Minimum0
5-th percentile0
Q10
Median0
Q30.8800290875
95-th percentile141.49033
Maximum1990.1183
Range1990.1183
Interquartile range0.8800290875

Descriptive statistics

Standard deviation130.7412857
Coef of variation5.11807316
Kurtosis146.6832568
Mean25.54502088
MAD42.19796355
Skewness11.34888556
Sum19005.49553
Variance17093.28379
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
Histogram
Histogram with variable size bins (bins=[0.00000000e+00 7.07566700e-05 7.25452760e-03 4.10426525e-01 1.44118795e+00 ... 8.06554015e+01 8.10835590e+01 1.84279515e+02 3.27759960e+02 1.99011830e+03], "bayesian blocks" binning strategy used)
ValueCountFrequency (%) 
0 492 66.1%
 
6.5863137 1 0.1%
 
181.57926 1 0.1%
 
80.729602 1 0.1%
 
0.97157056 1 0.1%
 
81.055121 1 0.1%
 
99.430035 1 0.1%
 
104.66549 1 0.1%
 
140.57165 1 0.1%
 
4.7108906 1 0.1%
 
Other values (243) 243 32.7%
 

Minimum 5 values

ValueCountFrequency (%) 
0 492 66.1%
 
0.00014151334 1 0.1%
 
0.00032741435 1 0.1%
 
0.0011803718 1 0.1%
 
0.001354776 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
1990.1183 1 0.1%
 
1700.9478 1 0.1%
 
1650.1659 1 0.1%
 
1274.1918 1 0.1%
 
328.86234 1 0.1%
 

ECMWF_raw
Highly correlated

This variable is highly correlated with ECMWF_max and should be ignored for analysis

Correlation0.9814667048

ElPanama_KNN
Numeric

Distinct count743
Unique (%)99.9%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
Mean38.50706546
Minimum0.19367
Maximum199.27916
Zeros (%)0.0%
Mini histogram

Quantile statistics

Minimum0.19367
5-th percentile5.097866
Q118.42310382
Median25.06357618
Q346.062785
95-th percentile119.7976835
Maximum199.27916
Range199.08549
Interquartile range27.63968118

Descriptive statistics

Standard deviation34.87997018
Coef of variation0.9058070191
Kurtosis3.753024679
Mean38.50706546
MAD25.08891774
Skewness1.949730118
Sum28649.2567
Variance1216.61232
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
Histogram
Histogram with variable size bins (bins=[1.93670000e-01 1.48297511e+01 1.74641413e+01 2.00520746e+01 2.01905814e+01 ... 2.98902846e+01 5.09866282e+01 9.81837800e+01 1.73924225e+02 1.99279160e+02], "bayesian blocks" binning strategy used)
ValueCountFrequency (%) 
14.78033 2 0.3%
 
19.41995 1 0.1%
 
16.92419803 1 0.1%
 
29.65348873 1 0.1%
 
18.89534188 1 0.1%
 
25.57098237 1 0.1%
 
18.97082504 1 0.1%
 
8.84645 1 0.1%
 
29.87933927 1 0.1%
 
17.48511391 1 0.1%
 
Other values (733) 733 98.5%
 

Minimum 5 values

ValueCountFrequency (%) 
0.19367 1 0.1%
 
0.20639 1 0.1%
 
0.48623 1 0.1%
 
0.491 1 0.1%
 
0.63251 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
199.27916 1 0.1%
 
195.32801 1 0.1%
 
174.01883 1 0.1%
 
173.82962 1 0.1%
 
173.22701 1 0.1%
 

ElPanama_raw
Highly correlated

This variable is highly correlated with ElPanama_KNN and should be ignored for analysis

Correlation1

NAM_area
Numeric

Distinct count269
Unique (%)36.2%
Missing (%)3.5%
Missing (n)26
Infinite (%)0.0%
Infinite (n)0
Mean42.6599322
Minimum0
Maximum2675.248667
Zeros (%)60.6%
Mini histogram

Quantile statistics

Minimum0
5-th percentile0
Q10
Median0
Q31.100006798
95-th percentile237.2296503
Maximum2675.248667
Range2675.248667
Interquartile range1.100006798

Descriptive statistics

Standard deviation196.0433147
Coef of variation4.595490536
Kurtosis86.17786499
Mean42.6599322
MAD72.89564232
Skewness8.199007813
Sum30629.83132
Variance38432.98124
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
ValueCountFrequency (%) 
0 451 60.6%
 
0.03694173411 1 0.1%
 
0.04118819122 1 0.1%
 
2417.47879 1 0.1%
 
682.0759965 1 0.1%
 
0.9781514178 1 0.1%
 
0.02323748698 1 0.1%
 
73.64165711 1 0.1%
 
22.88606981 1 0.1%
 
674.2230311 1 0.1%
 
Other values (258) 258 34.7%
 
(Missing) 26 3.5%
 

Minimum 5 values

ValueCountFrequency (%) 
0 451 60.6%
 
2.076743111e-06 1 0.1%
 
0.0002507481244 1 0.1%
 
0.0006494881556 1 0.1%
 
0.001494105572 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
2675.248667 1 0.1%
 
2417.47879 1 0.1%
 
1606.659167 1 0.1%
 
1284.937852 1 0.1%
 
1236.624724 1 0.1%
 

NAM_max
Highly correlated

This variable is highly correlated with NAM_area and should be ignored for analysis

Correlation0.9559986529

NAM_min
Numeric

Distinct count160
Unique (%)21.5%
Missing (%)3.5%
Missing (n)26
Infinite (%)0.0%
Infinite (n)0
Mean5.265579795
Minimum0
Maximum840.00407
Zeros (%)75.3%
Mini histogram

Quantile statistics

Minimum0
5-th percentile0
Q10
Median0
Q30
95-th percentile10.20885335
Maximum840.00407
Range840.00407
Interquartile range0

Descriptive statistics

Standard deviation44.13003211
Coef of variation8.38084956
Kurtosis223.4977509
Mean5.265579795
MAD9.645520028
Skewness13.9293179
Sum3780.686293
Variance1947.459734
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
ValueCountFrequency (%) 
0 560 75.3%
 
8.2918023 1 0.1%
 
0.058688183 1 0.1%
 
0.0025690925 1 0.1%
 
62.795007 1 0.1%
 
22.141712 1 0.1%
 
0.055979509 1 0.1%
 
69.686525 1 0.1%
 
0.080606064 1 0.1%
 
5.0687481 1 0.1%
 
Other values (149) 149 20.0%
 
(Missing) 26 3.5%
 

Minimum 5 values

ValueCountFrequency (%) 
0 560 75.3%
 
5.9702736e-05 1 0.1%
 
0.00021557263 1 0.1%
 
0.00043393006 1 0.1%
 
0.00051053622 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
840.00407 1 0.1%
 
553.9431 1 0.1%
 
345.23575 1 0.1%
 
336.22663 1 0.1%
 
312.0164 1 0.1%
 

NAM_raw
Numeric

Distinct count211
Unique (%)28.4%
Missing (%)3.5%
Missing (n)26
Infinite (%)0.0%
Infinite (n)0
Mean24.84326621
Minimum0
Maximum1106.8869
Zeros (%)68.4%
Mini histogram

Quantile statistics

Minimum0
5-th percentile0
Q10
Median0
Q30.0487237045
95-th percentile81.3270781
Maximum1106.8869
Range1106.8869
Interquartile range0.0487237045

Descriptive statistics

Standard deviation121.8669061
Coef of variation4.90543011
Kurtosis42.63335324
Mean24.84326621
MAD43.59727123
Skewness6.365899186
Sum17837.46514
Variance14851.5428
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
ValueCountFrequency (%) 
0 509 68.4%
 
0.070827653 1 0.1%
 
14.419989 1 0.1%
 
0.0054125917 1 0.1%
 
1.5223586 1 0.1%
 
38.081798 1 0.1%
 
1.7662785 1 0.1%
 
0.045377906 1 0.1%
 
1.0111494 1 0.1%
 
1.7428748 1 0.1%
 
Other values (200) 200 26.9%
 
(Missing) 26 3.5%
 

Minimum 5 values

ValueCountFrequency (%) 
0 509 68.4%
 
0.0002512307 1 0.1%
 
0.00064993949 1 0.1%
 
0.00094084518 1 0.1%
 
0.0026961489 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
1106.8869 1 0.1%
 
1023.8925 1 0.1%
 
1011.0027 1 0.1%
 
994.8971 1 0.1%
 
953.57175 1 0.1%
 

TimeBeginning
Date

Distinct count744
Unique (%)100.0%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
Minimum2017-03-01 00:00:00
Maximum2017-03-31 23:00:00
Mini histogram
Histogram
Histogram of 'TimeBeginning' (bins=N)

Correlations

Missing values

Sample

First rows

ECMWF_areaECMWF_maxECMWF_minECMWF_rawElPanama_KNNElPanama_rawNAM_areaNAM_maxNAM_minNAM_rawTimeBeginning
011.09796724.0198751.14119522.639317142.63700142.637000.0000000.0000000.0000000.0000002017-03-01 00:00:00
15.20122110.2580640.6732169.50270539.2663339.266330.0000000.0000000.0000000.0000002017-03-01 01:00:00
250.687521113.2330903.808609113.23309032.5628932.562890.0000000.0000000.0000000.0000002017-03-01 02:00:00
350.965738117.4206801.93530693.659692104.96672104.966720.0000000.0000000.0000000.0000002017-03-01 03:00:00
452.207585155.8263500.02021060.950464114.76112114.761120.0000000.0000000.0000000.0000002017-03-01 04:00:00
54.77519310.0180251.9072145.05144127.9264527.9264526.27508262.7774280.00000042.7634112017-03-01 05:00:00
61.4583452.2040490.2821501.91875032.4913432.491341.3556882.4255760.0532691.7326952017-03-01 06:00:00
71.4705832.2076350.3407402.02396421.4281221.428120.0000000.0000000.0000000.0000002017-03-01 07:00:00
834.383213109.7503700.10143818.46022544.3622844.362280.0000000.0000000.0000000.0000002017-03-01 08:00:00
942.982247141.2734100.00000040.77656973.2875673.287560.0000000.0000000.0000000.0000002017-03-01 09:00:00

Last rows

ECMWF_areaECMWF_maxECMWF_minECMWF_rawElPanama_KNNElPanama_rawNAM_areaNAM_maxNAM_minNAM_rawTimeBeginning
7342389.7295222814.1052001990.1183002389.42490018.148337NaN0.2817910.2890740.2743740.2817352017-03-31 14:00:00
7351396.2309781550.6343001274.1918001391.75220018.248541NaN0.5864890.6328430.5345170.5860962017-03-31 15:00:00
736366.859551408.710740326.657580367.35524018.343654NaN1.0126271.0803770.9409451.0124932017-03-31 16:00:00
73729.45450235.49661123.98945629.35154618.434069NaNNaNNaNNaNNaN2017-03-31 17:00:00
7383.0022173.7104792.3601762.99886718.520135NaNNaNNaNNaNNaN2017-03-31 18:00:00
7390.0000000.0000000.0000000.00000018.602170NaNNaNNaNNaNNaN2017-03-31 19:00:00
7400.0000000.0000000.0000000.00000018.680460NaNNaNNaNNaNNaN2017-03-31 20:00:00
7410.0000000.0000000.0000000.00000018.755265NaNNaNNaNNaNNaN2017-03-31 21:00:00
7420.0000000.0000000.0000000.00000018.826821NaNNaNNaNNaNNaN2017-03-31 22:00:00
7430.0000000.0000000.0000000.00000018.895342NaNNaNNaNNaNNaN2017-03-31 23:00:00
\ No newline at end of file diff --git a/Analysis/Stats.py b/Analysis/Stats.py new file mode 100644 index 0000000..490e683 --- /dev/null +++ b/Analysis/Stats.py @@ -0,0 +1,185 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- +"""Timeseries Analysis +.. module:: Stats + :platform: Unix + :synopis: +.. moduleauther: CEMAC (UoL) +.. description: This module was developed by CEMAC as part of the UNRESP + Project. This script takes CALPUFF concrec data from 2 models and compares + with observations. + From the output of timeseries.py normalise the data + :copyright: © 2019 University of Leeds. + :license: BSD-2 Clause. +Example: + To use:: + coming soon +.. CEMAC_UNRESPForcastingSystem: + https://github.com/cemac/UNRESPForcastingSystem +""" +import os +import glob +import matplotlib as mpl +import pandas as pd +import warnings +import numpy as np +import matplotlib.pyplot as plt +from datetime import datetime +from sklearn import preprocessing +import pandas_profiling +warnings.filterwarnings("ignore") +# University System python may be broken +# If some one insists on using it... +BACKEND = mpl.get_backend() +if BACKEND == 'Qt4Agg' and sys.version_info[0] == 2: + # Fix the backend + print('swapping to Agg Backend') + mpl.pyplot.switch_backend('Agg') + +Towns = ['ElPanama', 'Pacaya'] +NormalisePlots = False +CompositePlots = False +ScatterPlots = False + + +def dateparse(x): return pd.datetime.strptime(x, '%d/%m/%Y %H:%M') +# -------------------------------------------------------------------------- # +# Take data out put from timeseries.py and nomalise # +# # +# # +# ------------------------ 1. Normalise ------------------------------------ # + + +def gen_normalised_plots(town, plot=None): + """gen_normalised_plots + ..description: generate normalised plots from data sets, rescale to maxium + = 1? + ..args: + town(str) + dataset(str) + """ + fname = 'Timeseries_obs_model_raw_processed.csv' + try: + ts = pd.read_csv('TimeSeries_Data/' + town + '/' + town + fname, + index_col=0, parse_dates=True) + except FileNotFoundError: + ts = pd.read_csv('TimeSeries_Data/' + town + '/' + town + '_' + fname, + index_col=0, parse_dates=True) + Obs = ts[town + '_KNN'] + NAM = ts['NAM_area'] + ECMWF = ts['ECMWF_area'] + All = ts[[town + '_KNN', 'NAM_area', 'ECMWF_area']] + # The end of March is rubbish for El Panama + if town == 'ElPanama': + # Get rid of that + start_remove = pd.to_datetime('2017-3-25') + end_remove = pd.to_datetime('2017-4-01') + All = All.query('index < @start_remove or index > @end_remove') + # Turn to numpy array + x = All.values + # scikit learn makes this quick + min_max_scaler = preprocessing.MinMaxScaler() + x_scaled = min_max_scaler.fit_transform(x) + # Pop back into a dataframe + df = pd.DataFrame(x_scaled, columns=['Observations', 'NAM', 'ECMWF'], + index=All.index) + if plot: + # Plot + fig, ax = plt.subplots(figsize=(10, 5)) + df.plot(ax=ax) + plt.title('Normalised Observation, NAM, ECMWF for ' + town + + '\n (model data = area average)') + plt.ylabel('Normalised (via min/max scaler) concentration)') + plt.xlabel('Date in March 2017 (hourly data)') + plt.savefig(town + '_Timeseries_Normalised.png') + return df, All + +# Notes ElPanama +# ECMWF Looked Crazy at the end of March and we had no data for end of March +# so i removed that data? + + +if NormalisePlots is True: + for town in Towns: + df = gen_normalised_plots(town, plot='Y')[0] + plt.clf() + profile = pandas_profiling.ProfileReport(df) + profile.to_file(town + 'normalised_stats.html') + +# ------------------------ 2. Composite days (normalised)-------------------- # +if CompositePlots is True: + for town in Towns: + for i in np.arange(2): + fig, ax = plt.subplots(figsize=(10, 5)) + df = gen_normalised_plots(town)[i] + df = df.groupby(df.index.hour).mean() + if i == 1: + x = df.values + # scikit learn makes this quick + min_max_scaler = preprocessing.MinMaxScaler() + x_scaled = min_max_scaler.fit_transform(x) + # Pop back into a dataframe + df = pd.DataFrame(x_scaled, columns=['Observations', 'NAM', 'ECMWF'], + index=df.index) + df.plot(ax=ax) + plt.title('Composite mean hourly concentrations (Normalised)') + plt.ylabel('Normalised concentration') + plt.xlabel(' Hour in day') + plt.savefig(town + 'Composite_day' + str(i) + '.png') + plt.clf() + +if ScatterPlots is True: + for town in Towns: + df = gen_normalised_plots(town)[0] + # add an hour of day column + df['hour'] = df.index.hour + # Plot as scatter plot + fig, ax = plt.subplots(figsize=(10, 5)) + plt.scatter(df.hour, df.Observations, marker='d', alpha=0.5) + plt.scatter(df.hour, df.NAM, marker='*', alpha=0.6) + plt.scatter(df.hour, df.ECMWF, marker='x', alpha=0.6) + plt.title('Scatter plot of Normalised concentrations grouped by hour' + + ' of day \n' + town) + plt.ylabel('Normalised concentrations') + plt.xlabel('hour of day') + plt.legend(['Obs', 'NAM', 'ECMWF']) + plt.savefig(town+'scatterbyhour.png') + plt.clf() + # Plot as rose/ clock thing.. + times = [6, 3, 0, 21, 18, 15, 12, 9] + fig = plt.figure(figsize=(12, 10)) + ax = fig.add_subplot(221, projection='polar') + plt.scatter(np.pi / 2.0 - 2 * np.pi * df.hour / 24, df.Observations, + alpha=0.60, marker='d', label='observations') + ax.set_xticklabels(times) + ax.set_title('\n Observations') + plt.legend(scatterpoints=5, loc="upper left", bbox_to_anchor=(1.04, 1)) + ax = fig.add_subplot(222, projection='polar') + plt.scatter(np.pi / 2.0 - 2 * np.pi * df.hour / 24, df.NAM, + alpha=0.80, marker='x', color='orange', label='NAM') + ax.set_xticklabels(times) + ax.set_title('NAM') + plt.legend(scatterpoints=5, loc="upper left", bbox_to_anchor=(1.04, 1)) + ax = fig.add_subplot(223, projection='polar') + plt.scatter(np.pi / 2.0 - 2 * np.pi * df.hour / 24, df.ECMWF, + alpha=0.60, marker='+', color='g', label='ECMWF') + ax.set_xticklabels(times) + ax.set_title('ECMWF') + plt.legend(scatterpoints=5, loc="upper left", bbox_to_anchor=(1.04, 1)) + ax = fig.add_subplot(224, projection='polar') + plt.scatter(np.pi / 2.0 - 2 * np.pi * df.hour / 24, df.Observations, + alpha=0.60, marker='d', label='observations') + plt.scatter(np.pi / 2.0 - 2 * np.pi * df.hour / 24, df.NAM, + alpha=0.80, marker='x', label='NAM') + plt.scatter(np.pi / 2.0 - 2 * np.pi * df.hour / 24, df.ECMWF, + alpha=0.60, marker='+', label='ECMWF') + ax.set_xticklabels(times) + ax.set_title('All') + plt.legend(scatterpoints=5, loc="upper left", bbox_to_anchor=(1.04, 1)) + plt.suptitle('Scatter plots in polar co-ordinates of normalised ' + + 'concentrations \n for ' + town + '\n') + plt.tight_layout() + plt.savefig(town + 'normalised_clock_scatter.png') + plt.clf() + +# ------------------------ 3. Dayly maxium (normailised)-------------------- # diff --git a/Analysis/TimeSeries_Data/ElPanama/ECMWF_ElPanama.csv b/Analysis/TimeSeries_Data/ElPanama/ECMWF_ElPanama.csv new file mode 100644 index 0000000..682c6d8 --- /dev/null +++ b/Analysis/TimeSeries_Data/ElPanama/ECMWF_ElPanama.csv @@ -0,0 +1,745 @@ +,TS_station_point,9pntmin,9pntmax,9ptmean +2017-03-01 00:00:00,22.639317,1.1411947,24.019875,11.097967422222222 +2017-03-01 01:00:00,9.5027053,0.67321588,10.258064000000001,5.201220931111111 +2017-03-01 02:00:00,113.23309,3.8086093,113.23309,50.68752143333334 +2017-03-01 03:00:00,93.659692,1.9353063,117.42068,50.96573785555556 +2017-03-01 04:00:00,60.950464,0.020210397,155.82635000000002,52.207584821888894 +2017-03-01 05:00:00,5.0514413,1.9072141,10.018025,4.775192844444444 +2017-03-01 06:00:00,1.9187496,0.28215038000000003,2.204049,1.4583446377777778 +2017-03-01 07:00:00,2.0239643000000003,0.3407396,2.2076349,1.4705829522222222 +2017-03-01 08:00:00,18.460225,0.10143767000000001,109.75036999999999,34.383212987777775 +2017-03-01 09:00:00,40.776569,0.0,141.27340999999998,42.98224727777777 +2017-03-01 10:00:00,6.1883316,1.9053599,11.288358,4.863381477777779 +2017-03-01 11:00:00,1.8905824,0.1857001,2.5358095,1.539513888888889 +2017-03-01 12:00:00,0.078202532,0.0070751804000000005,0.10861176,0.060731479377777786 +2017-03-01 13:00:00,7.4276491,1.3627559,7.652532100000001,4.441770544444444 +2017-03-01 14:00:00,18.755718,2.5696536,19.049625,10.480080422222223 +2017-03-01 15:00:00,101.62799,8.090486499999999,110.87685,57.59532627777779 +2017-03-01 16:00:00,874.68082,193.66264999999999,978.80384,561.7176455555557 +2017-03-01 17:00:00,955.12794,125.99380999999998,1124.3707,647.3262466666666 +2017-03-01 18:00:00,1021.9978,178.89394,1092.0906,665.5828933333333 +2017-03-01 19:00:00,3259.0711,185.09713,3259.0711,1546.0414366666669 +2017-03-01 20:00:00,3304.4862000000003,183.4619,3694.1094,1593.0133533333335 +2017-03-01 21:00:00,2138.8662999999997,8.874791100000001,3918.0517000000004,1600.8728373444446 +2017-03-01 22:00:00,503.06145999999995,0.0,3620.0655,1292.7360094999997 +2017-03-01 23:00:00,18.880261,0.0,4049.9480000000003,728.6908657777778 +2017-03-02 00:00:00,1840.0134,0.0,4162.8432999999995,1847.122817 +2017-03-02 01:00:00,438.26248,0.0,952.49154,377.96394562666666 +2017-03-02 02:00:00,8.7008493,0.0,27.665503,10.002348827777775 +2017-03-02 03:00:00,4.6359924,0.0,9.532574899999998,4.213733565555555 +2017-03-02 04:00:00,3.6607912,0.14717461999999998,5.9013632000000005,3.001134607777778 +2017-03-02 05:00:00,3.0549922,0.23538321,4.3303489,2.3112072944444444 +2017-03-02 06:00:00,2.0603279,0.017932293999999998,147.95923,34.03985393755555 +2017-03-02 07:00:00,0.039051756,0.0,125.80307,21.601758061777776 +2017-03-02 08:00:00,0.0,0.0,72.11456199999999,10.117864598888888 +2017-03-02 09:00:00,0.0,0.0,80.929036,11.685794077777778 +2017-03-02 10:00:00,0.0,0.0,90.935748,13.97485618888889 +2017-03-02 11:00:00,0.0,0.0,99.544202,16.27316998888889 +2017-03-02 12:00:00,0.0,0.0,5.1634129,0.9735712911111111 +2017-03-02 13:00:00,2.1623275,0.25386194,2.7922463,1.4078016333333332 +2017-03-02 14:00:00,3.8511157000000003,0.11586614,7.727318,3.700659746666666 +2017-03-02 15:00:00,29.968707,0.7811098,58.982052,28.851310511111112 +2017-03-02 16:00:00,832.5912599999999,80.729602,1258.2995,596.8943135555555 +2017-03-02 17:00:00,1166.9437,298.58761,1368.1705000000002,745.1738822222222 +2017-03-02 18:00:00,1170.1216000000002,264.56395,1316.6724,745.2594788888889 +2017-03-02 19:00:00,2567.8992,179.90035,2567.8992,1363.617458888889 +2017-03-02 20:00:00,1725.383,180.88822,1798.2625,1031.0020155555555 +2017-03-02 21:00:00,2002.8825,29.776784,3742.744,1570.579690111111 +2017-03-02 22:00:00,224.96132,0.0,4132.5199,1072.6041183333334 +2017-03-02 23:00:00,2.4952687,0.0,2050.6063,298.3275561888888 +2017-03-03 00:00:00,0.0,0.0,105.34044999999999,13.02755345111111 +2017-03-03 01:00:00,0.0,0.0,61.49595000000001,6.832883333333334 +2017-03-03 02:00:00,0.0,0.0,56.541478,6.544066333333333 +2017-03-03 03:00:00,0.0,0.0,73.312556,8.94124688888889 +2017-03-03 04:00:00,0.0,0.0,87.17415799999999,11.027741666666666 +2017-03-03 05:00:00,0.0,0.0,105.77891,15.062839755555554 +2017-03-03 06:00:00,0.0,0.0,88.75101000000001,12.329541800000001 +2017-03-03 07:00:00,0.7716277500000001,0.0,8.7190401,2.001498061555556 +2017-03-03 08:00:00,0.88236334,0.0,3.0821443,1.2683522085555554 +2017-03-03 09:00:00,0.76800603,0.0,2.820738,1.1326810328888888 +2017-03-03 10:00:00,0.046710838000000005,0.0,6.7367127,0.8011711801 +2017-03-03 11:00:00,0.0,0.0,1.4846211,0.1649579 +2017-03-03 12:00:00,0.0,0.0,0.24787741,0.027541934444444444 +2017-03-03 13:00:00,0.5262275,0.0,4.196193500000001,1.3087801578544445 +2017-03-03 14:00:00,1.4785536,0.0,12.320580000000001,3.652271537333333 +2017-03-03 15:00:00,2.8888817,0.0,30.820334,8.926327756133334 +2017-03-03 16:00:00,72.56134999999999,0.0,340.64423999999997,118.29106902944444 +2017-03-03 17:00:00,305.11003999999997,0.05615188,997.86953,386.9947699866667 +2017-03-03 18:00:00,543.69605,25.366888,990.5138300000001,505.1339716666667 +2017-03-03 19:00:00,856.54203,66.62878099999999,1347.2157,619.482499 +2017-03-03 20:00:00,3255.7005,80.828126,4108.431299999999,1579.9438106666666 +2017-03-03 21:00:00,2603.1993,4.5634288,4245.888,1607.4592986444445 +2017-03-03 22:00:00,1519.3094,0.0,3156.3025,1391.348736322222 +2017-03-03 23:00:00,189.31889999999999,0.0,776.5669700000001,306.52024797777773 +2017-03-04 00:00:00,5.9753384,0.0,106.31583,29.35217594777778 +2017-03-04 01:00:00,3.5407791,0.0,20.753188,7.790599 +2017-03-04 02:00:00,1.9484822999999998,0.0,8.0487707,3.285892502222222 +2017-03-04 03:00:00,0.7603250100000001,0.0,6.192568400000001,2.0083538946333332 +2017-03-04 04:00:00,0.20821049,0.0,2.8529366,0.8101077592222222 +2017-03-04 05:00:00,0.062345229,0.0,1.4130842,0.3670247811522222 +2017-03-04 06:00:00,0.18267572,0.0,2.5770994,0.7519694948888888 +2017-03-04 07:00:00,0.18054715,0.0,2.2341444,0.5988713377777777 +2017-03-04 08:00:00,0.2869466,0.0,2.5780585,0.7241360122222223 +2017-03-04 09:00:00,0.50784308,0.0,2.915833,0.8302815131222221 +2017-03-04 10:00:00,0.031870609,0.0,0.92643523,0.14351579340333337 +2017-03-04 11:00:00,1.7033513999999998,0.11491124,3.0261483,1.474869972222222 +2017-03-04 12:00:00,0.11533294,0.0033977012,2.2460896999999997,0.36852094934444446 +2017-03-04 13:00:00,3.0506317,0.11049846,5.9868662,2.98443377 +2017-03-04 14:00:00,5.4437387,0.0074338748,11.870696,5.566779873866667 +2017-03-04 15:00:00,23.20249,0.0045039408,66.73380300000001,28.94894102431111 +2017-03-04 16:00:00,631.5296099999999,49.647813,1003.0739,480.4003114444444 +2017-03-04 17:00:00,847.76402,110.868,1191.712,574.3097677777779 +2017-03-04 18:00:00,905.2474599999999,140.57165,1216.5691000000002,594.9796922222222 +2017-03-04 19:00:00,932.92637,170.03934999999998,1204.2839000000001,601.5346877777778 +2017-03-04 20:00:00,3461.8725,141.65245,3944.2321,1584.3182722222223 +2017-03-04 21:00:00,3447.4244,82.819824,4381.379599999999,1667.2372826666665 +2017-03-04 22:00:00,3088.4125999999997,31.485088,4455.8193,1664.974642 +2017-03-04 23:00:00,3438.1296,65.474072,4714.848,1750.863848 +2017-03-05 00:00:00,164.60551999999998,0.40143951,4009.116,845.9647546233334 +2017-03-05 01:00:00,9.0841313,0.0,1109.4591,221.05579081111114 +2017-03-05 02:00:00,2.9236035,0.0,106.4098,24.493196166666664 +2017-03-05 03:00:00,0.38625316,0.0,19.47963,4.126162195555556 +2017-03-05 04:00:00,0.16842722999999998,0.0,8.0335185,1.659250851111111 +2017-03-05 05:00:00,0.1180519,0.0,4.3677064,0.9121583333333333 +2017-03-05 06:00:00,0.23045551,0.0,3.4989041000000003,0.8925613638888888 +2017-03-05 07:00:00,0.41610234999999995,0.0,2.9284245,0.962448292888889 +2017-03-05 08:00:00,0.85189163,0.0,2.9350292,1.2395737124444446 +2017-03-05 09:00:00,0.056643703000000004,0.0,7.6899987,0.9166952631555555 +2017-03-05 10:00:00,0.0,0.0,9.6184522,1.0687169111111112 +2017-03-05 11:00:00,0.0,0.0,10.029052,1.1143391111111112 +2017-03-05 12:00:00,0.0,0.0,1.1586237,0.15329589844444444 +2017-03-05 13:00:00,1.0336737,0.0011803718,4.9938853000000005,1.8243985987333333 +2017-03-05 14:00:00,1.7455515000000001,0.0,13.402045,4.187292320566667 +2017-03-05 15:00:00,8.182743799999999,0.0,57.711324000000005,19.597579353111108 +2017-03-05 16:00:00,425.1746,20.524072,733.6202,389.95240766666666 +2017-03-05 17:00:00,900.2026599999999,131.37823,1237.2633,602.17409 +2017-03-05 18:00:00,1023.4341,233.77142,1162.8153,655.0156722222223 +2017-03-05 19:00:00,876.8554,80.58120100000001,1232.7289,633.9791212222221 +2017-03-05 20:00:00,1039.8212999999998,2.1610997000000003,2977.7566,1162.1975568555556 +2017-03-05 21:00:00,2858.0958,0.0,3030.6294000000003,1557.1530466666668 +2017-03-05 22:00:00,2538.2736,147.72534,2679.2067,1160.7229588888888 +2017-03-05 23:00:00,209.96582999999998,3.1690031,299.8705,145.84778493333334 +2017-03-06 00:00:00,126.12113000000001,0.0,1063.2658,339.21551998966663 +2017-03-06 01:00:00,22.357547999999998,0.0,176.51738999999998,64.05520886666666 +2017-03-06 02:00:00,49.534632,0.0,398.79645999999997,142.87150566666665 +2017-03-06 03:00:00,16.615902,0.0,300.85375,97.84460515333333 +2017-03-06 04:00:00,0.4522515,0.0,226.0208,50.803566277777776 +2017-03-06 05:00:00,0.0,0.0,158.51896,27.781444311111112 +2017-03-06 06:00:00,0.0,0.0,139.30124,26.47598958888889 +2017-03-06 07:00:00,0.0,0.0,122.53850999999999,26.119843888888884 +2017-03-06 08:00:00,2.0122823,0.0,105.96239,25.92618903333333 +2017-03-06 09:00:00,0.053702827,0.0,101.42837,21.639160369666666 +2017-03-06 10:00:00,0.0,0.0,97.001452,19.596352455555557 +2017-03-06 11:00:00,0.0,0.0,90.641552,18.590804744444444 +2017-03-06 12:00:00,0.16608874999999998,0.0,4.2488214,1.2772284046666667 +2017-03-06 13:00:00,4.1830240000000005,1.2670112,4.261944,2.466224522222222 +2017-03-06 14:00:00,17.7113,2.0180885,21.574706,12.567855711111113 +2017-03-06 15:00:00,83.6299,9.8012088,93.930801,52.291127977777776 +2017-03-06 16:00:00,671.1329900000001,161.62789,710.70797,425.5599955555556 +2017-03-06 17:00:00,882.71225,82.410057,1221.6271,634.7723174444444 +2017-03-06 18:00:00,749.4040799999999,34.597546,1480.299,646.3780417777776 +2017-03-06 19:00:00,499.59158,2.0407904,1465.571,572.1821360444444 +2017-03-06 20:00:00,282.9232,0.0,1564.3212999999998,559.9367365777778 +2017-03-06 21:00:00,1881.5758,0.0,3638.6214,1510.6574866666665 +2017-03-06 22:00:00,1288.1882999999998,73.52333300000001,1288.1882999999998,629.5390003333333 +2017-03-06 23:00:00,127.49007,1.4145493,242.96604000000002,103.8753822 +2017-03-07 00:00:00,140.13397,0.0,1004.3815999999999,373.52118634000004 +2017-03-07 01:00:00,106.90723,0.0,709.3999299999999,258.019028 +2017-03-07 02:00:00,46.320798,0.0,332.24595,114.712609 +2017-03-07 03:00:00,21.141792,0.0,249.0989,82.18721694444444 +2017-03-07 04:00:00,8.8530523,0.0,200.68066,62.74346806377778 +2017-03-07 05:00:00,3.8999192,0.0,177.23226,48.638010022222225 +2017-03-07 06:00:00,0.063885224,0.0,158.59382,33.83842858044444 +2017-03-07 07:00:00,0.0,0.0,135.73882,24.198881266666667 +2017-03-07 08:00:00,0.0,0.0,108.39238,17.1678501 +2017-03-07 09:00:00,0.0,0.0,107.87272999999999,25.446879555555554 +2017-03-07 10:00:00,10.136955,0.0,98.469762,33.65694414444445 +2017-03-07 11:00:00,34.319452,0.0,102.69453,36.05283022222222 +2017-03-07 12:00:00,3.2387254,0.042706034000000004,6.2355320999999995,2.389717077111111 +2017-03-07 13:00:00,3.6926172,0.29831492,4.47506,2.00542324 +2017-03-07 14:00:00,18.574306999999997,3.2605706,19.549159,11.650707855555556 +2017-03-07 15:00:00,44.643381000000005,3.6488435999999997,51.490493,28.445917444444447 +2017-03-07 16:00:00,279.5422,21.771133,319.7068,208.84865533333334 +2017-03-07 17:00:00,448.48848000000004,1.24362,1322.1471999999999,513.3818227777779 +2017-03-07 18:00:00,454.60169,0.0,1430.6071,548.957438888889 +2017-03-07 19:00:00,418.60339,0.0,1393.4941999999999,530.7598328888888 +2017-03-07 20:00:00,486.08167000000003,0.0,2568.7129,973.3948744222222 +2017-03-07 21:00:00,2129.9473000000003,0.0,3720.3454,1555.0212446666667 +2017-03-07 22:00:00,3693.8206999999998,144.52334,3693.8206999999998,1650.2337777777777 +2017-03-07 23:00:00,3019.2698,13.299747,4634.0226999999995,1722.6425218888887 +2017-03-08 00:00:00,1729.2839,3.7406967,2666.4193999999998,1051.7364519666667 +2017-03-08 01:00:00,175.85712,2.7599424,280.23508,106.29322011111111 +2017-03-08 02:00:00,8.1940934,0.74635506,8.3547475,4.487359973333334 +2017-03-08 03:00:00,5.4922948,0.94838981,5.497991,3.0663801855555555 +2017-03-08 04:00:00,4.7145645,0.60369905,4.9557425,2.7825608611111114 +2017-03-08 05:00:00,3.8676149000000004,0.40529102,4.3478844,2.4639540444444443 +2017-03-08 06:00:00,3.2098270999999996,0.32556574,3.7449472,2.1988081888888886 +2017-03-08 07:00:00,2.5931636,0.26242122,3.7693087,1.9847044000000003 +2017-03-08 08:00:00,2.1047383,0.20841625000000003,3.3796955000000004,1.732100596666667 +2017-03-08 09:00:00,1.8866363,0.14656707,3.4698442,1.6917246955555554 +2017-03-08 10:00:00,1.6706367,0.1001149,3.5074331,1.6488924633333333 +2017-03-08 11:00:00,1.6321516999999999,0.07071368900000001,4.1101066,1.7808968043333333 +2017-03-08 12:00:00,1.5475160000000001,0.0039669441,4.1760817999999995,1.9492943749 +2017-03-08 13:00:00,1.4039414000000001,0.0,7.3963929,2.633646485888889 +2017-03-08 14:00:00,2.6705884,0.0,17.590304,5.85262949 +2017-03-08 15:00:00,3.0185204,0.0,69.766691,17.39335112177778 +2017-03-08 16:00:00,163.29686,0.0,860.35865,274.06416637611113 +2017-03-08 17:00:00,240.10561,0.0,1059.3119,362.2690139333333 +2017-03-08 18:00:00,359.49983,4.1071476,1075.3372000000002,437.74220217777776 +2017-03-08 19:00:00,492.70183,18.686638,988.12475,496.74905244444443 +2017-03-08 20:00:00,1348.8234,0.59825129,2869.7748,1358.9434054877777 +2017-03-08 21:00:00,423.75007999999997,0.0,3658.3028,1230.877551933333 +2017-03-08 22:00:00,35.107532000000006,0.0,1434.219,321.66499271111115 +2017-03-08 23:00:00,0.19516051,0.0,134.12995,23.297432367777777 +2017-03-09 00:00:00,0.0,0.0,28.081622,3.8804441157777783 +2017-03-09 01:00:00,0.0,0.0,11.136429,1.8359720499999999 +2017-03-09 02:00:00,0.0,0.0,5.5621758,1.050109108888889 +2017-03-09 03:00:00,0.06750421,0.0,4.607261,0.9104975977777777 +2017-03-09 04:00:00,0.07490533,0.0,4.0295567000000005,0.8158961622222223 +2017-03-09 05:00:00,0.090725663,0.0,3.521252,0.7183617792222221 +2017-03-09 06:00:00,0.16652899000000002,0.0,3.1329700999999996,0.7774162515555556 +2017-03-09 07:00:00,0.26478142,0.0,2.8888307,0.8956520522222221 +2017-03-09 08:00:00,0.38655693,0.0,3.0724943,0.9633556822222222 +2017-03-09 09:00:00,0.41249302,0.0,2.9824259,0.9453203098888889 +2017-03-09 10:00:00,0.42202964,0.0,2.8294583,0.9098447475555554 +2017-03-09 11:00:00,0.4198707,0.0,2.6756359,0.8657889740000001 +2017-03-09 12:00:00,0.27924267,0.0,1.90047,0.5967578696944444 +2017-03-09 13:00:00,0.39669888000000003,0.0,5.5430801,1.4044673908111112 +2017-03-09 14:00:00,1.0329913000000002,0.0,15.697355,4.112620124444444 +2017-03-09 15:00:00,2.211641,0.0,56.61097,13.555876138555554 +2017-03-09 16:00:00,161.30880000000002,0.0,778.75837,259.3078591051111 +2017-03-09 17:00:00,360.91876,4.0720920000000005,1111.8836999999999,446.6578252222222 +2017-03-09 18:00:00,717.86495,42.079544000000006,1221.7486999999999,604.6877247777778 +2017-03-09 19:00:00,1091.1595,176.67716,1442.5471,716.9394777777778 +2017-03-09 20:00:00,1138.5552,155.79841,1294.3564999999999,765.1935922222223 +2017-03-09 21:00:00,2888.3709999999996,99.430035,3889.1386,1594.8492883333336 +2017-03-09 22:00:00,426.29053,1.0076445,1052.5485999999999,474.47848711111106 +2017-03-09 23:00:00,8.4003959,0.0,149.97426000000002,41.24740178888889 +2017-03-10 00:00:00,0.072602688,0.0,703.77631,96.10466247644445 +2017-03-10 01:00:00,0.0,0.0,475.25857,79.17424655555556 +2017-03-10 02:00:00,0.0,0.0,249.52929,55.84953755555556 +2017-03-10 03:00:00,10.95245,0.0,180.53433,59.49607055555556 +2017-03-10 04:00:00,23.282619,0.0,162.67836,58.91370464444445 +2017-03-10 05:00:00,41.438459,0.0,157.85340000000002,57.06952588888888 +2017-03-10 06:00:00,21.121718,0.0,134.21504000000002,45.15564707777778 +2017-03-10 07:00:00,13.663393,0.0,114.35723,40.74975341111111 +2017-03-10 08:00:00,11.149523,0.0,121.06737,41.95004214444444 +2017-03-10 09:00:00,16.025546,0.0,110.05664,39.110248355555555 +2017-03-10 10:00:00,4.0754658,0.79027996,12.046261999999999,4.67765284 +2017-03-10 11:00:00,2.3318667,0.6959971899999999,2.3318667,1.5039251177777775 +2017-03-10 12:00:00,0.077636507,0.017444941,0.11445221,0.05503278633333333 +2017-03-10 13:00:00,4.251301600000001,0.49832568000000005,4.683176,2.5554384199999998 +2017-03-10 14:00:00,14.38171,2.2285858,15.880167,9.340709777777777 +2017-03-10 15:00:00,70.561102,6.8295535,71.776165,37.63467027777777 +2017-03-10 16:00:00,862.26716,108.02272,1040.3473,587.453351111111 +2017-03-10 17:00:00,757.37416,44.749115,1361.4841000000001,618.8426527777779 +2017-03-10 18:00:00,895.71055,79.304016,1278.5393000000001,653.0096395555556 +2017-03-10 19:00:00,1014.0699999999999,150.99488,1101.5777999999998,674.4651666666666 +2017-03-10 20:00:00,2266.0261,233.05303,2266.0261,1204.3509211111113 +2017-03-10 21:00:00,3175.3141,62.153696,4272.3059,1637.1443762222223 +2017-03-10 22:00:00,2068.632,0.9778239000000001,3927.4343000000003,1643.177106622222 +2017-03-10 23:00:00,1428.4641,0.0,3744.0516000000002,1663.785329066667 +2017-03-11 00:00:00,4316.9130000000005,0.0,7590.4964,2298.9421014444442 +2017-03-11 01:00:00,968.75016,16.108503000000002,1102.2685999999999,440.2759977777778 +2017-03-11 02:00:00,31.693296,0.62841326,45.979505,18.342469951111113 +2017-03-11 03:00:00,5.9640856,0.085225686,10.898897,4.877439405111111 +2017-03-11 04:00:00,4.0011241,0.31871591000000005,5.640255000000001,2.9828414744444447 +2017-03-11 05:00:00,2.7489315999999997,0.36628433,3.2569762,1.9825857633333333 +2017-03-11 06:00:00,1.9697477,0.035482801999999994,121.81318,27.610519588333336 +2017-03-11 07:00:00,0.058355226,0.0,115.96641,23.275238713999997 +2017-03-11 08:00:00,0.0,0.0,95.141419,16.152283122222222 +2017-03-11 09:00:00,0.0,0.0,98.305551,18.287223977777778 +2017-03-11 10:00:00,0.0,0.0,99.958626,20.393806355555554 +2017-03-11 11:00:00,0.0,0.0,96.613461,22.43909411111111 +2017-03-11 12:00:00,0.53446388,0.0,5.2961768,1.8408274833333331 +2017-03-11 13:00:00,2.7618441,0.13576128,5.3861868,2.0019189522222223 +2017-03-11 14:00:00,29.52238,1.1451862,54.14019,27.0484701 +2017-03-11 15:00:00,221.3602,5.5942924000000005,368.36523,185.75141904444445 +2017-03-11 16:00:00,992.72176,156.22625000000002,1320.6261,650.6918633333333 +2017-03-11 17:00:00,1203.7206999999999,258.85087000000004,1333.5753,771.0031422222222 +2017-03-11 18:00:00,793.61442,260.57867,910.1864999999999,554.1201444444445 +2017-03-11 19:00:00,719.54151,181.57926,902.03574,526.2850099999999 +2017-03-11 20:00:00,891.2072499999999,109.04726000000001,1325.3220000000001,680.0239822222223 +2017-03-11 21:00:00,1624.0576999999998,81.111997,2555.6854,1110.2746929999998 +2017-03-11 22:00:00,1408.9616,122.20585,2122.9475,962.3090266666667 +2017-03-11 23:00:00,3673.4319,94.733339,4683.8508,1815.8907754444444 +2017-03-12 00:00:00,6352.6151,21.380956,7031.1013,2378.028807666667 +2017-03-12 01:00:00,1023.1540999999999,0.0,1467.6271,511.1456645555555 +2017-03-12 02:00:00,117.836,0.0,388.71082,121.39538644444444 +2017-03-12 03:00:00,53.704693999999996,0.0,272.22413,86.85070788888889 +2017-03-12 04:00:00,24.866327,0.0,195.23072000000002,69.12156135555557 +2017-03-12 05:00:00,16.042917,0.0,175.95736,58.78977307777778 +2017-03-12 06:00:00,11.427227,0.0,150.53499,49.10016977777778 +2017-03-12 07:00:00,12.401316999999999,0.0,131.64785999999998,44.16868233333334 +2017-03-12 08:00:00,13.436663,0.0,116.56384999999999,40.354205300000004 +2017-03-12 09:00:00,18.411412000000002,0.0,109.03805,39.75324750000001 +2017-03-12 10:00:00,25.536749999999998,0.0,114.55343,39.44215925555555 +2017-03-12 11:00:00,38.137139,0.0,111.86623,39.06800139497778 +2017-03-12 12:00:00,4.4976091,0.09618320000000001,7.7281411,3.0690680155555556 +2017-03-12 13:00:00,0.0,0.0,0.0,0.0 +2017-03-12 14:00:00,0.0,0.0,0.0,0.0 +2017-03-12 15:00:00,124.39897,13.088955,150.67158,92.28324677777778 +2017-03-12 16:00:00,454.33894000000004,45.176032000000006,845.87565,414.20129911111115 +2017-03-12 17:00:00,443.22072000000003,32.044067,972.9843,453.946939 +2017-03-12 18:00:00,202.76019,11.926340000000001,598.74414,254.5066383333334 +2017-03-12 19:00:00,83.4538,0.7454888199999999,307.86425,129.00586201333334 +2017-03-12 20:00:00,6.145955000000001,0.0,180.36121,55.075298610000004 +2017-03-12 21:00:00,26.629880999999997,0.0,526.72793,159.00077144444447 +2017-03-12 22:00:00,173.25078000000002,0.0,1113.0058000000001,416.54260733333336 +2017-03-12 23:00:00,184.52875,0.0,3487.2713,1125.5594104155555 +2017-03-13 00:00:00,5191.9682999999995,0.0,7747.7348999999995,3149.608914444444 +2017-03-13 01:00:00,4397.585499999999,0.0,6747.6230000000005,2478.486886666667 +2017-03-13 02:00:00,1352.8459,0.0,1827.7888,589.7448083333334 +2017-03-13 03:00:00,203.61929,0.0,378.22989,152.08322092222224 +2017-03-13 04:00:00,35.747191,0.0,286.97669,97.07803592666667 +2017-03-13 05:00:00,3.4825509,0.0,294.18305999999995,72.3083466811111 +2017-03-13 06:00:00,27.578239,0.0,171.24349,60.18661396666667 +2017-03-13 07:00:00,72.523566,0.0,108.90053,42.81503693888889 +2017-03-13 08:00:00,89.37376,0.019482407,101.05628,37.130623845222225 +2017-03-13 09:00:00,85.105297,0.9715705600000001,87.92739399999999,34.955378428888885 +2017-03-13 10:00:00,77.985707,0.76892667,77.985707,31.08527881888889 +2017-03-13 11:00:00,72.360934,1.1032514,72.360934,28.478511877777773 +2017-03-13 12:00:00,4.515588,0.12226226,4.515588,1.963662818888889 +2017-03-13 13:00:00,0.0,0.0,0.0,0.0 +2017-03-13 14:00:00,0.0,0.0,0.0,0.0 +2017-03-13 15:00:00,162.96377999999999,36.393158,192.09171,128.98570377777776 +2017-03-13 16:00:00,427.04842,178.51301999999998,556.2469,342.6744644444445 +2017-03-13 17:00:00,760.14962,159.67761,978.68755,585.5604288888889 +2017-03-13 18:00:00,297.11874,30.318206,716.35604,312.1828213333333 +2017-03-13 19:00:00,90.36636,1.4678266,325.00381,133.8467945111111 +2017-03-13 20:00:00,4.0577102,0.0,119.75923,33.13419815888889 +2017-03-13 21:00:00,60.681177,0.0,1055.7096,351.27615744444444 +2017-03-13 22:00:00,1213.1777,0.0,2983.4632,1270.5316225555557 +2017-03-13 23:00:00,4029.4909999999995,107.04171000000001,4029.4909999999995,1834.4480411111113 +2017-03-14 00:00:00,3750.0507,2.6029581,9199.857699999999,3167.978892344445 +2017-03-14 01:00:00,9072.7946,0.0,9072.7946,3266.580413333334 +2017-03-14 02:00:00,3056.0365,0.0,3056.0365,1065.9817114444443 +2017-03-14 03:00:00,680.27707,0.0,736.97272,241.2777941111111 +2017-03-14 04:00:00,311.521,0.0,367.42509,122.72350160000002 +2017-03-14 05:00:00,296.10062,0.0,390.01979,110.22239893333334 +2017-03-14 06:00:00,174.26698,0.0,174.26698,62.97154300999999 +2017-03-14 07:00:00,63.660802000000004,0.0,144.14947,49.301447441111115 +2017-03-14 08:00:00,22.132373,0.0,117.59889,38.52306367777778 +2017-03-14 09:00:00,20.958734,0.0,96.354459,31.583302855555555 +2017-03-14 10:00:00,16.896252,0.0,82.83225200000001,27.493809133333336 +2017-03-14 11:00:00,12.927326,0.0,72.94171499999999,25.052510066666667 +2017-03-14 12:00:00,1.1217278,0.0,5.5458172,1.85767286 +2017-03-14 13:00:00,0.0,0.0,0.0,0.0 +2017-03-14 14:00:00,0.0,0.0,0.0,0.0 +2017-03-14 15:00:00,149.16527,40.451385,179.38419,125.04640700000002 +2017-03-14 16:00:00,383.39596,132.54253,516.78153,313.7415188888889 +2017-03-14 17:00:00,458.29159000000004,212.70665000000002,561.74345,372.9892233333333 +2017-03-14 18:00:00,363.88806999999997,85.57768899999999,643.4569399999999,331.2001143333334 +2017-03-14 19:00:00,182.28637,53.473173,247.88975,160.3974618888889 +2017-03-14 20:00:00,55.046654,4.785726599999999,208.87253,89.33493505555556 +2017-03-14 21:00:00,56.247372000000006,0.0,714.58879,228.0793606777778 +2017-03-14 22:00:00,231.20626000000001,0.0,1287.2067,490.39170899999993 +2017-03-14 23:00:00,96.49991999999999,0.0,3151.4219,911.7435258999999 +2017-03-15 00:00:00,0.28815109,0.0,295.75962,59.99744566555556 +2017-03-15 01:00:00,438.44268999999997,0.0,1421.8208,580.8056955555554 +2017-03-15 02:00:00,997.9765199999999,23.112705000000002,1865.2630000000001,642.0581305555555 +2017-03-15 03:00:00,510.65691999999996,0.0,1953.1394000000003,594.8068122222222 +2017-03-15 04:00:00,155.50287,0.0,1636.8371,517.7531484444445 +2017-03-15 05:00:00,24.911144999999998,0.0,1469.4961,411.9128766833334 +2017-03-15 06:00:00,0.0,0.0,691.34129,92.50395891111111 +2017-03-15 07:00:00,0.0,0.0,14.779594,1.688176271111111 +2017-03-15 08:00:00,0.0,0.0,0.0,0.0 +2017-03-15 09:00:00,0.0,0.0,0.0,0.0 +2017-03-15 10:00:00,0.0,0.0,0.0,0.0 +2017-03-15 11:00:00,0.0,0.0,0.0,0.0 +2017-03-15 12:00:00,0.0,0.0,0.055571952,0.006174661333333334 +2017-03-15 13:00:00,0.0,0.0,0.0,0.0 +2017-03-15 14:00:00,1.1843297,0.0,20.440302,4.778426252222222 +2017-03-15 15:00:00,25.797453,0.0,643.6713199999999,134.87028275124442 +2017-03-15 16:00:00,205.7336,8.2389643,771.6387,277.5271477 +2017-03-15 17:00:00,548.7703600000001,29.216622,994.97417,525.5147434444444 +2017-03-15 18:00:00,661.8700600000001,42.673983,1114.853,584.8646414444445 +2017-03-15 19:00:00,762.86937,63.358901,1216.1667,626.8181945555556 +2017-03-15 20:00:00,1456.8483,59.3041,2545.0131,1075.231988888889 +2017-03-15 21:00:00,2315.4784,5.9708395,3940.6852000000003,1694.5635225 +2017-03-15 22:00:00,2487.7968,0.0,4138.155400000001,1775.1365025555558 +2017-03-15 23:00:00,764.5021,3.0072629,1593.2784,739.4231132111112 +2017-03-16 00:00:00,418.05932,0.0,1100.0254,387.23673444444444 +2017-03-16 01:00:00,62.103542999999995,0.0,421.20268000000004,133.07117011111112 +2017-03-16 02:00:00,13.474692,0.0,203.49899000000002,64.83223361333333 +2017-03-16 03:00:00,0.5005557,0.0,189.29163,48.1960253 +2017-03-16 04:00:00,0.023843164,0.0,202.90466,34.13677498488889 +2017-03-16 05:00:00,0.0,0.0,155.55197,20.836361273333335 +2017-03-16 06:00:00,0.0,0.0,38.839815,4.4337216 +2017-03-16 07:00:00,0.0,0.0,4.853684899999999,0.5392983222222222 +2017-03-16 08:00:00,0.0,0.0,0.09102898,0.01011433111111111 +2017-03-16 09:00:00,0.0,0.0,0.0,0.0 +2017-03-16 10:00:00,0.0,0.0,0.0,0.0 +2017-03-16 11:00:00,0.0,0.0,0.0,0.0 +2017-03-16 12:00:00,0.0,0.0,0.6354057999999999,0.11788597088888889 +2017-03-16 13:00:00,0.0,0.0,1.0503592,0.14257553507222223 +2017-03-16 14:00:00,0.0,0.0,6.7676397,0.9834909867777779 +2017-03-16 15:00:00,0.0,0.0,41.33835,6.337779566666667 +2017-03-16 16:00:00,30.527935,0.0,627.6794000000001,134.22222452222223 +2017-03-16 17:00:00,121.20952,0.0,1148.0577999999998,296.5702108888888 +2017-03-16 18:00:00,94.818344,0.0,1167.5729000000001,279.19382366666673 +2017-03-16 19:00:00,63.709863999999996,0.0,1082.6905,239.11979099999996 +2017-03-16 20:00:00,2.4968947,0.0,1806.7429,295.3204779988889 +2017-03-16 21:00:00,0.0,0.0,1038.7598,137.42162976666665 +2017-03-16 22:00:00,0.0,0.0,119.98514999999999,14.36490923333333 +2017-03-16 23:00:00,0.0,0.0,1.4884497,0.1653833 +2017-03-17 00:00:00,0.0,0.0,0.0,0.0 +2017-03-17 01:00:00,0.0,0.0,0.0,0.0 +2017-03-17 02:00:00,0.0,0.0,0.0,0.0 +2017-03-17 03:00:00,0.0,0.0,0.0,0.0 +2017-03-17 04:00:00,0.0,0.0,0.0,0.0 +2017-03-17 05:00:00,0.0,0.0,0.0,0.0 +2017-03-17 06:00:00,0.0,0.0,0.0,0.0 +2017-03-17 07:00:00,0.0,0.0,0.0,0.0 +2017-03-17 08:00:00,0.0,0.0,0.0,0.0 +2017-03-17 09:00:00,0.0,0.0,0.0,0.0 +2017-03-17 10:00:00,0.0,0.0,0.0,0.0 +2017-03-17 11:00:00,0.0,0.0,0.0,0.0 +2017-03-17 12:00:00,0.25633392,0.0,2.4877705999999997,0.7674868665744444 +2017-03-17 13:00:00,0.018951159,0.0,2.4410592,0.42401133211111114 +2017-03-17 14:00:00,0.0,0.0,5.1760530000000005,0.7651790325555556 +2017-03-17 15:00:00,0.0036906924000000003,0.0,60.423819,10.168692454711111 +2017-03-17 16:00:00,324.34272,8.3402356,864.60554,371.6425338444444 +2017-03-17 17:00:00,844.93152,138.47760000000002,1130.6183,557.6863055555555 +2017-03-17 18:00:00,741.21123,67.26039300000001,1143.6366,549.4987647777778 +2017-03-17 19:00:00,514.11486,23.029277,942.54455,493.5188611111111 +2017-03-17 20:00:00,219.34042,0.31982995000000003,3815.2873000000004,1017.7451418166667 +2017-03-17 21:00:00,5.4860561,0.0,2691.2254,426.5608449 +2017-03-17 22:00:00,0.0,0.0,428.11956000000004,51.822133 +2017-03-17 23:00:00,0.0,0.0,8.3266059,0.9251784333333334 +2017-03-18 00:00:00,0.0,0.0,0.0,0.0 +2017-03-18 01:00:00,0.0,0.0,0.0,0.0 +2017-03-18 02:00:00,0.0,0.0,0.0,0.0 +2017-03-18 03:00:00,0.0,0.0,0.0,0.0 +2017-03-18 04:00:00,0.0,0.0,0.0,0.0 +2017-03-18 05:00:00,0.0,0.0,0.0,0.0 +2017-03-18 06:00:00,0.0,0.0,0.0,0.0 +2017-03-18 07:00:00,0.0,0.0,0.0,0.0 +2017-03-18 08:00:00,0.0,0.0,0.0,0.0 +2017-03-18 09:00:00,0.0,0.0,0.0,0.0 +2017-03-18 10:00:00,0.0,0.0,0.0,0.0 +2017-03-18 11:00:00,0.0,0.0,0.0,0.0 +2017-03-18 12:00:00,0.17896984,0.0,2.6013469999999996,0.6848735612222222 +2017-03-18 13:00:00,0.017253138,0.0,4.5031734,0.7758558958666666 +2017-03-18 14:00:00,0.0045036814,0.0,34.388238,5.664074875711112 +2017-03-18 15:00:00,0.029519764,0.0,1071.5214999999998,181.9909423071111 +2017-03-18 16:00:00,142.29411,0.0,1166.1645,315.0464162222222 +2017-03-18 17:00:00,358.71967,0.0,1229.9832000000001,468.78867944444454 +2017-03-18 18:00:00,562.8899700000001,21.298845,1117.3254000000002,563.4289366666667 +2017-03-18 19:00:00,814.66837,55.744214,1343.7221,654.5519760000001 +2017-03-18 20:00:00,2232.1292,84.10992499999999,3049.5063,1364.6665327777778 +2017-03-18 21:00:00,2557.0069,9.9230247,4392.9778,1749.082400411111 +2017-03-18 22:00:00,2099.7101,0.0,4135.2645,1776.2652760111112 +2017-03-18 23:00:00,1503.5407,0.0,3641.2241999999997,1638.4280842222224 +2017-03-19 00:00:00,29.290150999999998,0.0,597.62568,135.46629444444443 +2017-03-19 01:00:00,0.0,0.0,6.7308797,0.7478755222222222 +2017-03-19 02:00:00,0.0,0.0,0.0,0.0 +2017-03-19 03:00:00,0.0,0.0,0.0,0.0 +2017-03-19 04:00:00,0.0,0.0,0.0,0.0 +2017-03-19 05:00:00,0.0,0.0,0.0,0.0 +2017-03-19 06:00:00,0.0,0.0,0.0,0.0 +2017-03-19 07:00:00,0.0,0.0,0.0,0.0 +2017-03-19 08:00:00,0.0,0.0,0.0,0.0 +2017-03-19 09:00:00,0.0,0.0,0.0,0.0 +2017-03-19 10:00:00,0.0,0.0,0.0,0.0 +2017-03-19 11:00:00,0.0,0.0,0.0,0.0 +2017-03-19 12:00:00,0.0,0.0,0.08320052600000001,0.00924450288888889 +2017-03-19 13:00:00,0.0,0.0,1.5937107,0.21497978666666664 +2017-03-19 14:00:00,0.0,0.0,21.618247,3.1091449840111114 +2017-03-19 15:00:00,0.0,0.0,293.89383,44.66828076666666 +2017-03-19 16:00:00,107.47272,0.0,1101.8058,276.7457978888889 +2017-03-19 17:00:00,363.6757,0.0,1229.0266,471.6982641111111 +2017-03-19 18:00:00,415.88646,0.5631836800000001,1249.8888,508.17797107555555 +2017-03-19 19:00:00,452.57178,6.5863137,1281.44,536.2447053000001 +2017-03-19 20:00:00,681.1057099999999,0.055289238000000004,2602.2024,1066.3358188375557 +2017-03-19 21:00:00,163.48917,0.0,4412.5323,1061.673807757778 +2017-03-19 22:00:00,6.411987699999999,0.0,3316.5887,580.6345908555554 +2017-03-19 23:00:00,0.0,0.0,360.92251,56.221704244444446 +2017-03-20 00:00:00,0.0,0.0,3.0837884,0.40449352033333336 +2017-03-20 01:00:00,0.0,0.0,0.0,0.0 +2017-03-20 02:00:00,0.0,0.0,0.0,0.0 +2017-03-20 03:00:00,0.0,0.0,0.0,0.0 +2017-03-20 04:00:00,0.0,0.0,0.0,0.0 +2017-03-20 05:00:00,0.0,0.0,0.0,0.0 +2017-03-20 06:00:00,0.0,0.0,0.0,0.0 +2017-03-20 07:00:00,0.0,0.0,0.0,0.0 +2017-03-20 08:00:00,0.0,0.0,0.0,0.0 +2017-03-20 09:00:00,0.0,0.0,0.0,0.0 +2017-03-20 10:00:00,0.0,0.0,0.0,0.0 +2017-03-20 11:00:00,0.0,0.0,0.0,0.0 +2017-03-20 12:00:00,0.0,0.0,0.0,0.0 +2017-03-20 13:00:00,0.0,0.0,0.11736139999999999,0.013312497435555555 +2017-03-20 14:00:00,0.0,0.0,3.2492601,0.3614178033555555 +2017-03-20 15:00:00,0.0,0.0,53.543525,8.268177011111112 +2017-03-20 16:00:00,97.81939299999999,0.0,551.4542,170.1933867777778 +2017-03-20 17:00:00,664.9053,59.060698,1067.1401,542.2509308888889 +2017-03-20 18:00:00,586.77705,24.372421000000003,1154.0124,584.0739454444443 +2017-03-20 19:00:00,370.88164,1.1005448,1336.3367,497.14307408888885 +2017-03-20 20:00:00,165.59300000000002,0.0,2843.2566,700.0045207666667 +2017-03-20 21:00:00,10.163141,0.0,3156.906,516.4893849677778 +2017-03-20 22:00:00,0.0,0.0,1611.1424,217.4984913111111 +2017-03-20 23:00:00,0.0,0.0,464.57082,53.34282488888889 +2017-03-21 00:00:00,0.0,0.0,273.95464999999996,36.19599061111111 +2017-03-21 01:00:00,0.0,0.0,18.551515000000002,2.0612794444444447 +2017-03-21 02:00:00,0.0,0.0,5.0230447,0.5581160777777777 +2017-03-21 03:00:00,0.0,0.0,3.1606107000000003,0.3511789666666667 +2017-03-21 04:00:00,0.0,0.0,3.4557706,0.38397451111111114 +2017-03-21 05:00:00,0.0,0.0,2.0724185,0.23026872222222222 +2017-03-21 06:00:00,0.0,0.0,0.022347066,0.0024830073333333333 +2017-03-21 07:00:00,0.0,0.0,0.0,0.0 +2017-03-21 08:00:00,0.0,0.0,0.0,0.0 +2017-03-21 09:00:00,0.0,0.0,0.0,0.0 +2017-03-21 10:00:00,0.0,0.0,1.6373185,0.18192427777777775 +2017-03-21 11:00:00,0.0,0.0,16.735419,1.9843404333333332 +2017-03-21 12:00:00,0.0,0.0,2.5469481000000003,0.41671841377777785 +2017-03-21 13:00:00,0.0,0.0,0.0,0.0 +2017-03-21 14:00:00,0.0,0.0,0.0,0.0 +2017-03-21 15:00:00,44.656848000000004,11.825319,59.825568,36.87870266666667 +2017-03-21 16:00:00,374.72366,103.90736000000001,529.33872,293.2461611111111 +2017-03-21 17:00:00,694.57543,268.99096,781.88523,496.3723733333333 +2017-03-21 18:00:00,744.54967,224.67198000000002,784.1098099999999,537.8372355555555 +2017-03-21 19:00:00,722.85498,169.09062,861.0683700000001,539.6122922222222 +2017-03-21 20:00:00,1031.8477,80.927995,1604.8955,787.1101405555556 +2017-03-21 21:00:00,1842.5897,3.6192705,3065.9689,1431.0761278333332 +2017-03-21 22:00:00,1685.4426,0.0,3260.9004999999997,1458.9160903333332 +2017-03-21 23:00:00,547.46337,0.0,4709.7141,1673.6389342111115 +2017-03-22 00:00:00,517.18205,287.10981,1233.9560000000001,656.8297844444445 +2017-03-22 01:00:00,59.12959,0.0,857.23418,269.70974273333337 +2017-03-22 02:00:00,38.900194,0.0,933.30623,271.5029226666667 +2017-03-22 03:00:00,90.90868800000001,0.0,899.56133,302.50522677777775 +2017-03-22 04:00:00,207.16597000000002,0.0,1077.3414,330.10677444444445 +2017-03-22 05:00:00,374.76211,0.0,1083.3319,346.87245388888886 +2017-03-22 06:00:00,77.161174,0.0,657.25564,223.84366366666666 +2017-03-22 07:00:00,2.3454977,0.0,311.80077,88.83100885555557 +2017-03-22 08:00:00,0.0,0.0,99.681318,17.766182311111113 +2017-03-22 09:00:00,0.0,0.0,56.11404,8.06887349 +2017-03-22 10:00:00,0.0,0.0,37.678361,4.920906559 +2017-03-22 11:00:00,0.0,0.0,23.744577,2.9428417000000002 +2017-03-22 12:00:00,0.0,0.0,2.2201218,0.3508515692222222 +2017-03-22 13:00:00,0.0,0.0,0.0,0.0 +2017-03-22 14:00:00,0.0,0.0,0.0,0.0 +2017-03-22 15:00:00,50.831321,15.376902000000001,63.67015899999999,40.69984988888889 +2017-03-22 16:00:00,357.73555,136.63470999999998,423.43285000000003,280.89459222222223 +2017-03-22 17:00:00,363.31423,28.205375,849.1651400000001,391.3750151111111 +2017-03-22 18:00:00,301.27884,31.962626999999998,701.86704,308.8612492222222 +2017-03-22 19:00:00,307.86649,37.649111999999995,686.87822,313.50699533333335 +2017-03-22 20:00:00,406.06622,27.680895,908.48526,424.5404834444444 +2017-03-22 21:00:00,693.8134299999999,2.0158083999999996,2116.8911000000003,910.4450688222223 +2017-03-22 22:00:00,933.62335,0.0,3152.2706000000003,1254.7376468222221 +2017-03-22 23:00:00,364.65675999999996,0.0,4363.4982,1534.8878185444444 +2017-03-23 00:00:00,565.6105299999999,0.0,1068.0113000000001,542.7010500000001 +2017-03-23 01:00:00,916.1524900000001,0.0,1274.1002,405.5337665888889 +2017-03-23 02:00:00,722.7571899999999,0.0,1170.9081,386.54695777777783 +2017-03-23 03:00:00,1123.4229,0.0,1123.4229,399.0819018555556 +2017-03-23 04:00:00,433.80292000000003,0.0,1119.4948,369.9112355122222 +2017-03-23 05:00:00,29.344306,0.0,863.6484899999999,251.33108617777776 +2017-03-23 06:00:00,0.23474112,0.0,894.35239,167.07068445777776 +2017-03-23 07:00:00,0.0,0.0,663.9568,88.51754011999999 +2017-03-23 08:00:00,0.0,0.0,253.88764,30.145089555555558 +2017-03-23 09:00:00,0.0,0.0,210.33395,25.044479666666664 +2017-03-23 10:00:00,0.0,0.0,129.15053,15.727869333333334 +2017-03-23 11:00:00,0.0,0.0,79.85297999999999,10.438106888888889 +2017-03-23 12:00:00,0.08033837399999999,0.0,6.3943758,1.2772717537777778 +2017-03-23 13:00:00,0.0,0.0,0.0,0.0 +2017-03-23 14:00:00,0.0,0.0,0.0,0.0 +2017-03-23 15:00:00,38.054921,10.530322,51.79676,31.593306666666663 +2017-03-23 16:00:00,387.30170000000004,104.66548999999999,556.0464900000001,304.3755788888889 +2017-03-23 17:00:00,696.77585,213.35459,830.6136,501.5998388888889 +2017-03-23 18:00:00,735.55426,194.8923,822.57588,541.9997377777778 +2017-03-23 19:00:00,409.98895000000005,82.258201,711.79494,357.0260401111111 +2017-03-23 20:00:00,380.52211,4.7108906,1403.9406,553.6785044 +2017-03-23 21:00:00,83.835897,0.0,1882.0897,572.9180622055555 +2017-03-23 22:00:00,1.8020344,0.0,908.6497,212.77853478888886 +2017-03-23 23:00:00,0.0,0.0,37.642027999999996,7.121562344444444 +2017-03-24 00:00:00,82.38109899999999,0.0,3211.9504,1068.8460232222221 +2017-03-24 01:00:00,2319.5944,0.0,3136.4995999999996,1477.4404658888889 +2017-03-24 02:00:00,576.17674,27.790302,576.17674,253.04179466666665 +2017-03-24 03:00:00,44.906214,0.0,381.10404,131.36959367322223 +2017-03-24 04:00:00,0.76030648,0.0,213.40037,42.90295630366667 +2017-03-24 05:00:00,0.0,0.0,80.77408,10.086794506666667 +2017-03-24 06:00:00,0.0,0.0,63.776853,7.118386206666667 +2017-03-24 07:00:00,0.0,0.0,18.512672,2.0569635555555554 +2017-03-24 08:00:00,0.0,0.0,0.54361436,0.06040159555555555 +2017-03-24 09:00:00,0.0,0.0,17.730541000000002,1.9700601111111113 +2017-03-24 10:00:00,0.0,0.0,58.143254,6.802095877777777 +2017-03-24 11:00:00,0.0,0.0,26.691319,3.2954675555555557 +2017-03-24 12:00:00,0.0,0.0,1.6800749,0.2542180497777778 +2017-03-24 13:00:00,0.0,0.0,0.0,0.0 +2017-03-24 14:00:00,0.0,0.0,0.0,0.0 +2017-03-24 15:00:00,0.0,0.0,0.0,0.0 +2017-03-24 16:00:00,238.08514,90.932452,290.64196999999996,198.04508577777776 +2017-03-24 17:00:00,233.80634,24.725282999999997,581.3411,251.09995133333334 +2017-03-24 18:00:00,221.88535,16.45824,615.58309,255.71926544444446 +2017-03-24 19:00:00,177.00632,17.982764000000003,462.83528,201.77294777777777 +2017-03-24 20:00:00,193.98377,0.8572421800000001,700.97874,297.2776075755556 +2017-03-24 21:00:00,121.63251,0.0,908.1547,332.1183737777777 +2017-03-24 22:00:00,80.66073499999999,0.0,804.98529,285.0337656666667 +2017-03-24 23:00:00,2.9247753000000003,0.0,441.92294999999996,103.50655470444444 +2017-03-25 00:00:00,0.0,0.0,320.31134,56.720111555555555 +2017-03-25 01:00:00,15.449883,0.0,669.6360099999999,179.4720218888889 +2017-03-25 02:00:00,53.385858,0.0,306.13210000000004,108.8055968888889 +2017-03-25 03:00:00,87.10878299999999,0.0,556.6047,192.73179477777776 +2017-03-25 04:00:00,104.76402,0.0,799.8051,267.52405244444446 +2017-03-25 05:00:00,102.50824,0.0,933.0054200000001,307.9305635555556 +2017-03-25 06:00:00,666.05804,0.0,958.3009500000001,289.2428468888889 +2017-03-25 07:00:00,640.70302,1.9583645,974.36924,321.5470521888889 +2017-03-25 08:00:00,38.977803,0.0,842.15577,243.01967994444445 +2017-03-25 09:00:00,0.23418988,0.0,605.2837099999999,144.60506809777777 +2017-03-25 10:00:00,0.0,0.0,317.18775,53.572937788888886 +2017-03-25 11:00:00,6.3723737,0.0,76.325297,27.238642655555555 +2017-03-25 12:00:00,1.3109416,0.0,6.5807308,2.2721339577777777 +2017-03-25 13:00:00,0.0,0.0,0.0,0.0 +2017-03-25 14:00:00,0.0,0.0,0.0,0.0 +2017-03-25 15:00:00,0.0,0.0,0.0,0.0 +2017-03-25 16:00:00,187.54402,81.055121,241.44311000000002,164.981099 +2017-03-25 17:00:00,202.45384,25.67847,503.19749,230.83967777777778 +2017-03-25 18:00:00,223.68382,65.617205,321.30026,203.14582277777777 +2017-03-25 19:00:00,230.14771,81.01821000000001,280.03891999999996,196.08911 +2017-03-25 20:00:00,161.56201000000001,17.254837000000002,425.31735,200.9789878888889 +2017-03-25 21:00:00,9.976498399999999,0.05471648,175.08939,45.08049757222222 +2017-03-25 22:00:00,0.0,0.0,7.154717,1.2216068633333332 +2017-03-25 23:00:00,0.0,0.0,0.0,0.0 +2017-03-26 00:00:00,0.0,0.0,0.0,0.0 +2017-03-26 01:00:00,0.0,0.0,0.0,0.0 +2017-03-26 02:00:00,0.0,0.0,0.0,0.0 +2017-03-26 03:00:00,0.0,0.0,0.0,0.0 +2017-03-26 04:00:00,0.0,0.0,49.043842999999995,7.44810111111111 +2017-03-26 05:00:00,0.0,0.0,359.78833,65.36131566666667 +2017-03-26 06:00:00,33.480512,0.0,1049.9129,294.8122624444444 +2017-03-26 07:00:00,567.86358,0.0,920.50608,308.2202496666667 +2017-03-26 08:00:00,789.59612,5.2247615,997.0727800000001,341.9411469444444 +2017-03-26 09:00:00,565.5791,0.0,984.7075,309.31492898444446 +2017-03-26 10:00:00,326.7776,0.0,853.92426,270.8357833333333 +2017-03-26 11:00:00,146.71596,0.0,888.38674,236.70375155555556 +2017-03-26 12:00:00,38.473124999999996,0.4009253,58.346257,22.59789042222222 +2017-03-26 13:00:00,0.0,0.0,0.0,0.0 +2017-03-26 14:00:00,0.0,0.0,0.0,0.0 +2017-03-26 15:00:00,0.0,0.0,0.0,0.0 +2017-03-26 16:00:00,172.19686000000002,42.490654,278.15514,164.59828566666667 +2017-03-26 17:00:00,153.72576,27.018037,284.50644,158.87442466666667 +2017-03-26 18:00:00,187.39032,40.664341,304.79356,180.16617088888887 +2017-03-26 19:00:00,227.78206,64.149855,321.86060000000003,204.86666944444445 +2017-03-26 20:00:00,322.78328,49.946695,651.97743,324.17545711111114 +2017-03-26 21:00:00,35.101868,1.5419355000000001,298.18469,89.6725615 +2017-03-26 22:00:00,0.0,0.0,11.634318,2.0677628555555554 +2017-03-26 23:00:00,0.0,0.0,0.0,0.0 +2017-03-27 00:00:00,0.0017733658,0.0013547759999999998,0.002141596,0.0017801546666666665 +2017-03-27 01:00:00,0.00018783498,0.00014151334,0.00022944717,0.0001891972533333333 +2017-03-27 02:00:00,0.0,0.0,12.008272,1.3342524444444444 +2017-03-27 03:00:00,0.0,0.0,0.19830151,0.02203350111111111 +2017-03-27 04:00:00,0.0,0.0,0.0,0.0 +2017-03-27 05:00:00,0.0,0.0,0.0,0.0 +2017-03-27 06:00:00,0.0,0.0,4.6763134,0.7637696666666667 +2017-03-27 07:00:00,2.9546449999999997,0.0,106.88518,27.402470955555557 +2017-03-27 08:00:00,49.792663,0.0,86.31745699999999,38.47899892222222 +2017-03-27 09:00:00,63.952262,0.0,98.185956,35.65081892222222 +2017-03-27 10:00:00,64.16796500000001,0.0,94.542833,33.94643358888889 +2017-03-27 11:00:00,58.460289,0.0,87.276749,32.95745557222222 +2017-03-27 12:00:00,4.3848863,0.0,7.3709707,3.08904513 +2017-03-27 13:00:00,0.0,0.0,0.0,0.0 +2017-03-27 14:00:00,0.0,0.0,0.0,0.0 +2017-03-27 15:00:00,0.0,0.0,0.0,0.0 +2017-03-27 16:00:00,58.423037,3.5246419,171.87043,75.12154721111112 +2017-03-27 17:00:00,20.3742,0.41556203,130.35796000000002,48.67027293666667 +2017-03-27 18:00:00,16.182168,0.0,101.50005,36.05836918888889 +2017-03-27 19:00:00,16.864869,0.0,90.023044,31.660279077222224 +2017-03-27 20:00:00,3.5782109,0.0,21.006695999999998,6.460653276666666 +2017-03-27 21:00:00,0.0,0.0,0.0,0.0 +2017-03-27 22:00:00,0.0,0.0,0.0,0.0 +2017-03-27 23:00:00,0.0,0.0,0.0,0.0 +2017-03-28 00:00:00,0.0,0.0,0.0,0.0 +2017-03-28 01:00:00,0.0,0.0,0.0,0.0 +2017-03-28 02:00:00,0.0,0.0,0.0,0.0 +2017-03-28 03:00:00,0.0,0.0,0.0,0.0 +2017-03-28 04:00:00,0.0,0.0,0.0,0.0 +2017-03-28 05:00:00,0.0,0.0,0.0,0.0 +2017-03-28 06:00:00,0.0,0.0,0.0,0.0 +2017-03-28 07:00:00,0.0,0.0,0.0,0.0 +2017-03-28 08:00:00,0.0,0.0,0.0,0.0 +2017-03-28 09:00:00,0.0,0.0,0.0,0.0 +2017-03-28 10:00:00,0.0,0.0,5.552833,1.0871953444444444 +2017-03-28 11:00:00,0.0,0.0,23.865752,5.033290655555556 +2017-03-28 12:00:00,0.0,0.0,3.7290124,0.7560485366666667 +2017-03-28 13:00:00,0.0,0.0,0.0,0.0 +2017-03-28 14:00:00,0.0,0.0,0.0,0.0 +2017-03-28 15:00:00,0.0,0.0,0.0,0.0 +2017-03-28 16:00:00,37.675298000000005,0.0,149.25633,62.987896166666665 +2017-03-28 17:00:00,49.895098,0.0,208.13513,81.86357828888889 +2017-03-28 18:00:00,209.01814000000002,47.475842,374.85634999999996,219.38126377777778 +2017-03-28 19:00:00,440.34378000000004,328.86234,539.21778,408.8533444444445 +2017-03-28 20:00:00,885.66507,293.12077000000005,1130.0709,735.6762111111111 +2017-03-28 21:00:00,279.93746000000004,92.99368700000001,400.4513,272.3010296666667 +2017-03-28 22:00:00,15.411822,9.9239387,26.574427,17.040076522222225 +2017-03-28 23:00:00,1.6940717,1.3365764999999998,2.1291507000000003,1.714265288888889 +2017-03-29 00:00:00,0.39278771,0.3384568,0.45348682,0.3939215166666667 +2017-03-29 01:00:00,0.043446532999999996,0.036868634,0.050681987000000005,0.04366024877777778 +2017-03-29 02:00:00,0.0007048313,0.00032741435,0.0013154974,0.0007669054566666667 +2017-03-29 03:00:00,0.0,0.0,0.0,0.0 +2017-03-29 04:00:00,0.0,0.0,0.0,0.0 +2017-03-29 05:00:00,0.0,0.0,0.0,0.0 +2017-03-29 06:00:00,0.0,0.0,0.0,0.0 +2017-03-29 07:00:00,0.0,0.0,0.0,0.0 +2017-03-29 08:00:00,0.0,0.0,0.0,0.0 +2017-03-29 09:00:00,0.0,0.0,0.0,0.0 +2017-03-29 10:00:00,0.0,0.0,0.0,0.0 +2017-03-29 11:00:00,0.0,0.0,0.0,0.0 +2017-03-29 12:00:00,0.0,0.0,0.0,0.0 +2017-03-29 13:00:00,0.0,0.0,0.0,0.0 +2017-03-29 14:00:00,0.0,0.0,0.0,0.0 +2017-03-29 15:00:00,0.0,0.0,0.0,0.0 +2017-03-29 16:00:00,0.0,0.0,15.119551,4.967880555555555 +2017-03-29 17:00:00,0.0,0.0,8.7386015,2.6896551 +2017-03-29 18:00:00,0.0,0.0,13.599618999999999,4.3970503333333335 +2017-03-29 19:00:00,0.0,0.0,15.987709,5.098268333333333 +2017-03-29 20:00:00,0.36165181,0.25328322,16.453847,4.195502661111111 +2017-03-29 21:00:00,0.0,0.0,0.0,0.0 +2017-03-29 22:00:00,0.006739,0.0034134714999999997,0.059774179999999996,0.012016493377777777 +2017-03-29 23:00:00,0.0023638866,0.0020489757,0.0045672799,0.0025747915666666666 +2017-03-30 00:00:00,0.0,0.0,0.0,0.0 +2017-03-30 01:00:00,0.0,0.0,0.0,0.0 +2017-03-30 02:00:00,0.0,0.0,0.0,0.0 +2017-03-30 03:00:00,0.0,0.0,0.0,0.0 +2017-03-30 04:00:00,0.0,0.0,0.0,0.0 +2017-03-30 05:00:00,0.0,0.0,0.0,0.0 +2017-03-30 06:00:00,0.0,0.0,0.0,0.0 +2017-03-30 07:00:00,0.0,0.0,0.0,0.0 +2017-03-30 08:00:00,0.0,0.0,0.0,0.0 +2017-03-30 09:00:00,0.0,0.0,0.0,0.0 +2017-03-30 10:00:00,0.0,0.0,0.0,0.0 +2017-03-30 11:00:00,0.0,0.0,0.0,0.0 +2017-03-30 12:00:00,0.0,0.0,0.0,0.0 +2017-03-30 13:00:00,0.0,0.0,0.0,0.0 +2017-03-30 14:00:00,0.43629242,0.36252553,0.55207624,0.45048985444444445 +2017-03-30 15:00:00,2.4797618999999997,2.280507,2.7310762,2.4958115666666667 +2017-03-30 16:00:00,4.076882299999999,3.7695675,20.338455,9.416062555555554 +2017-03-30 17:00:00,7.2970624,6.7541555,10.739296,8.169769811111113 +2017-03-30 18:00:00,7.7017648,7.3709298,8.049883000000001,7.713462155555557 +2017-03-30 19:00:00,8.0430946,7.3877486,8.672293000000002,8.039263577777778 +2017-03-30 20:00:00,3.5631966999999998,2.6966929,4.5393449,3.5796467 +2017-03-30 21:00:00,1.3237128999999999,1.0031338,1.7101499,1.3315734333333333 +2017-03-30 22:00:00,3.1090250999999998,0.69107017,52.486095,10.482892281111113 +2017-03-30 23:00:00,56.674015999999995,20.534491,232.54662,81.77451688888888 +2017-03-31 00:00:00,0.0,0.0,0.0,0.0 +2017-03-31 01:00:00,0.0,0.0,0.0,0.0 +2017-03-31 02:00:00,0.0,0.0,0.0,0.0 +2017-03-31 03:00:00,0.0,0.0,0.0,0.0 +2017-03-31 04:00:00,0.0,0.0,0.0,0.0 +2017-03-31 05:00:00,0.0,0.0,0.0,0.0 +2017-03-31 06:00:00,0.0,0.0,0.0,0.0 +2017-03-31 07:00:00,0.0,0.0,0.0,0.0 +2017-03-31 08:00:00,0.0,0.0,0.0,0.0 +2017-03-31 09:00:00,0.0,0.0,0.0,0.0 +2017-03-31 10:00:00,0.0,0.0,0.0,0.0 +2017-03-31 11:00:00,0.0,0.0,0.0,0.0 +2017-03-31 12:00:00,66259.96500000001,1650.1659,148706.8,66671.88765555556 +2017-03-31 13:00:00,29496.813000000002,1700.9478,46804.085,27368.965522222225 +2017-03-31 14:00:00,2389.4249,1990.1183,2814.1052,2389.729522222222 +2017-03-31 15:00:00,1391.7522000000001,1274.1918,1550.6343000000002,1396.2309777777778 +2017-03-31 16:00:00,367.35524,326.65758,408.71074,366.85955111111105 +2017-03-31 17:00:00,29.351546000000003,23.989456,35.496611,29.454501555555552 +2017-03-31 18:00:00,2.9988673,2.360176,3.7104792,3.0022172555555553 +2017-03-31 19:00:00,0.0,0.0,0.0,0.0 +2017-03-31 20:00:00,0.0,0.0,0.0,0.0 +2017-03-31 21:00:00,0.0,0.0,0.0,0.0 +2017-03-31 22:00:00,0.0,0.0,0.0,0.0 +2017-03-31 23:00:00,0.0,0.0,0.0,0.0 diff --git a/Analysis/TimeSeries_Data/ElPanama/ElPanamaTimeseries_obs_model_raw_processed.csv b/Analysis/TimeSeries_Data/ElPanama/ElPanamaTimeseries_obs_model_raw_processed.csv new file mode 100644 index 0000000..0ae7432 --- /dev/null +++ b/Analysis/TimeSeries_Data/ElPanama/ElPanamaTimeseries_obs_model_raw_processed.csv @@ -0,0 +1,745 @@ +TimeBeginning,ElPanama_raw,ElPanama_KNN,ECMWF_raw,ECMWF_min,ECMWF_max,ECMWF_area,NAM_raw,NAM_min,NAM_max,NAM_area +2017-03-01 00:00:00,142.637,142.637,22.639317,1.1411947,24.019875,11.097967422222222,0.0,0.0,0.0,0.0 +2017-03-01 01:00:00,39.266329999999996,39.266329999999996,9.5027053,0.67321588,10.258064000000001,5.201220931111111,0.0,0.0,0.0,0.0 +2017-03-01 02:00:00,32.56289,32.56289,113.23309,3.8086093,113.23309,50.68752143333334,0.0,0.0,0.0,0.0 +2017-03-01 03:00:00,104.96672,104.96672,93.659692,1.9353063,117.42068,50.96573785555556,0.0,0.0,0.0,0.0 +2017-03-01 04:00:00,114.76111999999999,114.76111999999999,60.950464,0.020210397,155.82635000000002,52.207584821888894,0.0,0.0,0.0,0.0 +2017-03-01 05:00:00,27.92645,27.92645,5.0514413,1.9072141,10.018025,4.775192844444444,42.763411,0.0,62.77742799999999,26.275081914444442 +2017-03-01 06:00:00,32.49134,32.49134,1.9187496,0.28215038000000003,2.204049,1.4583446377777778,1.7326948,0.053269019,2.4255755000000003,1.355687972111111 +2017-03-01 07:00:00,21.42812,21.42812,2.0239643000000003,0.3407396,2.2076349,1.4705829522222222,0.0,0.0,0.0,0.0 +2017-03-01 08:00:00,44.36228,44.36228,18.460225,0.10143767000000001,109.75036999999999,34.383212987777775,0.0,0.0,0.0,0.0 +2017-03-01 09:00:00,73.28756,73.28756,40.776569,0.0,141.27340999999998,42.98224727777777,0.0,0.0,0.0,0.0 +2017-03-01 10:00:00,27.867620000000002,27.867620000000002,6.1883316,1.9053599,11.288358,4.863381477777779,0.0,0.0,0.0,0.0 +2017-03-01 11:00:00,8.84645,8.84645,1.8905824,0.1857001,2.5358095,1.539513888888889,0.0,0.0,62.577281,7.879326822222222 +2017-03-01 12:00:00,,51.04109643498767,0.078202532,0.0070751804000000005,0.10861176,0.060731479377777786,4.480491499999999,2.4705487,9.1179618,5.096166933333333 +2017-03-01 13:00:00,,56.45847493777853,7.4276491,1.3627559,7.652532100000001,4.441770544444444,0.0,0.0,0.0,0.0 +2017-03-01 14:00:00,,58.82315884739315,18.755718,2.5696536,19.049625,10.480080422222223,0.0,0.0,0.0,0.0 +2017-03-01 15:00:00,,59.29673026808841,101.62799,8.090486499999999,110.87685,57.59532627777779,0.0,0.0,0.0,0.0 +2017-03-01 16:00:00,,56.07245409025582,874.68082,193.66264999999999,978.80384,561.7176455555557,0.0,0.0,88.626846,23.399081555555554 +2017-03-01 17:00:00,4.24817,4.24817,955.12794,125.99380999999998,1124.3707,647.3262466666666,179.35087,53.124542,229.87754999999999,151.86746744444446 +2017-03-01 18:00:00,20.91773,20.91773,1021.9978,178.89394,1092.0906,665.5828933333333,0.050121994,0.010238919999999999,0.10350361,0.04912778455555556 +2017-03-01 19:00:00,103.81555999999999,103.81555999999999,3259.0711,185.09713,3259.0711,1546.0414366666669,0.0,0.0,0.0,0.0 +2017-03-01 20:00:00,131.88701,131.88701,3304.4862000000003,183.4619,3694.1094,1593.0133533333335,0.0,0.0,0.0,0.0 +2017-03-01 21:00:00,76.47551,76.47551,2138.8662999999997,8.874791100000001,3918.0517000000004,1600.8728373444446,0.0,0.0,0.0,0.0 +2017-03-01 22:00:00,94.58084000000001,94.58084000000001,503.06145999999995,0.0,3620.0655,1292.7360094999997,0.0,0.0,0.0,0.0 +2017-03-01 23:00:00,88.63901,88.63901,18.880261,0.0,4049.9480000000003,728.6908657777778,72.723291,0.0,722.3273300000001,249.10663092222225 +2017-03-02 00:00:00,84.41438000000001,84.41438000000001,1840.0134,0.0,4162.8432999999995,1847.122817,0.019992214,0.0025690925,0.044109394999999996,0.01836455603333333 +2017-03-02 01:00:00,47.27834,47.27834,438.26248,0.0,952.49154,377.96394562666666,0.0,0.0,0.0,0.0 +2017-03-02 02:00:00,49.23245,49.23245,8.7008493,0.0,27.665503,10.002348827777775,0.0,0.0,0.0,0.0 +2017-03-02 03:00:00,133.4945,133.4945,4.6359924,0.0,9.532574899999998,4.213733565555555,0.0,0.0,0.0,0.0 +2017-03-02 04:00:00,148.48183999999998,148.48183999999998,3.6607912,0.14717461999999998,5.9013632000000005,3.001134607777778,0.0,0.0,0.0,0.0 +2017-03-02 05:00:00,199.27916000000002,199.27916000000002,3.0549922,0.23538321,4.3303489,2.3112072944444444,52.748163999999996,0.0,62.509142,23.02268521111111 +2017-03-02 06:00:00,156.98516,156.98516,2.0603279,0.017932293999999998,147.95923,34.03985393755555,0.66465037,0.0,2.2144275,0.8199293488888889 +2017-03-02 07:00:00,165.04328,165.04328,0.039051756,0.0,125.80307,21.601758061777776,0.0,0.0,0.0,0.0 +2017-03-02 08:00:00,109.92116000000001,109.92116000000001,0.0,0.0,72.11456199999999,10.117864598888888,0.0,0.0,0.0,0.0 +2017-03-02 09:00:00,60.62161999999999,60.62161999999999,0.0,0.0,80.929036,11.685794077777778,0.0,0.0,0.0,0.0 +2017-03-02 10:00:00,49.91933,49.91933,0.0,0.0,90.935748,13.97485618888889,0.0,0.0,0.0,0.0 +2017-03-02 11:00:00,19.89377,19.89377,0.0,0.0,99.544202,16.27316998888889,0.0,0.0,6.9508028,0.7723114222222223 +2017-03-02 12:00:00,36.32006,36.32006,0.0,0.0,5.1634129,0.9735712911111111,5.2698647,2.8706486,7.0930523,4.785373311111112 +2017-03-02 13:00:00,14.285839999999999,14.285839999999999,2.1623275,0.25386194,2.7922463,1.4078016333333332,0.0,0.0,0.0,0.0 +2017-03-02 14:00:00,16.61678,16.61678,3.8511157000000003,0.11586614,7.727318,3.700659746666666,0.0,0.0,0.0,0.0 +2017-03-02 15:00:00,41.04077,41.04077,29.968707,0.7811098,58.982052,28.851310511111112,0.0,0.0,0.0,0.0 +2017-03-02 16:00:00,17.52149,17.52149,832.5912599999999,80.729602,1258.2995,596.8943135555555,50.490446,0.0,246.41113,90.69228730000002 +2017-03-02 17:00:00,54.325219999999995,54.325219999999995,1166.9437,298.58761,1368.1705000000002,745.1738822222222,56.828889,34.20694,69.885711,50.40075233333333 +2017-03-02 18:00:00,19.65527,19.65527,1170.1216000000002,264.56395,1316.6724,745.2594788888889,0.16253165,0.029898558,26.235062000000003,8.23608075488889 +2017-03-02 19:00:00,,65.35209487349098,2567.8992,179.90035,2567.8992,1363.617458888889,0.0,0.0,0.27509725,0.07399013222222223 +2017-03-02 20:00:00,29.71838,29.71838,1725.383,180.88822,1798.2625,1031.0020155555555,0.0,0.0,0.0,0.0 +2017-03-02 21:00:00,61.79821999999999,61.79821999999999,2002.8825,29.776784,3742.744,1570.579690111111,0.0,0.0,0.0,0.0 +2017-03-02 22:00:00,110.49833000000001,110.49833000000001,224.96132,0.0,4132.5199,1072.6041183333334,0.0,0.0,0.0,0.0 +2017-03-02 23:00:00,80.84801,80.84801,2.4952687,0.0,2050.6063,298.3275561888888,689.39931,47.104614999999995,780.36496,514.4370227777777 +2017-03-03 00:00:00,155.44127,155.44127,0.0,0.0,105.34044999999999,13.02755345111111,0.010025691000000002,0.0039548071,0.017846005999999998,0.010686233477777777 +2017-03-03 01:00:00,135.85088000000002,135.85088000000002,0.0,0.0,61.49595000000001,6.832883333333334,0.0,0.0,0.0,0.0 +2017-03-03 02:00:00,146.93795,146.93795,0.0,0.0,56.541478,6.544066333333333,0.0,0.0,0.0,0.0 +2017-03-03 03:00:00,123.93701000000001,123.93701000000001,0.0,0.0,73.312556,8.94124688888889,0.0,0.0,0.0,0.0 +2017-03-03 04:00:00,169.43327,169.43327,0.0,0.0,87.17415799999999,11.027741666666666,0.0,0.0,0.0,0.0 +2017-03-03 05:00:00,160.32416,160.32416,0.0,0.0,105.77891,15.062839755555554,611.08219,1.1917111999999999,763.9775900000001,354.0126181555556 +2017-03-03 06:00:00,141.90083,141.90083,0.0,0.0,88.75101000000001,12.329541800000001,0.057911105,0.02244616,0.07446951900000001,0.05005028777777778 +2017-03-03 07:00:00,98.71961,98.71961,0.7716277500000001,0.0,8.7190401,2.001498061555556,0.0,0.0,0.0,0.0 +2017-03-03 08:00:00,77.54399000000001,77.54399000000001,0.88236334,0.0,3.0821443,1.2683522085555554,0.0,0.0,0.0,0.0 +2017-03-03 09:00:00,71.01545,71.01545,0.76800603,0.0,2.820738,1.1326810328888888,0.0,0.0,0.0,0.0 +2017-03-03 10:00:00,42.16967,42.16967,0.046710838000000005,0.0,6.7367127,0.8011711801,0.0,0.0,0.0,0.0 +2017-03-03 11:00:00,81.44266999999999,81.44266999999999,0.0,0.0,1.4846211,0.1649579,0.0,0.0,1023.5371,200.06581740000001 +2017-03-03 12:00:00,25.83878,25.83878,0.0,0.0,0.24787741,0.027541934444444444,1.5223586,0.82203167,1.7768275,1.3418211522222223 +2017-03-03 13:00:00,11.126510000000001,11.126510000000001,0.5262275,0.0,4.196193500000001,1.3087801578544445,0.0,0.0,0.0,0.0 +2017-03-03 14:00:00,,62.83366676926607,1.4785536,0.0,12.320580000000001,3.652271537333333,0.0,0.0,0.0,0.0 +2017-03-03 15:00:00,30.61673,30.61673,2.8888817,0.0,30.820334,8.926327756133334,0.0,0.0,0.0,0.0 +2017-03-03 16:00:00,41.70539,41.70539,72.56134999999999,0.0,340.64423999999997,118.29106902944444,93.189992,0.0,857.5533300000001,312.9174751111111 +2017-03-03 17:00:00,38.530159999999995,38.530159999999995,305.11003999999997,0.05615188,997.86953,386.9947699866667,90.072594,63.973006,129.31573999999998,85.83325033333332 +2017-03-03 18:00:00,174.01883,174.01883,543.69605,25.366888,990.5138300000001,505.1339716666667,0.07218510900000001,0.025655906000000003,222.61415,64.781167375 +2017-03-03 19:00:00,130.95845,130.95845,856.54203,66.62878099999999,1347.2157,619.482499,0.0,0.0,2.8627757999999996,0.7211880666666667 +2017-03-03 20:00:00,61.10816,61.10816,3255.7005,80.828126,4108.431299999999,1579.9438106666666,0.0,0.0,0.0,0.0 +2017-03-03 21:00:00,68.86895,68.86895,2603.1993,4.5634288,4245.888,1607.4592986444445,0.0,0.0,0.0,0.0 +2017-03-03 22:00:00,195.32801,195.32801,1519.3094,0.0,3156.3025,1391.348736322222,0.0,0.0,0.0,0.0 +2017-03-03 23:00:00,91.47239,91.47239,189.31889999999999,0.0,776.5669700000001,306.52024797777773,570.12285,110.13449999999999,623.83676,462.56515888888885 +2017-03-04 00:00:00,83.08355,83.08355,5.9753384,0.0,106.31583,29.35217594777778,0.0,0.0,0.0,0.0 +2017-03-04 01:00:00,,73.91031493529952,3.5407791,0.0,20.753188,7.790599,0.0,0.0,0.0,0.0 +2017-03-04 02:00:00,0.20639000000000002,0.20639000000000002,1.9484822999999998,0.0,8.0487707,3.285892502222222,0.0,0.0,0.0,0.0 +2017-03-04 03:00:00,59.12066,59.12066,0.7603250100000001,0.0,6.192568400000001,2.0083538946333332,0.0,0.0,0.0,0.0 +2017-03-04 04:00:00,51.814609999999995,51.814609999999995,0.20821049,0.0,2.8529366,0.8101077592222222,0.0,0.0,0.0,0.0 +2017-03-04 05:00:00,150.31034,150.31034,0.062345229,0.0,1.4130842,0.3670247811522222,0.28391983,0.18467071000000002,875.1906600000001,214.45457246777778 +2017-03-04 06:00:00,116.93306000000001,116.93306000000001,0.18267572,0.0,2.5770994,0.7519694948888888,0.044949505,0.013180689,0.057449732,0.036125180444444446 +2017-03-04 07:00:00,32.467490000000005,32.467490000000005,0.18054715,0.0,2.2341444,0.5988713377777777,0.0,0.0,0.0,0.0 +2017-03-04 08:00:00,79.9115,79.9115,0.2869466,0.0,2.5780585,0.7241360122222223,0.0,0.0,0.0,0.0 +2017-03-04 09:00:00,71.61488,71.61488,0.50784308,0.0,2.915833,0.8302815131222221,0.0,0.0,0.0,0.0 +2017-03-04 10:00:00,48.865159999999996,48.865159999999996,0.031870609,0.0,0.92643523,0.14351579340333337,0.0,0.0,0.0,0.0 +2017-03-04 11:00:00,41.91527,41.91527,1.7033513999999998,0.11491124,3.0261483,1.474869972222222,1023.8924999999999,2.3031027,1313.625,522.5449780777777 +2017-03-04 12:00:00,43.128440000000005,43.128440000000005,0.11533294,0.0033977012,2.2460896999999997,0.36852094934444446,1.7428747999999998,1.0255981,2.0452334999999997,1.5986135888888888 +2017-03-04 13:00:00,41.39216,41.39216,3.0506317,0.11049846,5.9868662,2.98443377,0.0,0.0,0.0,0.0 +2017-03-04 14:00:00,46.83473,46.83473,5.4437387,0.0074338748,11.870696,5.566779873866667,0.0,0.0,0.0,0.0 +2017-03-04 15:00:00,55.392109999999995,55.392109999999995,23.20249,0.0045039408,66.73380300000001,28.94894102431111,0.0,0.0,0.0,0.0 +2017-03-04 16:00:00,22.40756,22.40756,631.5296099999999,49.647813,1003.0739,480.4003114444444,4.9583268,0.0,323.33372,101.88585964444444 +2017-03-04 17:00:00,59.246269999999996,59.246269999999996,847.76402,110.868,1191.712,574.3097677777779,103.78078,62.795007,116.84306,91.88312933333333 +2017-03-04 18:00:00,126.74972,126.74972,905.2474599999999,140.57165,1216.5691000000002,594.9796922222222,0.30596982,0.098984344,21.557258,6.429884802666667 +2017-03-04 19:00:00,28.174490000000002,28.174490000000002,932.92637,170.03934999999998,1204.2839000000001,601.5346877777778,0.0,0.0,0.12690049,0.03694173411111111 +2017-03-04 20:00:00,3.25601,3.25601,3461.8725,141.65245,3944.2321,1584.3182722222223,0.0,0.0,0.0,0.0 +2017-03-04 21:00:00,29.629340000000003,29.629340000000003,3447.4244,82.819824,4381.379599999999,1667.2372826666665,0.0,0.0,0.0,0.0 +2017-03-04 22:00:00,126.59548999999998,126.59548999999998,3088.4125999999997,31.485088,4455.8193,1664.974642,0.0,0.0,0.0,0.0 +2017-03-04 23:00:00,173.22701,173.22701,3438.1296,65.474072,4714.848,1750.863848,94.080518,0.0,373.69338999999997,153.9188145555555 +2017-03-05 00:00:00,161.9555,161.9555,164.60551999999998,0.40143951,4009.116,845.9647546233334,0.047283784,0.010436385,0.081578861,0.04402769100000001 +2017-03-05 01:00:00,77.00339,77.00339,9.0841313,0.0,1109.4591,221.05579081111114,0.0,0.0,0.0,0.0 +2017-03-05 02:00:00,29.8265,29.8265,2.9236035,0.0,106.4098,24.493196166666664,0.0,0.0,0.0,0.0 +2017-03-05 03:00:00,30.64217,30.64217,0.38625316,0.0,19.47963,4.126162195555556,0.0,0.0,0.0,0.0 +2017-03-05 04:00:00,95.20411999999999,95.20411999999999,0.16842722999999998,0.0,8.0335185,1.659250851111111,0.0,0.0,0.0,0.0 +2017-03-05 05:00:00,133.08905,133.08905,0.1180519,0.0,4.3677064,0.9121583333333333,37.998772,0.80381892,771.25977,235.89343375777779 +2017-03-05 06:00:00,125.27738000000001,125.27738000000001,0.23045551,0.0,3.4989041000000003,0.8925613638888888,0.052736603,0.013728241,0.073418008,0.04414599722222221 +2017-03-05 07:00:00,,65.27593864184468,0.41610234999999995,0.0,2.9284245,0.962448292888889,0.0,0.0,0.0,0.0 +2017-03-05 08:00:00,11.75933,11.75933,0.85189163,0.0,2.9350292,1.2395737124444446,0.0,0.0,0.0,0.0 +2017-03-05 09:00:00,55.92794,55.92794,0.056643703000000004,0.0,7.6899987,0.9166952631555555,0.0,0.0,0.0,0.0 +2017-03-05 10:00:00,20.30399,20.30399,0.0,0.0,9.6184522,1.0687169111111112,0.0,0.0,0.0,0.0 +2017-03-05 11:00:00,29.708840000000002,29.708840000000002,0.0,0.0,10.029052,1.1143391111111112,0.0,0.0,2568.9979,694.8531127155555 +2017-03-05 12:00:00,18.80939,18.80939,0.0,0.0,1.1586237,0.15329589844444444,1.2274589,0.41882427,1.5020839,0.982632211111111 +2017-03-05 13:00:00,4.61228,4.61228,1.0336737,0.0011803718,4.9938853000000005,1.8243985987333333,0.0,0.0,0.0,0.0 +2017-03-05 14:00:00,,46.11087686507355,1.7455515000000001,0.0,13.402045,4.187292320566667,0.0,0.0,0.0,0.0 +2017-03-05 15:00:00,,49.549155209767676,8.182743799999999,0.0,57.711324000000005,19.597579353111108,0.0,0.0,0.0,0.0 +2017-03-05 16:00:00,24.65105,24.65105,425.1746,20.524072,733.6202,389.95240766666666,52.968939,0.0,239.66440999999998,89.78020542222221 +2017-03-05 17:00:00,50.768390000000004,50.768390000000004,900.2026599999999,131.37823,1237.2633,602.17409,46.691774,32.527860000000004,55.222496,42.438908999999995 +2017-03-05 18:00:00,150.06389,150.06389,1023.4341,233.77142,1162.8153,655.0156722222223,0.21692527,0.058688183,25.107478,8.023980856444446 +2017-03-05 19:00:00,49.07345,49.07345,876.8554,80.58120100000001,1232.7289,633.9791212222221,0.0,0.0,0.22834065,0.06490754444444444 +2017-03-05 20:00:00,29.71361,29.71361,1039.8212999999998,2.1610997000000003,2977.7566,1162.1975568555556,0.0,0.0,0.0,0.0 +2017-03-05 21:00:00,25.08512,25.08512,2858.0958,0.0,3030.6294000000003,1557.1530466666668,0.0,0.0,0.0,0.0 +2017-03-05 22:00:00,60.20345,60.20345,2538.2736,147.72534,2679.2067,1160.7229588888888,0.0,0.0,0.0,0.0 +2017-03-05 23:00:00,105.5105,105.5105,209.96582999999998,3.1690031,299.8705,145.84778493333334,224.69539999999998,0.0,689.04291,297.06790545555555 +2017-03-06 00:00:00,34.178329999999995,34.178329999999995,126.12113000000001,0.0,1063.2658,339.21551998966663,0.0041553827,0.00043393006,0.01413106,0.004957382083333333 +2017-03-06 01:00:00,9.671660000000001,9.671660000000001,22.357547999999998,0.0,176.51738999999998,64.05520886666666,0.0,0.0,0.0,0.0 +2017-03-06 02:00:00,10.04849,10.04849,49.534632,0.0,398.79645999999997,142.87150566666665,0.0,0.0,0.0,0.0 +2017-03-06 03:00:00,38.20262,38.20262,16.615902,0.0,300.85375,97.84460515333333,0.0,0.0,0.0,0.0 +2017-03-06 04:00:00,140.05166,140.05166,0.4522515,0.0,226.0208,50.803566277777776,0.0,0.0,0.0,0.0 +2017-03-06 05:00:00,88.38461,88.38461,0.0,0.0,158.51896,27.781444311111112,17.331972999999998,0.0,65.96333,24.77903682222222 +2017-03-06 06:00:00,78.24677,78.24677,0.0,0.0,139.30124,26.47598958888889,2.0291259,0.27076925,2.0498521,1.4646676722222223 +2017-03-06 07:00:00,46.19873,46.19873,0.0,0.0,122.53850999999999,26.119843888888884,0.0,0.0,0.0,0.0 +2017-03-06 08:00:00,77.24189,77.24189,2.0122823,0.0,105.96239,25.92618903333333,0.0,0.0,0.0,0.0 +2017-03-06 09:00:00,110.12945,110.12945,0.053702827,0.0,101.42837,21.639160369666666,0.0,0.0,0.0,0.0 +2017-03-06 10:00:00,49.96544,49.96544,0.0,0.0,97.001452,19.596352455555557,0.0,0.0,0.0,0.0 +2017-03-06 11:00:00,17.5835,17.5835,0.0,0.0,90.641552,18.590804744444444,0.0,0.0,390.30640999999997,107.69179956666667 +2017-03-06 12:00:00,,49.855431715170404,0.16608874999999998,0.0,4.2488214,1.2772284046666667,1.1741811999999998,0.55890189,1.3513061,0.9781514177777777 +2017-03-06 13:00:00,,49.73729258800395,4.1830240000000005,1.2670112,4.261944,2.466224522222222,0.0,0.0,0.0,0.0 +2017-03-06 14:00:00,,45.672121358777886,17.7113,2.0180885,21.574706,12.567855711111113,0.0,0.0,0.0,0.0 +2017-03-06 15:00:00,1.7502799999999998,1.7502799999999998,83.6299,9.8012088,93.930801,52.291127977777776,0.0,0.0,0.0,0.0 +2017-03-06 16:00:00,,45.158722415634514,671.1329900000001,161.62789,710.70797,425.5599955555556,11.640875000000001,0.0,96.866446,33.818532499999996 +2017-03-06 17:00:00,,49.408816004704384,882.71225,82.410057,1221.6271,634.7723174444444,45.735054000000005,17.375765,68.731082,42.06411944444445 +2017-03-06 18:00:00,,50.07923027548261,749.4040799999999,34.597546,1480.299,646.3780417777776,0.10232178,0.019850654,0.27427895999999996,0.11242645655555555 +2017-03-06 19:00:00,6.90188,6.90188,499.59158,2.0407904,1465.571,572.1821360444444,0.0,0.0,0.0,0.0 +2017-03-06 20:00:00,135.09722,135.09722,282.9232,0.0,1564.3212999999998,559.9367365777778,0.0,0.0,0.0,0.0 +2017-03-06 21:00:00,82.26788,82.26788,1881.5758,0.0,3638.6214,1510.6574866666665,0.0,0.0,0.0,0.0 +2017-03-06 22:00:00,4.79672,4.79672,1288.1882999999998,73.52333300000001,1288.1882999999998,629.5390003333333,0.0,0.0,0.0,0.0 +2017-03-06 23:00:00,27.84695,27.84695,127.49007,1.4145493,242.96604000000002,103.8753822,11.150643,0.0,391.029,107.21372922222223 +2017-03-07 00:00:00,25.91033,25.91033,140.13397,0.0,1004.3815999999999,373.52118634000004,0.0,0.0,0.0,0.0 +2017-03-07 01:00:00,14.78033,14.78033,106.90723,0.0,709.3999299999999,258.019028,0.0,0.0,0.0,0.0 +2017-03-07 02:00:00,21.09422,21.09422,46.320798,0.0,332.24595,114.712609,0.0,0.0,0.0,0.0 +2017-03-07 03:00:00,63.46771999999999,63.46771999999999,21.141792,0.0,249.0989,82.18721694444444,0.0,0.0,0.0,0.0 +2017-03-07 04:00:00,18.39599,18.39599,8.8530523,0.0,200.68066,62.74346806377778,0.0,0.0,0.0,0.0 +2017-03-07 05:00:00,167.42033,167.42033,3.8999192,0.0,177.23226,48.638010022222225,1.7662785,0.46045392,58.553949,14.754240402222223 +2017-03-07 06:00:00,123.59038999999999,123.59038999999999,0.063885224,0.0,158.59382,33.83842858044444,0.021952895,0.0016765559,0.058451355999999996,0.023237486977777777 +2017-03-07 07:00:00,96.12473,96.12473,0.0,0.0,135.73882,24.198881266666667,0.0,0.0,0.0,0.0 +2017-03-07 08:00:00,76.90321999999999,76.90321999999999,0.0,0.0,108.39238,17.1678501,0.0,0.0,0.0,0.0 +2017-03-07 09:00:00,18.935,18.935,0.0,0.0,107.87272999999999,25.446879555555554,0.0,0.0,0.0,0.0 +2017-03-07 10:00:00,8.282,8.282,10.136955,0.0,98.469762,33.65694414444445,0.0,0.0,0.0,0.0 +2017-03-07 11:00:00,,53.39691752957359,34.319452,0.0,102.69453,36.05283022222222,0.0,0.0,77.21059199999999,25.387888666666665 +2017-03-07 12:00:00,,59.37054011174963,3.2387254,0.042706034000000004,6.2355320999999995,2.389717077111111,1.1914944,0.6476041100000001,1.5429289000000002,1.1422834455555555 +2017-03-07 13:00:00,,61.40291387517299,3.6926172,0.29831492,4.47506,2.00542324,0.0,0.0,0.0,0.0 +2017-03-07 14:00:00,,63.14319148373423,18.574306999999997,3.2605706,19.549159,11.650707855555556,0.0,0.0,0.0,0.0 +2017-03-07 15:00:00,,64.47923493605562,44.643381000000005,3.6488435999999997,51.490493,28.445917444444447,0.0,0.0,0.0,0.0 +2017-03-07 16:00:00,,65.2678760049984,279.5422,21.771133,319.7068,208.84865533333334,0.0,0.0,0.0,0.0 +2017-03-07 17:00:00,,65.92234848569086,448.48848000000004,1.24362,1322.1471999999999,513.3818227777779,24.181498,3.5126692999999998,57.542525999999995,27.9618578 +2017-03-07 18:00:00,,66.78831237474117,454.60169,0.0,1430.6071,548.957438888889,0.021801573999999997,0.0020673168,0.069280581,0.024943710511111113 +2017-03-07 19:00:00,,66.60310053670186,418.60339,0.0,1393.4941999999999,530.7598328888888,0.0,0.0,0.0,0.0 +2017-03-07 20:00:00,,66.6645374634421,486.08167000000003,0.0,2568.7129,973.3948744222222,0.0,0.0,0.0,0.0 +2017-03-07 21:00:00,,64.5420874200783,2129.9473000000003,0.0,3720.3454,1555.0212446666667,0.0,0.0,0.0,0.0 +2017-03-07 22:00:00,8.45372,8.45372,3693.8206999999998,144.52334,3693.8206999999998,1650.2337777777777,0.0,0.0,0.0,0.0 +2017-03-07 23:00:00,135.11312,135.11312,3019.2698,13.299747,4634.0226999999995,1722.6425218888887,0.0,0.0,139.11932,27.43913411111111 +2017-03-08 00:00:00,97.64795,97.64795,1729.2839,3.7406967,2666.4193999999998,1051.7364519666667,0.0,0.0,1.8690687999999998e-05,2.076743111111111e-06 +2017-03-08 01:00:00,97.62250999999999,97.62250999999999,175.85712,2.7599424,280.23508,106.29322011111111,0.0,0.0,0.0,0.0 +2017-03-08 02:00:00,89.89034000000001,89.89034000000001,8.1940934,0.74635506,8.3547475,4.487359973333334,0.0,0.0,0.0,0.0 +2017-03-08 03:00:00,142.93433000000002,142.93433000000002,5.4922948,0.94838981,5.497991,3.0663801855555555,0.0,0.0,0.0,0.0 +2017-03-08 04:00:00,91.80311,91.80311,4.7145645,0.60369905,4.9557425,2.7825608611111114,0.0,0.0,0.0,0.0 +2017-03-08 05:00:00,34.529720000000005,34.529720000000005,3.8676149000000004,0.40529102,4.3478844,2.4639540444444443,62.625265999999996,0.65089682,71.06723199999999,30.097886268888892 +2017-03-08 06:00:00,54.47945,54.47945,3.2098270999999996,0.32556574,3.7449472,2.1988081888888886,1.826514,0.023293188,2.6310213,1.3769652597777775 +2017-03-08 07:00:00,50.68094,50.68094,2.5931636,0.26242122,3.7693087,1.9847044000000003,0.0,0.0,0.0,0.0 +2017-03-08 08:00:00,72.10778,72.10778,2.1047383,0.20841625000000003,3.3796955000000004,1.732100596666667,0.0,0.0,0.0,0.0 +2017-03-08 09:00:00,91.13372,91.13372,1.8866363,0.14656707,3.4698442,1.6917246955555554,0.0,0.0,0.0,0.0 +2017-03-08 10:00:00,55.43026999999999,55.43026999999999,1.6706367,0.1001149,3.5074331,1.6488924633333333,0.0,0.0,0.0,0.0 +2017-03-08 11:00:00,49.145,49.145,1.6321516999999999,0.07071368900000001,4.1101066,1.7808968043333333,0.0,0.0,2.319224,0.25769155555555556 +2017-03-08 12:00:00,50.932159999999996,50.932159999999996,1.5475160000000001,0.0039669441,4.1760817999999995,1.9492943749,4.1154935,2.3490650000000004,4.7759722,3.7846825555555554 +2017-03-08 13:00:00,12.28562,12.28562,1.4039414000000001,0.0,7.3963929,2.633646485888889,0.0,0.0,0.0,0.0 +2017-03-08 14:00:00,49.33739,49.33739,2.6705884,0.0,17.590304,5.85262949,0.0,0.0,0.0,0.0 +2017-03-08 15:00:00,42.50516,42.50516,3.0185204,0.0,69.766691,17.39335112177778,0.0,0.0,0.0,0.0 +2017-03-08 16:00:00,75.43406,75.43406,163.29686,0.0,860.35865,274.06416637611113,309.20716,0.0,1523.8272,543.135608 +2017-03-08 17:00:00,6.26588,6.26588,240.10561,0.0,1059.3119,362.2690139333333,109.5839,63.789506,155.78521,103.86307122222223 +2017-03-08 18:00:00,139.76705,139.76705,359.49983,4.1071476,1075.3372000000002,437.74220217777776,0.086168519,0.038612381,98.766388,23.59552884388889 +2017-03-08 19:00:00,119.96201,119.96201,492.70183,18.686638,988.12475,496.74905244444443,0.0,0.0,0.90890342,0.15450447444444446 +2017-03-08 20:00:00,94.301,94.301,1348.8234,0.59825129,2869.7748,1358.9434054877777,0.0,0.0,0.0,0.0 +2017-03-08 21:00:00,75.58511,75.58511,423.75007999999997,0.0,3658.3028,1230.877551933333,0.0,0.0,0.0,0.0 +2017-03-08 22:00:00,100.15856,100.15856,35.107532000000006,0.0,1434.219,321.66499271111115,0.0,0.0,0.0,0.0 +2017-03-08 23:00:00,85.28411,85.28411,0.19516051,0.0,134.12995,23.297432367777777,382.76243,3.5396456,650.89396,327.3543287333333 +2017-03-09 00:00:00,15.14444,15.14444,0.0,0.0,28.081622,3.8804441157777783,0.0,0.0,0.0,0.0 +2017-03-09 01:00:00,44.48312,44.48312,0.0,0.0,11.136429,1.8359720499999999,0.0,0.0,0.0,0.0 +2017-03-09 02:00:00,,48.2070915599883,0.0,0.0,5.5621758,1.050109108888889,0.0,0.0,0.0,0.0 +2017-03-09 03:00:00,,42.450362567506616,0.06750421,0.0,4.607261,0.9104975977777777,0.0,0.0,0.0,0.0 +2017-03-09 04:00:00,1.53722,1.53722,0.07490533,0.0,4.0295567000000005,0.8158961622222223,0.0,0.0,0.0,0.0 +2017-03-09 05:00:00,24.22334,24.22334,0.090725663,0.0,3.521252,0.7183617792222221,2.7720171000000002,0.0,196.57495,58.47705601111112 +2017-03-09 06:00:00,23.59688,23.59688,0.16652899000000002,0.0,3.1329700999999996,0.7774162515555556,3.0275455,1.0721204,3.2579601,2.4098919333333333 +2017-03-09 07:00:00,35.96549,35.96549,0.26478142,0.0,2.8888307,0.8956520522222221,0.0,0.0,0.0,0.0 +2017-03-09 08:00:00,5.08451,5.08451,0.38655693,0.0,3.0724943,0.9633556822222222,0.0,0.0,0.0,0.0 +2017-03-09 09:00:00,3.15584,3.15584,0.41249302,0.0,2.9824259,0.9453203098888889,0.0,0.0,0.0,0.0 +2017-03-09 10:00:00,52.776559999999996,52.776559999999996,0.42202964,0.0,2.8294583,0.9098447475555554,0.0,0.0,0.0,0.0 +2017-03-09 11:00:00,31.831490000000002,31.831490000000002,0.4198707,0.0,2.6756359,0.8657889740000001,0.0,0.0,0.0,0.0 +2017-03-09 12:00:00,45.22883,45.22883,0.27924267,0.0,1.90047,0.5967578696944444,6.2314784,1.8939517,7.790045899999999,4.741675077777778 +2017-03-09 13:00:00,32.09861,32.09861,0.39669888000000003,0.0,5.5430801,1.4044673908111112,0.0,0.0,0.0,0.0 +2017-03-09 14:00:00,19.41995,19.41995,1.0329913000000002,0.0,15.697355,4.112620124444444,0.0,0.0,0.0,0.0 +2017-03-09 15:00:00,4.67111,4.67111,2.211641,0.0,56.61097,13.555876138555554,0.0,0.0,0.0,0.0 +2017-03-09 16:00:00,37.542770000000004,37.542770000000004,161.30880000000002,0.0,778.75837,259.3078591051111,137.57007,0.0,1125.4771,402.2782186333333 +2017-03-09 17:00:00,19.28639,19.28639,360.91876,4.0720920000000005,1111.8836999999999,446.6578252222222,106.24009000000001,66.166438,146.99539000000001,99.46559955555556 +2017-03-09 18:00:00,29.86784,29.86784,717.86495,42.079544000000006,1221.7486999999999,604.6877247777778,0.083607318,0.033742467,89.868066,24.293736140999997 +2017-03-09 19:00:00,34.701440000000005,34.701440000000005,1091.1595,176.67716,1442.5471,716.9394777777778,0.0,0.0,1.1024558,0.23777092777777778 +2017-03-09 20:00:00,24.767120000000002,24.767120000000002,1138.5552,155.79841,1294.3564999999999,765.1935922222223,0.0,0.0,0.0,0.0 +2017-03-09 21:00:00,118.8665,118.8665,2888.3709999999996,99.430035,3889.1386,1594.8492883333336,0.0,0.0,0.0,0.0 +2017-03-09 22:00:00,145.06333999999998,145.06333999999998,426.29053,1.0076445,1052.5485999999999,474.47848711111106,0.0,0.0,0.0,0.0 +2017-03-09 23:00:00,104.97148999999999,104.97148999999999,8.4003959,0.0,149.97426000000002,41.24740178888889,808.86181,69.686525,896.79606,607.4713316666666 +2017-03-10 00:00:00,83.55578,83.55578,0.072602688,0.0,703.77631,96.10466247644445,0.025112620999999998,0.0059233267,0.050595027,0.025159207188888887 +2017-03-10 01:00:00,93.03376999999999,93.03376999999999,0.0,0.0,475.25857,79.17424655555556,0.0,0.0,0.0,0.0 +2017-03-10 02:00:00,154.66693999999998,154.66693999999998,0.0,0.0,249.52929,55.84953755555556,0.0,0.0,0.0,0.0 +2017-03-10 03:00:00,43.40033,43.40033,10.95245,0.0,180.53433,59.49607055555556,0.0,0.0,0.0,0.0 +2017-03-10 04:00:00,14.893220000000001,14.893220000000001,23.282619,0.0,162.67836,58.91370464444445,0.0,0.0,0.0,0.0 +2017-03-10 05:00:00,84.85322,84.85322,41.438459,0.0,157.85340000000002,57.06952588888888,7.3931719,0.0,65.799999,22.870060344444443 +2017-03-10 06:00:00,96.93245,96.93245,21.121718,0.0,134.21504000000002,45.15564707777778,2.3280475,0.5574014500000001,2.7316968999999998,1.920884072222222 +2017-03-10 07:00:00,83.47628,83.47628,13.663393,0.0,114.35723,40.74975341111111,0.0,0.0,0.0,0.0 +2017-03-10 08:00:00,42.26189,42.26189,11.149523,0.0,121.06737,41.95004214444444,0.0,0.0,0.0,0.0 +2017-03-10 09:00:00,25.95962,25.95962,16.025546,0.0,110.05664,39.110248355555555,0.0,0.0,0.0,0.0 +2017-03-10 10:00:00,8.32334,8.32334,4.0754658,0.79027996,12.046261999999999,4.67765284,0.0,0.0,0.0,0.0 +2017-03-10 11:00:00,,41.75841832456929,2.3318667,0.6959971899999999,2.3318667,1.5039251177777775,0.0,0.0,42.769589,7.7304171 +2017-03-10 12:00:00,,44.301661133840796,0.077636507,0.017444941,0.11445221,0.05503278633333333,1.0111494,0.5125817800000001,1.612727,1.0416956166666667 +2017-03-10 13:00:00,,44.623691459251596,4.251301600000001,0.49832568000000005,4.683176,2.5554384199999998,0.0,0.0,0.0,0.0 +2017-03-10 14:00:00,,43.95657454692005,14.38171,2.2285858,15.880167,9.340709777777777,0.0,0.0,0.0,0.0 +2017-03-10 15:00:00,,43.222423640078034,70.561102,6.8295535,71.776165,37.63467027777777,0.0,0.0,0.0,0.0 +2017-03-10 16:00:00,,42.16545755110364,862.26716,108.02272,1040.3473,587.453351111111,0.0,0.0,16.149021,5.003663111111112 +2017-03-10 17:00:00,,40.0625397399229,757.37416,44.749115,1361.4841000000001,618.8426527777779,31.730901999999997,8.289724999999999,57.710837,31.36536011111111 +2017-03-10 18:00:00,9.99284,9.99284,895.71055,79.304016,1278.5393000000001,653.0096395555556,0.054193187,0.0055183986,0.20213174,0.06851254006666668 +2017-03-10 19:00:00,108.77,108.77,1014.0699999999999,150.99488,1101.5777999999998,674.4651666666666,0.0,0.0,0.0,0.0 +2017-03-10 20:00:00,6.55049,6.55049,2266.0261,233.05303,2266.0261,1204.3509211111113,0.0,0.0,0.0,0.0 +2017-03-10 21:00:00,44.71049,44.71049,3175.3141,62.153696,4272.3059,1637.1443762222223,0.0,0.0,0.0,0.0 +2017-03-10 22:00:00,24.29012,24.29012,2068.632,0.9778239000000001,3927.4343000000003,1643.177106622222,0.0,0.0,0.0,0.0 +2017-03-10 23:00:00,44.1365,44.1365,1428.4641,0.0,3744.0516000000002,1663.785329066667,82.79131699999999,0.0,643.48406,233.63469008888887 +2017-03-11 00:00:00,55.65923000000001,55.65923000000001,4316.9130000000005,0.0,7590.4964,2298.9421014444442,0.0054125917,0.00055137528,0.01329107,0.0053447714333333335 +2017-03-11 01:00:00,8.725610000000001,8.725610000000001,968.75016,16.108503000000002,1102.2685999999999,440.2759977777778,0.0,0.0,0.0,0.0 +2017-03-11 02:00:00,19.73795,19.73795,31.693296,0.62841326,45.979505,18.342469951111113,0.0,0.0,0.0,0.0 +2017-03-11 03:00:00,15.02201,15.02201,5.9640856,0.085225686,10.898897,4.877439405111111,0.0,0.0,0.0,0.0 +2017-03-11 04:00:00,29.85512,29.85512,4.0011241,0.31871591000000005,5.640255000000001,2.9828414744444447,0.0,0.0,0.0,0.0 +2017-03-11 05:00:00,,27.410049560746643,2.7489315999999997,0.36628433,3.2569762,1.9825857633333333,50.924012999999995,0.0,50.924012999999995,22.886069811111113 +2017-03-11 06:00:00,2.5325599999999997,2.5325599999999997,1.9697477,0.035482801999999994,121.81318,27.610519588333336,0.6125206900000001,0.0,2.17151,0.8215638527777778 +2017-03-11 07:00:00,,28.63703570291145,0.058355226,0.0,115.96641,23.275238713999997,0.0,0.0,0.0,0.0 +2017-03-11 08:00:00,46.00634,46.00634,0.0,0.0,95.141419,16.152283122222222,0.0,0.0,0.0,0.0 +2017-03-11 09:00:00,21.45833,21.45833,0.0,0.0,98.305551,18.287223977777778,0.0,0.0,0.0,0.0 +2017-03-11 10:00:00,10.662230000000001,10.662230000000001,0.0,0.0,99.958626,20.393806355555554,0.0,0.0,0.0,0.0 +2017-03-11 11:00:00,,27.72346816554099,0.0,0.0,96.613461,22.43909411111111,0.0,0.0,97.070537,13.402195566666668 +2017-03-11 12:00:00,,29.87933926985508,0.53446388,0.0,5.2961768,1.8408274833333331,6.5082058,2.6831183000000003,13.066749,7.176470299999999 +2017-03-11 13:00:00,,30.649349436102096,2.7618441,0.13576128,5.3861868,2.0019189522222223,0.0,0.0,0.0,0.0 +2017-03-11 14:00:00,,31.163148712694973,29.52238,1.1451862,54.14019,27.0484701,0.0,0.0,0.0,0.0 +2017-03-11 15:00:00,,30.617954724690076,221.3602,5.5942924000000005,368.36523,185.75141904444445,0.0,0.0,0.0,0.0 +2017-03-11 16:00:00,,29.653488725299177,992.72176,156.22625000000002,1320.6261,650.6918633333333,0.0,0.0,0.0,0.0 +2017-03-11 17:00:00,,27.08736686187003,1203.7206999999999,258.85087000000004,1333.5753,771.0031422222222,88.06418900000001,2.3263211999999998,253.2184,115.9195286888889 +2017-03-11 18:00:00,,22.258818495568047,793.61442,260.57867,910.1864999999999,554.1201444444445,0.043796067,0.009519205,0.083534886,0.041188191222222226 +2017-03-11 19:00:00,3.13994,3.13994,719.54151,181.57926,902.03574,526.2850099999999,0.0,0.0,0.0,0.0 +2017-03-11 20:00:00,,20.889092382493796,891.2072499999999,109.04726000000001,1325.3220000000001,680.0239822222223,0.0,0.0,0.0,0.0 +2017-03-11 21:00:00,,23.433597220063056,1624.0576999999998,81.111997,2555.6854,1110.2746929999998,0.0,0.0,0.0,0.0 +2017-03-11 22:00:00,,23.540964572413092,1408.9616,122.20585,2122.9475,962.3090266666667,0.0,0.0,0.0,0.0 +2017-03-11 23:00:00,,22.3348820541544,3673.4319,94.733339,4683.8508,1815.8907754444444,0.0,0.0,19.750798,3.404981444444444 +2017-03-12 00:00:00,,19.848106308190562,6352.6151,21.380956,7031.1013,2378.028807666667,0.025436384,0.0040016856,0.064112442,0.026968750677777778 +2017-03-12 01:00:00,4.650440000000001,4.650440000000001,1023.1540999999999,0.0,1467.6271,511.1456645555555,0.0,0.0,0.0,0.0 +2017-03-12 02:00:00,,19.53456955832082,117.836,0.0,388.71082,121.39538644444444,0.0,0.0,0.0,0.0 +2017-03-12 03:00:00,,20.228292584274673,53.704693999999996,0.0,272.22413,86.85070788888889,0.0,0.0,0.0,0.0 +2017-03-12 04:00:00,,19.504144079607602,24.866327,0.0,195.23072000000002,69.12156135555557,0.0,0.0,0.0,0.0 +2017-03-12 05:00:00,8.94662,8.94662,16.042917,0.0,175.95736,58.78977307777778,7.9891860999999995,0.0,59.833157,20.117490177777782 +2017-03-12 06:00:00,27.07262,27.07262,11.427227,0.0,150.53499,49.10016977777778,0.049203678,0.0,1.7055752,0.40281060333333335 +2017-03-12 07:00:00,3.12245,3.12245,12.401316999999999,0.0,131.64785999999998,44.16868233333334,0.0,0.0,0.0,0.0 +2017-03-12 08:00:00,4.04306,4.04306,13.436663,0.0,116.56384999999999,40.354205300000004,0.0,0.0,0.0,0.0 +2017-03-12 09:00:00,,21.493163030873443,18.411412000000002,0.0,109.03805,39.75324750000001,0.0,0.0,0.0,0.0 +2017-03-12 10:00:00,38.67962,38.67962,25.536749999999998,0.0,114.55343,39.44215925555555,0.0,0.0,0.0,0.0 +2017-03-12 11:00:00,27.579829999999998,27.579829999999998,38.137139,0.0,111.86623,39.06800139497778,23.917188,0.0,75.357842,25.146751944444443 +2017-03-12 12:00:00,,23.640709681562097,4.4976091,0.09618320000000001,7.7281411,3.0690680155555556,2.9728808,0.080421827,8.5790098,3.3344379641111113 +2017-03-12 13:00:00,,21.042189913283824,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-12 14:00:00,5.62511,5.62511,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-12 15:00:00,,19.150285146244855,124.39897,13.088955,150.67158,92.28324677777778,0.0,0.0,0.0,0.0 +2017-03-12 16:00:00,2.49122,2.49122,454.33894000000004,45.176032000000006,845.87565,414.20129911111115,0.0,0.0,3.9193686999999997,0.7633096833333333 +2017-03-12 17:00:00,,23.869552469969367,443.22072000000003,32.044067,972.9843,453.946939,29.873027,7.5783346,51.926443,28.7164894 +2017-03-12 18:00:00,,29.25779467119529,202.76019,11.926340000000001,598.74414,254.5066383333334,0.34602563999999997,0.044134260999999994,1.7404774,0.5010783234444445 +2017-03-12 19:00:00,33.33245,33.33245,83.4538,0.7454888199999999,307.86425,129.00586201333334,0.0,0.0,0.0,0.0 +2017-03-12 20:00:00,66.01966999999999,66.01966999999999,6.145955000000001,0.0,180.36121,55.075298610000004,0.0,0.0,0.0,0.0 +2017-03-12 21:00:00,,37.692557323673185,26.629880999999997,0.0,526.72793,159.00077144444447,0.0,0.0,0.0,0.0 +2017-03-12 22:00:00,,35.331496890434416,173.25078000000002,0.0,1113.0058000000001,416.54260733333336,0.0,0.0,0.0,0.0 +2017-03-12 23:00:00,,36.50618410625258,184.52875,0.0,3487.2713,1125.5594104155555,19.79282,0.0,671.3627399999999,183.53704133333335 +2017-03-13 00:00:00,,39.441401556665696,5191.9682999999995,0.0,7747.7348999999995,3149.608914444444,0.026895123,0.0040700269999999995,0.067196432,0.02835609777777778 +2017-03-13 01:00:00,,46.73557444533051,4397.585499999999,0.0,6747.6230000000005,2478.486886666667,0.0,0.0,0.0,0.0 +2017-03-13 02:00:00,97.27112,97.27112,1352.8459,0.0,1827.7888,589.7448083333334,0.0,0.0,0.0,0.0 +2017-03-13 03:00:00,55.16633,55.16633,203.61929,0.0,378.22989,152.08322092222224,0.0,0.0,0.0,0.0 +2017-03-13 04:00:00,,40.12452493793151,35.747191,0.0,286.97669,97.07803592666667,0.0,0.0,0.0,0.0 +2017-03-13 05:00:00,,35.34176267330031,3.4825509,0.0,294.18305999999995,72.3083466811111,0.0,0.0,10.863679999999999,2.3770554444444443 +2017-03-13 06:00:00,34.05272,34.05272,27.578239,0.0,171.24349,60.18661396666667,0.0,0.0,0.083260474,0.016836867444444445 +2017-03-13 07:00:00,,31.94236663130569,72.523566,0.0,108.90053,42.81503693888889,0.0,0.0,0.0,0.0 +2017-03-13 08:00:00,24.4205,24.4205,89.37376,0.019482407,101.05628,37.130623845222225,0.0,0.0,0.0,0.0 +2017-03-13 09:00:00,80.02439,80.02439,85.105297,0.9715705600000001,87.92739399999999,34.955378428888885,0.0,0.0,0.0,0.0 +2017-03-13 10:00:00,9.05633,9.05633,77.985707,0.76892667,77.985707,31.08527881888889,0.0,0.0,0.0,0.0 +2017-03-13 11:00:00,12.86438,12.86438,72.360934,1.1032514,72.360934,28.478511877777773,62.03110399999999,0.0,80.41695399999999,29.26088407777777 +2017-03-13 12:00:00,12.55751,12.55751,4.515588,0.12226226,4.515588,1.963662818888889,2.3818777,0.012624206,8.1680901,2.873479039555556 +2017-03-13 13:00:00,0.92984,0.92984,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-13 14:00:00,3.512,3.512,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-13 15:00:00,,19.827948016361695,162.96377999999999,36.393158,192.09171,128.98570377777776,0.0,0.0,0.0,0.0 +2017-03-13 16:00:00,,23.28156901190665,427.04842,178.51301999999998,556.2469,342.6744644444445,0.0,0.0,3.7060956000000003,0.8547445 +2017-03-13 17:00:00,,25.68744802070847,760.14962,159.67761,978.68755,585.5604288888889,26.174686,9.639531499999999,34.807537,23.990884277777777 +2017-03-13 18:00:00,,29.06417421698214,297.11874,30.318206,716.35604,312.1828213333333,0.0,0.0,0.0,0.0 +2017-03-13 19:00:00,48.16238,48.16238,90.36636,1.4678266,325.00381,133.8467945111111,0.0,0.0,0.0,0.0 +2017-03-13 20:00:00,31.93484,31.93484,4.0577102,0.0,119.75923,33.13419815888889,0.0,0.0,0.0,0.0 +2017-03-13 21:00:00,,27.72211093709778,60.681177,0.0,1055.7096,351.27615744444444,0.0,0.0,0.0,0.0 +2017-03-13 22:00:00,,26.08954917247864,1213.1777,0.0,2983.4632,1270.5316225555557,0.0,0.0,0.0,0.0 +2017-03-13 23:00:00,,25.042032357718973,4029.4909999999995,107.04171000000001,4029.4909999999995,1834.4480411111113,0.0,0.0,25.657642000000003,4.009305444444445 +2017-03-14 00:00:00,,24.096672277154756,3750.0507,2.6029581,9199.857699999999,3167.978892344445,0.043136716,0.010354901000000001,0.090390863,0.04385624955555555 +2017-03-14 01:00:00,,22.539341507556937,9072.7946,0.0,9072.7946,3266.580413333334,0.0,0.0,0.0,0.0 +2017-03-14 02:00:00,5.17355,5.17355,3056.0365,0.0,3056.0365,1065.9817114444443,0.0,0.0,0.0,0.0 +2017-03-14 03:00:00,52.668440000000004,52.668440000000004,680.27707,0.0,736.97272,241.2777941111111,0.0,0.0,0.0,0.0 +2017-03-14 04:00:00,,25.315340661729394,311.521,0.0,367.42509,122.72350160000002,0.0,0.0,0.0,0.0 +2017-03-14 05:00:00,,20.947051078788714,296.10062,0.0,390.01979,110.22239893333334,0.6863160100000001,0.0,38.352511,9.504154145555555 +2017-03-14 06:00:00,4.0351099999999995,4.0351099999999995,174.26698,0.0,174.26698,62.97154300999999,0.0026961489,0.0,0.6002341,0.1266468456 +2017-03-14 07:00:00,15.947389999999999,15.947389999999999,63.660802000000004,0.0,144.14947,49.301447441111115,0.0,0.0,0.0,0.0 +2017-03-14 08:00:00,17.73455,17.73455,22.132373,0.0,117.59889,38.52306367777778,0.0,0.0,0.0,0.0 +2017-03-14 09:00:00,33.742670000000004,33.742670000000004,20.958734,0.0,96.354459,31.583302855555555,0.0,0.0,0.0,0.0 +2017-03-14 10:00:00,15.9935,15.9935,16.896252,0.0,82.83225200000001,27.493809133333336,0.0,0.0,0.0,0.0 +2017-03-14 11:00:00,18.617,18.617,12.927326,0.0,72.94171499999999,25.052510066666667,0.0,0.0,62.439307,10.68255042222222 +2017-03-14 12:00:00,0.491,0.491,1.1217278,0.0,5.5458172,1.85767286,6.6896646,1.6806431,12.096031,6.565444166666667 +2017-03-14 13:00:00,,17.485113905476574,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-14 14:00:00,10.059619999999999,10.059619999999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-14 15:00:00,21.41699,21.41699,149.16527,40.451385,179.38419,125.04640700000002,0.0,0.0,0.0,0.0 +2017-03-14 16:00:00,7.63805,7.63805,383.39596,132.54253,516.78153,313.7415188888889,0.0,0.0,5.4395027,1.4640465111111112 +2017-03-14 17:00:00,,21.60683489566093,458.29159000000004,212.70665000000002,561.74345,372.9892233333333,24.223686,8.440819300000001,35.323781,22.532413811111113 +2017-03-14 18:00:00,,24.762653320090322,363.88806999999997,85.57768899999999,643.4569399999999,331.2001143333334,3.7449115,1.1885278,6.117001699999999,3.6046676222222223 +2017-03-14 19:00:00,,27.96485513960649,182.28637,53.473173,247.88975,160.3974618888889,0.0,0.0,0.0,0.0 +2017-03-14 20:00:00,,32.29422652287009,55.046654,4.785726599999999,208.87253,89.33493505555556,0.0,0.0,0.0,0.0 +2017-03-14 21:00:00,37.061,37.061,56.247372000000006,0.0,714.58879,228.0793606777778,0.0,0.0,0.0,0.0 +2017-03-14 22:00:00,100.59899,100.59899,231.20626000000001,0.0,1287.2067,490.39170899999993,0.0,0.0,0.0,0.0 +2017-03-14 23:00:00,57.07433,57.07433,96.49991999999999,0.0,3151.4219,911.7435258999999,0.0,0.0,0.0,0.0 +2017-03-15 00:00:00,,32.11128514070801,0.28815109,0.0,295.75962,59.99744566555556,0.0,0.0,0.0,0.0 +2017-03-15 01:00:00,,23.859636051647648,438.44268999999997,0.0,1421.8208,580.8056955555554,0.0,0.0,0.0,0.0 +2017-03-15 02:00:00,9.515839999999999,9.515839999999999,997.9765199999999,23.112705000000002,1865.2630000000001,642.0581305555555,0.0,0.0,0.0,0.0 +2017-03-15 03:00:00,7.04339,7.04339,510.65691999999996,0.0,1953.1394000000003,594.8068122222222,0.0,0.0,0.0,0.0 +2017-03-15 04:00:00,7.617380000000001,7.617380000000001,155.50287,0.0,1636.8371,517.7531484444445,0.0,0.0,0.0,0.0 +2017-03-15 05:00:00,5.8922300000000005,5.8922300000000005,24.911144999999998,0.0,1469.4961,411.9128766833334,38.081798,0.0,56.869892,24.16941696666667 +2017-03-15 06:00:00,3.62489,3.62489,0.0,0.0,691.34129,92.50395891111111,1.0162247,0.043269861,1.4195891,0.8083154556666666 +2017-03-15 07:00:00,,15.702784901256054,0.0,0.0,14.779594,1.688176271111111,0.0,0.0,0.0,0.0 +2017-03-15 08:00:00,,17.443168718500477,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 09:00:00,,18.06386824837606,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 10:00:00,,17.16576075123399,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 11:00:00,3.65351,3.65351,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 12:00:00,,17.525266836124533,0.0,0.0,0.055571952,0.006174661333333334,7.2746038,2.0976606,9.3479466,5.522977088888889 +2017-03-15 13:00:00,16.57067,16.57067,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 14:00:00,15.41156,15.41156,1.1843297,0.0,20.440302,4.778426252222222,0.0,0.0,0.0,0.0 +2017-03-15 15:00:00,,20.296781669348334,25.797453,0.0,643.6713199999999,134.87028275124442,0.0,0.0,0.0,0.0 +2017-03-15 16:00:00,,21.71741586869639,205.7336,8.2389643,771.6387,277.5271477,1.0192426,0.0,38.512771,12.19015221111111 +2017-03-15 17:00:00,,22.764590343956034,548.7703600000001,29.216622,994.97417,525.5147434444444,35.172212,22.264781,39.956558,31.354772 +2017-03-15 18:00:00,,23.865399853788556,661.8700600000001,42.673983,1114.853,584.8646414444445,0.18019838000000002,0.042555623,5.9203949,1.9431670246666666 +2017-03-15 19:00:00,,26.14718047958118,762.86937,63.358901,1216.1667,626.8181945555556,0.0,0.0,0.053977061,0.014436766222222223 +2017-03-15 20:00:00,46.04927,46.04927,1456.8483,59.3041,2545.0131,1075.231988888889,0.0,0.0,0.0,0.0 +2017-03-15 21:00:00,3.9095,3.9095,2315.4784,5.9708395,3940.6852000000003,1694.5635225,0.0,0.0,0.0,0.0 +2017-03-15 22:00:00,,20.876298807418305,2487.7968,0.0,4138.155400000001,1775.1365025555558,0.0,0.0,0.0,0.0 +2017-03-15 23:00:00,10.45712,10.45712,764.5021,3.0072629,1593.2784,739.4231132111112,590.6166,0.0,1255.2482,583.9102344444444 +2017-03-16 00:00:00,,23.55510827241302,418.05932,0.0,1100.0254,387.23673444444444,0.052900504,0.019899911,0.067831287,0.045945704222222224 +2017-03-16 01:00:00,,26.325070657086684,62.103542999999995,0.0,421.20268000000004,133.07117011111112,0.0,0.0,0.0,0.0 +2017-03-16 02:00:00,17.79656,17.79656,13.474692,0.0,203.49899000000002,64.83223361333333,0.0,0.0,0.0,0.0 +2017-03-16 03:00:00,79.64438,79.64438,0.5005557,0.0,189.29163,48.1960253,0.0,0.0,0.0,0.0 +2017-03-16 04:00:00,16.01099,16.01099,0.023843164,0.0,202.90466,34.13677498488889,0.0,0.0,0.0,0.0 +2017-03-16 05:00:00,,25.827564606313697,0.0,0.0,155.55197,20.836361273333335,994.8971,0.25083361,1802.3419,682.0759964511112 +2017-03-16 06:00:00,,22.84479216322679,0.0,0.0,38.839815,4.4337216,0.053507826,0.011227573999999999,0.078075857,0.04621471500000001 +2017-03-16 07:00:00,2.81717,2.81717,0.0,0.0,4.853684899999999,0.5392983222222222,0.0,0.0,0.0,0.0 +2017-03-16 08:00:00,,20.72578634144575,0.0,0.0,0.09102898,0.01011433111111111,0.0,0.0,0.0,0.0 +2017-03-16 09:00:00,5.08133,5.08133,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 10:00:00,32.960390000000004,32.960390000000004,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 11:00:00,26.441390000000002,26.441390000000002,0.0,0.0,0.0,0.0,0.0,0.0,94.703406,10.522600666666667 +2017-03-16 12:00:00,19.97327,19.97327,0.0,0.0,0.6354057999999999,0.11788597088888889,0.38211027,0.0069872832000000005,1.1304855,0.5144634150222221 +2017-03-16 13:00:00,21.02744,21.02744,0.0,0.0,1.0503592,0.14257553507222223,0.0,0.0,0.0,0.0 +2017-03-16 14:00:00,23.51738,23.51738,0.0,0.0,6.7676397,0.9834909867777779,0.0,0.0,0.0,0.0 +2017-03-16 15:00:00,18.11138,18.11138,0.0,0.0,41.33835,6.337779566666667,0.0,0.0,0.0,0.0 +2017-03-16 16:00:00,54.43334,54.43334,30.527935,0.0,627.6794000000001,134.22222452222223,246.93232000000003,0.0,1552.0027,548.8724265555555 +2017-03-16 17:00:00,,32.99706330106994,121.20952,0.0,1148.0577999999998,296.5702108888888,221.92091000000002,131.44713,276.15725,209.54196444444443 +2017-03-16 18:00:00,,31.739017647867488,94.818344,0.0,1167.5729000000001,279.19382366666673,145.64069999999998,0.051995936,1105.8451,392.4104079051111 +2017-03-16 19:00:00,,31.81062426055618,63.709863999999996,0.0,1082.6905,239.11979099999996,2.5053932,0.0,42.182899000000006,12.735659487111112 +2017-03-16 20:00:00,,31.903376487554574,2.4968947,0.0,1806.7429,295.3204779988889,0.0,0.0,0.0,0.0 +2017-03-16 21:00:00,,32.18688111890567,0.0,0.0,1038.7598,137.42162976666665,0.0,0.0,0.0,0.0 +2017-03-16 22:00:00,20.42483,20.42483,0.0,0.0,119.98514999999999,14.36490923333333,489.45360999999997,0.0,7081.7303,2417.478790222222 +2017-03-16 23:00:00,69.19649,69.19649,0.0,0.0,1.4884497,0.1653833,735.2076900000001,345.23575,907.6267,674.2230311111111 +2017-03-17 00:00:00,14.78033,14.78033,0.0,0.0,0.0,0.0,0.034674905,0.016527034,4030.4163,1284.9378517663333 +2017-03-17 01:00:00,,34.90130128567068,0.0,0.0,0.0,0.0,0.0,0.0,127.02621,32.10444947777778 +2017-03-17 02:00:00,41.09483,41.09483,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 03:00:00,22.587229999999998,22.587229999999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 04:00:00,74.90777,74.90777,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 05:00:00,74.42123000000001,74.42123000000001,0.0,0.0,0.0,0.0,1106.8869,0.0,2235.6678,813.1804913333333 +2017-03-17 06:00:00,25.03901,25.03901,0.0,0.0,0.0,0.0,1.3836893,0.011333474,3.1829036,1.4682126403333333 +2017-03-17 07:00:00,17.35295,17.35295,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 08:00:00,,34.96937240431219,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 09:00:00,,35.08844576265937,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 10:00:00,17.93966,17.93966,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 11:00:00,,36.85096903122592,0.0,0.0,0.0,0.0,0.0,0.0,6935.7357,1606.6591666666668 +2017-03-17 12:00:00,44.25416,44.25416,0.25633392,0.0,2.4877705999999997,0.7674868665744444,0.4171454,0.26244254,663.8054,149.70254363555557 +2017-03-17 13:00:00,39.14549,39.14549,0.018951159,0.0,2.4410592,0.42401133211111114,0.0,0.0,20.209462,3.1612723666666667 +2017-03-17 14:00:00,37.153220000000005,37.153220000000005,0.0,0.0,5.1760530000000005,0.7651790325555556,0.0,0.0,0.0,0.0 +2017-03-17 15:00:00,36.88451,36.88451,0.0036906924000000003,0.0,60.423819,10.168692454711111,0.0,0.0,0.0,0.0 +2017-03-17 16:00:00,52.79405,52.79405,324.34272,8.3402356,864.60554,371.6425338444444,150.31302000000002,16.298965,444.43039,183.13643166666668 +2017-03-17 17:00:00,,44.27087203940724,844.93152,138.47760000000002,1130.6183,557.6863055555555,64.373824,37.550923000000004,77.20872999999999,56.91732499999999 +2017-03-17 18:00:00,,43.873717308732544,741.21123,67.26039300000001,1143.6366,549.4987647777778,39.530682,0.058378841,204.04386,75.20749458788889 +2017-03-17 19:00:00,,44.62042848524259,514.11486,23.029277,942.54455,493.5188611111111,0.5806536999999999,0.0,5.941788900000001,1.9874160357777777 +2017-03-17 20:00:00,,44.84577060584101,219.34042,0.31982995000000003,3815.2873000000004,1017.7451418166667,0.0,0.0,0.0,0.0 +2017-03-17 21:00:00,,45.318352069223906,5.4860561,0.0,2691.2254,426.5608449,0.0,0.0,0.0,0.0 +2017-03-17 22:00:00,,45.62525498890956,0.0,0.0,428.11956000000004,51.822133,0.0,0.0,80.03204099999999,8.892449 +2017-03-17 23:00:00,,45.85123161214997,0.0,0.0,8.3266059,0.9251784333333334,1011.0027,840.0040700000001,1164.9767000000002,990.4911133333333 +2017-03-18 00:00:00,,45.641435288603226,0.0,0.0,0.0,0.0,0.058375470000000006,0.015897056,396.88052,64.49477396344443 +2017-03-18 01:00:00,,44.92505423319997,0.0,0.0,0.0,0.0,0.0,0.0,6.4208239,0.7134248777777779 +2017-03-18 02:00:00,,43.77460808100799,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 03:00:00,,40.85307463725968,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 04:00:00,24.12794,24.12794,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 05:00:00,,38.99907888184321,0.0,0.0,0.0,0.0,953.57175,336.22663,1957.4682,1236.6247244444446 +2017-03-18 06:00:00,,36.62395767888055,0.0,0.0,0.0,0.0,0.0,0.0,1202.4178,270.9813633333333 +2017-03-18 07:00:00,6.587060000000001,6.587060000000001,0.0,0.0,0.0,0.0,0.0,0.0,107.21831,23.834256 +2017-03-18 08:00:00,21.04334,21.04334,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 09:00:00,,39.87393170769389,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 10:00:00,34.28645,34.28645,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 11:00:00,40.81022,40.81022,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 12:00:00,57.27944,57.27944,0.17896984,0.0,2.6013469999999996,0.6848735612222222,1.569752,0.025565217,5.510942600000001,2.323943345777778 +2017-03-18 13:00:00,28.5545,28.5545,0.017253138,0.0,4.5031734,0.7758558958666666,0.0,0.0,0.0,0.0 +2017-03-18 14:00:00,7.80023,7.80023,0.0045036814,0.0,34.388238,5.664074875711112,0.0,0.0,0.0,0.0 +2017-03-18 15:00:00,,47.31268448828106,0.029519764,0.0,1071.5214999999998,181.9909423071111,0.0,0.0,0.0,0.0 +2017-03-18 16:00:00,,53.14609885593965,142.29411,0.0,1166.1645,315.0464162222222,258.17932,45.707046,582.87743,263.3993751111111 +2017-03-18 17:00:00,48.032,48.032,358.71967,0.0,1229.9832000000001,468.78867944444454,63.44512100000001,29.190313999999997,79.87462599999999,56.60552477777778 +2017-03-18 18:00:00,83.33795,83.33795,562.8899700000001,21.298845,1117.3254000000002,563.4289366666667,32.949578,0.12358345,178.88466,65.82581724444445 +2017-03-18 19:00:00,41.00738,41.00738,814.66837,55.744214,1343.7221,654.5519760000001,0.39183055,0.0,4.3486743,1.4282257483333334 +2017-03-18 20:00:00,41.50028,41.50028,2232.1292,84.10992499999999,3049.5063,1364.6665327777778,0.0,0.0,0.0,0.0 +2017-03-18 21:00:00,56.358830000000005,56.358830000000005,2557.0069,9.9230247,4392.9778,1749.082400411111,0.0,0.0,0.0,0.0 +2017-03-18 22:00:00,108.48539,108.48539,2099.7101,0.0,4135.2645,1776.2652760111112,0.0,0.0,0.0,0.0 +2017-03-18 23:00:00,173.82962,173.82962,1503.5407,0.0,3641.2241999999997,1638.4280842222224,861.42315,312.0164,967.2334400000001,744.2209688888889 +2017-03-19 00:00:00,106.57739,106.57739,29.290150999999998,0.0,597.62568,135.46629444444443,0.044434831,0.010234152,0.070063003,0.03806327666666667 +2017-03-19 01:00:00,137.68733,137.68733,0.0,0.0,6.7308797,0.7478755222222222,0.0,0.0,0.0,0.0 +2017-03-19 02:00:00,88.43549,88.43549,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 03:00:00,39.01034,39.01034,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 04:00:00,107.73173,107.73173,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 05:00:00,136.18478000000002,136.18478000000002,0.0,0.0,0.0,0.0,0.0,0.0,2180.5516,558.8580444444444 +2017-03-19 06:00:00,101.67383000000001,101.67383000000001,0.0,0.0,0.0,0.0,1.3087763000000001,0.025868257,2.2442243,1.119443858111111 +2017-03-19 07:00:00,71.47973,71.47973,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 08:00:00,92.69351,92.69351,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 09:00:00,35.39945,35.39945,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 10:00:00,29.42105,29.42105,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 11:00:00,64.568,64.568,0.0,0.0,0.0,0.0,0.0,0.0,36.541444999999996,4.350525788888889 +2017-03-19 12:00:00,35.99888,35.99888,0.0,0.0,0.08320052600000001,0.00924450288888889,5.4643237000000004,3.3353351,7.926182700000001,5.430327944444445 +2017-03-19 13:00:00,12.89777,12.89777,0.0,0.0,1.5937107,0.21497978666666664,0.0,0.0,0.0,0.0 +2017-03-19 14:00:00,35.88917,35.88917,0.0,0.0,21.618247,3.1091449840111114,0.0,0.0,0.0,0.0 +2017-03-19 15:00:00,19.71251,19.71251,0.0,0.0,293.89383,44.66828076666666,0.0,0.0,0.0,0.0 +2017-03-19 16:00:00,,39.36211497286942,107.47272,0.0,1101.8058,276.7457978888889,6.309383,0.0,46.955171,17.11510861111111 +2017-03-19 17:00:00,,37.521117015547546,363.6757,0.0,1229.0266,471.6982641111111,31.902312999999996,22.244608999999997,39.408831,28.888735555555552 +2017-03-19 18:00:00,21.420170000000002,21.420170000000002,415.88646,0.5631836800000001,1249.8888,508.17797107555555,15.986443000000001,0.056520587,113.4748,40.44975998522223 +2017-03-19 19:00:00,0.73427,0.73427,452.57178,6.5863137,1281.44,536.2447053000001,0.1740782,0.0,2.2247807,0.7581510262222221 +2017-03-19 20:00:00,4.9557199999999995,4.9557199999999995,681.1057099999999,0.055289238000000004,2602.2024,1066.3358188375557,0.0,0.0,0.0,0.0 +2017-03-19 21:00:00,27.839000000000002,27.839000000000002,163.48917,0.0,4412.5323,1061.673807757778,0.0,0.0,0.0,0.0 +2017-03-19 22:00:00,46.70912,46.70912,6.411987699999999,0.0,3316.5887,580.6345908555554,0.0,0.0,1295.7832,294.5086411111111 +2017-03-19 23:00:00,67.21217,67.21217,0.0,0.0,360.92251,56.221704244444446,672.34098,553.9431000000001,823.21506,678.3341077777778 +2017-03-20 00:00:00,46.44995,46.44995,0.0,0.0,3.0837884,0.40449352033333336,0.030792958000000002,0.021278764999999998,2736.1412,781.8826942303333 +2017-03-20 01:00:00,16.55477,16.55477,0.0,0.0,0.0,0.0,0.0,0.0,71.16559600000001,16.358397444444446 +2017-03-20 02:00:00,29.901229999999998,29.901229999999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 03:00:00,40.09472,40.09472,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 04:00:00,47.814170000000004,47.814170000000004,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 05:00:00,40.756159999999994,40.756159999999994,0.0,0.0,0.0,0.0,0.0,0.0,2981.7987000000003,800.2099709999999 +2017-03-20 06:00:00,,34.27108929734159,0.0,0.0,0.0,0.0,0.036921143,0.0,1.405391,0.3403387892222222 +2017-03-20 07:00:00,0.19367,0.19367,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 08:00:00,,32.07665899842363,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 09:00:00,,34.37141324451,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 10:00:00,,33.45470034975958,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 11:00:00,15.59123,15.59123,0.0,0.0,0.0,0.0,0.0,0.0,9520.5102,2675.248666666667 +2017-03-20 12:00:00,,34.58063943744567,0.0,0.0,0.0,0.0,0.0053359934,0.0,793.5473099999999,244.8015440610444 +2017-03-20 13:00:00,47.480270000000004,47.480270000000004,0.0,0.0,0.11736139999999999,0.013312497435555555,0.0,0.0,38.83303,10.246802888888888 +2017-03-20 14:00:00,21.796999999999997,21.796999999999997,0.0,0.0,3.2492601,0.3614178033555555,0.0,0.0,0.0,0.0 +2017-03-20 15:00:00,0.63251,0.63251,0.0,0.0,53.543525,8.268177011111112,0.0,0.0,0.0,0.0 +2017-03-20 16:00:00,9.32822,9.32822,97.81939299999999,0.0,551.4542,170.1933867777778,466.83835999999997,43.280579,1088.8953,499.6546697777777 +2017-03-20 17:00:00,46.10333,46.10333,664.9053,59.060698,1067.1401,542.2509308888889,83.29650199999999,46.187753,95.91501299999999,73.6416571111111 +2017-03-20 18:00:00,94.73984,94.73984,586.77705,24.372421000000003,1154.0124,584.0739454444443,27.163065,0.055979509000000004,344.91094999999996,120.40439566566667 +2017-03-20 19:00:00,95.76061999999999,95.76061999999999,370.88164,1.1005448,1336.3367,497.14307408888885,0.34192865,0.0,9.057223899999999,2.585762535555555 +2017-03-20 20:00:00,61.370509999999996,61.370509999999996,165.59300000000002,0.0,2843.2566,700.0045207666667,0.0,0.0,0.0,0.0 +2017-03-20 21:00:00,20.55044,20.55044,10.163141,0.0,3156.906,516.4893849677778,0.0,0.0,0.0,0.0 +2017-03-20 22:00:00,30.72962,30.72962,0.0,0.0,1611.1424,217.4984913111111,0.0,0.0,0.0,0.0 +2017-03-20 23:00:00,40.80545,40.80545,0.0,0.0,464.57082,53.34282488888889,707.61185,37.938997,753.74311,484.8702152222222 +2017-03-21 00:00:00,18.71717,18.71717,0.0,0.0,273.95464999999996,36.19599061111111,0.053655511999999995,0.023274755,0.064829685,0.048349918666666665 +2017-03-21 01:00:00,14.357389999999999,14.357389999999999,0.0,0.0,18.551515000000002,2.0612794444444447,0.0,0.0,0.0,0.0 +2017-03-21 02:00:00,11.67188,11.67188,0.0,0.0,5.0230447,0.5581160777777777,0.0,0.0,0.0,0.0 +2017-03-21 03:00:00,,26.063211009821305,0.0,0.0,3.1606107000000003,0.3511789666666667,0.0,0.0,0.0,0.0 +2017-03-21 04:00:00,,27.68840224364242,0.0,0.0,3.4557706,0.38397451111111114,0.0,0.0,0.0,0.0 +2017-03-21 05:00:00,,28.13769729038119,0.0,0.0,2.0724185,0.23026872222222222,,,, +2017-03-21 06:00:00,,27.024456488141805,0.0,0.0,0.022347066,0.0024830073333333333,,,, +2017-03-21 07:00:00,,25.570982368579518,0.0,0.0,0.0,0.0,,,, +2017-03-21 08:00:00,25.123279999999998,25.123279999999998,0.0,0.0,0.0,0.0,,,, +2017-03-21 09:00:00,3.97151,3.97151,0.0,0.0,0.0,0.0,,,, +2017-03-21 10:00:00,11.07245,11.07245,0.0,0.0,1.6373185,0.18192427777777775,,,, +2017-03-21 11:00:00,,22.420521779841266,0.0,0.0,16.735419,1.9843404333333332,,,, +2017-03-21 12:00:00,,24.955410140675284,0.0,0.0,2.5469481000000003,0.41671841377777785,,,, +2017-03-21 13:00:00,,26.35180187248189,0.0,0.0,0.0,0.0,,,, +2017-03-21 14:00:00,,27.074448512050626,0.0,0.0,0.0,0.0,,,, +2017-03-21 15:00:00,,27.856376453514173,44.656848000000004,11.825319,59.825568,36.87870266666667,,,, +2017-03-21 16:00:00,,28.396875615041406,374.72366,103.90736000000001,529.33872,293.2461611111111,,,, +2017-03-21 17:00:00,,28.688681457225275,694.57543,268.99096,781.88523,496.3723733333333,,,, +2017-03-21 18:00:00,,28.889518800377843,744.54967,224.67198000000002,784.1098099999999,537.8372355555555,,,, +2017-03-21 19:00:00,,29.017456156211843,722.85498,169.09062,861.0683700000001,539.6122922222222,,,, +2017-03-21 20:00:00,,29.187893300138054,1031.8477,80.927995,1604.8955,787.1101405555556,,,, +2017-03-21 21:00:00,,29.068012244148306,1842.5897,3.6192705,3065.9689,1431.0761278333332,,,, +2017-03-21 22:00:00,,29.023191968460832,1685.4426,0.0,3260.9004999999997,1458.9160903333332,,,, +2017-03-21 23:00:00,,28.914809885041436,547.46337,0.0,4709.7141,1673.6389342111115,,,, +2017-03-22 00:00:00,,28.73174827346309,517.18205,287.10981,1233.9560000000001,656.8297844444445,0.0,0.0,0.0,0.0 +2017-03-22 01:00:00,,28.45389932167041,59.12959,0.0,857.23418,269.70974273333337,0.0,0.0,0.0,0.0 +2017-03-22 02:00:00,,27.502900472729163,38.900194,0.0,933.30623,271.5029226666667,0.0,0.0,0.0,0.0 +2017-03-22 03:00:00,,26.929633384453904,90.90868800000001,0.0,899.56133,302.50522677777775,0.0,0.0,0.0,0.0 +2017-03-22 04:00:00,,25.70222444155836,207.16597000000002,0.0,1077.3414,330.10677444444445,0.0,0.0,0.0,0.0 +2017-03-22 05:00:00,,24.270777460525686,374.76211,0.0,1083.3319,346.87245388888886,46.839104,0.0,175.55786,54.787319555555555 +2017-03-22 06:00:00,,20.791611673953984,77.161174,0.0,657.25564,223.84366366666666,8.3314326,0.2581597,10.075973,6.154241066666667 +2017-03-22 07:00:00,0.48623,0.48623,2.3454977,0.0,311.80077,88.83100885555557,0.0,0.0,0.0,0.0 +2017-03-22 08:00:00,,20.089355447063372,0.0,0.0,99.681318,17.766182311111113,0.0,0.0,0.0,0.0 +2017-03-22 09:00:00,9.28688,9.28688,0.0,0.0,56.11404,8.06887349,0.0,0.0,0.0,0.0 +2017-03-22 10:00:00,32.38322,32.38322,0.0,0.0,37.678361,4.920906559,0.0,0.0,0.0,0.0 +2017-03-22 11:00:00,22.94339,22.94339,0.0,0.0,23.744577,2.9428417000000002,0.0,0.0,0.0,0.0 +2017-03-22 12:00:00,,26.285476524806427,0.0,0.0,2.2201218,0.3508515692222222,11.960965999999999,4.179888900000001,16.160739,9.679206444444446 +2017-03-22 13:00:00,,25.040002509216762,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 14:00:00,3.84272,3.84272,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 15:00:00,,26.28057246421037,50.831321,15.376902000000001,63.67015899999999,40.69984988888889,0.0,0.0,0.0,0.0 +2017-03-22 16:00:00,11.76728,11.76728,357.73555,136.63470999999998,423.43285000000003,280.89459222222223,0.0,0.0,9.5288779,2.9750032555555554 +2017-03-22 17:00:00,11.85155,11.85155,363.31423,28.205375,849.1651400000001,391.3750151111111,25.290026,13.335234,31.371572,22.828336444444442 +2017-03-22 18:00:00,53.630390000000006,53.630390000000006,301.27884,31.962626999999998,701.86704,308.8612492222222,0.0,0.0,2.5339218,0.6473127666666666 +2017-03-22 19:00:00,118.70273,118.70273,307.86649,37.649111999999995,686.87822,313.50699533333335,0.0,0.0,0.020318334,0.0055260775555555555 +2017-03-22 20:00:00,71.41771999999999,71.41771999999999,406.06622,27.680895,908.48526,424.5404834444444,0.0,0.0,0.0,0.0 +2017-03-22 21:00:00,73.34639,73.34639,693.8134299999999,2.0158083999999996,2116.8911000000003,910.4450688222223,0.0,0.0,0.0,0.0 +2017-03-22 22:00:00,91.05899000000001,91.05899000000001,933.62335,0.0,3152.2706000000003,1254.7376468222221,0.0,0.0,0.0,0.0 +2017-03-22 23:00:00,1.7216599999999997,1.7216599999999997,364.65675999999996,0.0,4363.4982,1534.8878185444444,555.1341500000001,0.0,1146.3884,527.4687484444444 +2017-03-23 00:00:00,,34.08195075054092,565.6105299999999,0.0,1068.0113000000001,542.7010500000001,0.062102856000000005,0.026778899,0.075983991,0.05510402444444445 +2017-03-23 01:00:00,,33.112348028209986,916.1524900000001,0.0,1274.1002,405.5337665888889,0.0,0.0,0.0,0.0 +2017-03-23 02:00:00,,30.918899481572176,722.7571899999999,0.0,1170.9081,386.54695777777783,0.0,0.0,0.0,0.0 +2017-03-23 03:00:00,,28.35136539960589,1123.4229,0.0,1123.4229,399.0819018555556,0.0,0.0,0.0,0.0 +2017-03-23 04:00:00,,25.44461254754141,433.80292000000003,0.0,1119.4948,369.9112355122222,0.0,0.0,0.0,0.0 +2017-03-23 05:00:00,20.40416,20.40416,29.344306,0.0,863.6484899999999,251.33108617777776,0.0,0.0,119.62302000000001,16.16396111111111 +2017-03-23 06:00:00,18.340339999999998,18.340339999999998,0.23474112,0.0,894.35239,167.07068445777776,8.7398148,4.8548404,10.565451999999999,8.446697955555557 +2017-03-23 07:00:00,8.466439999999999,8.466439999999999,0.0,0.0,663.9568,88.51754011999999,0.0,0.0,0.0,0.0 +2017-03-23 08:00:00,1.29395,1.29395,0.0,0.0,253.88764,30.145089555555558,0.0,0.0,0.0,0.0 +2017-03-23 09:00:00,4.98911,4.98911,0.0,0.0,210.33395,25.044479666666664,0.0,0.0,0.0,0.0 +2017-03-23 10:00:00,20.37872,20.37872,0.0,0.0,129.15053,15.727869333333334,0.0,0.0,0.0,0.0 +2017-03-23 11:00:00,17.13989,17.13989,0.0,0.0,79.85297999999999,10.438106888888889,0.0,0.0,1.5535925,0.1726213888888889 +2017-03-23 12:00:00,,21.66709167081524,0.08033837399999999,0.0,6.3943758,1.2772717537777778,8.0258878,3.7236152,10.548831,7.457150611111111 +2017-03-23 13:00:00,,22.988608533828028,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 14:00:00,,24.07694271759896,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 15:00:00,,25.09277580598338,38.054921,10.530322,51.79676,31.593306666666663,0.0,0.0,0.0,0.0 +2017-03-23 16:00:00,,26.31443376918583,387.30170000000004,104.66548999999999,556.0464900000001,304.3755788888889,0.0,0.0,1.4100559,0.15667287777777777 +2017-03-23 17:00:00,,28.405565581249373,696.77585,213.35459,830.6136,501.5998388888889,81.068683,30.57305,124.61410000000001,75.83882722222222 +2017-03-23 18:00:00,37.70177,37.70177,735.55426,194.8923,822.57588,541.9997377777778,0.13234667,0.035439761,0.27222379,0.1289710371111111 +2017-03-23 19:00:00,34.35005,34.35005,409.98895000000005,82.258201,711.79494,357.0260401111111,0.0,0.0,0.0,0.0 +2017-03-23 20:00:00,,28.019170771277135,380.52211,4.7108906,1403.9406,553.6785044,0.0,0.0,0.0,0.0 +2017-03-23 21:00:00,,26.150982127345266,83.835897,0.0,1882.0897,572.9180622055555,0.0,0.0,0.0,0.0 +2017-03-23 22:00:00,,24.95127839829112,1.8020344,0.0,908.6497,212.77853478888886,0.0,0.0,0.0,0.0 +2017-03-23 23:00:00,,23.949153994912617,0.0,0.0,37.642027999999996,7.121562344444444,0.0,0.0,0.0,0.0 +2017-03-24 00:00:00,,22.955718227562453,82.38109899999999,0.0,3211.9504,1068.8460232222221,0.061816941,0.015923950000000003,0.10468299,0.05715870988888889 +2017-03-24 01:00:00,,21.821224011844407,2319.5944,0.0,3136.4995999999996,1477.4404658888889,0.0,0.0,0.0,0.0 +2017-03-24 02:00:00,,20.29940320569897,576.17674,27.790302,576.17674,253.04179466666665,0.0,0.0,0.0,0.0 +2017-03-24 03:00:00,,17.5946773731482,44.906214,0.0,381.10404,131.36959367322223,0.0,0.0,0.0,0.0 +2017-03-24 04:00:00,5.34845,5.34845,0.76030648,0.0,213.40037,42.90295630366667,0.0,0.0,0.0,0.0 +2017-03-24 05:00:00,,16.620794512506652,0.0,0.0,80.77408,10.086794506666667,0.0,0.0,166.00205,41.754631655555556 +2017-03-24 06:00:00,,16.650835875086333,0.0,0.0,63.776853,7.118386206666667,8.0996942,4.5528777,9.8242108,7.680239277777777 +2017-03-24 07:00:00,2.75834,2.75834,0.0,0.0,18.512672,2.0569635555555554,0.0,0.0,0.0,0.0 +2017-03-24 08:00:00,28.88045,28.88045,0.0,0.0,0.54361436,0.06040159555555555,0.0,0.0,0.0,0.0 +2017-03-24 09:00:00,12.683119999999999,12.683119999999999,0.0,0.0,17.730541000000002,1.9700601111111113,0.0,0.0,0.0,0.0 +2017-03-24 10:00:00,15.93944,15.93944,0.0,0.0,58.143254,6.802095877777777,0.0,0.0,0.0,0.0 +2017-03-24 11:00:00,26.00573,26.00573,0.0,0.0,26.691319,3.2954675555555557,0.0,0.0,0.0,0.0 +2017-03-24 12:00:00,,21.31957489173043,0.0,0.0,1.6800749,0.2542180497777778,8.7313001,4.6092514,10.680235,7.544520433333334 +2017-03-24 13:00:00,,21.073146776176745,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 14:00:00,,21.02603640575522,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 15:00:00,,20.932589261935874,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 16:00:00,,20.69861711161571,238.08514,90.932452,290.64196999999996,198.04508577777776,0.0,0.0,2.1994194,0.5243095333333333 +2017-03-24 17:00:00,,20.17903540577249,233.80634,24.725282999999997,581.3411,251.09995133333334,17.445052,5.9905478,26.397544999999997,16.411043133333337 +2017-03-24 18:00:00,,18.898133753564796,221.88535,16.45824,615.58309,255.71926544444446,1.3001837,0.21606981,4.6098785,1.736365081111111 +2017-03-24 19:00:00,13.26188,13.26188,177.00632,17.982764000000003,462.83528,201.77294777777777,0.0,0.0,0.0,0.0 +2017-03-24 20:00:00,,18.807671930744903,193.98377,0.8572421800000001,700.97874,297.2776075755556,0.0,0.0,0.0,0.0 +2017-03-24 21:00:00,,20.065433192548944,121.63251,0.0,908.1547,332.1183737777777,0.0,0.0,0.0,0.0 +2017-03-24 22:00:00,,20.595212711450547,80.66073499999999,0.0,804.98529,285.0337656666667,0.0,0.0,0.0,0.0 +2017-03-24 23:00:00,,20.853561530179963,2.9247753000000003,0.0,441.92294999999996,103.50655470444444,0.0,0.0,0.0,0.0 +2017-03-25 00:00:00,,20.96930239130677,0.0,0.0,320.31134,56.720111555555555,0.052534048,0.011062685,0.10686604,0.04990606766666667 +2017-03-25 01:00:00,,20.991267600448094,15.449883,0.0,669.6360099999999,179.4720218888889,0.0,0.0,0.0,0.0 +2017-03-25 02:00:00,,20.9395322906642,53.385858,0.0,306.13210000000004,108.8055968888889,0.0,0.0,0.0,0.0 +2017-03-25 03:00:00,,20.81920559072216,87.10878299999999,0.0,556.6047,192.73179477777776,0.0,0.0,0.0,0.0 +2017-03-25 04:00:00,,20.620184364994458,104.76402,0.0,799.8051,267.52405244444446,0.0,0.0,0.0,0.0 +2017-03-25 05:00:00,,20.292884549202178,102.50824,0.0,933.0054200000001,307.9305635555556,23.226705,0.0,37.52573,18.39711388888889 +2017-03-25 06:00:00,,19.558680882563213,666.05804,0.0,958.3009500000001,289.2428468888889,0.24360568,0.0,2.0473619,0.5921747909222222 +2017-03-25 07:00:00,12.44462,12.44462,640.70302,1.9583645,974.36924,321.5470521888889,0.0,0.0,0.0,0.0 +2017-03-25 08:00:00,37.37423,37.37423,38.977803,0.0,842.15577,243.01967994444445,0.0,0.0,0.0,0.0 +2017-03-25 09:00:00,9.76706,9.76706,0.23418988,0.0,605.2837099999999,144.60506809777777,0.0,0.0,0.0,0.0 +2017-03-25 10:00:00,12.50027,12.50027,0.0,0.0,317.18775,53.572937788888886,0.0,0.0,0.0,0.0 +2017-03-25 11:00:00,19.273670000000003,19.273670000000003,6.3723737,0.0,76.325297,27.238642655555555,0.0,0.0,26.491321,3.316857777777778 +2017-03-25 12:00:00,,19.147436887372454,1.3109416,0.0,6.5807308,2.2721339577777777,11.000852,4.019545,14.550238,9.897858000000001 +2017-03-25 13:00:00,,19.579396544561494,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 14:00:00,,19.86662027734253,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 15:00:00,,19.587957465291574,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 16:00:00,,19.230089785174467,187.54402,81.055121,241.44311000000002,164.981099,0.0,0.0,0.0,0.0 +2017-03-25 17:00:00,,19.19377476616678,202.45384,25.67847,503.19749,230.83967777777778,18.014158,2.9558114,46.411944000000005,21.486715877777776 +2017-03-25 18:00:00,,18.77873833847642,223.68382,65.617205,321.30026,203.14582277777777,0.0,0.0,0.0,0.0 +2017-03-25 19:00:00,,18.61578124672798,230.14771,81.01821000000001,280.03891999999996,196.08911,0.0,0.0,0.0,0.0 +2017-03-25 20:00:00,,18.388708772618354,161.56201000000001,17.254837000000002,425.31735,200.9789878888889,0.0,0.0,0.0,0.0 +2017-03-25 21:00:00,,18.082560145081136,9.976498399999999,0.05471648,175.08939,45.08049757222222,0.0,0.0,0.0,0.0 +2017-03-25 22:00:00,,17.67169360644528,0.0,0.0,7.154717,1.2216068633333332,0.0,0.0,0.0,0.0 +2017-03-25 23:00:00,,17.11081672367386,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 00:00:00,,16.312693635299496,0.0,0.0,0.0,0.0,0.00094084518,5.9702736e-05,0.004542801700000001,0.001494105571888889 +2017-03-26 01:00:00,,15.081730303910973,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 02:00:00,,12.846122774174344,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 03:00:00,6.68405,6.68405,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 04:00:00,,12.358192124694618,0.0,0.0,49.043842999999995,7.44810111111111,0.0,0.0,0.0,0.0 +2017-03-26 05:00:00,,13.598802156931962,0.0,0.0,359.78833,65.36131566666667,0.0,0.0,13.847759,3.104974388888889 +2017-03-26 06:00:00,,13.311486003632172,33.480512,0.0,1049.9129,294.8122624444444,0.0,0.0,0.12746574,0.02610802411111111 +2017-03-26 07:00:00,,11.376309569456597,567.86358,0.0,920.50608,308.2202496666667,0.0,0.0,0.0,0.0 +2017-03-26 08:00:00,4.64567,4.64567,789.59612,5.2247615,997.0727800000001,341.9411469444444,0.0,0.0,0.0,0.0 +2017-03-26 09:00:00,,11.426839519765034,565.5791,0.0,984.7075,309.31492898444446,0.0,0.0,0.0,0.0 +2017-03-26 10:00:00,,13.89992166436037,326.7776,0.0,853.92426,270.8357833333333,0.0,0.0,0.0,0.0 +2017-03-26 11:00:00,,15.256496704585427,146.71596,0.0,888.38674,236.70375155555556,47.808662,0.0,77.459779,29.11025095555555 +2017-03-26 12:00:00,,16.14226055652788,38.473124999999996,0.4009253,58.346257,22.59789042222222,3.3641045,0.033234802,10.149315000000001,3.790424078 +2017-03-26 13:00:00,,16.77864945177191,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 14:00:00,,17.26406266938681,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 15:00:00,,17.649695653855797,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 16:00:00,,17.965176890653403,172.19686000000002,42.490654,278.15514,164.59828566666667,0.0,0.0,0.0,0.0 +2017-03-26 17:00:00,,18.22901881792534,153.72576,27.018037,284.50644,158.87442466666667,6.8099375,0.58634862,24.853902,9.96101779111111 +2017-03-26 18:00:00,,18.453475147764767,187.39032,40.664341,304.79356,180.16617088888887,0.0,0.0,0.0,0.0 +2017-03-26 19:00:00,,18.647029522118146,227.78206,64.149855,321.86060000000003,204.86666944444445,0.0,0.0,0.0,0.0 +2017-03-26 20:00:00,,18.815770398332088,322.78328,49.946695,651.97743,324.17545711111114,0.0,0.0,0.0,0.0 +2017-03-26 21:00:00,,18.964197610919157,35.101868,1.5419355000000001,298.18469,89.6725615,0.0,0.0,0.0,0.0 +2017-03-26 22:00:00,,19.095719250729257,0.0,0.0,11.634318,2.0677628555555554,0.0,0.0,0.0,0.0 +2017-03-26 23:00:00,,19.212970448998906,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 00:00:00,,19.31802502185842,0.0017733658,0.0013547759999999998,0.002141596,0.0017801546666666665,0.035711799999999995,0.0047529243,0.12744022000000002,0.04860210125555556 +2017-03-27 01:00:00,,19.41254015230369,0.00018783498,0.00014151334,0.00022944717,0.0001891972533333333,0.0,0.0,0.0,0.0 +2017-03-27 02:00:00,,19.49785782588744,0.0,0.0,12.008272,1.3342524444444444,0.0,0.0,0.0,0.0 +2017-03-27 03:00:00,,19.575077531133225,0.0,0.0,0.19830151,0.02203350111111111,0.0,0.0,0.0,0.0 +2017-03-27 04:00:00,,19.645109385131356,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 05:00:00,,19.708713628005423,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 06:00:00,,19.76653043760784,0.0,0.0,4.6763134,0.7637696666666667,0.0,0.0,0.0,0.0 +2017-03-27 07:00:00,,19.81910274881601,2.9546449999999997,0.0,106.88518,27.402470955555557,0.0,0.0,0.0,0.0 +2017-03-27 08:00:00,,19.86689393683857,49.792663,0.0,86.31745699999999,38.47899892222222,0.0,0.0,0.0,0.0 +2017-03-27 09:00:00,,19.91030167527035,63.952262,0.0,98.185956,35.65081892222222,0.0,0.0,0.0,0.0 +2017-03-27 10:00:00,,19.94966890765322,64.16796500000001,0.0,94.542833,33.94643358888889,0.0,0.0,0.0,0.0 +2017-03-27 11:00:00,,19.985292614674506,58.460289,0.0,87.276749,32.95745557222222,15.183928,0.0,72.36681999999999,26.595195077777774 +2017-03-27 12:00:00,,20.017430879253805,4.3848863,0.0,7.3709707,3.08904513,0.080020229,0.0,3.3298752,0.7850933605555556 +2017-03-27 13:00:00,,20.046308623829834,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 14:00:00,,20.072122301934012,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 15:00:00,,20.095043758827803,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 16:00:00,,20.115223426286992,58.423037,3.5246419,171.87043,75.12154721111112,0.0,0.0,0.0,0.0 +2017-03-27 17:00:00,,20.13279297953237,20.3742,0.41556203,130.35796000000002,48.67027293666667,1.3448376,0.0,9.114462999999999,3.125008063222222 +2017-03-27 18:00:00,,20.147867556354893,16.182168,0.0,101.50005,36.05836918888889,0.0,0.0,0.0,0.0 +2017-03-27 19:00:00,,20.16054761721481,16.864869,0.0,90.023044,31.660279077222224,0.0,0.0,0.0,0.0 +2017-03-27 20:00:00,,20.17092050876658,3.5782109,0.0,21.006695999999998,6.460653276666666,0.0,0.0,0.0,0.0 +2017-03-27 21:00:00,,20.179061780620266,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 22:00:00,,20.185036295282075,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 23:00:00,,20.188899163453364,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 00:00:00,,20.190696530711364,0.0,0.0,0.0,0.0,0.65328504,0.57125271,0.68186876,0.6273741944444444 +2017-03-28 01:00:00,,20.190466236675213,0.0,0.0,0.0,0.0,0.045377906,0.014703293000000001,0.098308426,0.050814232555555554 +2017-03-28 02:00:00,,20.1882383637978,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 03:00:00,,20.184035689704615,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 04:00:00,,20.177874054361684,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 05:00:00,,20.169762651169833,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 06:00:00,,20.159704249253295,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 07:00:00,,20.14769535265905,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 08:00:00,,20.133726300847414,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 09:00:00,,20.11778131368417,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 10:00:00,,20.099838483097944,0.0,0.0,5.552833,1.0871953444444444,0.0,0.0,0.0,0.0 +2017-03-28 11:00:00,,20.079869712609916,0.0,0.0,23.865752,5.033290655555556,0.0,0.0,0.0,0.0 +2017-03-28 12:00:00,,20.057840605045122,0.0,0.0,3.7290124,0.7560485366666667,0.0,0.0,0.0,0.0 +2017-03-28 13:00:00,,20.033710297869895,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 14:00:00,,20.00743124474299,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 15:00:00,,19.97894894099583,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 16:00:00,,19.948201589845638,37.675298000000005,0.0,149.25633,62.987896166666665,0.0,0.0,0.0,0.0 +2017-03-28 17:00:00,,19.91511970516982,49.895098,0.0,208.13513,81.86357828888889,0.0,0.0,1.5094545,0.3213409544444444 +2017-03-28 18:00:00,,19.879625645604435,209.01814000000002,47.475842,374.85634999999996,219.38126377777778,0.0,0.0,0.028695464,0.005703628333333334 +2017-03-28 19:00:00,,19.841633073543385,440.34378000000004,328.86234,539.21778,408.8533444444445,0.46286758,0.28738488999999995,0.70559372,0.47512396111111105 +2017-03-28 20:00:00,,19.801046331274936,885.66507,293.12077000000005,1130.0709,735.6762111111111,0.12092932999999999,0.087064826,0.15949982000000001,0.12201295000000001 +2017-03-28 21:00:00,,19.757759724957335,279.93746000000004,92.99368700000001,400.4513,272.3010296666667,0.0,0.0,0.0,0.0 +2017-03-28 22:00:00,,19.711656705359147,15.411822,9.9239387,26.574427,17.040076522222225,0.0,0.0,0.0,0.0 +2017-03-28 23:00:00,,19.66260893221311,1.6940717,1.3365764999999998,2.1291507000000003,1.714265288888889,0.0,0.0,0.0,0.0 +2017-03-29 00:00:00,,19.610475206585846,0.39278771,0.3384568,0.45348682,0.3939215166666667,0.035167663,0.03388562,0.040934494999999994,0.036311883222222216 +2017-03-29 01:00:00,,19.555100252760724,0.043446532999999996,0.036868634,0.050681987000000005,0.04366024877777778,0.027923855,0.025691019000000002,0.02876558,0.027895450999999998 +2017-03-29 02:00:00,,19.496313327659553,0.0007048313,0.00032741435,0.0013154974,0.0007669054566666667,0.016420062,0.014780037,0.017796994,0.016461907111111108 +2017-03-29 03:00:00,,19.433926631652536,0.0,0.0,0.0,0.0,0.0002512307,0.00021557262999999998,0.00029065778,0.0002507481244444444 +2017-03-29 04:00:00,,19.367733489551572,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 05:00:00,,19.29750626442689,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 06:00:00,,19.222993959344542,0.0,0.0,0.0,0.0,0.0,0.0,0.13891314,0.031358249888888884 +2017-03-29 07:00:00,,19.143919452820153,0.0,0.0,0.0,0.0,0.070827653,0.0,0.29989781,0.1045880948888889 +2017-03-29 08:00:00,,19.05997630223442,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 09:00:00,,18.97082503501183,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 10:00:00,,18.87608882916173,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 11:00:00,,18.77534846165161,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 12:00:00,,18.668136373425337,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 13:00:00,,18.55392966147405,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 14:00:00,,18.432141758085677,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 15:00:00,,18.30211249076387,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 16:00:00,,18.16309612679083,0.0,0.0,15.119551,4.967880555555555,0.0,0.0,0.0,0.0 +2017-03-29 17:00:00,,18.01424688430648,0.0,0.0,8.7386015,2.6896551,0.0,0.0,1.2132834000000001,0.25898987 +2017-03-29 18:00:00,,17.854601222332988,0.0,0.0,13.599618999999999,4.3970503333333335,0.0,0.0,0.0,0.0 +2017-03-29 19:00:00,,17.683055982399058,0.0,0.0,15.987709,5.098268333333333,0.42899688,0.27777517,0.61489692,0.43309352888888886 +2017-03-29 20:00:00,,17.498341107505677,0.36165181,0.25328322,16.453847,4.195502661111111,0.10702048,0.08060606399999999,0.13819714,0.10819215666666666 +2017-03-29 21:00:00,,17.298985149384638,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 22:00:00,,17.083270988690252,0.006739,0.0034134714999999997,0.059774179999999996,0.012016493377777777,0.0,0.0,0.0,0.0 +2017-03-29 23:00:00,,16.84917795137248,0.0023638866,0.0020489757,0.0045672799,0.0025747915666666666,0.0,0.0,0.0,0.0 +2017-03-30 00:00:00,,16.59430446915195,0.0,0.0,0.0,0.0,0.004562629800000001,0.0037210828000000004,0.0059795782,0.00472913798888889 +2017-03-30 01:00:00,,16.315761947607868,0.0,0.0,0.0,0.0,0.0006499394900000001,0.00051053622,0.00076457263,0.0006494881555555555 +2017-03-30 02:00:00,,16.010024237626542,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 03:00:00,,15.672705172525372,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 04:00:00,,15.298212372230203,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 05:00:00,,14.879172267763199,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 06:00:00,,14.405393305118189,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 07:00:00,,13.861790581651007,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 08:00:00,,13.223633476755177,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 09:00:00,,12.443525289340428,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 10:00:00,,11.40524731156624,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 11:00:00,,9.671684383506708,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 12:00:00,2.21138,2.21138,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 13:00:00,19.11467,19.11467,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 14:00:00,7.553780000000001,7.553780000000001,0.43629242,0.36252553,0.55207624,0.45048985444444445,0.0,0.0,0.0,0.0 +2017-03-30 15:00:00,,11.332179867722747,2.4797618999999997,2.280507,2.7310762,2.4958115666666667,0.0,0.0,0.0,0.0 +2017-03-30 16:00:00,,12.324197303268186,4.076882299999999,3.7695675,20.338455,9.416062555555554,0.0,0.0,0.0,0.0 +2017-03-30 17:00:00,,13.013570030119377,7.2970624,6.7541555,10.739296,8.169769811111113,0.50641859,0.0,2.7118444,0.9696237322222222 +2017-03-30 18:00:00,,13.580268082010704,7.7017648,7.3709298,8.049883000000001,7.713462155555557,5.9809818,3.2801543000000004,9.8271339,6.220727077777777 +2017-03-30 19:00:00,,14.069093712179262,8.0430946,7.3877486,8.672293000000002,8.039263577777778,7.021012600000001,5.3627364,8.9607256,7.060220822222224 +2017-03-30 20:00:00,,14.499461172129328,3.5631966999999998,2.6966929,4.5393449,3.5796467,0.52815318,0.38814861,0.7044907300000001,0.5313841477777778 +2017-03-30 21:00:00,,14.882841771605895,1.3237128999999999,1.0031338,1.7101499,1.3315734333333333,0.0,0.0,0.0,0.0 +2017-03-30 22:00:00,,15.227194629217607,3.1090250999999998,0.69107017,52.486095,10.482892281111113,0.0,0.0,0.0,0.0 +2017-03-30 23:00:00,,15.53851191988687,56.674015999999995,20.534491,232.54662,81.77451688888888,0.0,0.0,0.0,0.0 +2017-03-31 00:00:00,,15.82150835890076,0.0,0.0,0.0,0.0,0.004947033,0.0040477510000000005,0.0058923622,0.0049691089444444435 +2017-03-31 01:00:00,,16.079992521699342,0.0,0.0,0.0,0.0,0.62794618,0.30350492,1.498918,0.7862079177777778 +2017-03-31 02:00:00,,16.317095372594967,0.0,0.0,0.0,0.0,12.655611,10.351117,15.096066,12.698716111111112 +2017-03-31 03:00:00,,16.53542403986373,0.0,0.0,0.0,0.0,22.462109,19.84767,25.27186,22.499407 +2017-03-31 04:00:00,,16.737171517832394,0.0,0.0,0.0,0.0,25.417461,23.122808,27.847469,25.430444777777776 +2017-03-31 05:00:00,,16.924198032432415,0.0,0.0,0.0,0.0,28.866825000000002,26.881711,30.892614000000002,28.859101333333328 +2017-03-31 06:00:00,,17.09809303846021,0.0,0.0,0.0,0.0,23.097859999999997,22.141712000000002,24.019933,23.094033555555555 +2017-03-31 07:00:00,,17.26022339642206,0.0,0.0,0.0,0.0,19.266643000000002,18.595514,19.930165,19.262717444444448 +2017-03-31 08:00:00,,17.41177137898982,0.0,0.0,0.0,0.0,14.419989000000001,13.994526,14.833231,14.413670111111113 +2017-03-31 09:00:00,,17.553765020373298,0.0,0.0,0.0,0.0,10.462323,10.183748,10.738454999999998,10.46211811111111 +2017-03-31 10:00:00,,17.687102598715477,0.0,0.0,0.0,0.0,8.4713956,8.291802299999999,8.6454229,8.46801928888889 +2017-03-31 11:00:00,,17.81257255952982,0.0,0.0,0.0,0.0,13.40162,11.384863000000001,16.192589,13.530136777777777 +2017-03-31 12:00:00,,17.93086985510504,66259.96500000001,1650.1659,148706.8,66671.88765555556,6.1215742,5.0687481,7.3256374,6.154920377777778 +2017-03-31 13:00:00,,18.04260943817409,29496.813000000002,1700.9478,46804.085,27368.965522222225,0.86903384,0.78127869,0.9616272800000001,0.8675567066666667 +2017-03-31 14:00:00,,18.148337476326983,2389.4249,1990.1183,2814.1052,2389.729522222222,0.28173503,0.27437419999999996,0.28907419,0.2817909511111111 +2017-03-31 15:00:00,,18.248540726674115,1391.7522000000001,1274.1918,1550.6343000000002,1396.2309777777778,0.58609606,0.5345168,0.63284273,0.5864890099999999 +2017-03-31 16:00:00,,18.34365441505986,367.35524,326.65758,408.71074,366.85955111111105,1.0124926,0.94094537,1.0803767,1.0126268722222223 +2017-03-31 17:00:00,,18.43406889185736,29.351546000000003,23.989456,35.496611,29.454501555555552,,,, +2017-03-31 18:00:00,,18.520135280933022,2.9988673,2.360176,3.7104792,3.0022172555555553,,,, +2017-03-31 19:00:00,,18.602170295437585,0.0,0.0,0.0,0.0,,,, +2017-03-31 20:00:00,,18.68046036055792,0.0,0.0,0.0,0.0,,,, +2017-03-31 21:00:00,,18.75526515698933,0.0,0.0,0.0,0.0,,,, +2017-03-31 22:00:00,,18.826820677993805,0.0,0.0,0.0,0.0,,,, +2017-03-31 23:00:00,,18.895341876250114,0.0,0.0,0.0,0.0,,,, diff --git a/Analysis/TimeSeries_Data/ElPanama/ElPanama_cleaned.csv b/Analysis/TimeSeries_Data/ElPanama/ElPanama_cleaned.csv new file mode 100644 index 0000000..e941b6a --- /dev/null +++ b/Analysis/TimeSeries_Data/ElPanama/ElPanama_cleaned.csv @@ -0,0 +1,745 @@ +TimeBeginning,ElPanama_raw,ElPanama_KNN +2017-03-01 00:00:00,142.637,142.637 +2017-03-01 01:00:00,39.266329999999996,39.266329999999996 +2017-03-01 02:00:00,32.56289,32.56289 +2017-03-01 03:00:00,104.96672,104.96672 +2017-03-01 04:00:00,114.76111999999999,114.76111999999999 +2017-03-01 05:00:00,27.92645,27.92645 +2017-03-01 06:00:00,32.49134,32.49134 +2017-03-01 07:00:00,21.42812,21.42812 +2017-03-01 08:00:00,44.36228,44.36228 +2017-03-01 09:00:00,73.28756,73.28756 +2017-03-01 10:00:00,27.867620000000002,27.867620000000002 +2017-03-01 11:00:00,8.84645,8.84645 +2017-03-01 12:00:00,,51.04109643498767 +2017-03-01 13:00:00,,56.45847493777853 +2017-03-01 14:00:00,,58.82315884739315 +2017-03-01 15:00:00,,59.29673026808841 +2017-03-01 16:00:00,,56.07245409025582 +2017-03-01 17:00:00,4.24817,4.24817 +2017-03-01 18:00:00,20.91773,20.91773 +2017-03-01 19:00:00,103.81555999999999,103.81555999999999 +2017-03-01 20:00:00,131.88701,131.88701 +2017-03-01 21:00:00,76.47551,76.47551 +2017-03-01 22:00:00,94.58084000000001,94.58084000000001 +2017-03-01 23:00:00,88.63901,88.63901 +2017-03-02 00:00:00,84.41438000000001,84.41438000000001 +2017-03-02 01:00:00,47.27834,47.27834 +2017-03-02 02:00:00,49.23245,49.23245 +2017-03-02 03:00:00,133.4945,133.4945 +2017-03-02 04:00:00,148.48183999999998,148.48183999999998 +2017-03-02 05:00:00,199.27916000000002,199.27916000000002 +2017-03-02 06:00:00,156.98516,156.98516 +2017-03-02 07:00:00,165.04328,165.04328 +2017-03-02 08:00:00,109.92116000000001,109.92116000000001 +2017-03-02 09:00:00,60.62161999999999,60.62161999999999 +2017-03-02 10:00:00,49.91933,49.91933 +2017-03-02 11:00:00,19.89377,19.89377 +2017-03-02 12:00:00,36.32006,36.32006 +2017-03-02 13:00:00,14.285839999999999,14.285839999999999 +2017-03-02 14:00:00,16.61678,16.61678 +2017-03-02 15:00:00,41.04077,41.04077 +2017-03-02 16:00:00,17.52149,17.52149 +2017-03-02 17:00:00,54.325219999999995,54.325219999999995 +2017-03-02 18:00:00,19.65527,19.65527 +2017-03-02 19:00:00,,65.35209487349098 +2017-03-02 20:00:00,29.71838,29.71838 +2017-03-02 21:00:00,61.79821999999999,61.79821999999999 +2017-03-02 22:00:00,110.49833000000001,110.49833000000001 +2017-03-02 23:00:00,80.84801,80.84801 +2017-03-03 00:00:00,155.44127,155.44127 +2017-03-03 01:00:00,135.85088000000002,135.85088000000002 +2017-03-03 02:00:00,146.93795,146.93795 +2017-03-03 03:00:00,123.93701000000001,123.93701000000001 +2017-03-03 04:00:00,169.43327,169.43327 +2017-03-03 05:00:00,160.32416,160.32416 +2017-03-03 06:00:00,141.90083,141.90083 +2017-03-03 07:00:00,98.71961,98.71961 +2017-03-03 08:00:00,77.54399000000001,77.54399000000001 +2017-03-03 09:00:00,71.01545,71.01545 +2017-03-03 10:00:00,42.16967,42.16967 +2017-03-03 11:00:00,81.44266999999999,81.44266999999999 +2017-03-03 12:00:00,25.83878,25.83878 +2017-03-03 13:00:00,11.126510000000001,11.126510000000001 +2017-03-03 14:00:00,,62.83366676926607 +2017-03-03 15:00:00,30.61673,30.61673 +2017-03-03 16:00:00,41.70539,41.70539 +2017-03-03 17:00:00,38.530159999999995,38.530159999999995 +2017-03-03 18:00:00,174.01883,174.01883 +2017-03-03 19:00:00,130.95845,130.95845 +2017-03-03 20:00:00,61.10816,61.10816 +2017-03-03 21:00:00,68.86895,68.86895 +2017-03-03 22:00:00,195.32801,195.32801 +2017-03-03 23:00:00,91.47239,91.47239 +2017-03-04 00:00:00,83.08355,83.08355 +2017-03-04 01:00:00,,73.91031493529952 +2017-03-04 02:00:00,0.20639000000000002,0.20639000000000002 +2017-03-04 03:00:00,59.12066,59.12066 +2017-03-04 04:00:00,51.814609999999995,51.814609999999995 +2017-03-04 05:00:00,150.31034,150.31034 +2017-03-04 06:00:00,116.93306000000001,116.93306000000001 +2017-03-04 07:00:00,32.467490000000005,32.467490000000005 +2017-03-04 08:00:00,79.9115,79.9115 +2017-03-04 09:00:00,71.61488,71.61488 +2017-03-04 10:00:00,48.865159999999996,48.865159999999996 +2017-03-04 11:00:00,41.91527,41.91527 +2017-03-04 12:00:00,43.128440000000005,43.128440000000005 +2017-03-04 13:00:00,41.39216,41.39216 +2017-03-04 14:00:00,46.83473,46.83473 +2017-03-04 15:00:00,55.392109999999995,55.392109999999995 +2017-03-04 16:00:00,22.40756,22.40756 +2017-03-04 17:00:00,59.246269999999996,59.246269999999996 +2017-03-04 18:00:00,126.74972,126.74972 +2017-03-04 19:00:00,28.174490000000002,28.174490000000002 +2017-03-04 20:00:00,3.25601,3.25601 +2017-03-04 21:00:00,29.629340000000003,29.629340000000003 +2017-03-04 22:00:00,126.59548999999998,126.59548999999998 +2017-03-04 23:00:00,173.22701,173.22701 +2017-03-05 00:00:00,161.9555,161.9555 +2017-03-05 01:00:00,77.00339,77.00339 +2017-03-05 02:00:00,29.8265,29.8265 +2017-03-05 03:00:00,30.64217,30.64217 +2017-03-05 04:00:00,95.20411999999999,95.20411999999999 +2017-03-05 05:00:00,133.08905,133.08905 +2017-03-05 06:00:00,125.27738000000001,125.27738000000001 +2017-03-05 07:00:00,,65.27593864184468 +2017-03-05 08:00:00,11.75933,11.75933 +2017-03-05 09:00:00,55.92794,55.92794 +2017-03-05 10:00:00,20.30399,20.30399 +2017-03-05 11:00:00,29.708840000000002,29.708840000000002 +2017-03-05 12:00:00,18.80939,18.80939 +2017-03-05 13:00:00,4.61228,4.61228 +2017-03-05 14:00:00,,46.11087686507355 +2017-03-05 15:00:00,,49.549155209767676 +2017-03-05 16:00:00,24.65105,24.65105 +2017-03-05 17:00:00,50.768390000000004,50.768390000000004 +2017-03-05 18:00:00,150.06389,150.06389 +2017-03-05 19:00:00,49.07345,49.07345 +2017-03-05 20:00:00,29.71361,29.71361 +2017-03-05 21:00:00,25.08512,25.08512 +2017-03-05 22:00:00,60.20345,60.20345 +2017-03-05 23:00:00,105.5105,105.5105 +2017-03-06 00:00:00,34.178329999999995,34.178329999999995 +2017-03-06 01:00:00,9.671660000000001,9.671660000000001 +2017-03-06 02:00:00,10.04849,10.04849 +2017-03-06 03:00:00,38.20262,38.20262 +2017-03-06 04:00:00,140.05166,140.05166 +2017-03-06 05:00:00,88.38461,88.38461 +2017-03-06 06:00:00,78.24677,78.24677 +2017-03-06 07:00:00,46.19873,46.19873 +2017-03-06 08:00:00,77.24189,77.24189 +2017-03-06 09:00:00,110.12945,110.12945 +2017-03-06 10:00:00,49.96544,49.96544 +2017-03-06 11:00:00,17.5835,17.5835 +2017-03-06 12:00:00,,49.855431715170404 +2017-03-06 13:00:00,,49.73729258800395 +2017-03-06 14:00:00,,45.672121358777886 +2017-03-06 15:00:00,1.7502799999999998,1.7502799999999998 +2017-03-06 16:00:00,,45.158722415634514 +2017-03-06 17:00:00,,49.408816004704384 +2017-03-06 18:00:00,,50.07923027548261 +2017-03-06 19:00:00,6.90188,6.90188 +2017-03-06 20:00:00,135.09722,135.09722 +2017-03-06 21:00:00,82.26788,82.26788 +2017-03-06 22:00:00,4.79672,4.79672 +2017-03-06 23:00:00,27.84695,27.84695 +2017-03-07 00:00:00,25.91033,25.91033 +2017-03-07 01:00:00,14.78033,14.78033 +2017-03-07 02:00:00,21.09422,21.09422 +2017-03-07 03:00:00,63.46771999999999,63.46771999999999 +2017-03-07 04:00:00,18.39599,18.39599 +2017-03-07 05:00:00,167.42033,167.42033 +2017-03-07 06:00:00,123.59038999999999,123.59038999999999 +2017-03-07 07:00:00,96.12473,96.12473 +2017-03-07 08:00:00,76.90321999999999,76.90321999999999 +2017-03-07 09:00:00,18.935,18.935 +2017-03-07 10:00:00,8.282,8.282 +2017-03-07 11:00:00,,53.39691752957359 +2017-03-07 12:00:00,,59.37054011174963 +2017-03-07 13:00:00,,61.40291387517299 +2017-03-07 14:00:00,,63.14319148373423 +2017-03-07 15:00:00,,64.47923493605562 +2017-03-07 16:00:00,,65.2678760049984 +2017-03-07 17:00:00,,65.92234848569086 +2017-03-07 18:00:00,,66.78831237474117 +2017-03-07 19:00:00,,66.60310053670186 +2017-03-07 20:00:00,,66.6645374634421 +2017-03-07 21:00:00,,64.5420874200783 +2017-03-07 22:00:00,8.45372,8.45372 +2017-03-07 23:00:00,135.11312,135.11312 +2017-03-08 00:00:00,97.64795,97.64795 +2017-03-08 01:00:00,97.62250999999999,97.62250999999999 +2017-03-08 02:00:00,89.89034000000001,89.89034000000001 +2017-03-08 03:00:00,142.93433000000002,142.93433000000002 +2017-03-08 04:00:00,91.80311,91.80311 +2017-03-08 05:00:00,34.529720000000005,34.529720000000005 +2017-03-08 06:00:00,54.47945,54.47945 +2017-03-08 07:00:00,50.68094,50.68094 +2017-03-08 08:00:00,72.10778,72.10778 +2017-03-08 09:00:00,91.13372,91.13372 +2017-03-08 10:00:00,55.43026999999999,55.43026999999999 +2017-03-08 11:00:00,49.145,49.145 +2017-03-08 12:00:00,50.932159999999996,50.932159999999996 +2017-03-08 13:00:00,12.28562,12.28562 +2017-03-08 14:00:00,49.33739,49.33739 +2017-03-08 15:00:00,42.50516,42.50516 +2017-03-08 16:00:00,75.43406,75.43406 +2017-03-08 17:00:00,6.26588,6.26588 +2017-03-08 18:00:00,139.76705,139.76705 +2017-03-08 19:00:00,119.96201,119.96201 +2017-03-08 20:00:00,94.301,94.301 +2017-03-08 21:00:00,75.58511,75.58511 +2017-03-08 22:00:00,100.15856,100.15856 +2017-03-08 23:00:00,85.28411,85.28411 +2017-03-09 00:00:00,15.14444,15.14444 +2017-03-09 01:00:00,44.48312,44.48312 +2017-03-09 02:00:00,,48.2070915599883 +2017-03-09 03:00:00,,42.450362567506616 +2017-03-09 04:00:00,1.53722,1.53722 +2017-03-09 05:00:00,24.22334,24.22334 +2017-03-09 06:00:00,23.59688,23.59688 +2017-03-09 07:00:00,35.96549,35.96549 +2017-03-09 08:00:00,5.08451,5.08451 +2017-03-09 09:00:00,3.15584,3.15584 +2017-03-09 10:00:00,52.776559999999996,52.776559999999996 +2017-03-09 11:00:00,31.831490000000002,31.831490000000002 +2017-03-09 12:00:00,45.22883,45.22883 +2017-03-09 13:00:00,32.09861,32.09861 +2017-03-09 14:00:00,19.41995,19.41995 +2017-03-09 15:00:00,4.67111,4.67111 +2017-03-09 16:00:00,37.542770000000004,37.542770000000004 +2017-03-09 17:00:00,19.28639,19.28639 +2017-03-09 18:00:00,29.86784,29.86784 +2017-03-09 19:00:00,34.701440000000005,34.701440000000005 +2017-03-09 20:00:00,24.767120000000002,24.767120000000002 +2017-03-09 21:00:00,118.8665,118.8665 +2017-03-09 22:00:00,145.06333999999998,145.06333999999998 +2017-03-09 23:00:00,104.97148999999999,104.97148999999999 +2017-03-10 00:00:00,83.55578,83.55578 +2017-03-10 01:00:00,93.03376999999999,93.03376999999999 +2017-03-10 02:00:00,154.66693999999998,154.66693999999998 +2017-03-10 03:00:00,43.40033,43.40033 +2017-03-10 04:00:00,14.893220000000001,14.893220000000001 +2017-03-10 05:00:00,84.85322,84.85322 +2017-03-10 06:00:00,96.93245,96.93245 +2017-03-10 07:00:00,83.47628,83.47628 +2017-03-10 08:00:00,42.26189,42.26189 +2017-03-10 09:00:00,25.95962,25.95962 +2017-03-10 10:00:00,8.32334,8.32334 +2017-03-10 11:00:00,,41.75841832456929 +2017-03-10 12:00:00,,44.301661133840796 +2017-03-10 13:00:00,,44.623691459251596 +2017-03-10 14:00:00,,43.95657454692005 +2017-03-10 15:00:00,,43.222423640078034 +2017-03-10 16:00:00,,42.16545755110364 +2017-03-10 17:00:00,,40.0625397399229 +2017-03-10 18:00:00,9.99284,9.99284 +2017-03-10 19:00:00,108.77,108.77 +2017-03-10 20:00:00,6.55049,6.55049 +2017-03-10 21:00:00,44.71049,44.71049 +2017-03-10 22:00:00,24.29012,24.29012 +2017-03-10 23:00:00,44.1365,44.1365 +2017-03-11 00:00:00,55.65923000000001,55.65923000000001 +2017-03-11 01:00:00,8.725610000000001,8.725610000000001 +2017-03-11 02:00:00,19.73795,19.73795 +2017-03-11 03:00:00,15.02201,15.02201 +2017-03-11 04:00:00,29.85512,29.85512 +2017-03-11 05:00:00,,27.410049560746643 +2017-03-11 06:00:00,2.5325599999999997,2.5325599999999997 +2017-03-11 07:00:00,,28.63703570291145 +2017-03-11 08:00:00,46.00634,46.00634 +2017-03-11 09:00:00,21.45833,21.45833 +2017-03-11 10:00:00,10.662230000000001,10.662230000000001 +2017-03-11 11:00:00,,27.72346816554099 +2017-03-11 12:00:00,,29.87933926985508 +2017-03-11 13:00:00,,30.649349436102096 +2017-03-11 14:00:00,,31.163148712694973 +2017-03-11 15:00:00,,30.617954724690076 +2017-03-11 16:00:00,,29.653488725299177 +2017-03-11 17:00:00,,27.08736686187003 +2017-03-11 18:00:00,,22.258818495568047 +2017-03-11 19:00:00,3.13994,3.13994 +2017-03-11 20:00:00,,20.889092382493796 +2017-03-11 21:00:00,,23.433597220063056 +2017-03-11 22:00:00,,23.540964572413092 +2017-03-11 23:00:00,,22.3348820541544 +2017-03-12 00:00:00,,19.848106308190562 +2017-03-12 01:00:00,4.650440000000001,4.650440000000001 +2017-03-12 02:00:00,,19.53456955832082 +2017-03-12 03:00:00,,20.228292584274673 +2017-03-12 04:00:00,,19.504144079607602 +2017-03-12 05:00:00,8.94662,8.94662 +2017-03-12 06:00:00,27.07262,27.07262 +2017-03-12 07:00:00,3.12245,3.12245 +2017-03-12 08:00:00,4.04306,4.04306 +2017-03-12 09:00:00,,21.493163030873443 +2017-03-12 10:00:00,38.67962,38.67962 +2017-03-12 11:00:00,27.579829999999998,27.579829999999998 +2017-03-12 12:00:00,,23.640709681562097 +2017-03-12 13:00:00,,21.042189913283824 +2017-03-12 14:00:00,5.62511,5.62511 +2017-03-12 15:00:00,,19.150285146244855 +2017-03-12 16:00:00,2.49122,2.49122 +2017-03-12 17:00:00,,23.869552469969367 +2017-03-12 18:00:00,,29.25779467119529 +2017-03-12 19:00:00,33.33245,33.33245 +2017-03-12 20:00:00,66.01966999999999,66.01966999999999 +2017-03-12 21:00:00,,37.692557323673185 +2017-03-12 22:00:00,,35.331496890434416 +2017-03-12 23:00:00,,36.50618410625258 +2017-03-13 00:00:00,,39.441401556665696 +2017-03-13 01:00:00,,46.73557444533051 +2017-03-13 02:00:00,97.27112,97.27112 +2017-03-13 03:00:00,55.16633,55.16633 +2017-03-13 04:00:00,,40.12452493793151 +2017-03-13 05:00:00,,35.34176267330031 +2017-03-13 06:00:00,34.05272,34.05272 +2017-03-13 07:00:00,,31.94236663130569 +2017-03-13 08:00:00,24.4205,24.4205 +2017-03-13 09:00:00,80.02439,80.02439 +2017-03-13 10:00:00,9.05633,9.05633 +2017-03-13 11:00:00,12.86438,12.86438 +2017-03-13 12:00:00,12.55751,12.55751 +2017-03-13 13:00:00,0.92984,0.92984 +2017-03-13 14:00:00,3.512,3.512 +2017-03-13 15:00:00,,19.827948016361695 +2017-03-13 16:00:00,,23.28156901190665 +2017-03-13 17:00:00,,25.68744802070847 +2017-03-13 18:00:00,,29.06417421698214 +2017-03-13 19:00:00,48.16238,48.16238 +2017-03-13 20:00:00,31.93484,31.93484 +2017-03-13 21:00:00,,27.72211093709778 +2017-03-13 22:00:00,,26.08954917247864 +2017-03-13 23:00:00,,25.042032357718973 +2017-03-14 00:00:00,,24.096672277154756 +2017-03-14 01:00:00,,22.539341507556937 +2017-03-14 02:00:00,5.17355,5.17355 +2017-03-14 03:00:00,52.668440000000004,52.668440000000004 +2017-03-14 04:00:00,,25.315340661729394 +2017-03-14 05:00:00,,20.947051078788714 +2017-03-14 06:00:00,4.0351099999999995,4.0351099999999995 +2017-03-14 07:00:00,15.947389999999999,15.947389999999999 +2017-03-14 08:00:00,17.73455,17.73455 +2017-03-14 09:00:00,33.742670000000004,33.742670000000004 +2017-03-14 10:00:00,15.9935,15.9935 +2017-03-14 11:00:00,18.617,18.617 +2017-03-14 12:00:00,0.491,0.491 +2017-03-14 13:00:00,,17.485113905476574 +2017-03-14 14:00:00,10.059619999999999,10.059619999999999 +2017-03-14 15:00:00,21.41699,21.41699 +2017-03-14 16:00:00,7.63805,7.63805 +2017-03-14 17:00:00,,21.60683489566093 +2017-03-14 18:00:00,,24.762653320090322 +2017-03-14 19:00:00,,27.96485513960649 +2017-03-14 20:00:00,,32.29422652287009 +2017-03-14 21:00:00,37.061,37.061 +2017-03-14 22:00:00,100.59899,100.59899 +2017-03-14 23:00:00,57.07433,57.07433 +2017-03-15 00:00:00,,32.11128514070801 +2017-03-15 01:00:00,,23.859636051647648 +2017-03-15 02:00:00,9.515839999999999,9.515839999999999 +2017-03-15 03:00:00,7.04339,7.04339 +2017-03-15 04:00:00,7.617380000000001,7.617380000000001 +2017-03-15 05:00:00,5.8922300000000005,5.8922300000000005 +2017-03-15 06:00:00,3.62489,3.62489 +2017-03-15 07:00:00,,15.702784901256054 +2017-03-15 08:00:00,,17.443168718500477 +2017-03-15 09:00:00,,18.06386824837606 +2017-03-15 10:00:00,,17.16576075123399 +2017-03-15 11:00:00,3.65351,3.65351 +2017-03-15 12:00:00,,17.525266836124533 +2017-03-15 13:00:00,16.57067,16.57067 +2017-03-15 14:00:00,15.41156,15.41156 +2017-03-15 15:00:00,,20.296781669348334 +2017-03-15 16:00:00,,21.71741586869639 +2017-03-15 17:00:00,,22.764590343956034 +2017-03-15 18:00:00,,23.865399853788556 +2017-03-15 19:00:00,,26.14718047958118 +2017-03-15 20:00:00,46.04927,46.04927 +2017-03-15 21:00:00,3.9095,3.9095 +2017-03-15 22:00:00,,20.876298807418305 +2017-03-15 23:00:00,10.45712,10.45712 +2017-03-16 00:00:00,,23.55510827241302 +2017-03-16 01:00:00,,26.325070657086684 +2017-03-16 02:00:00,17.79656,17.79656 +2017-03-16 03:00:00,79.64438,79.64438 +2017-03-16 04:00:00,16.01099,16.01099 +2017-03-16 05:00:00,,25.827564606313697 +2017-03-16 06:00:00,,22.84479216322679 +2017-03-16 07:00:00,2.81717,2.81717 +2017-03-16 08:00:00,,20.72578634144575 +2017-03-16 09:00:00,5.08133,5.08133 +2017-03-16 10:00:00,32.960390000000004,32.960390000000004 +2017-03-16 11:00:00,26.441390000000002,26.441390000000002 +2017-03-16 12:00:00,19.97327,19.97327 +2017-03-16 13:00:00,21.02744,21.02744 +2017-03-16 14:00:00,23.51738,23.51738 +2017-03-16 15:00:00,18.11138,18.11138 +2017-03-16 16:00:00,54.43334,54.43334 +2017-03-16 17:00:00,,32.99706330106994 +2017-03-16 18:00:00,,31.739017647867488 +2017-03-16 19:00:00,,31.81062426055618 +2017-03-16 20:00:00,,31.903376487554574 +2017-03-16 21:00:00,,32.18688111890567 +2017-03-16 22:00:00,20.42483,20.42483 +2017-03-16 23:00:00,69.19649,69.19649 +2017-03-17 00:00:00,14.78033,14.78033 +2017-03-17 01:00:00,,34.90130128567068 +2017-03-17 02:00:00,41.09483,41.09483 +2017-03-17 03:00:00,22.587229999999998,22.587229999999998 +2017-03-17 04:00:00,74.90777,74.90777 +2017-03-17 05:00:00,74.42123000000001,74.42123000000001 +2017-03-17 06:00:00,25.03901,25.03901 +2017-03-17 07:00:00,17.35295,17.35295 +2017-03-17 08:00:00,,34.96937240431219 +2017-03-17 09:00:00,,35.08844576265937 +2017-03-17 10:00:00,17.93966,17.93966 +2017-03-17 11:00:00,,36.85096903122592 +2017-03-17 12:00:00,44.25416,44.25416 +2017-03-17 13:00:00,39.14549,39.14549 +2017-03-17 14:00:00,37.153220000000005,37.153220000000005 +2017-03-17 15:00:00,36.88451,36.88451 +2017-03-17 16:00:00,52.79405,52.79405 +2017-03-17 17:00:00,,44.27087203940724 +2017-03-17 18:00:00,,43.873717308732544 +2017-03-17 19:00:00,,44.62042848524259 +2017-03-17 20:00:00,,44.84577060584101 +2017-03-17 21:00:00,,45.318352069223906 +2017-03-17 22:00:00,,45.62525498890956 +2017-03-17 23:00:00,,45.85123161214997 +2017-03-18 00:00:00,,45.641435288603226 +2017-03-18 01:00:00,,44.92505423319997 +2017-03-18 02:00:00,,43.77460808100799 +2017-03-18 03:00:00,,40.85307463725968 +2017-03-18 04:00:00,24.12794,24.12794 +2017-03-18 05:00:00,,38.99907888184321 +2017-03-18 06:00:00,,36.62395767888055 +2017-03-18 07:00:00,6.587060000000001,6.587060000000001 +2017-03-18 08:00:00,21.04334,21.04334 +2017-03-18 09:00:00,,39.87393170769389 +2017-03-18 10:00:00,34.28645,34.28645 +2017-03-18 11:00:00,40.81022,40.81022 +2017-03-18 12:00:00,57.27944,57.27944 +2017-03-18 13:00:00,28.5545,28.5545 +2017-03-18 14:00:00,7.80023,7.80023 +2017-03-18 15:00:00,,47.31268448828106 +2017-03-18 16:00:00,,53.14609885593965 +2017-03-18 17:00:00,48.032,48.032 +2017-03-18 18:00:00,83.33795,83.33795 +2017-03-18 19:00:00,41.00738,41.00738 +2017-03-18 20:00:00,41.50028,41.50028 +2017-03-18 21:00:00,56.358830000000005,56.358830000000005 +2017-03-18 22:00:00,108.48539,108.48539 +2017-03-18 23:00:00,173.82962,173.82962 +2017-03-19 00:00:00,106.57739,106.57739 +2017-03-19 01:00:00,137.68733,137.68733 +2017-03-19 02:00:00,88.43549,88.43549 +2017-03-19 03:00:00,39.01034,39.01034 +2017-03-19 04:00:00,107.73173,107.73173 +2017-03-19 05:00:00,136.18478000000002,136.18478000000002 +2017-03-19 06:00:00,101.67383000000001,101.67383000000001 +2017-03-19 07:00:00,71.47973,71.47973 +2017-03-19 08:00:00,92.69351,92.69351 +2017-03-19 09:00:00,35.39945,35.39945 +2017-03-19 10:00:00,29.42105,29.42105 +2017-03-19 11:00:00,64.568,64.568 +2017-03-19 12:00:00,35.99888,35.99888 +2017-03-19 13:00:00,12.89777,12.89777 +2017-03-19 14:00:00,35.88917,35.88917 +2017-03-19 15:00:00,19.71251,19.71251 +2017-03-19 16:00:00,,39.36211497286942 +2017-03-19 17:00:00,,37.521117015547546 +2017-03-19 18:00:00,21.420170000000002,21.420170000000002 +2017-03-19 19:00:00,0.73427,0.73427 +2017-03-19 20:00:00,4.9557199999999995,4.9557199999999995 +2017-03-19 21:00:00,27.839000000000002,27.839000000000002 +2017-03-19 22:00:00,46.70912,46.70912 +2017-03-19 23:00:00,67.21217,67.21217 +2017-03-20 00:00:00,46.44995,46.44995 +2017-03-20 01:00:00,16.55477,16.55477 +2017-03-20 02:00:00,29.901229999999998,29.901229999999998 +2017-03-20 03:00:00,40.09472,40.09472 +2017-03-20 04:00:00,47.814170000000004,47.814170000000004 +2017-03-20 05:00:00,40.756159999999994,40.756159999999994 +2017-03-20 06:00:00,,34.27108929734159 +2017-03-20 07:00:00,0.19367,0.19367 +2017-03-20 08:00:00,,32.07665899842363 +2017-03-20 09:00:00,,34.37141324451 +2017-03-20 10:00:00,,33.45470034975958 +2017-03-20 11:00:00,15.59123,15.59123 +2017-03-20 12:00:00,,34.58063943744567 +2017-03-20 13:00:00,47.480270000000004,47.480270000000004 +2017-03-20 14:00:00,21.796999999999997,21.796999999999997 +2017-03-20 15:00:00,0.63251,0.63251 +2017-03-20 16:00:00,9.32822,9.32822 +2017-03-20 17:00:00,46.10333,46.10333 +2017-03-20 18:00:00,94.73984,94.73984 +2017-03-20 19:00:00,95.76061999999999,95.76061999999999 +2017-03-20 20:00:00,61.370509999999996,61.370509999999996 +2017-03-20 21:00:00,20.55044,20.55044 +2017-03-20 22:00:00,30.72962,30.72962 +2017-03-20 23:00:00,40.80545,40.80545 +2017-03-21 00:00:00,18.71717,18.71717 +2017-03-21 01:00:00,14.357389999999999,14.357389999999999 +2017-03-21 02:00:00,11.67188,11.67188 +2017-03-21 03:00:00,,26.063211009821305 +2017-03-21 04:00:00,,27.68840224364242 +2017-03-21 05:00:00,,28.13769729038119 +2017-03-21 06:00:00,,27.024456488141805 +2017-03-21 07:00:00,,25.570982368579518 +2017-03-21 08:00:00,25.123279999999998,25.123279999999998 +2017-03-21 09:00:00,3.97151,3.97151 +2017-03-21 10:00:00,11.07245,11.07245 +2017-03-21 11:00:00,,22.420521779841266 +2017-03-21 12:00:00,,24.955410140675284 +2017-03-21 13:00:00,,26.35180187248189 +2017-03-21 14:00:00,,27.074448512050626 +2017-03-21 15:00:00,,27.856376453514173 +2017-03-21 16:00:00,,28.396875615041406 +2017-03-21 17:00:00,,28.688681457225275 +2017-03-21 18:00:00,,28.889518800377843 +2017-03-21 19:00:00,,29.017456156211843 +2017-03-21 20:00:00,,29.187893300138054 +2017-03-21 21:00:00,,29.068012244148306 +2017-03-21 22:00:00,,29.023191968460832 +2017-03-21 23:00:00,,28.914809885041436 +2017-03-22 00:00:00,,28.73174827346309 +2017-03-22 01:00:00,,28.45389932167041 +2017-03-22 02:00:00,,27.502900472729163 +2017-03-22 03:00:00,,26.929633384453904 +2017-03-22 04:00:00,,25.70222444155836 +2017-03-22 05:00:00,,24.270777460525686 +2017-03-22 06:00:00,,20.791611673953984 +2017-03-22 07:00:00,0.48623,0.48623 +2017-03-22 08:00:00,,20.089355447063372 +2017-03-22 09:00:00,9.28688,9.28688 +2017-03-22 10:00:00,32.38322,32.38322 +2017-03-22 11:00:00,22.94339,22.94339 +2017-03-22 12:00:00,,26.285476524806427 +2017-03-22 13:00:00,,25.040002509216762 +2017-03-22 14:00:00,3.84272,3.84272 +2017-03-22 15:00:00,,26.28057246421037 +2017-03-22 16:00:00,11.76728,11.76728 +2017-03-22 17:00:00,11.85155,11.85155 +2017-03-22 18:00:00,53.630390000000006,53.630390000000006 +2017-03-22 19:00:00,118.70273,118.70273 +2017-03-22 20:00:00,71.41771999999999,71.41771999999999 +2017-03-22 21:00:00,73.34639,73.34639 +2017-03-22 22:00:00,91.05899000000001,91.05899000000001 +2017-03-22 23:00:00,1.7216599999999997,1.7216599999999997 +2017-03-23 00:00:00,,34.08195075054092 +2017-03-23 01:00:00,,33.112348028209986 +2017-03-23 02:00:00,,30.918899481572176 +2017-03-23 03:00:00,,28.35136539960589 +2017-03-23 04:00:00,,25.44461254754141 +2017-03-23 05:00:00,20.40416,20.40416 +2017-03-23 06:00:00,18.340339999999998,18.340339999999998 +2017-03-23 07:00:00,8.466439999999999,8.466439999999999 +2017-03-23 08:00:00,1.29395,1.29395 +2017-03-23 09:00:00,4.98911,4.98911 +2017-03-23 10:00:00,20.37872,20.37872 +2017-03-23 11:00:00,17.13989,17.13989 +2017-03-23 12:00:00,,21.66709167081524 +2017-03-23 13:00:00,,22.988608533828028 +2017-03-23 14:00:00,,24.07694271759896 +2017-03-23 15:00:00,,25.09277580598338 +2017-03-23 16:00:00,,26.31443376918583 +2017-03-23 17:00:00,,28.405565581249373 +2017-03-23 18:00:00,37.70177,37.70177 +2017-03-23 19:00:00,34.35005,34.35005 +2017-03-23 20:00:00,,28.019170771277135 +2017-03-23 21:00:00,,26.150982127345266 +2017-03-23 22:00:00,,24.95127839829112 +2017-03-23 23:00:00,,23.949153994912617 +2017-03-24 00:00:00,,22.955718227562453 +2017-03-24 01:00:00,,21.821224011844407 +2017-03-24 02:00:00,,20.29940320569897 +2017-03-24 03:00:00,,17.5946773731482 +2017-03-24 04:00:00,5.34845,5.34845 +2017-03-24 05:00:00,,16.620794512506652 +2017-03-24 06:00:00,,16.650835875086333 +2017-03-24 07:00:00,2.75834,2.75834 +2017-03-24 08:00:00,28.88045,28.88045 +2017-03-24 09:00:00,12.683119999999999,12.683119999999999 +2017-03-24 10:00:00,15.93944,15.93944 +2017-03-24 11:00:00,26.00573,26.00573 +2017-03-24 12:00:00,,21.31957489173043 +2017-03-24 13:00:00,,21.073146776176745 +2017-03-24 14:00:00,,21.02603640575522 +2017-03-24 15:00:00,,20.932589261935874 +2017-03-24 16:00:00,,20.69861711161571 +2017-03-24 17:00:00,,20.17903540577249 +2017-03-24 18:00:00,,18.898133753564796 +2017-03-24 19:00:00,13.26188,13.26188 +2017-03-24 20:00:00,,18.807671930744903 +2017-03-24 21:00:00,,20.065433192548944 +2017-03-24 22:00:00,,20.595212711450547 +2017-03-24 23:00:00,,20.853561530179963 +2017-03-25 00:00:00,,20.96930239130677 +2017-03-25 01:00:00,,20.991267600448094 +2017-03-25 02:00:00,,20.9395322906642 +2017-03-25 03:00:00,,20.81920559072216 +2017-03-25 04:00:00,,20.620184364994458 +2017-03-25 05:00:00,,20.292884549202178 +2017-03-25 06:00:00,,19.558680882563213 +2017-03-25 07:00:00,12.44462,12.44462 +2017-03-25 08:00:00,37.37423,37.37423 +2017-03-25 09:00:00,9.76706,9.76706 +2017-03-25 10:00:00,12.50027,12.50027 +2017-03-25 11:00:00,19.273670000000003,19.273670000000003 +2017-03-25 12:00:00,,19.147436887372454 +2017-03-25 13:00:00,,19.579396544561494 +2017-03-25 14:00:00,,19.86662027734253 +2017-03-25 15:00:00,,19.587957465291574 +2017-03-25 16:00:00,,19.230089785174467 +2017-03-25 17:00:00,,19.19377476616678 +2017-03-25 18:00:00,,18.77873833847642 +2017-03-25 19:00:00,,18.61578124672798 +2017-03-25 20:00:00,,18.388708772618354 +2017-03-25 21:00:00,,18.082560145081136 +2017-03-25 22:00:00,,17.67169360644528 +2017-03-25 23:00:00,,17.11081672367386 +2017-03-26 00:00:00,,16.312693635299496 +2017-03-26 01:00:00,,15.081730303910973 +2017-03-26 02:00:00,,12.846122774174344 +2017-03-26 03:00:00,6.68405,6.68405 +2017-03-26 04:00:00,,12.358192124694618 +2017-03-26 05:00:00,,13.598802156931962 +2017-03-26 06:00:00,,13.311486003632172 +2017-03-26 07:00:00,,11.376309569456597 +2017-03-26 08:00:00,4.64567,4.64567 +2017-03-26 09:00:00,,11.426839519765034 +2017-03-26 10:00:00,,13.89992166436037 +2017-03-26 11:00:00,,15.256496704585427 +2017-03-26 12:00:00,,16.14226055652788 +2017-03-26 13:00:00,,16.77864945177191 +2017-03-26 14:00:00,,17.26406266938681 +2017-03-26 15:00:00,,17.649695653855797 +2017-03-26 16:00:00,,17.965176890653403 +2017-03-26 17:00:00,,18.22901881792534 +2017-03-26 18:00:00,,18.453475147764767 +2017-03-26 19:00:00,,18.647029522118146 +2017-03-26 20:00:00,,18.815770398332088 +2017-03-26 21:00:00,,18.964197610919157 +2017-03-26 22:00:00,,19.095719250729257 +2017-03-26 23:00:00,,19.212970448998906 +2017-03-27 00:00:00,,19.31802502185842 +2017-03-27 01:00:00,,19.41254015230369 +2017-03-27 02:00:00,,19.49785782588744 +2017-03-27 03:00:00,,19.575077531133225 +2017-03-27 04:00:00,,19.645109385131356 +2017-03-27 05:00:00,,19.708713628005423 +2017-03-27 06:00:00,,19.76653043760784 +2017-03-27 07:00:00,,19.81910274881601 +2017-03-27 08:00:00,,19.86689393683857 +2017-03-27 09:00:00,,19.91030167527035 +2017-03-27 10:00:00,,19.94966890765322 +2017-03-27 11:00:00,,19.985292614674506 +2017-03-27 12:00:00,,20.017430879253805 +2017-03-27 13:00:00,,20.046308623829834 +2017-03-27 14:00:00,,20.072122301934012 +2017-03-27 15:00:00,,20.095043758827803 +2017-03-27 16:00:00,,20.115223426286992 +2017-03-27 17:00:00,,20.13279297953237 +2017-03-27 18:00:00,,20.147867556354893 +2017-03-27 19:00:00,,20.16054761721481 +2017-03-27 20:00:00,,20.17092050876658 +2017-03-27 21:00:00,,20.179061780620266 +2017-03-27 22:00:00,,20.185036295282075 +2017-03-27 23:00:00,,20.188899163453364 +2017-03-28 00:00:00,,20.190696530711364 +2017-03-28 01:00:00,,20.190466236675213 +2017-03-28 02:00:00,,20.1882383637978 +2017-03-28 03:00:00,,20.184035689704615 +2017-03-28 04:00:00,,20.177874054361684 +2017-03-28 05:00:00,,20.169762651169833 +2017-03-28 06:00:00,,20.159704249253295 +2017-03-28 07:00:00,,20.14769535265905 +2017-03-28 08:00:00,,20.133726300847414 +2017-03-28 09:00:00,,20.11778131368417 +2017-03-28 10:00:00,,20.099838483097944 +2017-03-28 11:00:00,,20.079869712609916 +2017-03-28 12:00:00,,20.057840605045122 +2017-03-28 13:00:00,,20.033710297869895 +2017-03-28 14:00:00,,20.00743124474299 +2017-03-28 15:00:00,,19.97894894099583 +2017-03-28 16:00:00,,19.948201589845638 +2017-03-28 17:00:00,,19.91511970516982 +2017-03-28 18:00:00,,19.879625645604435 +2017-03-28 19:00:00,,19.841633073543385 +2017-03-28 20:00:00,,19.801046331274936 +2017-03-28 21:00:00,,19.757759724957335 +2017-03-28 22:00:00,,19.711656705359147 +2017-03-28 23:00:00,,19.66260893221311 +2017-03-29 00:00:00,,19.610475206585846 +2017-03-29 01:00:00,,19.555100252760724 +2017-03-29 02:00:00,,19.496313327659553 +2017-03-29 03:00:00,,19.433926631652536 +2017-03-29 04:00:00,,19.367733489551572 +2017-03-29 05:00:00,,19.29750626442689 +2017-03-29 06:00:00,,19.222993959344542 +2017-03-29 07:00:00,,19.143919452820153 +2017-03-29 08:00:00,,19.05997630223442 +2017-03-29 09:00:00,,18.97082503501183 +2017-03-29 10:00:00,,18.87608882916173 +2017-03-29 11:00:00,,18.77534846165161 +2017-03-29 12:00:00,,18.668136373425337 +2017-03-29 13:00:00,,18.55392966147405 +2017-03-29 14:00:00,,18.432141758085677 +2017-03-29 15:00:00,,18.30211249076387 +2017-03-29 16:00:00,,18.16309612679083 +2017-03-29 17:00:00,,18.01424688430648 +2017-03-29 18:00:00,,17.854601222332988 +2017-03-29 19:00:00,,17.683055982399058 +2017-03-29 20:00:00,,17.498341107505677 +2017-03-29 21:00:00,,17.298985149384638 +2017-03-29 22:00:00,,17.083270988690252 +2017-03-29 23:00:00,,16.84917795137248 +2017-03-30 00:00:00,,16.59430446915195 +2017-03-30 01:00:00,,16.315761947607868 +2017-03-30 02:00:00,,16.010024237626542 +2017-03-30 03:00:00,,15.672705172525372 +2017-03-30 04:00:00,,15.298212372230203 +2017-03-30 05:00:00,,14.879172267763199 +2017-03-30 06:00:00,,14.405393305118189 +2017-03-30 07:00:00,,13.861790581651007 +2017-03-30 08:00:00,,13.223633476755177 +2017-03-30 09:00:00,,12.443525289340428 +2017-03-30 10:00:00,,11.40524731156624 +2017-03-30 11:00:00,,9.671684383506708 +2017-03-30 12:00:00,2.21138,2.21138 +2017-03-30 13:00:00,19.11467,19.11467 +2017-03-30 14:00:00,7.553780000000001,7.553780000000001 +2017-03-30 15:00:00,,11.332179867722747 +2017-03-30 16:00:00,,12.324197303268186 +2017-03-30 17:00:00,,13.013570030119377 +2017-03-30 18:00:00,,13.580268082010704 +2017-03-30 19:00:00,,14.069093712179262 +2017-03-30 20:00:00,,14.499461172129328 +2017-03-30 21:00:00,,14.882841771605895 +2017-03-30 22:00:00,,15.227194629217607 +2017-03-30 23:00:00,,15.53851191988687 +2017-03-31 00:00:00,,15.82150835890076 +2017-03-31 01:00:00,,16.079992521699342 +2017-03-31 02:00:00,,16.317095372594967 +2017-03-31 03:00:00,,16.53542403986373 +2017-03-31 04:00:00,,16.737171517832394 +2017-03-31 05:00:00,,16.924198032432415 +2017-03-31 06:00:00,,17.09809303846021 +2017-03-31 07:00:00,,17.26022339642206 +2017-03-31 08:00:00,,17.41177137898982 +2017-03-31 09:00:00,,17.553765020373298 +2017-03-31 10:00:00,,17.687102598715477 +2017-03-31 11:00:00,,17.81257255952982 +2017-03-31 12:00:00,,17.93086985510504 +2017-03-31 13:00:00,,18.04260943817409 +2017-03-31 14:00:00,,18.148337476326983 +2017-03-31 15:00:00,,18.248540726674115 +2017-03-31 16:00:00,,18.34365441505986 +2017-03-31 17:00:00,,18.43406889185736 +2017-03-31 18:00:00,,18.520135280933022 +2017-03-31 19:00:00,,18.602170295437585 +2017-03-31 20:00:00,,18.68046036055792 +2017-03-31 21:00:00,,18.75526515698933 +2017-03-31 22:00:00,,18.826820677993805 +2017-03-31 23:00:00,,18.895341876250114 diff --git a/Analysis/TimeSeries_Data/ElPanama/ElPanamanormalised_stats.html b/Analysis/TimeSeries_Data/ElPanama/ElPanamanormalised_stats.html new file mode 100644 index 0000000..6d4391f --- /dev/null +++ b/Analysis/TimeSeries_Data/ElPanama/ElPanamanormalised_stats.html @@ -0,0 +1,1556 @@ + + + + + + + Profile report + + + + + + + + + + + + + + + +
+
+

Overview

+
+
+
+

Dataset info

+ + + + + + + + + + + + + + + + + + + + + + + +
Number of variables4
Number of observations576
Total Missing (%)0.8%
Total size in memory18.1 KiB
Average record size in memory32.2 B
+
+
+

Variables types

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Numeric3
Categorical0
Boolean0
Date1
Text (Unique)0
Rejected0
Unsupported0
+
+
+ +

Warnings

+
  • NAM has 19 / 3.3% missing values Missing
  • NAM has 344 / 59.7% zeros Zeros
  • ECMWF has 72 / 12.5% zeros Zeros
+
+
+
+

Variables

+
+
+
+

TimeBeginning
+ Date +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count576
Unique (%)100.0%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
+
+
+ + + + + + + + + +
Minimum2017-03-01 00:00:00
Maximum2017-03-24 23:00:00
+
+
+
+
+ +
+ +
+ +
+
+
+

Observations
+ Numeric +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count575
Unique (%)99.8%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
+ +
+
+ + + + + + + + + + + + + + + + + + +
Mean0.22291
Minimum0
Maximum1
Zeros (%)0.2%
+
+
+
+
+ + +
+ +
+ + +
+
+
+

Quantile statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Minimum0
5-th percentile0.022338
Q10.10338
Median0.15945
Q30.27731
95-th percentile0.66804
Maximum1
Range1
Interquartile range0.17393
+
+
+

Descriptive statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Standard deviation0.1883
Coef of variation0.84474
Kurtosis2.3202
Mean0.22291
MAD0.13941
Skewness1.5942
Sum128.39
Variance0.035456
Memory size4.6 KiB
+
+
+
+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.0732683230706567320.3% +
 
+
0.2095662521663432310.2% +
 
+
0.0999353867881751110.2% +
 
+
0.0987236001387673110.2% +
 
+
0.1594726799592762510.2% +
 
+
0.04346263507199847610.2% +
 
+
0.418325865938296210.2% +
 
+
0.174677232400574210.2% +
 
+
0.3779300540687320410.2% +
 
+
0.1993126757138046210.2% +
 
+
Other values (565)56598.1% +
 
+
+
+
+

Minimum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.010.2% +
 
+
6.389215005071433e-0510.2% +
 
+
0.00146951945116643110.2% +
 
+
0.001493479007435448810.2% +
 
+
0.002204279176749646610.2% +
 
+
+

Maximum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.869140890177380610.2% +
 
+
0.872167780786033210.2% +
 
+
0.873118176518037610.2% +
 
+
0.980153500890496910.2% +
 
+
1.010.2% +
 
+
+
+
+
+
+
+

NAM
+ Numeric +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count215
Unique (%)37.3%
Missing (%)3.3%
Missing (n)19
Infinite (%)0.0%
Infinite (n)0
+ +
+
+ + + + + + + + + + + + + + + + + + +
Mean0.02033
Minimum0
Maximum1
Zeros (%)59.7%
+
+
+
+
+ + +
+ +
+ + +
+
+
+

Quantile statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Minimum0
5-th percentile0
Q10
Median0
Q30.00096655
95-th percentile0.12436
Maximum1
Range1
Interquartile range0.00096655
+
+
+

Descriptive statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Standard deviation0.082691
Coef of variation4.0675
Kurtosis66.539
Mean0.02033
MAD0.034059
Skewness7.2068
Sum11.324
Variance0.0068377
Memory size4.6 KiB
+
+
+
+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.034459.7% +
 
+
0.0002833946001613639310.2% +
 
+
1.0080838844555175e-0510.2% +
 
+
0.00041844478685636610.2% +
 
+
0.002300437018565003510.2% +
 
+
0.00245414351513242510.2% +
 
+
1.8530546880003427e-0610.2% +
 
+
0.0003070981262468726610.2% +
 
+
4.202467529705858e-0510.2% +
 
+
0.02047933720636893610.2% +
 
+
Other values (204)20435.4% +
 
+
(Missing)193.3% +
 
+
+
+
+

Minimum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.034459.7% +
 
+
7.762804022620866e-1010.2% +
 
+
1.8530546880003427e-0610.2% +
 
+
1.997859675599004e-0610.2% +
 
+
2.0656313651923035e-0610.2% +
 
+
+

Maximum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.462246646396899810.2% +
 
+
0.48030594978946510.2% +
 
+
0.600564421051949610.2% +
 
+
0.903646386350460810.2% +
 
+
1.010.2% +
 
+
+
+
+
+
+
+

ECMWF
+ Numeric +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count505
Unique (%)87.7%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
+ +
+
+ + + + + + + + + + + + + + + + + + +
Mean0.093056
Minimum0
Maximum1
Zeros (%)12.5%
+
+
+
+
+ + +
+ +
+ + +
+
+
+

Quantile statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Minimum0
5-th percentile0
Q10.00045817
Median0.012024
Q30.13144
95-th percentile0.48152
Maximum1
Range1
Interquartile range0.13098
+
+
+

Descriptive statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Standard deviation0.15659
Coef of variation1.6828
Kurtosis6.9887
Mean0.093056
MAD0.1105
Skewness2.4417
Sum53.6
Variance0.024522
Memory size4.6 KiB
+
+
+
+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.07212.5% +
 
+
0.480802396200140210.2% +
 
+
0.355332736996499110.2% +
 
+
0.000279239515920116210.2% +
 
+
0.00661295768921071110.2% +
 
+
0.001281858026049267410.2% +
 
+
0.1585000468168824310.2% +
 
+
0.1452523517175371110.2% +
 
+
0.01235365433995887610.2% +
 
+
0.0768693617057178410.2% +
 
+
Other values (495)49585.9% +
 
+
+
+
+

Minimum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.07212.5% +
 
+
7.60124356099835e-0710.2% +
 
+
1.8902523593571949e-0610.2% +
 
+
2.8300245881458267e-0610.2% +
 
+
3.096305564628697e-0610.2% +
 
+
+

Maximum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.727987224181033710.2% +
 
+
0.758740509356551110.2% +
 
+
0.964191452807516310.2% +
 
+
0.969815063916252510.2% +
 
+
1.010.2% +
 
+
+
+
+
+
+
+

Correlations

+
+
+ + +
+
+

Sample

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ObservationsNAMECMWF
TimeBeginning
2017-03-01 00:00:000.7154880.00.003397
2017-03-01 01:00:000.1962610.00.001592
2017-03-01 02:00:000.1625900.00.015517
2017-03-01 03:00:000.5262720.00.015602
2017-03-01 04:00:000.5754690.00.015982
+
+
+
+ + \ No newline at end of file diff --git a/Analysis/TimeSeries_Data/ElPanama/NAM_ElPanama.csv b/Analysis/TimeSeries_Data/ElPanama/NAM_ElPanama.csv new file mode 100644 index 0000000..fcf776c --- /dev/null +++ b/Analysis/TimeSeries_Data/ElPanama/NAM_ElPanama.csv @@ -0,0 +1,745 @@ +,TS_station_point,9pntmin,9pntmax,9ptmean +2017-03-01 00:00:00,0.0,0.0,0.0,0.0 +2017-03-01 01:00:00,0.0,0.0,0.0,0.0 +2017-03-01 02:00:00,0.0,0.0,0.0,0.0 +2017-03-01 03:00:00,0.0,0.0,0.0,0.0 +2017-03-01 04:00:00,0.0,0.0,0.0,0.0 +2017-03-01 05:00:00,42.763411,0.0,62.77742799999999,26.275081914444442 +2017-03-01 06:00:00,1.7326948,0.053269019,2.4255755000000003,1.355687972111111 +2017-03-01 07:00:00,0.0,0.0,0.0,0.0 +2017-03-01 08:00:00,0.0,0.0,0.0,0.0 +2017-03-01 09:00:00,0.0,0.0,0.0,0.0 +2017-03-01 10:00:00,0.0,0.0,0.0,0.0 +2017-03-01 11:00:00,0.0,0.0,62.577281,7.879326822222222 +2017-03-01 12:00:00,4.480491499999999,2.4705487,9.1179618,5.096166933333333 +2017-03-01 13:00:00,0.0,0.0,0.0,0.0 +2017-03-01 14:00:00,0.0,0.0,0.0,0.0 +2017-03-01 15:00:00,0.0,0.0,0.0,0.0 +2017-03-01 16:00:00,0.0,0.0,88.626846,23.399081555555554 +2017-03-01 17:00:00,179.35087,53.124542,229.87754999999999,151.86746744444446 +2017-03-01 18:00:00,0.050121994,0.010238919999999999,0.10350361,0.04912778455555556 +2017-03-01 19:00:00,0.0,0.0,0.0,0.0 +2017-03-01 20:00:00,0.0,0.0,0.0,0.0 +2017-03-01 21:00:00,0.0,0.0,0.0,0.0 +2017-03-01 22:00:00,0.0,0.0,0.0,0.0 +2017-03-01 23:00:00,72.723291,0.0,722.3273300000001,249.10663092222225 +2017-03-02 00:00:00,0.019992214,0.0025690925,0.044109394999999996,0.01836455603333333 +2017-03-02 01:00:00,0.0,0.0,0.0,0.0 +2017-03-02 02:00:00,0.0,0.0,0.0,0.0 +2017-03-02 03:00:00,0.0,0.0,0.0,0.0 +2017-03-02 04:00:00,0.0,0.0,0.0,0.0 +2017-03-02 05:00:00,52.748163999999996,0.0,62.509142,23.02268521111111 +2017-03-02 06:00:00,0.66465037,0.0,2.2144275,0.8199293488888889 +2017-03-02 07:00:00,0.0,0.0,0.0,0.0 +2017-03-02 08:00:00,0.0,0.0,0.0,0.0 +2017-03-02 09:00:00,0.0,0.0,0.0,0.0 +2017-03-02 10:00:00,0.0,0.0,0.0,0.0 +2017-03-02 11:00:00,0.0,0.0,6.9508028,0.7723114222222223 +2017-03-02 12:00:00,5.2698647,2.8706486,7.0930523,4.785373311111112 +2017-03-02 13:00:00,0.0,0.0,0.0,0.0 +2017-03-02 14:00:00,0.0,0.0,0.0,0.0 +2017-03-02 15:00:00,0.0,0.0,0.0,0.0 +2017-03-02 16:00:00,50.490446,0.0,246.41113,90.69228730000002 +2017-03-02 17:00:00,56.828889,34.20694,69.885711,50.40075233333333 +2017-03-02 18:00:00,0.16253165,0.029898558,26.235062000000003,8.23608075488889 +2017-03-02 19:00:00,0.0,0.0,0.27509725,0.07399013222222223 +2017-03-02 20:00:00,0.0,0.0,0.0,0.0 +2017-03-02 21:00:00,0.0,0.0,0.0,0.0 +2017-03-02 22:00:00,0.0,0.0,0.0,0.0 +2017-03-02 23:00:00,689.39931,47.104614999999995,780.36496,514.4370227777777 +2017-03-03 00:00:00,0.010025691000000002,0.0039548071,0.017846005999999998,0.010686233477777777 +2017-03-03 01:00:00,0.0,0.0,0.0,0.0 +2017-03-03 02:00:00,0.0,0.0,0.0,0.0 +2017-03-03 03:00:00,0.0,0.0,0.0,0.0 +2017-03-03 04:00:00,0.0,0.0,0.0,0.0 +2017-03-03 05:00:00,611.08219,1.1917111999999999,763.9775900000001,354.0126181555556 +2017-03-03 06:00:00,0.057911105,0.02244616,0.07446951900000001,0.05005028777777778 +2017-03-03 07:00:00,0.0,0.0,0.0,0.0 +2017-03-03 08:00:00,0.0,0.0,0.0,0.0 +2017-03-03 09:00:00,0.0,0.0,0.0,0.0 +2017-03-03 10:00:00,0.0,0.0,0.0,0.0 +2017-03-03 11:00:00,0.0,0.0,1023.5371,200.06581740000001 +2017-03-03 12:00:00,1.5223586,0.82203167,1.7768275,1.3418211522222223 +2017-03-03 13:00:00,0.0,0.0,0.0,0.0 +2017-03-03 14:00:00,0.0,0.0,0.0,0.0 +2017-03-03 15:00:00,0.0,0.0,0.0,0.0 +2017-03-03 16:00:00,93.189992,0.0,857.5533300000001,312.9174751111111 +2017-03-03 17:00:00,90.072594,63.973006,129.31573999999998,85.83325033333332 +2017-03-03 18:00:00,0.07218510900000001,0.025655906000000003,222.61415,64.781167375 +2017-03-03 19:00:00,0.0,0.0,2.8627757999999996,0.7211880666666667 +2017-03-03 20:00:00,0.0,0.0,0.0,0.0 +2017-03-03 21:00:00,0.0,0.0,0.0,0.0 +2017-03-03 22:00:00,0.0,0.0,0.0,0.0 +2017-03-03 23:00:00,570.12285,110.13449999999999,623.83676,462.56515888888885 +2017-03-04 00:00:00,0.0,0.0,0.0,0.0 +2017-03-04 01:00:00,0.0,0.0,0.0,0.0 +2017-03-04 02:00:00,0.0,0.0,0.0,0.0 +2017-03-04 03:00:00,0.0,0.0,0.0,0.0 +2017-03-04 04:00:00,0.0,0.0,0.0,0.0 +2017-03-04 05:00:00,0.28391983,0.18467071000000002,875.1906600000001,214.45457246777778 +2017-03-04 06:00:00,0.044949505,0.013180689,0.057449732,0.036125180444444446 +2017-03-04 07:00:00,0.0,0.0,0.0,0.0 +2017-03-04 08:00:00,0.0,0.0,0.0,0.0 +2017-03-04 09:00:00,0.0,0.0,0.0,0.0 +2017-03-04 10:00:00,0.0,0.0,0.0,0.0 +2017-03-04 11:00:00,1023.8924999999999,2.3031027,1313.625,522.5449780777777 +2017-03-04 12:00:00,1.7428747999999998,1.0255981,2.0452334999999997,1.5986135888888888 +2017-03-04 13:00:00,0.0,0.0,0.0,0.0 +2017-03-04 14:00:00,0.0,0.0,0.0,0.0 +2017-03-04 15:00:00,0.0,0.0,0.0,0.0 +2017-03-04 16:00:00,4.9583268,0.0,323.33372,101.88585964444444 +2017-03-04 17:00:00,103.78078,62.795007,116.84306,91.88312933333333 +2017-03-04 18:00:00,0.30596982,0.098984344,21.557258,6.429884802666667 +2017-03-04 19:00:00,0.0,0.0,0.12690049,0.03694173411111111 +2017-03-04 20:00:00,0.0,0.0,0.0,0.0 +2017-03-04 21:00:00,0.0,0.0,0.0,0.0 +2017-03-04 22:00:00,0.0,0.0,0.0,0.0 +2017-03-04 23:00:00,94.080518,0.0,373.69338999999997,153.9188145555555 +2017-03-05 00:00:00,0.047283784,0.010436385,0.081578861,0.04402769100000001 +2017-03-05 01:00:00,0.0,0.0,0.0,0.0 +2017-03-05 02:00:00,0.0,0.0,0.0,0.0 +2017-03-05 03:00:00,0.0,0.0,0.0,0.0 +2017-03-05 04:00:00,0.0,0.0,0.0,0.0 +2017-03-05 05:00:00,37.998772,0.80381892,771.25977,235.89343375777779 +2017-03-05 06:00:00,0.052736603,0.013728241,0.073418008,0.04414599722222221 +2017-03-05 07:00:00,0.0,0.0,0.0,0.0 +2017-03-05 08:00:00,0.0,0.0,0.0,0.0 +2017-03-05 09:00:00,0.0,0.0,0.0,0.0 +2017-03-05 10:00:00,0.0,0.0,0.0,0.0 +2017-03-05 11:00:00,0.0,0.0,2568.9979,694.8531127155555 +2017-03-05 12:00:00,1.2274589,0.41882427,1.5020839,0.982632211111111 +2017-03-05 13:00:00,0.0,0.0,0.0,0.0 +2017-03-05 14:00:00,0.0,0.0,0.0,0.0 +2017-03-05 15:00:00,0.0,0.0,0.0,0.0 +2017-03-05 16:00:00,52.968939,0.0,239.66440999999998,89.78020542222221 +2017-03-05 17:00:00,46.691774,32.527860000000004,55.222496,42.438908999999995 +2017-03-05 18:00:00,0.21692527,0.058688183,25.107478,8.023980856444446 +2017-03-05 19:00:00,0.0,0.0,0.22834065,0.06490754444444444 +2017-03-05 20:00:00,0.0,0.0,0.0,0.0 +2017-03-05 21:00:00,0.0,0.0,0.0,0.0 +2017-03-05 22:00:00,0.0,0.0,0.0,0.0 +2017-03-05 23:00:00,224.69539999999998,0.0,689.04291,297.06790545555555 +2017-03-06 00:00:00,0.0041553827,0.00043393006,0.01413106,0.004957382083333333 +2017-03-06 01:00:00,0.0,0.0,0.0,0.0 +2017-03-06 02:00:00,0.0,0.0,0.0,0.0 +2017-03-06 03:00:00,0.0,0.0,0.0,0.0 +2017-03-06 04:00:00,0.0,0.0,0.0,0.0 +2017-03-06 05:00:00,17.331972999999998,0.0,65.96333,24.77903682222222 +2017-03-06 06:00:00,2.0291259,0.27076925,2.0498521,1.4646676722222223 +2017-03-06 07:00:00,0.0,0.0,0.0,0.0 +2017-03-06 08:00:00,0.0,0.0,0.0,0.0 +2017-03-06 09:00:00,0.0,0.0,0.0,0.0 +2017-03-06 10:00:00,0.0,0.0,0.0,0.0 +2017-03-06 11:00:00,0.0,0.0,390.30640999999997,107.69179956666667 +2017-03-06 12:00:00,1.1741811999999998,0.55890189,1.3513061,0.9781514177777777 +2017-03-06 13:00:00,0.0,0.0,0.0,0.0 +2017-03-06 14:00:00,0.0,0.0,0.0,0.0 +2017-03-06 15:00:00,0.0,0.0,0.0,0.0 +2017-03-06 16:00:00,11.640875000000001,0.0,96.866446,33.818532499999996 +2017-03-06 17:00:00,45.735054000000005,17.375765,68.731082,42.06411944444445 +2017-03-06 18:00:00,0.10232178,0.019850654,0.27427895999999996,0.11242645655555555 +2017-03-06 19:00:00,0.0,0.0,0.0,0.0 +2017-03-06 20:00:00,0.0,0.0,0.0,0.0 +2017-03-06 21:00:00,0.0,0.0,0.0,0.0 +2017-03-06 22:00:00,0.0,0.0,0.0,0.0 +2017-03-06 23:00:00,11.150643,0.0,391.029,107.21372922222223 +2017-03-07 00:00:00,0.0,0.0,0.0,0.0 +2017-03-07 01:00:00,0.0,0.0,0.0,0.0 +2017-03-07 02:00:00,0.0,0.0,0.0,0.0 +2017-03-07 03:00:00,0.0,0.0,0.0,0.0 +2017-03-07 04:00:00,0.0,0.0,0.0,0.0 +2017-03-07 05:00:00,1.7662785,0.46045392,58.553949,14.754240402222223 +2017-03-07 06:00:00,0.021952895,0.0016765559,0.058451355999999996,0.023237486977777777 +2017-03-07 07:00:00,0.0,0.0,0.0,0.0 +2017-03-07 08:00:00,0.0,0.0,0.0,0.0 +2017-03-07 09:00:00,0.0,0.0,0.0,0.0 +2017-03-07 10:00:00,0.0,0.0,0.0,0.0 +2017-03-07 11:00:00,0.0,0.0,77.21059199999999,25.387888666666665 +2017-03-07 12:00:00,1.1914944,0.6476041100000001,1.5429289000000002,1.1422834455555555 +2017-03-07 13:00:00,0.0,0.0,0.0,0.0 +2017-03-07 14:00:00,0.0,0.0,0.0,0.0 +2017-03-07 15:00:00,0.0,0.0,0.0,0.0 +2017-03-07 16:00:00,0.0,0.0,0.0,0.0 +2017-03-07 17:00:00,24.181498,3.5126692999999998,57.542525999999995,27.9618578 +2017-03-07 18:00:00,0.021801573999999997,0.0020673168,0.069280581,0.024943710511111113 +2017-03-07 19:00:00,0.0,0.0,0.0,0.0 +2017-03-07 20:00:00,0.0,0.0,0.0,0.0 +2017-03-07 21:00:00,0.0,0.0,0.0,0.0 +2017-03-07 22:00:00,0.0,0.0,0.0,0.0 +2017-03-07 23:00:00,0.0,0.0,139.11932,27.43913411111111 +2017-03-08 00:00:00,0.0,0.0,1.8690687999999998e-05,2.076743111111111e-06 +2017-03-08 01:00:00,0.0,0.0,0.0,0.0 +2017-03-08 02:00:00,0.0,0.0,0.0,0.0 +2017-03-08 03:00:00,0.0,0.0,0.0,0.0 +2017-03-08 04:00:00,0.0,0.0,0.0,0.0 +2017-03-08 05:00:00,62.625265999999996,0.65089682,71.06723199999999,30.097886268888892 +2017-03-08 06:00:00,1.826514,0.023293188,2.6310213,1.3769652597777775 +2017-03-08 07:00:00,0.0,0.0,0.0,0.0 +2017-03-08 08:00:00,0.0,0.0,0.0,0.0 +2017-03-08 09:00:00,0.0,0.0,0.0,0.0 +2017-03-08 10:00:00,0.0,0.0,0.0,0.0 +2017-03-08 11:00:00,0.0,0.0,2.319224,0.25769155555555556 +2017-03-08 12:00:00,4.1154935,2.3490650000000004,4.7759722,3.7846825555555554 +2017-03-08 13:00:00,0.0,0.0,0.0,0.0 +2017-03-08 14:00:00,0.0,0.0,0.0,0.0 +2017-03-08 15:00:00,0.0,0.0,0.0,0.0 +2017-03-08 16:00:00,309.20716,0.0,1523.8272,543.135608 +2017-03-08 17:00:00,109.5839,63.789506,155.78521,103.86307122222223 +2017-03-08 18:00:00,0.086168519,0.038612381,98.766388,23.59552884388889 +2017-03-08 19:00:00,0.0,0.0,0.90890342,0.15450447444444446 +2017-03-08 20:00:00,0.0,0.0,0.0,0.0 +2017-03-08 21:00:00,0.0,0.0,0.0,0.0 +2017-03-08 22:00:00,0.0,0.0,0.0,0.0 +2017-03-08 23:00:00,382.76243,3.5396456,650.89396,327.3543287333333 +2017-03-09 00:00:00,0.0,0.0,0.0,0.0 +2017-03-09 01:00:00,0.0,0.0,0.0,0.0 +2017-03-09 02:00:00,0.0,0.0,0.0,0.0 +2017-03-09 03:00:00,0.0,0.0,0.0,0.0 +2017-03-09 04:00:00,0.0,0.0,0.0,0.0 +2017-03-09 05:00:00,2.7720171000000002,0.0,196.57495,58.47705601111112 +2017-03-09 06:00:00,3.0275455,1.0721204,3.2579601,2.4098919333333333 +2017-03-09 07:00:00,0.0,0.0,0.0,0.0 +2017-03-09 08:00:00,0.0,0.0,0.0,0.0 +2017-03-09 09:00:00,0.0,0.0,0.0,0.0 +2017-03-09 10:00:00,0.0,0.0,0.0,0.0 +2017-03-09 11:00:00,0.0,0.0,0.0,0.0 +2017-03-09 12:00:00,6.2314784,1.8939517,7.790045899999999,4.741675077777778 +2017-03-09 13:00:00,0.0,0.0,0.0,0.0 +2017-03-09 14:00:00,0.0,0.0,0.0,0.0 +2017-03-09 15:00:00,0.0,0.0,0.0,0.0 +2017-03-09 16:00:00,137.57007,0.0,1125.4771,402.2782186333333 +2017-03-09 17:00:00,106.24009000000001,66.166438,146.99539000000001,99.46559955555556 +2017-03-09 18:00:00,0.083607318,0.033742467,89.868066,24.293736140999997 +2017-03-09 19:00:00,0.0,0.0,1.1024558,0.23777092777777778 +2017-03-09 20:00:00,0.0,0.0,0.0,0.0 +2017-03-09 21:00:00,0.0,0.0,0.0,0.0 +2017-03-09 22:00:00,0.0,0.0,0.0,0.0 +2017-03-09 23:00:00,808.86181,69.686525,896.79606,607.4713316666666 +2017-03-10 00:00:00,0.025112620999999998,0.0059233267,0.050595027,0.025159207188888887 +2017-03-10 01:00:00,0.0,0.0,0.0,0.0 +2017-03-10 02:00:00,0.0,0.0,0.0,0.0 +2017-03-10 03:00:00,0.0,0.0,0.0,0.0 +2017-03-10 04:00:00,0.0,0.0,0.0,0.0 +2017-03-10 05:00:00,7.3931719,0.0,65.799999,22.870060344444443 +2017-03-10 06:00:00,2.3280475,0.5574014500000001,2.7316968999999998,1.920884072222222 +2017-03-10 07:00:00,0.0,0.0,0.0,0.0 +2017-03-10 08:00:00,0.0,0.0,0.0,0.0 +2017-03-10 09:00:00,0.0,0.0,0.0,0.0 +2017-03-10 10:00:00,0.0,0.0,0.0,0.0 +2017-03-10 11:00:00,0.0,0.0,42.769589,7.7304171 +2017-03-10 12:00:00,1.0111494,0.5125817800000001,1.612727,1.0416956166666667 +2017-03-10 13:00:00,0.0,0.0,0.0,0.0 +2017-03-10 14:00:00,0.0,0.0,0.0,0.0 +2017-03-10 15:00:00,0.0,0.0,0.0,0.0 +2017-03-10 16:00:00,0.0,0.0,16.149021,5.003663111111112 +2017-03-10 17:00:00,31.730901999999997,8.289724999999999,57.710837,31.36536011111111 +2017-03-10 18:00:00,0.054193187,0.0055183986,0.20213174,0.06851254006666668 +2017-03-10 19:00:00,0.0,0.0,0.0,0.0 +2017-03-10 20:00:00,0.0,0.0,0.0,0.0 +2017-03-10 21:00:00,0.0,0.0,0.0,0.0 +2017-03-10 22:00:00,0.0,0.0,0.0,0.0 +2017-03-10 23:00:00,82.79131699999999,0.0,643.48406,233.63469008888887 +2017-03-11 00:00:00,0.0054125917,0.00055137528,0.01329107,0.0053447714333333335 +2017-03-11 01:00:00,0.0,0.0,0.0,0.0 +2017-03-11 02:00:00,0.0,0.0,0.0,0.0 +2017-03-11 03:00:00,0.0,0.0,0.0,0.0 +2017-03-11 04:00:00,0.0,0.0,0.0,0.0 +2017-03-11 05:00:00,50.924012999999995,0.0,50.924012999999995,22.886069811111113 +2017-03-11 06:00:00,0.6125206900000001,0.0,2.17151,0.8215638527777778 +2017-03-11 07:00:00,0.0,0.0,0.0,0.0 +2017-03-11 08:00:00,0.0,0.0,0.0,0.0 +2017-03-11 09:00:00,0.0,0.0,0.0,0.0 +2017-03-11 10:00:00,0.0,0.0,0.0,0.0 +2017-03-11 11:00:00,0.0,0.0,97.070537,13.402195566666668 +2017-03-11 12:00:00,6.5082058,2.6831183000000003,13.066749,7.176470299999999 +2017-03-11 13:00:00,0.0,0.0,0.0,0.0 +2017-03-11 14:00:00,0.0,0.0,0.0,0.0 +2017-03-11 15:00:00,0.0,0.0,0.0,0.0 +2017-03-11 16:00:00,0.0,0.0,0.0,0.0 +2017-03-11 17:00:00,88.06418900000001,2.3263211999999998,253.2184,115.9195286888889 +2017-03-11 18:00:00,0.043796067,0.009519205,0.083534886,0.041188191222222226 +2017-03-11 19:00:00,0.0,0.0,0.0,0.0 +2017-03-11 20:00:00,0.0,0.0,0.0,0.0 +2017-03-11 21:00:00,0.0,0.0,0.0,0.0 +2017-03-11 22:00:00,0.0,0.0,0.0,0.0 +2017-03-11 23:00:00,0.0,0.0,19.750798,3.404981444444444 +2017-03-12 00:00:00,0.025436384,0.0040016856,0.064112442,0.026968750677777778 +2017-03-12 01:00:00,0.0,0.0,0.0,0.0 +2017-03-12 02:00:00,0.0,0.0,0.0,0.0 +2017-03-12 03:00:00,0.0,0.0,0.0,0.0 +2017-03-12 04:00:00,0.0,0.0,0.0,0.0 +2017-03-12 05:00:00,7.9891860999999995,0.0,59.833157,20.117490177777782 +2017-03-12 06:00:00,0.049203678,0.0,1.7055752,0.40281060333333335 +2017-03-12 07:00:00,0.0,0.0,0.0,0.0 +2017-03-12 08:00:00,0.0,0.0,0.0,0.0 +2017-03-12 09:00:00,0.0,0.0,0.0,0.0 +2017-03-12 10:00:00,0.0,0.0,0.0,0.0 +2017-03-12 11:00:00,23.917188,0.0,75.357842,25.146751944444443 +2017-03-12 12:00:00,2.9728808,0.080421827,8.5790098,3.3344379641111113 +2017-03-12 13:00:00,0.0,0.0,0.0,0.0 +2017-03-12 14:00:00,0.0,0.0,0.0,0.0 +2017-03-12 15:00:00,0.0,0.0,0.0,0.0 +2017-03-12 16:00:00,0.0,0.0,3.9193686999999997,0.7633096833333333 +2017-03-12 17:00:00,29.873027,7.5783346,51.926443,28.7164894 +2017-03-12 18:00:00,0.34602563999999997,0.044134260999999994,1.7404774,0.5010783234444445 +2017-03-12 19:00:00,0.0,0.0,0.0,0.0 +2017-03-12 20:00:00,0.0,0.0,0.0,0.0 +2017-03-12 21:00:00,0.0,0.0,0.0,0.0 +2017-03-12 22:00:00,0.0,0.0,0.0,0.0 +2017-03-12 23:00:00,19.79282,0.0,671.3627399999999,183.53704133333335 +2017-03-13 00:00:00,0.026895123,0.0040700269999999995,0.067196432,0.02835609777777778 +2017-03-13 01:00:00,0.0,0.0,0.0,0.0 +2017-03-13 02:00:00,0.0,0.0,0.0,0.0 +2017-03-13 03:00:00,0.0,0.0,0.0,0.0 +2017-03-13 04:00:00,0.0,0.0,0.0,0.0 +2017-03-13 05:00:00,0.0,0.0,10.863679999999999,2.3770554444444443 +2017-03-13 06:00:00,0.0,0.0,0.083260474,0.016836867444444445 +2017-03-13 07:00:00,0.0,0.0,0.0,0.0 +2017-03-13 08:00:00,0.0,0.0,0.0,0.0 +2017-03-13 09:00:00,0.0,0.0,0.0,0.0 +2017-03-13 10:00:00,0.0,0.0,0.0,0.0 +2017-03-13 11:00:00,62.03110399999999,0.0,80.41695399999999,29.26088407777777 +2017-03-13 12:00:00,2.3818777,0.012624206,8.1680901,2.873479039555556 +2017-03-13 13:00:00,0.0,0.0,0.0,0.0 +2017-03-13 14:00:00,0.0,0.0,0.0,0.0 +2017-03-13 15:00:00,0.0,0.0,0.0,0.0 +2017-03-13 16:00:00,0.0,0.0,3.7060956000000003,0.8547445 +2017-03-13 17:00:00,26.174686,9.639531499999999,34.807537,23.990884277777777 +2017-03-13 18:00:00,0.0,0.0,0.0,0.0 +2017-03-13 19:00:00,0.0,0.0,0.0,0.0 +2017-03-13 20:00:00,0.0,0.0,0.0,0.0 +2017-03-13 21:00:00,0.0,0.0,0.0,0.0 +2017-03-13 22:00:00,0.0,0.0,0.0,0.0 +2017-03-13 23:00:00,0.0,0.0,25.657642000000003,4.009305444444445 +2017-03-14 00:00:00,0.043136716,0.010354901000000001,0.090390863,0.04385624955555555 +2017-03-14 01:00:00,0.0,0.0,0.0,0.0 +2017-03-14 02:00:00,0.0,0.0,0.0,0.0 +2017-03-14 03:00:00,0.0,0.0,0.0,0.0 +2017-03-14 04:00:00,0.0,0.0,0.0,0.0 +2017-03-14 05:00:00,0.6863160100000001,0.0,38.352511,9.504154145555555 +2017-03-14 06:00:00,0.0026961489,0.0,0.6002341,0.1266468456 +2017-03-14 07:00:00,0.0,0.0,0.0,0.0 +2017-03-14 08:00:00,0.0,0.0,0.0,0.0 +2017-03-14 09:00:00,0.0,0.0,0.0,0.0 +2017-03-14 10:00:00,0.0,0.0,0.0,0.0 +2017-03-14 11:00:00,0.0,0.0,62.439307,10.68255042222222 +2017-03-14 12:00:00,6.6896646,1.6806431,12.096031,6.565444166666667 +2017-03-14 13:00:00,0.0,0.0,0.0,0.0 +2017-03-14 14:00:00,0.0,0.0,0.0,0.0 +2017-03-14 15:00:00,0.0,0.0,0.0,0.0 +2017-03-14 16:00:00,0.0,0.0,5.4395027,1.4640465111111112 +2017-03-14 17:00:00,24.223686,8.440819300000001,35.323781,22.532413811111113 +2017-03-14 18:00:00,3.7449115,1.1885278,6.117001699999999,3.6046676222222223 +2017-03-14 19:00:00,0.0,0.0,0.0,0.0 +2017-03-14 20:00:00,0.0,0.0,0.0,0.0 +2017-03-14 21:00:00,0.0,0.0,0.0,0.0 +2017-03-14 22:00:00,0.0,0.0,0.0,0.0 +2017-03-14 23:00:00,0.0,0.0,0.0,0.0 +2017-03-15 00:00:00,0.0,0.0,0.0,0.0 +2017-03-15 01:00:00,0.0,0.0,0.0,0.0 +2017-03-15 02:00:00,0.0,0.0,0.0,0.0 +2017-03-15 03:00:00,0.0,0.0,0.0,0.0 +2017-03-15 04:00:00,0.0,0.0,0.0,0.0 +2017-03-15 05:00:00,38.081798,0.0,56.869892,24.16941696666667 +2017-03-15 06:00:00,1.0162247,0.043269861,1.4195891,0.8083154556666666 +2017-03-15 07:00:00,0.0,0.0,0.0,0.0 +2017-03-15 08:00:00,0.0,0.0,0.0,0.0 +2017-03-15 09:00:00,0.0,0.0,0.0,0.0 +2017-03-15 10:00:00,0.0,0.0,0.0,0.0 +2017-03-15 11:00:00,0.0,0.0,0.0,0.0 +2017-03-15 12:00:00,7.2746038,2.0976606,9.3479466,5.522977088888889 +2017-03-15 13:00:00,0.0,0.0,0.0,0.0 +2017-03-15 14:00:00,0.0,0.0,0.0,0.0 +2017-03-15 15:00:00,0.0,0.0,0.0,0.0 +2017-03-15 16:00:00,1.0192426,0.0,38.512771,12.19015221111111 +2017-03-15 17:00:00,35.172212,22.264781,39.956558,31.354772 +2017-03-15 18:00:00,0.18019838000000002,0.042555623,5.9203949,1.9431670246666666 +2017-03-15 19:00:00,0.0,0.0,0.053977061,0.014436766222222223 +2017-03-15 20:00:00,0.0,0.0,0.0,0.0 +2017-03-15 21:00:00,0.0,0.0,0.0,0.0 +2017-03-15 22:00:00,0.0,0.0,0.0,0.0 +2017-03-15 23:00:00,590.6166,0.0,1255.2482,583.9102344444444 +2017-03-16 00:00:00,0.052900504,0.019899911,0.067831287,0.045945704222222224 +2017-03-16 01:00:00,0.0,0.0,0.0,0.0 +2017-03-16 02:00:00,0.0,0.0,0.0,0.0 +2017-03-16 03:00:00,0.0,0.0,0.0,0.0 +2017-03-16 04:00:00,0.0,0.0,0.0,0.0 +2017-03-16 05:00:00,994.8971,0.25083361,1802.3419,682.0759964511112 +2017-03-16 06:00:00,0.053507826,0.011227573999999999,0.078075857,0.04621471500000001 +2017-03-16 07:00:00,0.0,0.0,0.0,0.0 +2017-03-16 08:00:00,0.0,0.0,0.0,0.0 +2017-03-16 09:00:00,0.0,0.0,0.0,0.0 +2017-03-16 10:00:00,0.0,0.0,0.0,0.0 +2017-03-16 11:00:00,0.0,0.0,94.703406,10.522600666666667 +2017-03-16 12:00:00,0.38211027,0.0069872832000000005,1.1304855,0.5144634150222221 +2017-03-16 13:00:00,0.0,0.0,0.0,0.0 +2017-03-16 14:00:00,0.0,0.0,0.0,0.0 +2017-03-16 15:00:00,0.0,0.0,0.0,0.0 +2017-03-16 16:00:00,246.93232000000003,0.0,1552.0027,548.8724265555555 +2017-03-16 17:00:00,221.92091000000002,131.44713,276.15725,209.54196444444443 +2017-03-16 18:00:00,145.64069999999998,0.051995936,1105.8451,392.4104079051111 +2017-03-16 19:00:00,2.5053932,0.0,42.182899000000006,12.735659487111112 +2017-03-16 20:00:00,0.0,0.0,0.0,0.0 +2017-03-16 21:00:00,0.0,0.0,0.0,0.0 +2017-03-16 22:00:00,489.45360999999997,0.0,7081.7303,2417.478790222222 +2017-03-16 23:00:00,735.2076900000001,345.23575,907.6267,674.2230311111111 +2017-03-17 00:00:00,0.034674905,0.016527034,4030.4163,1284.9378517663333 +2017-03-17 01:00:00,0.0,0.0,127.02621,32.10444947777778 +2017-03-17 02:00:00,0.0,0.0,0.0,0.0 +2017-03-17 03:00:00,0.0,0.0,0.0,0.0 +2017-03-17 04:00:00,0.0,0.0,0.0,0.0 +2017-03-17 05:00:00,1106.8869,0.0,2235.6678,813.1804913333333 +2017-03-17 06:00:00,1.3836893,0.011333474,3.1829036,1.4682126403333333 +2017-03-17 07:00:00,0.0,0.0,0.0,0.0 +2017-03-17 08:00:00,0.0,0.0,0.0,0.0 +2017-03-17 09:00:00,0.0,0.0,0.0,0.0 +2017-03-17 10:00:00,0.0,0.0,0.0,0.0 +2017-03-17 11:00:00,0.0,0.0,6935.7357,1606.6591666666668 +2017-03-17 12:00:00,0.4171454,0.26244254,663.8054,149.70254363555557 +2017-03-17 13:00:00,0.0,0.0,20.209462,3.1612723666666667 +2017-03-17 14:00:00,0.0,0.0,0.0,0.0 +2017-03-17 15:00:00,0.0,0.0,0.0,0.0 +2017-03-17 16:00:00,150.31302000000002,16.298965,444.43039,183.13643166666668 +2017-03-17 17:00:00,64.373824,37.550923000000004,77.20872999999999,56.91732499999999 +2017-03-17 18:00:00,39.530682,0.058378841,204.04386,75.20749458788889 +2017-03-17 19:00:00,0.5806536999999999,0.0,5.941788900000001,1.9874160357777777 +2017-03-17 20:00:00,0.0,0.0,0.0,0.0 +2017-03-17 21:00:00,0.0,0.0,0.0,0.0 +2017-03-17 22:00:00,0.0,0.0,80.03204099999999,8.892449 +2017-03-17 23:00:00,1011.0027,840.0040700000001,1164.9767000000002,990.4911133333333 +2017-03-18 00:00:00,0.058375470000000006,0.015897056,396.88052,64.49477396344443 +2017-03-18 01:00:00,0.0,0.0,6.4208239,0.7134248777777779 +2017-03-18 02:00:00,0.0,0.0,0.0,0.0 +2017-03-18 03:00:00,0.0,0.0,0.0,0.0 +2017-03-18 04:00:00,0.0,0.0,0.0,0.0 +2017-03-18 05:00:00,953.57175,336.22663,1957.4682,1236.6247244444446 +2017-03-18 06:00:00,0.0,0.0,1202.4178,270.9813633333333 +2017-03-18 07:00:00,0.0,0.0,107.21831,23.834256 +2017-03-18 08:00:00,0.0,0.0,0.0,0.0 +2017-03-18 09:00:00,0.0,0.0,0.0,0.0 +2017-03-18 10:00:00,0.0,0.0,0.0,0.0 +2017-03-18 11:00:00,0.0,0.0,0.0,0.0 +2017-03-18 12:00:00,1.569752,0.025565217,5.510942600000001,2.323943345777778 +2017-03-18 13:00:00,0.0,0.0,0.0,0.0 +2017-03-18 14:00:00,0.0,0.0,0.0,0.0 +2017-03-18 15:00:00,0.0,0.0,0.0,0.0 +2017-03-18 16:00:00,258.17932,45.707046,582.87743,263.3993751111111 +2017-03-18 17:00:00,63.44512100000001,29.190313999999997,79.87462599999999,56.60552477777778 +2017-03-18 18:00:00,32.949578,0.12358345,178.88466,65.82581724444445 +2017-03-18 19:00:00,0.39183055,0.0,4.3486743,1.4282257483333334 +2017-03-18 20:00:00,0.0,0.0,0.0,0.0 +2017-03-18 21:00:00,0.0,0.0,0.0,0.0 +2017-03-18 22:00:00,0.0,0.0,0.0,0.0 +2017-03-18 23:00:00,861.42315,312.0164,967.2334400000001,744.2209688888889 +2017-03-19 00:00:00,0.044434831,0.010234152,0.070063003,0.03806327666666667 +2017-03-19 01:00:00,0.0,0.0,0.0,0.0 +2017-03-19 02:00:00,0.0,0.0,0.0,0.0 +2017-03-19 03:00:00,0.0,0.0,0.0,0.0 +2017-03-19 04:00:00,0.0,0.0,0.0,0.0 +2017-03-19 05:00:00,0.0,0.0,2180.5516,558.8580444444444 +2017-03-19 06:00:00,1.3087763000000001,0.025868257,2.2442243,1.119443858111111 +2017-03-19 07:00:00,0.0,0.0,0.0,0.0 +2017-03-19 08:00:00,0.0,0.0,0.0,0.0 +2017-03-19 09:00:00,0.0,0.0,0.0,0.0 +2017-03-19 10:00:00,0.0,0.0,0.0,0.0 +2017-03-19 11:00:00,0.0,0.0,36.541444999999996,4.350525788888889 +2017-03-19 12:00:00,5.4643237000000004,3.3353351,7.926182700000001,5.430327944444445 +2017-03-19 13:00:00,0.0,0.0,0.0,0.0 +2017-03-19 14:00:00,0.0,0.0,0.0,0.0 +2017-03-19 15:00:00,0.0,0.0,0.0,0.0 +2017-03-19 16:00:00,6.309383,0.0,46.955171,17.11510861111111 +2017-03-19 17:00:00,31.902312999999996,22.244608999999997,39.408831,28.888735555555552 +2017-03-19 18:00:00,15.986443000000001,0.056520587,113.4748,40.44975998522223 +2017-03-19 19:00:00,0.1740782,0.0,2.2247807,0.7581510262222221 +2017-03-19 20:00:00,0.0,0.0,0.0,0.0 +2017-03-19 21:00:00,0.0,0.0,0.0,0.0 +2017-03-19 22:00:00,0.0,0.0,1295.7832,294.5086411111111 +2017-03-19 23:00:00,672.34098,553.9431000000001,823.21506,678.3341077777778 +2017-03-20 00:00:00,0.030792958000000002,0.021278764999999998,2736.1412,781.8826942303333 +2017-03-20 01:00:00,0.0,0.0,71.16559600000001,16.358397444444446 +2017-03-20 02:00:00,0.0,0.0,0.0,0.0 +2017-03-20 03:00:00,0.0,0.0,0.0,0.0 +2017-03-20 04:00:00,0.0,0.0,0.0,0.0 +2017-03-20 05:00:00,0.0,0.0,2981.7987000000003,800.2099709999999 +2017-03-20 06:00:00,0.036921143,0.0,1.405391,0.3403387892222222 +2017-03-20 07:00:00,0.0,0.0,0.0,0.0 +2017-03-20 08:00:00,0.0,0.0,0.0,0.0 +2017-03-20 09:00:00,0.0,0.0,0.0,0.0 +2017-03-20 10:00:00,0.0,0.0,0.0,0.0 +2017-03-20 11:00:00,0.0,0.0,9520.5102,2675.248666666667 +2017-03-20 12:00:00,0.0053359934,0.0,793.5473099999999,244.8015440610444 +2017-03-20 13:00:00,0.0,0.0,38.83303,10.246802888888888 +2017-03-20 14:00:00,0.0,0.0,0.0,0.0 +2017-03-20 15:00:00,0.0,0.0,0.0,0.0 +2017-03-20 16:00:00,466.83835999999997,43.280579,1088.8953,499.6546697777777 +2017-03-20 17:00:00,83.29650199999999,46.187753,95.91501299999999,73.6416571111111 +2017-03-20 18:00:00,27.163065,0.055979509000000004,344.91094999999996,120.40439566566667 +2017-03-20 19:00:00,0.34192865,0.0,9.057223899999999,2.585762535555555 +2017-03-20 20:00:00,0.0,0.0,0.0,0.0 +2017-03-20 21:00:00,0.0,0.0,0.0,0.0 +2017-03-20 22:00:00,0.0,0.0,0.0,0.0 +2017-03-20 23:00:00,707.61185,37.938997,753.74311,484.8702152222222 +2017-03-21 00:00:00,0.053655511999999995,0.023274755,0.064829685,0.048349918666666665 +2017-03-21 01:00:00,0.0,0.0,0.0,0.0 +2017-03-21 02:00:00,0.0,0.0,0.0,0.0 +2017-03-21 03:00:00,0.0,0.0,0.0,0.0 +2017-03-21 04:00:00,0.0,0.0,0.0,0.0 +2017-03-21 05:00:00,,,, +2017-03-21 06:00:00,,,, +2017-03-21 07:00:00,,,, +2017-03-21 08:00:00,,,, +2017-03-21 09:00:00,,,, +2017-03-21 10:00:00,,,, +2017-03-21 11:00:00,,,, +2017-03-21 12:00:00,,,, +2017-03-21 13:00:00,,,, +2017-03-21 14:00:00,,,, +2017-03-21 15:00:00,,,, +2017-03-21 16:00:00,,,, +2017-03-21 17:00:00,,,, +2017-03-21 18:00:00,,,, +2017-03-21 19:00:00,,,, +2017-03-21 20:00:00,,,, +2017-03-21 21:00:00,,,, +2017-03-21 22:00:00,,,, +2017-03-21 23:00:00,,,, +2017-03-22 00:00:00,0.0,0.0,0.0,0.0 +2017-03-22 01:00:00,0.0,0.0,0.0,0.0 +2017-03-22 02:00:00,0.0,0.0,0.0,0.0 +2017-03-22 03:00:00,0.0,0.0,0.0,0.0 +2017-03-22 04:00:00,0.0,0.0,0.0,0.0 +2017-03-22 05:00:00,46.839104,0.0,175.55786,54.787319555555555 +2017-03-22 06:00:00,8.3314326,0.2581597,10.075973,6.154241066666667 +2017-03-22 07:00:00,0.0,0.0,0.0,0.0 +2017-03-22 08:00:00,0.0,0.0,0.0,0.0 +2017-03-22 09:00:00,0.0,0.0,0.0,0.0 +2017-03-22 10:00:00,0.0,0.0,0.0,0.0 +2017-03-22 11:00:00,0.0,0.0,0.0,0.0 +2017-03-22 12:00:00,11.960965999999999,4.179888900000001,16.160739,9.679206444444446 +2017-03-22 13:00:00,0.0,0.0,0.0,0.0 +2017-03-22 14:00:00,0.0,0.0,0.0,0.0 +2017-03-22 15:00:00,0.0,0.0,0.0,0.0 +2017-03-22 16:00:00,0.0,0.0,9.5288779,2.9750032555555554 +2017-03-22 17:00:00,25.290026,13.335234,31.371572,22.828336444444442 +2017-03-22 18:00:00,0.0,0.0,2.5339218,0.6473127666666666 +2017-03-22 19:00:00,0.0,0.0,0.020318334,0.0055260775555555555 +2017-03-22 20:00:00,0.0,0.0,0.0,0.0 +2017-03-22 21:00:00,0.0,0.0,0.0,0.0 +2017-03-22 22:00:00,0.0,0.0,0.0,0.0 +2017-03-22 23:00:00,555.1341500000001,0.0,1146.3884,527.4687484444444 +2017-03-23 00:00:00,0.062102856000000005,0.026778899,0.075983991,0.05510402444444445 +2017-03-23 01:00:00,0.0,0.0,0.0,0.0 +2017-03-23 02:00:00,0.0,0.0,0.0,0.0 +2017-03-23 03:00:00,0.0,0.0,0.0,0.0 +2017-03-23 04:00:00,0.0,0.0,0.0,0.0 +2017-03-23 05:00:00,0.0,0.0,119.62302000000001,16.16396111111111 +2017-03-23 06:00:00,8.7398148,4.8548404,10.565451999999999,8.446697955555557 +2017-03-23 07:00:00,0.0,0.0,0.0,0.0 +2017-03-23 08:00:00,0.0,0.0,0.0,0.0 +2017-03-23 09:00:00,0.0,0.0,0.0,0.0 +2017-03-23 10:00:00,0.0,0.0,0.0,0.0 +2017-03-23 11:00:00,0.0,0.0,1.5535925,0.1726213888888889 +2017-03-23 12:00:00,8.0258878,3.7236152,10.548831,7.457150611111111 +2017-03-23 13:00:00,0.0,0.0,0.0,0.0 +2017-03-23 14:00:00,0.0,0.0,0.0,0.0 +2017-03-23 15:00:00,0.0,0.0,0.0,0.0 +2017-03-23 16:00:00,0.0,0.0,1.4100559,0.15667287777777777 +2017-03-23 17:00:00,81.068683,30.57305,124.61410000000001,75.83882722222222 +2017-03-23 18:00:00,0.13234667,0.035439761,0.27222379,0.1289710371111111 +2017-03-23 19:00:00,0.0,0.0,0.0,0.0 +2017-03-23 20:00:00,0.0,0.0,0.0,0.0 +2017-03-23 21:00:00,0.0,0.0,0.0,0.0 +2017-03-23 22:00:00,0.0,0.0,0.0,0.0 +2017-03-23 23:00:00,0.0,0.0,0.0,0.0 +2017-03-24 00:00:00,0.061816941,0.015923950000000003,0.10468299,0.05715870988888889 +2017-03-24 01:00:00,0.0,0.0,0.0,0.0 +2017-03-24 02:00:00,0.0,0.0,0.0,0.0 +2017-03-24 03:00:00,0.0,0.0,0.0,0.0 +2017-03-24 04:00:00,0.0,0.0,0.0,0.0 +2017-03-24 05:00:00,0.0,0.0,166.00205,41.754631655555556 +2017-03-24 06:00:00,8.0996942,4.5528777,9.8242108,7.680239277777777 +2017-03-24 07:00:00,0.0,0.0,0.0,0.0 +2017-03-24 08:00:00,0.0,0.0,0.0,0.0 +2017-03-24 09:00:00,0.0,0.0,0.0,0.0 +2017-03-24 10:00:00,0.0,0.0,0.0,0.0 +2017-03-24 11:00:00,0.0,0.0,0.0,0.0 +2017-03-24 12:00:00,8.7313001,4.6092514,10.680235,7.544520433333334 +2017-03-24 13:00:00,0.0,0.0,0.0,0.0 +2017-03-24 14:00:00,0.0,0.0,0.0,0.0 +2017-03-24 15:00:00,0.0,0.0,0.0,0.0 +2017-03-24 16:00:00,0.0,0.0,2.1994194,0.5243095333333333 +2017-03-24 17:00:00,17.445052,5.9905478,26.397544999999997,16.411043133333337 +2017-03-24 18:00:00,1.3001837,0.21606981,4.6098785,1.736365081111111 +2017-03-24 19:00:00,0.0,0.0,0.0,0.0 +2017-03-24 20:00:00,0.0,0.0,0.0,0.0 +2017-03-24 21:00:00,0.0,0.0,0.0,0.0 +2017-03-24 22:00:00,0.0,0.0,0.0,0.0 +2017-03-24 23:00:00,0.0,0.0,0.0,0.0 +2017-03-25 00:00:00,0.052534048,0.011062685,0.10686604,0.04990606766666667 +2017-03-25 01:00:00,0.0,0.0,0.0,0.0 +2017-03-25 02:00:00,0.0,0.0,0.0,0.0 +2017-03-25 03:00:00,0.0,0.0,0.0,0.0 +2017-03-25 04:00:00,0.0,0.0,0.0,0.0 +2017-03-25 05:00:00,23.226705,0.0,37.52573,18.39711388888889 +2017-03-25 06:00:00,0.24360568,0.0,2.0473619,0.5921747909222222 +2017-03-25 07:00:00,0.0,0.0,0.0,0.0 +2017-03-25 08:00:00,0.0,0.0,0.0,0.0 +2017-03-25 09:00:00,0.0,0.0,0.0,0.0 +2017-03-25 10:00:00,0.0,0.0,0.0,0.0 +2017-03-25 11:00:00,0.0,0.0,26.491321,3.316857777777778 +2017-03-25 12:00:00,11.000852,4.019545,14.550238,9.897858000000001 +2017-03-25 13:00:00,0.0,0.0,0.0,0.0 +2017-03-25 14:00:00,0.0,0.0,0.0,0.0 +2017-03-25 15:00:00,0.0,0.0,0.0,0.0 +2017-03-25 16:00:00,0.0,0.0,0.0,0.0 +2017-03-25 17:00:00,18.014158,2.9558114,46.411944000000005,21.486715877777776 +2017-03-25 18:00:00,0.0,0.0,0.0,0.0 +2017-03-25 19:00:00,0.0,0.0,0.0,0.0 +2017-03-25 20:00:00,0.0,0.0,0.0,0.0 +2017-03-25 21:00:00,0.0,0.0,0.0,0.0 +2017-03-25 22:00:00,0.0,0.0,0.0,0.0 +2017-03-25 23:00:00,0.0,0.0,0.0,0.0 +2017-03-26 00:00:00,0.00094084518,5.9702736e-05,0.004542801700000001,0.001494105571888889 +2017-03-26 01:00:00,0.0,0.0,0.0,0.0 +2017-03-26 02:00:00,0.0,0.0,0.0,0.0 +2017-03-26 03:00:00,0.0,0.0,0.0,0.0 +2017-03-26 04:00:00,0.0,0.0,0.0,0.0 +2017-03-26 05:00:00,0.0,0.0,13.847759,3.104974388888889 +2017-03-26 06:00:00,0.0,0.0,0.12746574,0.02610802411111111 +2017-03-26 07:00:00,0.0,0.0,0.0,0.0 +2017-03-26 08:00:00,0.0,0.0,0.0,0.0 +2017-03-26 09:00:00,0.0,0.0,0.0,0.0 +2017-03-26 10:00:00,0.0,0.0,0.0,0.0 +2017-03-26 11:00:00,47.808662,0.0,77.459779,29.11025095555555 +2017-03-26 12:00:00,3.3641045,0.033234802,10.149315000000001,3.790424078 +2017-03-26 13:00:00,0.0,0.0,0.0,0.0 +2017-03-26 14:00:00,0.0,0.0,0.0,0.0 +2017-03-26 15:00:00,0.0,0.0,0.0,0.0 +2017-03-26 16:00:00,0.0,0.0,0.0,0.0 +2017-03-26 17:00:00,6.8099375,0.58634862,24.853902,9.96101779111111 +2017-03-26 18:00:00,0.0,0.0,0.0,0.0 +2017-03-26 19:00:00,0.0,0.0,0.0,0.0 +2017-03-26 20:00:00,0.0,0.0,0.0,0.0 +2017-03-26 21:00:00,0.0,0.0,0.0,0.0 +2017-03-26 22:00:00,0.0,0.0,0.0,0.0 +2017-03-26 23:00:00,0.0,0.0,0.0,0.0 +2017-03-27 00:00:00,0.035711799999999995,0.0047529243,0.12744022000000002,0.04860210125555556 +2017-03-27 01:00:00,0.0,0.0,0.0,0.0 +2017-03-27 02:00:00,0.0,0.0,0.0,0.0 +2017-03-27 03:00:00,0.0,0.0,0.0,0.0 +2017-03-27 04:00:00,0.0,0.0,0.0,0.0 +2017-03-27 05:00:00,0.0,0.0,0.0,0.0 +2017-03-27 06:00:00,0.0,0.0,0.0,0.0 +2017-03-27 07:00:00,0.0,0.0,0.0,0.0 +2017-03-27 08:00:00,0.0,0.0,0.0,0.0 +2017-03-27 09:00:00,0.0,0.0,0.0,0.0 +2017-03-27 10:00:00,0.0,0.0,0.0,0.0 +2017-03-27 11:00:00,15.183928,0.0,72.36681999999999,26.595195077777774 +2017-03-27 12:00:00,0.080020229,0.0,3.3298752,0.7850933605555556 +2017-03-27 13:00:00,0.0,0.0,0.0,0.0 +2017-03-27 14:00:00,0.0,0.0,0.0,0.0 +2017-03-27 15:00:00,0.0,0.0,0.0,0.0 +2017-03-27 16:00:00,0.0,0.0,0.0,0.0 +2017-03-27 17:00:00,1.3448376,0.0,9.114462999999999,3.125008063222222 +2017-03-27 18:00:00,0.0,0.0,0.0,0.0 +2017-03-27 19:00:00,0.0,0.0,0.0,0.0 +2017-03-27 20:00:00,0.0,0.0,0.0,0.0 +2017-03-27 21:00:00,0.0,0.0,0.0,0.0 +2017-03-27 22:00:00,0.0,0.0,0.0,0.0 +2017-03-27 23:00:00,0.0,0.0,0.0,0.0 +2017-03-28 00:00:00,0.65328504,0.57125271,0.68186876,0.6273741944444444 +2017-03-28 01:00:00,0.045377906,0.014703293000000001,0.098308426,0.050814232555555554 +2017-03-28 02:00:00,0.0,0.0,0.0,0.0 +2017-03-28 03:00:00,0.0,0.0,0.0,0.0 +2017-03-28 04:00:00,0.0,0.0,0.0,0.0 +2017-03-28 05:00:00,0.0,0.0,0.0,0.0 +2017-03-28 06:00:00,0.0,0.0,0.0,0.0 +2017-03-28 07:00:00,0.0,0.0,0.0,0.0 +2017-03-28 08:00:00,0.0,0.0,0.0,0.0 +2017-03-28 09:00:00,0.0,0.0,0.0,0.0 +2017-03-28 10:00:00,0.0,0.0,0.0,0.0 +2017-03-28 11:00:00,0.0,0.0,0.0,0.0 +2017-03-28 12:00:00,0.0,0.0,0.0,0.0 +2017-03-28 13:00:00,0.0,0.0,0.0,0.0 +2017-03-28 14:00:00,0.0,0.0,0.0,0.0 +2017-03-28 15:00:00,0.0,0.0,0.0,0.0 +2017-03-28 16:00:00,0.0,0.0,0.0,0.0 +2017-03-28 17:00:00,0.0,0.0,1.5094545,0.3213409544444444 +2017-03-28 18:00:00,0.0,0.0,0.028695464,0.005703628333333334 +2017-03-28 19:00:00,0.46286758,0.28738488999999995,0.70559372,0.47512396111111105 +2017-03-28 20:00:00,0.12092932999999999,0.087064826,0.15949982000000001,0.12201295000000001 +2017-03-28 21:00:00,0.0,0.0,0.0,0.0 +2017-03-28 22:00:00,0.0,0.0,0.0,0.0 +2017-03-28 23:00:00,0.0,0.0,0.0,0.0 +2017-03-29 00:00:00,0.035167663,0.03388562,0.040934494999999994,0.036311883222222216 +2017-03-29 01:00:00,0.027923855,0.025691019000000002,0.02876558,0.027895450999999998 +2017-03-29 02:00:00,0.016420062,0.014780037,0.017796994,0.016461907111111108 +2017-03-29 03:00:00,0.0002512307,0.00021557262999999998,0.00029065778,0.0002507481244444444 +2017-03-29 04:00:00,0.0,0.0,0.0,0.0 +2017-03-29 05:00:00,0.0,0.0,0.0,0.0 +2017-03-29 06:00:00,0.0,0.0,0.13891314,0.031358249888888884 +2017-03-29 07:00:00,0.070827653,0.0,0.29989781,0.1045880948888889 +2017-03-29 08:00:00,0.0,0.0,0.0,0.0 +2017-03-29 09:00:00,0.0,0.0,0.0,0.0 +2017-03-29 10:00:00,0.0,0.0,0.0,0.0 +2017-03-29 11:00:00,0.0,0.0,0.0,0.0 +2017-03-29 12:00:00,0.0,0.0,0.0,0.0 +2017-03-29 13:00:00,0.0,0.0,0.0,0.0 +2017-03-29 14:00:00,0.0,0.0,0.0,0.0 +2017-03-29 15:00:00,0.0,0.0,0.0,0.0 +2017-03-29 16:00:00,0.0,0.0,0.0,0.0 +2017-03-29 17:00:00,0.0,0.0,1.2132834000000001,0.25898987 +2017-03-29 18:00:00,0.0,0.0,0.0,0.0 +2017-03-29 19:00:00,0.42899688,0.27777517,0.61489692,0.43309352888888886 +2017-03-29 20:00:00,0.10702048,0.08060606399999999,0.13819714,0.10819215666666666 +2017-03-29 21:00:00,0.0,0.0,0.0,0.0 +2017-03-29 22:00:00,0.0,0.0,0.0,0.0 +2017-03-29 23:00:00,0.0,0.0,0.0,0.0 +2017-03-30 00:00:00,0.004562629800000001,0.0037210828000000004,0.0059795782,0.00472913798888889 +2017-03-30 01:00:00,0.0006499394900000001,0.00051053622,0.00076457263,0.0006494881555555555 +2017-03-30 02:00:00,0.0,0.0,0.0,0.0 +2017-03-30 03:00:00,0.0,0.0,0.0,0.0 +2017-03-30 04:00:00,0.0,0.0,0.0,0.0 +2017-03-30 05:00:00,0.0,0.0,0.0,0.0 +2017-03-30 06:00:00,0.0,0.0,0.0,0.0 +2017-03-30 07:00:00,0.0,0.0,0.0,0.0 +2017-03-30 08:00:00,0.0,0.0,0.0,0.0 +2017-03-30 09:00:00,0.0,0.0,0.0,0.0 +2017-03-30 10:00:00,0.0,0.0,0.0,0.0 +2017-03-30 11:00:00,0.0,0.0,0.0,0.0 +2017-03-30 12:00:00,0.0,0.0,0.0,0.0 +2017-03-30 13:00:00,0.0,0.0,0.0,0.0 +2017-03-30 14:00:00,0.0,0.0,0.0,0.0 +2017-03-30 15:00:00,0.0,0.0,0.0,0.0 +2017-03-30 16:00:00,0.0,0.0,0.0,0.0 +2017-03-30 17:00:00,0.50641859,0.0,2.7118444,0.9696237322222222 +2017-03-30 18:00:00,5.9809818,3.2801543000000004,9.8271339,6.220727077777777 +2017-03-30 19:00:00,7.021012600000001,5.3627364,8.9607256,7.060220822222224 +2017-03-30 20:00:00,0.52815318,0.38814861,0.7044907300000001,0.5313841477777778 +2017-03-30 21:00:00,0.0,0.0,0.0,0.0 +2017-03-30 22:00:00,0.0,0.0,0.0,0.0 +2017-03-30 23:00:00,0.0,0.0,0.0,0.0 +2017-03-31 00:00:00,0.004947033,0.0040477510000000005,0.0058923622,0.0049691089444444435 +2017-03-31 01:00:00,0.62794618,0.30350492,1.498918,0.7862079177777778 +2017-03-31 02:00:00,12.655611,10.351117,15.096066,12.698716111111112 +2017-03-31 03:00:00,22.462109,19.84767,25.27186,22.499407 +2017-03-31 04:00:00,25.417461,23.122808,27.847469,25.430444777777776 +2017-03-31 05:00:00,28.866825000000002,26.881711,30.892614000000002,28.859101333333328 +2017-03-31 06:00:00,23.097859999999997,22.141712000000002,24.019933,23.094033555555555 +2017-03-31 07:00:00,19.266643000000002,18.595514,19.930165,19.262717444444448 +2017-03-31 08:00:00,14.419989000000001,13.994526,14.833231,14.413670111111113 +2017-03-31 09:00:00,10.462323,10.183748,10.738454999999998,10.46211811111111 +2017-03-31 10:00:00,8.4713956,8.291802299999999,8.6454229,8.46801928888889 +2017-03-31 11:00:00,13.40162,11.384863000000001,16.192589,13.530136777777777 +2017-03-31 12:00:00,6.1215742,5.0687481,7.3256374,6.154920377777778 +2017-03-31 13:00:00,0.86903384,0.78127869,0.9616272800000001,0.8675567066666667 +2017-03-31 14:00:00,0.28173503,0.27437419999999996,0.28907419,0.2817909511111111 +2017-03-31 15:00:00,0.58609606,0.5345168,0.63284273,0.5864890099999999 +2017-03-31 16:00:00,1.0124926,0.94094537,1.0803767,1.0126268722222223 +2017-03-31 17:00:00,,,, +2017-03-31 18:00:00,,,, +2017-03-31 19:00:00,,,, +2017-03-31 20:00:00,,,, +2017-03-31 21:00:00,,,, +2017-03-31 22:00:00,,,, +2017-03-31 23:00:00,,,, diff --git a/Analysis/TimeSeries_Data/Pacaya/ECMWF_Pacaya.csv b/Analysis/TimeSeries_Data/Pacaya/ECMWF_Pacaya.csv new file mode 100644 index 0000000..17ca73b --- /dev/null +++ b/Analysis/TimeSeries_Data/Pacaya/ECMWF_Pacaya.csv @@ -0,0 +1,745 @@ +,TS_station_point,9pntmin,9pntmax,9ptmean +2017-03-01 00:00:00,31.199316999999997,8.6852342,53.981923,31.356817022222216 +2017-03-01 01:00:00,28.832335,15.875909,30.813145999999996,25.487562444444443 +2017-03-01 02:00:00,95.93114399999999,27.507172,164.78972000000002,95.8748598888889 +2017-03-01 03:00:00,53.625565,8.2640418,157.06281,67.17928453333333 +2017-03-01 04:00:00,16.078255,0.46286248999999996,80.92103999999999,27.02115368222222 +2017-03-01 05:00:00,1.5705050999999999,0.18020545999999998,11.067292,3.375293094444445 +2017-03-01 06:00:00,0.087208889,0.0,0.66146396,0.2240288386666667 +2017-03-01 07:00:00,0.3467029,0.0,1.5585291000000001,0.5927590084444445 +2017-03-01 08:00:00,0.16634453,0.13405661000000002,10.093827000000001,2.4113308444444446 +2017-03-01 09:00:00,4.6303303,0.0,38.702909999999996,10.843436177777777 +2017-03-01 10:00:00,4.1380931,2.6697537000000002,17.04651,6.810694933333333 +2017-03-01 11:00:00,1.3327529999999999,0.23766279,3.7112213,1.687567851111111 +2017-03-01 12:00:00,7.851536800000001,3.8241750999999997,8.712563600000001,6.9983922666666665 +2017-03-01 13:00:00,13.556775,6.5029499,16.086042,12.42172031111111 +2017-03-01 14:00:00,18.836578,4.5246306,40.354105000000004,20.64647768888889 +2017-03-01 15:00:00,24.841866,3.4464636,88.45496600000001,34.15050462222223 +2017-03-01 16:00:00,40.37104,10.517584000000001,93.96393599999999,45.100648666666665 +2017-03-01 17:00:00,62.44819100000001,21.839969,108.74042999999999,63.001671333333334 +2017-03-01 18:00:00,58.236266,19.020998000000002,109.04026,60.021693 +2017-03-01 19:00:00,141.15028999999998,31.419328000000004,364.30653,164.37962655555555 +2017-03-01 20:00:00,118.15617,19.29974,373.35689,150.90653255555557 +2017-03-01 21:00:00,27.442031,1.7181266,144.52737,46.34288783333333 +2017-03-01 22:00:00,0.7819848,0.0,19.394047,4.316502368888889 +2017-03-01 23:00:00,0.0,0.0,0.037103963,0.004122662555555556 +2017-03-02 00:00:00,0.0,0.0,43.108485,9.730240144444444 +2017-03-02 01:00:00,1.6330864,0.0,42.458236,10.124235506666666 +2017-03-02 02:00:00,0.0,0.0,3.8591052,0.7686021122222222 +2017-03-02 03:00:00,0.19659356,0.0,2.6493797,0.6655323788888889 +2017-03-02 04:00:00,0.3323085,0.0,2.5968898,0.7343718877777777 +2017-03-02 05:00:00,0.51122481,0.0,2.788599,0.9010865103333335 +2017-03-02 06:00:00,0.11644136,0.0,0.59390061,0.20154767088888892 +2017-03-02 07:00:00,0.0,0.0,0.0,0.0 +2017-03-02 08:00:00,0.0,0.0,0.0,0.0 +2017-03-02 09:00:00,0.0,0.0,0.0,0.0 +2017-03-02 10:00:00,0.0,0.0,0.0,0.0 +2017-03-02 11:00:00,0.0,0.0,0.0,0.0 +2017-03-02 12:00:00,2.1524907,0.5828220000000001,3.9436476999999996,2.225684376666667 +2017-03-02 13:00:00,3.9854534999999998,1.1547095,7.2342964,4.118881233333333 +2017-03-02 14:00:00,1.9163548999999998,0.2860954,6.5450777,2.613360981111111 +2017-03-02 15:00:00,1.0483383,0.0,10.726745999999999,2.810604322911111 +2017-03-02 16:00:00,4.9486962000000005,0.0,24.37331,7.7542095899999985 +2017-03-02 17:00:00,24.01352,5.0244716,69.007088,29.044329566666665 +2017-03-02 18:00:00,34.130364,8.441365,86.581924,39.24382722222222 +2017-03-02 19:00:00,140.28366,33.03889,346.04091,157.49549888888887 +2017-03-02 20:00:00,156.92783999999997,41.19474,364.18394,171.55051111111112 +2017-03-02 21:00:00,27.628712,5.0055532,113.52440999999999,40.87987603333333 +2017-03-02 22:00:00,0.0,0.0,5.7906809,1.192873418888889 +2017-03-02 23:00:00,0.0,0.0,0.0,0.0 +2017-03-03 00:00:00,0.0,0.0,0.0,0.0 +2017-03-03 01:00:00,0.0,0.0,0.0,0.0 +2017-03-03 02:00:00,0.0,0.0,0.0,0.0 +2017-03-03 03:00:00,0.0,0.0,0.0,0.0 +2017-03-03 04:00:00,0.0,0.0,0.0,0.0 +2017-03-03 05:00:00,0.0,0.0,0.0,0.0 +2017-03-03 06:00:00,0.0,0.0,0.0,0.0 +2017-03-03 07:00:00,0.0,0.0,0.11758608000000001,0.01906119788888889 +2017-03-03 08:00:00,0.0,0.0,0.19918270999999999,0.039780219111111105 +2017-03-03 09:00:00,0.0,0.0,0.29680172,0.06966285444444445 +2017-03-03 10:00:00,0.0074186621,0.0,0.090231907,0.024249674799999996 +2017-03-03 11:00:00,0.0,0.0,0.0,0.0 +2017-03-03 12:00:00,0.18937767,0.0,1.288103,0.3955363255555555 +2017-03-03 13:00:00,0.077162511,0.0,0.7252642100000001,0.19951231465555555 +2017-03-03 14:00:00,0.0,0.0,0.13231731,0.030053722711111112 +2017-03-03 15:00:00,0.0,0.0,0.0,0.0 +2017-03-03 16:00:00,0.0,0.0,0.017184426,0.0019093806666666666 +2017-03-03 17:00:00,0.0,0.0,1.0749685999999998,0.11944095555555553 +2017-03-03 18:00:00,0.0,0.0,6.1038554000000005,1.2974425922222224 +2017-03-03 19:00:00,3.1963955000000004,0.0,20.186684,5.863020587777778 +2017-03-03 20:00:00,36.107918000000005,0.25981925,176.63441,57.53802961666666 +2017-03-03 21:00:00,20.449164,0.0,133.17629,38.92831940111111 +2017-03-03 22:00:00,2.5002169000000003,0.0,60.420669,14.379499223333333 +2017-03-03 23:00:00,0.0,0.0,10.009368,2.0717370344444443 +2017-03-04 00:00:00,0.0,0.0,0.0,0.0 +2017-03-04 01:00:00,0.0,0.0,1.2120971,0.19375184 +2017-03-04 02:00:00,0.0,0.0,0.885774,0.16102855066666666 +2017-03-04 03:00:00,0.0,0.0,0.047505722,0.007210993766666667 +2017-03-04 04:00:00,0.0,0.0,0.0,0.0 +2017-03-04 05:00:00,0.0,0.0,0.0,0.0 +2017-03-04 06:00:00,0.0,0.0,0.0,0.0 +2017-03-04 07:00:00,0.0,0.0,0.0,0.0 +2017-03-04 08:00:00,0.0,0.0,0.0,0.0 +2017-03-04 09:00:00,0.0,0.0,0.49449578999999994,0.10248022555555554 +2017-03-04 10:00:00,0.38047546000000004,0.0,2.2045108,0.6948713138888888 +2017-03-04 11:00:00,1.614571,0.29005733,4.369509,1.9740029311111114 +2017-03-04 12:00:00,0.59248765,0.056243767,2.8400996,0.9772850865555553 +2017-03-04 13:00:00,0.32171279999999997,0.0,2.4867222,0.7030952814666667 +2017-03-04 14:00:00,0.33319815999999997,0.0,3.691755,0.9518110746666666 +2017-03-04 15:00:00,0.067820054,0.0,4.8293041,0.984157256 +2017-03-04 16:00:00,2.6774294,0.0,17.199538,4.990400774444444 +2017-03-04 17:00:00,9.370822200000001,0.85530814,37.965932,13.368838926666667 +2017-03-04 18:00:00,14.618271,2.2924653,50.714545,19.287294711111112 +2017-03-04 19:00:00,20.132977,3.7571671999999996,61.300954,25.016614533333335 +2017-03-04 20:00:00,83.654297,12.167938999999999,282.47024999999996,109.7873271111111 +2017-03-04 21:00:00,78.236197,8.8592087,306.38259999999997,111.25728318888889 +2017-03-04 22:00:00,55.148848,2.1416479,253.88971,85.29881525555555 +2017-03-04 23:00:00,66.086934,5.28793,285.49973,98.11588677777777 +2017-03-05 00:00:00,3.3181075,0.072199128,21.293938999999998,6.305041858666666 +2017-03-05 01:00:00,0.0,0.0,0.0,0.0 +2017-03-05 02:00:00,0.0,0.0,0.0,0.0 +2017-03-05 03:00:00,0.0,0.0,0.0,0.0 +2017-03-05 04:00:00,0.0,0.0,0.0,0.0 +2017-03-05 05:00:00,0.0,0.0,0.0,0.0 +2017-03-05 06:00:00,0.0,0.0,0.0,0.0 +2017-03-05 07:00:00,0.0,0.0,0.38251682000000004,0.085592632 +2017-03-05 08:00:00,0.25172952,0.0,1.4681746,0.4625119515555556 +2017-03-05 09:00:00,0.093705218,0.0050913784,0.40729094,0.14898619837777777 +2017-03-05 10:00:00,0.0,0.0,0.0,0.0 +2017-03-05 11:00:00,0.0,0.0,0.0,0.0 +2017-03-05 12:00:00,1.8194946,0.36843519999999996,4.5123061,2.135973746666666 +2017-03-05 13:00:00,0.6503920000000001,0.11106751,2.4140867999999998,0.9237906277777778 +2017-03-05 14:00:00,0.046078838999999996,0.0,0.48842378000000003,0.12048901744444446 +2017-03-05 15:00:00,0.0,0.0,0.077047211,0.009486757822222223 +2017-03-05 16:00:00,0.57122799,0.0,7.0386313000000005,1.7102150766666666 +2017-03-05 17:00:00,8.908135,1.1097036,35.815632,12.641810244444445 +2017-03-05 18:00:00,33.292985,8.1164299,79.275233,37.24775732222221 +2017-03-05 19:00:00,72.263771,29.562461,104.9151,69.48813044444445 +2017-03-05 20:00:00,391.47949,282.83798,406.55152,344.8725977777778 +2017-03-05 21:00:00,403.34612000000004,175.45056,520.3191,374.82626555555555 +2017-03-05 22:00:00,160.80316000000002,32.600692,420.82136,187.36757088888888 +2017-03-05 23:00:00,13.077963,0.8679072,63.163112000000005,20.833592044444444 +2017-03-06 00:00:00,0.0,0.0,0.49857999000000003,0.06383579611111112 +2017-03-06 01:00:00,0.0,0.0,0.0,0.0 +2017-03-06 02:00:00,0.0,0.0,0.26588248,0.029542497777777774 +2017-03-06 03:00:00,0.0,0.0,0.0,0.0 +2017-03-06 04:00:00,0.0,0.0,0.0,0.0 +2017-03-06 05:00:00,0.0,0.0,0.0,0.0 +2017-03-06 06:00:00,0.0,0.0,0.0,0.0 +2017-03-06 07:00:00,0.0,0.0,0.0,0.0 +2017-03-06 08:00:00,0.0,0.0,0.0,0.0 +2017-03-06 09:00:00,0.0,0.0,0.0,0.0 +2017-03-06 10:00:00,0.0,0.0,0.0,0.0 +2017-03-06 11:00:00,0.0,0.0,0.0,0.0 +2017-03-06 12:00:00,1.365345,0.39766093,3.6322376000000003,1.6067830255555557 +2017-03-06 13:00:00,8.9862169,4.2451829,10.962896,8.31788451111111 +2017-03-06 14:00:00,10.019574,4.6875448,22.180970000000002,11.583056833333334 +2017-03-06 15:00:00,20.446301000000002,3.2931996,65.096203,26.526814333333338 +2017-03-06 16:00:00,47.535585,14.611533,94.07624,50.04475433333333 +2017-03-06 17:00:00,81.897371,40.027134999999994,103.93273,76.89045988888888 +2017-03-06 18:00:00,103.95639,66.12685,113.25504000000001,94.34536333333332 +2017-03-06 19:00:00,106.81136000000001,79.899139,112.22284,96.80354822222222 +2017-03-06 20:00:00,222.28798,111.74897,282.566,209.1060788888889 +2017-03-06 21:00:00,400.51452,224.36455999999998,449.46396,366.5377555555555 +2017-03-06 22:00:00,155.82325,39.91733,373.40506000000005,175.87107655555556 +2017-03-06 23:00:00,7.7412924,0.33407446,55.147717,16.274659905555556 +2017-03-07 00:00:00,0.013876294,0.0,8.7649541,1.398090734888889 +2017-03-07 01:00:00,0.0,0.0,6.749467,0.7499407777777778 +2017-03-07 02:00:00,0.0,0.0,5.1742177,0.5749130777777778 +2017-03-07 03:00:00,0.0,0.0,0.71654546,0.07961616222222222 +2017-03-07 04:00:00,0.0,0.0,0.0,0.0 +2017-03-07 05:00:00,0.0,0.0,0.0,0.0 +2017-03-07 06:00:00,0.0,0.0,0.0,0.0 +2017-03-07 07:00:00,0.0,0.0,0.0,0.0 +2017-03-07 08:00:00,0.0,0.0,0.0,0.0 +2017-03-07 09:00:00,0.0,0.0,0.0,0.0 +2017-03-07 10:00:00,0.0,0.0,4.0051841,0.7765095811111111 +2017-03-07 11:00:00,2.9265263,0.0,28.487026,7.804365077777779 +2017-03-07 12:00:00,8.6088803,5.5455248,16.913036,9.807763111111111 +2017-03-07 13:00:00,10.741824999999999,6.6576781,11.435936,9.412618588888888 +2017-03-07 14:00:00,29.769924,19.232466,30.563981000000002,26.175138444444443 +2017-03-07 15:00:00,69.679249,43.482468999999995,72.28602,61.10730100000001 +2017-03-07 16:00:00,97.260483,71.723,100.72445,86.58708077777777 +2017-03-07 17:00:00,84.749088,49.394431999999995,102.42017,78.36800255555555 +2017-03-07 18:00:00,90.15615100000001,48.006881,115.39198999999999,84.39556233333332 +2017-03-07 19:00:00,92.043294,49.095313,117.26897,86.20529422222222 +2017-03-07 20:00:00,342.28299000000004,165.07144,434.86065,316.6779388888889 +2017-03-07 21:00:00,518.55651,318.23575,559.19244,463.54611555555556 +2017-03-07 22:00:00,285.59925999999996,84.817162,556.32839,297.78598244444447 +2017-03-07 23:00:00,85.61225,9.6047979,320.28905,118.77571154444445 +2017-03-08 00:00:00,83.445258,9.266776,324.3775,118.70253311111112 +2017-03-08 01:00:00,52.931515,11.359256,133.83629,61.77663211111111 +2017-03-08 02:00:00,15.65903,4.1772983,26.912432000000003,15.819405477777776 +2017-03-08 03:00:00,5.3897302,1.1838161999999999,11.57364,5.916797666666667 +2017-03-08 04:00:00,3.212929,0.5495876399999999,8.723373,3.913859551111111 +2017-03-08 05:00:00,2.3146849,0.36447196,6.9076582,2.9600451011111115 +2017-03-08 06:00:00,2.6861544,0.5157572800000001,6.528820400000001,3.1154117233333327 +2017-03-08 07:00:00,3.0903934,0.7517252200000001,6.1841843,3.309428835555556 +2017-03-08 08:00:00,2.9690859,0.81498081,5.3639250999999994,3.0640756677777774 +2017-03-08 09:00:00,2.4540132000000003,0.59613694,5.030756299999999,2.6598437255555556 +2017-03-08 10:00:00,2.0712116,0.43659651000000005,4.8721399,2.374694297777778 +2017-03-08 11:00:00,1.6547858999999998,0.29113571,4.5098309,2.0286711955555554 +2017-03-08 12:00:00,0.57562232,0.047304559999999996,2.7187261,0.9278926466666668 +2017-03-08 13:00:00,0.058821424,0.0,0.40818562999999997,0.12192205444444444 +2017-03-08 14:00:00,0.0,0.0,0.0,0.0 +2017-03-08 15:00:00,0.0,0.0,0.0,0.0 +2017-03-08 16:00:00,0.0,0.0,0.0,0.0 +2017-03-08 17:00:00,0.0,0.0,0.0,0.0 +2017-03-08 18:00:00,0.0,0.0,1.4697441999999998,0.1633049111111111 +2017-03-08 19:00:00,0.0,0.0,4.536547700000001,0.8795085777777778 +2017-03-08 20:00:00,0.0,0.0,26.125435000000003,5.499604648888889 +2017-03-08 21:00:00,0.0,0.0,4.433688399999999,0.7659778533333333 +2017-03-08 22:00:00,0.0,0.0,0.0,0.0 +2017-03-08 23:00:00,0.0,0.0,0.0,0.0 +2017-03-09 00:00:00,0.0,0.0,0.0,0.0 +2017-03-09 01:00:00,0.0,0.0,0.0,0.0 +2017-03-09 02:00:00,0.0,0.0,0.0,0.0 +2017-03-09 03:00:00,0.0,0.0,0.0,0.0 +2017-03-09 04:00:00,0.0,0.0,0.0,0.0 +2017-03-09 05:00:00,0.0,0.0,0.0,0.0 +2017-03-09 06:00:00,0.0,0.0,0.0,0.0 +2017-03-09 07:00:00,0.0,0.0,0.54413863,0.13510539600000002 +2017-03-09 08:00:00,0.09157931700000001,0.0,0.8307204699999999,0.23492193866666666 +2017-03-09 09:00:00,0.054030487,0.0,0.6070836199999999,0.16410455744444447 +2017-03-09 10:00:00,0.0029928582000000002,0.0,0.37462129,0.09334547779999999 +2017-03-09 11:00:00,0.0,0.0,0.22632356,0.05058260413333334 +2017-03-09 12:00:00,0.08873745100000001,0.0,0.833299,0.22546223832222217 +2017-03-09 13:00:00,0.044883816,0.0,0.29729492,0.09102119875555555 +2017-03-09 14:00:00,0.0,0.0,0.0,0.0 +2017-03-09 15:00:00,0.0,0.0,0.0,0.0 +2017-03-09 16:00:00,0.0,0.0,0.0,0.0 +2017-03-09 17:00:00,0.0,0.0,2.0129382,0.3185089944444444 +2017-03-09 18:00:00,1.4813679,0.0,12.828697,3.403075844444444 +2017-03-09 19:00:00,13.416502999999999,1.9417801,47.554581999999996,17.78366768888889 +2017-03-09 20:00:00,112.25796000000001,37.934933,216.50686,116.14084744444443 +2017-03-09 21:00:00,53.308981,10.271716000000001,182.68863,70.49923466666667 +2017-03-09 22:00:00,3.7687919,0.0,35.337471,9.317747484444446 +2017-03-09 23:00:00,0.0,0.0,0.019965174,0.0022183526666666666 +2017-03-10 00:00:00,0.0,0.0,0.0,0.0 +2017-03-10 01:00:00,0.0,0.0,0.0,0.0 +2017-03-10 02:00:00,0.0,0.0,0.0,0.0 +2017-03-10 03:00:00,0.0,0.0,0.0,0.0 +2017-03-10 04:00:00,0.0,0.0,0.8415098599999999,0.09350109555555555 +2017-03-10 05:00:00,0.0,0.0,10.168732,2.0532857888888887 +2017-03-10 06:00:00,0.0,0.0,9.266908800000001,1.9322872 +2017-03-10 07:00:00,0.0,0.0,7.1585464,1.4173305222222221 +2017-03-10 08:00:00,0.0,0.0,5.6673484,1.0163360155555554 +2017-03-10 09:00:00,0.0,0.0,10.252471,2.1591486444444445 +2017-03-10 10:00:00,1.1615588000000001,0.22349687999999998,6.1890055,2.105312786666667 +2017-03-10 11:00:00,1.4806643,0.30576268,3.4479935,1.677752398888889 +2017-03-10 12:00:00,3.2583391,0.9474549099999999,5.6088425,3.298205178888889 +2017-03-10 13:00:00,9.1887068,4.679604,10.191505,8.199403477777778 +2017-03-10 14:00:00,28.421870000000002,19.815314,28.688979,24.765166555555552 +2017-03-10 15:00:00,69.016045,23.296667,114.29538000000001,69.58529044444444 +2017-03-10 16:00:00,80.048179,32.972715,117.2937,77.27303044444444 +2017-03-10 17:00:00,109.05999,64.174303,120.39465,99.79152855555556 +2017-03-10 18:00:00,105.09909999999999,56.223907000000004,122.52976,97.27414577777778 +2017-03-10 19:00:00,88.00197200000001,38.805909,125.71615,84.55246177777778 +2017-03-10 20:00:00,178.89135,53.24747,365.30341999999996,186.54044166666665 +2017-03-10 21:00:00,124.78972000000002,24.620977,367.47323,154.89682988888887 +2017-03-10 22:00:00,38.652997,1.9277659,194.30384,63.66212645555556 +2017-03-10 23:00:00,7.620532,0.0,82.53433,21.81067645555556 +2017-03-11 00:00:00,72.501047,5.5053983,330.15205000000003,111.9163587 +2017-03-11 01:00:00,74.464209,7.5809470999999995,308.42025,109.94157212222223 +2017-03-11 02:00:00,6.5930549,0.0,40.536204,12.554828828888889 +2017-03-11 03:00:00,0.35005388,0.0,4.1010544,1.065322240888889 +2017-03-11 04:00:00,4.771356999999999,1.5351549,7.6796814,4.717188822222223 +2017-03-11 05:00:00,6.0227493999999995,3.4306565,6.4700334,5.361422466666666 +2017-03-11 06:00:00,1.4193378,0.9592262100000001,1.5038373,1.2204586566666669 +2017-03-11 07:00:00,0.0,0.0,0.0,0.0 +2017-03-11 08:00:00,0.0,0.0,0.0,0.0 +2017-03-11 09:00:00,0.0,0.0,0.0,0.0 +2017-03-11 10:00:00,0.0,0.0,0.0,0.0 +2017-03-11 11:00:00,0.0,0.0,0.0,0.0 +2017-03-11 12:00:00,0.0,0.0,0.58485625,0.11622724999999999 +2017-03-11 13:00:00,6.2116615,2.6874866,10.461435999999999,6.431270855555556 +2017-03-11 14:00:00,4.385206500000001,0.6263873000000001,18.62958,6.688595268888888 +2017-03-11 15:00:00,4.8631123,0.0,37.416292,10.453095527777778 +2017-03-11 16:00:00,18.731518,3.4815969,59.354020999999996,23.820825477777774 +2017-03-11 17:00:00,50.056304000000004,15.529797,105.43669,53.58450322222223 +2017-03-11 18:00:00,42.289259,12.819773999999999,92.398295,45.80805033333334 +2017-03-11 19:00:00,26.652086,7.3933752,66.643246,30.524842466666662 +2017-03-11 20:00:00,29.693481000000002,6.1994833,89.26956799999999,36.729306155555555 +2017-03-11 21:00:00,47.213747,8.909702,155.16607,60.33495155555555 +2017-03-11 22:00:00,78.676952,17.834169000000003,225.40579,94.38790222222222 +2017-03-11 23:00:00,234.54223,69.941278,501.24765,252.5468285555556 +2017-03-12 00:00:00,446.09528,87.76920700000001,1280.7617,544.456013 +2017-03-12 01:00:00,67.573077,0.54280542,422.44043999999997,129.69334383555554 +2017-03-12 02:00:00,0.0,0.0,18.715687,3.0389444077777776 +2017-03-12 03:00:00,0.0,0.0,1.7869521000000002,0.21248869111111113 +2017-03-12 04:00:00,0.0,0.0,0.0,0.0 +2017-03-12 05:00:00,0.0,0.0,0.0,0.0 +2017-03-12 06:00:00,0.0,0.0,0.0,0.0 +2017-03-12 07:00:00,0.0,0.0,0.0,0.0 +2017-03-12 08:00:00,0.0,0.0,0.0,0.0 +2017-03-12 09:00:00,0.0,0.0,0.76975363,0.0855281811111111 +2017-03-12 10:00:00,0.0,0.0,6.5695131,1.13303777 +2017-03-12 11:00:00,0.0,0.0,21.333688,4.4720021999999995 +2017-03-12 12:00:00,4.290553500000001,0.46942557,18.6612,6.721390431111112 +2017-03-12 13:00:00,0.0,0.0,0.0,0.0 +2017-03-12 14:00:00,15.761179,8.9240193,18.33259,13.640920922222223 +2017-03-12 15:00:00,97.54294999999999,67.52927600000001,101.3428,88.92806322222222 +2017-03-12 16:00:00,111.35922000000001,80.13520700000001,118.75862000000001,103.01405277777776 +2017-03-12 17:00:00,125.78801000000001,100.19022,133.28734,117.19992111111111 +2017-03-12 18:00:00,110.57577,83.555606,124.08591000000001,104.20877300000001 +2017-03-12 19:00:00,89.030873,58.860765,101.06393,85.99710033333334 +2017-03-12 20:00:00,50.660576,27.323586,71.81276299999999,50.83985255555555 +2017-03-12 21:00:00,60.576065,22.917764000000002,111.22251,65.02809433333333 +2017-03-12 22:00:00,127.81121999999999,62.44824200000001,187.55933,128.18738711111112 +2017-03-12 23:00:00,233.56116,82.79834600000001,410.71002,246.09265288888886 +2017-03-13 00:00:00,1429.1676,862.59033,1480.091,1235.81548 +2017-03-13 01:00:00,1887.8529,868.0407799999999,2059.7223,1521.7955866666664 +2017-03-13 02:00:00,876.0294299999999,333.00613999999996,1009.9402,735.0672422222221 +2017-03-13 03:00:00,510.99848,300.67632999999995,564.58596,419.26149888888887 +2017-03-13 04:00:00,273.98762,66.79983200000001,502.91105,269.19048155555555 +2017-03-13 05:00:00,67.604604,4.5911715,242.70147,105.59578538888888 +2017-03-13 06:00:00,167.67569,36.213896,339.41606,176.88520433333335 +2017-03-13 07:00:00,209.46874,124.48407,235.06177,173.8254388888889 +2017-03-13 08:00:00,130.12218,39.468418,172.13437,116.53847200000001 +2017-03-13 09:00:00,90.677611,16.472501,184.08362,91.3266247777778 +2017-03-13 10:00:00,52.692918,6.4718561,154.80643,62.678883899999995 +2017-03-13 11:00:00,38.723934,3.2653465,144.45272,54.539316577777775 +2017-03-13 12:00:00,8.8808893,1.1523193,28.854188999999998,11.904942366666667 +2017-03-13 13:00:00,0.0,0.0,0.0,0.0 +2017-03-13 14:00:00,0.0,0.0,0.0,0.0 +2017-03-13 15:00:00,11.861059000000001,2.9002535,32.571505,14.12508218888889 +2017-03-13 16:00:00,28.859844000000002,10.228826,61.553539,31.74853088888889 +2017-03-13 17:00:00,72.340081,34.786714,111.46186,72.21428522222223 +2017-03-13 18:00:00,108.77984000000001,86.755754,115.34259999999999,103.8431141111111 +2017-03-13 19:00:00,103.63732999999999,61.055609,132.10975,100.4208108888889 +2017-03-13 20:00:00,20.897524999999998,10.307343,34.207067,21.672338555555555 +2017-03-13 21:00:00,38.921276,9.6900949,96.114745,47.14142998888889 +2017-03-13 22:00:00,377.07176,207.46329,510.06285,354.91014222222225 +2017-03-13 23:00:00,620.00612,403.29708,670.96564,565.0074011111111 +2017-03-14 00:00:00,1368.9462,694.66868,1625.4565,1186.23117 +2017-03-14 01:00:00,1469.5446,601.48997,1722.1897999999999,1288.2441011111111 +2017-03-14 02:00:00,441.49699,60.500312,1319.9539000000002,539.4893718888889 +2017-03-14 03:00:00,270.96726,31.577520999999997,760.00986,323.62170833333334 +2017-03-14 04:00:00,170.26665,16.088883000000003,561.89444,223.92341444444443 +2017-03-14 05:00:00,75.55724,1.4593134,480.13669,147.52428521111108 +2017-03-14 06:00:00,7.667499599999999,0.0,125.82789000000001,30.492471191111115 +2017-03-14 07:00:00,0.0,0.0,5.0561557,0.8705362722222222 +2017-03-14 08:00:00,0.0,0.0,0.0,0.0 +2017-03-14 09:00:00,0.0,0.0,0.0,0.0 +2017-03-14 10:00:00,0.0,0.0,0.73779938,0.08197770888888889 +2017-03-14 11:00:00,0.0,0.0,1.1090983,0.12323314444444446 +2017-03-14 12:00:00,0.0,0.0,1.3001924999999999,0.24142924 +2017-03-14 13:00:00,0.0,0.0,0.0,0.0 +2017-03-14 14:00:00,0.0,0.0,0.0,0.0 +2017-03-14 15:00:00,6.2894042,1.2138069999999999,19.90384,7.939544777777779 +2017-03-14 16:00:00,15.982537999999998,4.6616751,40.373259000000004,18.49589718888889 +2017-03-14 17:00:00,41.628326,17.433757,76.802884,44.69328688888889 +2017-03-14 18:00:00,57.764231,26.308094999999998,100.47812,59.65383288888889 +2017-03-14 19:00:00,51.535320000000006,26.33542,79.998194,52.45503022222223 +2017-03-14 20:00:00,52.534364,41.195261,56.451347,51.207722 +2017-03-14 21:00:00,82.512001,51.389165,103.87274,80.50611433333331 +2017-03-14 22:00:00,114.3715,67.50223100000001,145.09309,110.11776488888887 +2017-03-14 23:00:00,119.32942,43.017335,231.18989,131.5523912222222 +2017-03-15 00:00:00,15.351987,1.204381,61.423198000000006,22.490220133333334 +2017-03-15 01:00:00,680.91892,311.95072,737.92157,569.6225955555557 +2017-03-15 02:00:00,154.76397,50.582392,325.45757000000003,164.68636344444445 +2017-03-15 03:00:00,0.4070707,0.0,53.340187,10.2361036 +2017-03-15 04:00:00,0.0,0.0,3.8356269999999997,0.5394480444444444 +2017-03-15 05:00:00,0.0,0.0,0.0,0.0 +2017-03-15 06:00:00,0.0,0.0,0.0,0.0 +2017-03-15 07:00:00,0.0,0.0,0.0,0.0 +2017-03-15 08:00:00,0.0,0.0,0.0,0.0 +2017-03-15 09:00:00,0.0,0.0,0.0,0.0 +2017-03-15 10:00:00,0.0,0.0,0.0,0.0 +2017-03-15 11:00:00,0.0,0.0,0.0,0.0 +2017-03-15 12:00:00,0.0,0.0,0.0,0.0 +2017-03-15 13:00:00,0.0,0.0,0.29322476,0.07376447777777778 +2017-03-15 14:00:00,0.0,0.0,0.10627921,0.024717723666666667 +2017-03-15 15:00:00,0.0,0.0,0.0,0.0 +2017-03-15 16:00:00,0.0,0.0,0.0,0.0 +2017-03-15 17:00:00,0.0,0.0,4.7928111,0.9670917411111112 +2017-03-15 18:00:00,1.0001779,0.0,10.348825999999999,2.6090942888888886 +2017-03-15 19:00:00,3.0184679,0.0,17.543550999999997,5.106108789888889 +2017-03-15 20:00:00,17.389515000000003,0.045789655,79.848753,25.868674895 +2017-03-15 21:00:00,23.729215,0.0,125.77369000000002,38.95108935444445 +2017-03-15 22:00:00,30.724907,0.0,162.6508,50.68676120000001 +2017-03-15 23:00:00,23.870205000000002,1.39579,110.52631,36.60131261111111 +2017-03-16 00:00:00,2.2688744,0.0,74.698306,16.267553662222227 +2017-03-16 01:00:00,0.0,0.0,8.2779861,1.4922731444444444 +2017-03-16 02:00:00,0.0,0.0,0.0,0.0 +2017-03-16 03:00:00,0.0,0.0,0.0,0.0 +2017-03-16 04:00:00,0.0,0.0,0.0,0.0 +2017-03-16 05:00:00,0.0,0.0,0.0,0.0 +2017-03-16 06:00:00,0.0,0.0,0.0,0.0 +2017-03-16 07:00:00,0.0,0.0,0.0,0.0 +2017-03-16 08:00:00,0.0,0.0,0.0,0.0 +2017-03-16 09:00:00,0.0,0.0,0.0,0.0 +2017-03-16 10:00:00,0.0,0.0,0.0,0.0 +2017-03-16 11:00:00,0.0,0.0,0.0,0.0 +2017-03-16 12:00:00,0.0,0.0,0.0,0.0 +2017-03-16 13:00:00,0.0,0.0,0.0,0.0 +2017-03-16 14:00:00,0.0,0.0,0.0,0.0 +2017-03-16 15:00:00,0.0,0.0,0.0,0.0 +2017-03-16 16:00:00,0.0,0.0,0.0,0.0 +2017-03-16 17:00:00,0.0,0.0,0.0,0.0 +2017-03-16 18:00:00,0.0,0.0,0.0,0.0 +2017-03-16 19:00:00,0.0,0.0,0.0,0.0 +2017-03-16 20:00:00,0.0,0.0,0.0,0.0 +2017-03-16 21:00:00,0.0,0.0,0.0,0.0 +2017-03-16 22:00:00,0.0,0.0,0.0,0.0 +2017-03-16 23:00:00,0.0,0.0,0.0,0.0 +2017-03-17 00:00:00,0.0,0.0,0.0,0.0 +2017-03-17 01:00:00,0.0,0.0,0.0,0.0 +2017-03-17 02:00:00,0.0,0.0,0.0,0.0 +2017-03-17 03:00:00,0.0,0.0,0.0,0.0 +2017-03-17 04:00:00,0.0,0.0,0.0,0.0 +2017-03-17 05:00:00,0.0,0.0,0.0,0.0 +2017-03-17 06:00:00,0.0,0.0,0.0,0.0 +2017-03-17 07:00:00,0.0,0.0,0.0,0.0 +2017-03-17 08:00:00,0.00021177478999999998,0.0,0.021000451,0.004064005661111111 +2017-03-17 09:00:00,0.014034336,0.0,0.15322249,0.03845383921111111 +2017-03-17 10:00:00,0.13587776,0.0,0.61919809,0.22581821833333338 +2017-03-17 11:00:00,0.43527783,0.056327735,1.5141854000000001,0.633128569111111 +2017-03-17 12:00:00,0.9897052000000001,0.14190759,3.5208144999999997,1.3986567777777776 +2017-03-17 13:00:00,0.27498993,0.044157556,0.87105525,0.36934354244444445 +2017-03-17 14:00:00,0.0,0.0,0.0,0.0 +2017-03-17 15:00:00,0.0,0.0,0.0,0.0 +2017-03-17 16:00:00,0.0,0.0,2.3919230999999996,0.3939773888888889 +2017-03-17 17:00:00,15.79649,2.5343022,51.436225,20.215342555555555 +2017-03-17 18:00:00,7.2073467,0.43822405,32.523567,10.853933374444445 +2017-03-17 19:00:00,0.73089063,0.0,10.321093,2.675055447888889 +2017-03-17 20:00:00,0.0,0.0,1.7405367,0.338925008 +2017-03-17 21:00:00,0.0,0.0,0.0,0.0 +2017-03-17 22:00:00,0.0,0.0,0.0,0.0 +2017-03-17 23:00:00,0.0,0.0,0.0,0.0 +2017-03-18 00:00:00,0.0,0.0,0.0,0.0 +2017-03-18 01:00:00,0.0,0.0,0.0,0.0 +2017-03-18 02:00:00,0.0,0.0,0.0,0.0 +2017-03-18 03:00:00,0.0,0.0,0.0,0.0 +2017-03-18 04:00:00,0.0,0.0,0.0,0.0 +2017-03-18 05:00:00,0.0,0.0,0.0,0.0 +2017-03-18 06:00:00,0.0,0.0,0.0,0.0 +2017-03-18 07:00:00,0.0,0.0,0.0,0.0 +2017-03-18 08:00:00,0.0,0.0,0.0,0.0 +2017-03-18 09:00:00,0.0,0.0,0.0,0.0 +2017-03-18 10:00:00,0.0,0.0,0.0,0.0 +2017-03-18 11:00:00,0.0,0.0,0.0,0.0 +2017-03-18 12:00:00,0.0,0.0,0.14015953,0.022513959666666666 +2017-03-18 13:00:00,0.0,0.0,0.069546871,0.014180373777777776 +2017-03-18 14:00:00,0.0,0.0,0.0,0.0 +2017-03-18 15:00:00,0.0,0.0,0.0,0.0 +2017-03-18 16:00:00,0.0,0.0,0.0,0.0 +2017-03-18 17:00:00,0.0,0.0,1.3013201,0.14459112222222223 +2017-03-18 18:00:00,0.0,0.0,4.8966017,0.9166362988888888 +2017-03-18 19:00:00,1.1606619,0.0,11.773589999999999,2.991162133333333 +2017-03-18 20:00:00,12.451687000000002,0.0,79.580066,22.324607604444445 +2017-03-18 21:00:00,12.175899000000001,0.0,93.928553,26.0402364 +2017-03-18 22:00:00,7.0248834,0.0,79.191545,20.741778622222224 +2017-03-18 23:00:00,4.3014261000000005,0.0,73.53313399999999,18.51786092111111 +2017-03-19 00:00:00,0.0,0.0,2.6749511999999998,0.5349515446666666 +2017-03-19 01:00:00,0.0,0.0,0.0,0.0 +2017-03-19 02:00:00,0.0,0.0,0.0,0.0 +2017-03-19 03:00:00,0.0,0.0,0.0,0.0 +2017-03-19 04:00:00,0.0,0.0,0.0,0.0 +2017-03-19 05:00:00,0.0,0.0,0.0,0.0 +2017-03-19 06:00:00,0.0,0.0,0.0,0.0 +2017-03-19 07:00:00,0.0,0.0,0.0,0.0 +2017-03-19 08:00:00,0.0,0.0,0.0,0.0 +2017-03-19 09:00:00,0.0,0.0,0.0,0.0 +2017-03-19 10:00:00,0.0,0.0,0.0,0.0 +2017-03-19 11:00:00,0.0,0.0,0.0,0.0 +2017-03-19 12:00:00,0.0,0.0,0.0,0.0 +2017-03-19 13:00:00,0.0,0.0,0.0,0.0 +2017-03-19 14:00:00,0.0,0.0,0.0,0.0 +2017-03-19 15:00:00,0.0,0.0,0.0,0.0 +2017-03-19 16:00:00,0.0,0.0,0.0,0.0 +2017-03-19 17:00:00,0.0,0.0,0.59189443,0.06576604777777778 +2017-03-19 18:00:00,0.0,0.0,1.7448696000000001,0.1938744 +2017-03-19 19:00:00,0.0,0.0,3.0394183,0.4746584666666666 +2017-03-19 20:00:00,0.0,0.0,12.362721,2.2007456555555556 +2017-03-19 21:00:00,0.0,0.0,2.1835438,0.3111247277777778 +2017-03-19 22:00:00,0.0,0.0,0.0,0.0 +2017-03-19 23:00:00,0.0,0.0,0.0,0.0 +2017-03-20 00:00:00,0.0,0.0,0.0,0.0 +2017-03-20 01:00:00,0.0,0.0,0.0,0.0 +2017-03-20 02:00:00,0.0,0.0,0.0,0.0 +2017-03-20 03:00:00,0.0,0.0,0.0,0.0 +2017-03-20 04:00:00,0.0,0.0,0.0,0.0 +2017-03-20 05:00:00,0.0,0.0,0.0,0.0 +2017-03-20 06:00:00,0.0,0.0,0.0,0.0 +2017-03-20 07:00:00,0.0,0.0,0.0,0.0 +2017-03-20 08:00:00,0.0,0.0,0.0,0.0 +2017-03-20 09:00:00,0.0,0.0,0.0,0.0 +2017-03-20 10:00:00,0.0,0.0,0.0,0.0 +2017-03-20 11:00:00,0.0,0.0,0.0,0.0 +2017-03-20 12:00:00,0.0,0.0,0.0,0.0 +2017-03-20 13:00:00,0.0,0.0,0.0,0.0 +2017-03-20 14:00:00,0.0,0.0,0.0,0.0 +2017-03-20 15:00:00,0.0,0.0,0.0,0.0 +2017-03-20 16:00:00,0.0,0.0,0.0,0.0 +2017-03-20 17:00:00,0.45080662000000005,0.0,5.9399476,1.3756901799999999 +2017-03-20 18:00:00,0.0,0.0,3.2684725,0.6035412444444445 +2017-03-20 19:00:00,0.0,0.0,0.21713745,0.024126383333333334 +2017-03-20 20:00:00,0.0,0.0,0.0,0.0 +2017-03-20 21:00:00,0.0,0.0,0.0,0.0 +2017-03-20 22:00:00,0.0,0.0,0.0,0.0 +2017-03-20 23:00:00,0.0,0.0,0.0,0.0 +2017-03-21 00:00:00,0.0,0.0,0.0,0.0 +2017-03-21 01:00:00,0.0,0.0,0.0,0.0 +2017-03-21 02:00:00,0.0,0.0,0.0,0.0 +2017-03-21 03:00:00,0.0,0.0,0.0,0.0 +2017-03-21 04:00:00,0.0,0.0,0.0,0.0 +2017-03-21 05:00:00,0.0,0.0,0.0,0.0 +2017-03-21 06:00:00,0.0,0.0,0.0,0.0 +2017-03-21 07:00:00,0.0,0.0,0.0,0.0 +2017-03-21 08:00:00,0.0,0.0,0.0,0.0 +2017-03-21 09:00:00,0.0,0.0,0.0,0.0 +2017-03-21 10:00:00,0.0,0.0,0.0,0.0 +2017-03-21 11:00:00,0.0,0.0,0.0,0.0 +2017-03-21 12:00:00,0.0,0.0,0.0,0.0 +2017-03-21 13:00:00,0.0,0.0,0.0,0.0 +2017-03-21 14:00:00,0.0,0.0,0.0,0.0 +2017-03-21 15:00:00,21.127124,7.5099201,41.782449,22.508114588888887 +2017-03-21 16:00:00,24.533516,7.563016,56.654808,27.546747200000002 +2017-03-21 17:00:00,32.190575,9.601990299999999,73.640796,35.65356636666667 +2017-03-21 18:00:00,55.209046,20.180837999999998,103.13647,57.05341377777778 +2017-03-21 19:00:00,75.416465,33.057688,118.91501,74.5594848888889 +2017-03-21 20:00:00,225.80969,120.79003,288.22501,213.68259666666665 +2017-03-21 21:00:00,463.66482,271.65274,522.89886,420.7861077777778 +2017-03-21 22:00:00,596.97923,445.77927,616.46284,536.649051111111 +2017-03-21 23:00:00,435.76930000000004,215.45202,576.3496700000001,418.26265 +2017-03-22 00:00:00,448.35926,299.34992,462.99322,397.37420888888886 +2017-03-22 01:00:00,0.0,0.0,0.0,0.0 +2017-03-22 02:00:00,0.0,0.0,0.0,0.0 +2017-03-22 03:00:00,0.0,0.0,0.0,0.0 +2017-03-22 04:00:00,0.0,0.0,0.0,0.0 +2017-03-22 05:00:00,0.0,0.0,14.217716999999999,2.1575230555555556 +2017-03-22 06:00:00,0.0,0.0,1.6442164000000001,0.22751511333333335 +2017-03-22 07:00:00,0.0,0.0,0.0,0.0 +2017-03-22 08:00:00,0.0,0.0,0.0,0.0 +2017-03-22 09:00:00,0.0,0.0,0.0,0.0 +2017-03-22 10:00:00,0.0,0.0,0.0,0.0 +2017-03-22 11:00:00,0.0,0.0,0.0,0.0 +2017-03-22 12:00:00,0.0,0.0,0.0,0.0 +2017-03-22 13:00:00,0.0,0.0,0.0,0.0 +2017-03-22 14:00:00,0.0,0.0,0.0,0.0 +2017-03-22 15:00:00,7.1851887,1.5913486000000001,21.522015,8.975412255555556 +2017-03-22 16:00:00,40.153442000000005,16.318627,72.062496,41.45847022222222 +2017-03-22 17:00:00,98.437849,78.201228,105.15634,92.78764022222224 +2017-03-22 18:00:00,109.25365,90.59046000000001,113.66675000000001,101.80797288888888 +2017-03-22 19:00:00,100.5754,73.595984,107.91999,93.82718844444445 +2017-03-22 20:00:00,144.77067,103.22598,155.61153,134.44492888888888 +2017-03-22 21:00:00,352.41558,253.89189,397.95597,321.2358644444444 +2017-03-22 22:00:00,467.34491,246.09562,579.6664,435.6353877777778 +2017-03-22 23:00:00,283.3824,93.682844,503.74423,297.4025771111111 +2017-03-23 00:00:00,412.68800999999996,345.28319,445.37077,402.3076433333333 +2017-03-23 01:00:00,400.97183,125.52951999999999,490.29301999999996,352.7756322222222 +2017-03-23 02:00:00,382.68516,109.7667,483.64405,339.1554022222222 +2017-03-23 03:00:00,89.135523,11.178786,314.52040999999997,119.72865022222219 +2017-03-23 04:00:00,2.8928309,0.0,36.213038,8.644825284444444 +2017-03-23 05:00:00,0.0,0.0,0.13777915,0.015308794444444444 +2017-03-23 06:00:00,0.0,0.0,0.0,0.0 +2017-03-23 07:00:00,0.0,0.0,0.0,0.0 +2017-03-23 08:00:00,0.0,0.0,0.0,0.0 +2017-03-23 09:00:00,0.0,0.0,0.0,0.0 +2017-03-23 10:00:00,0.0,0.0,0.0,0.0 +2017-03-23 11:00:00,0.0,0.0,0.0,0.0 +2017-03-23 12:00:00,0.0,0.0,0.0,0.0 +2017-03-23 13:00:00,0.0,0.0,0.0,0.0 +2017-03-23 14:00:00,0.0,0.0,0.0,0.0 +2017-03-23 15:00:00,13.170537,4.120656299999999,29.921398999999997,14.771988488888887 +2017-03-23 16:00:00,17.195247,4.6252408,44.521387999999995,20.187983288888887 +2017-03-23 17:00:00,18.452310999999998,4.2737229,51.873179,22.064262922222223 +2017-03-23 18:00:00,51.689676,19.07057,96.835742,53.39049011111111 +2017-03-23 19:00:00,81.214384,44.174663,106.07136999999999,78.00133733333332 +2017-03-23 20:00:00,139.96343,110.95652,152.94604,130.48551555555557 +2017-03-23 21:00:00,112.31042000000001,40.365765,213.42753,123.65227911111111 +2017-03-23 22:00:00,12.809694,1.4967492,59.129987,21.34045593333333 +2017-03-23 23:00:00,0.0,0.0,1.4180986,0.25067120555555555 +2017-03-24 00:00:00,39.790106,1.3947703999999999,156.62727999999998,60.689898288888884 +2017-03-24 01:00:00,590.62295,437.95709,613.29314,537.3211455555555 +2017-03-24 02:00:00,143.10243,45.724039,278.45777,149.77164955555554 +2017-03-24 03:00:00,0.28988708,0.0,5.3725457,1.2867396199999999 +2017-03-24 04:00:00,0.0,0.0,0.0,0.0 +2017-03-24 05:00:00,0.0,0.0,0.0,0.0 +2017-03-24 06:00:00,0.0,0.0,0.0,0.0 +2017-03-24 07:00:00,0.0,0.0,0.0,0.0 +2017-03-24 08:00:00,0.0,0.0,0.0,0.0 +2017-03-24 09:00:00,0.0,0.0,0.0,0.0 +2017-03-24 10:00:00,0.0,0.0,0.0,0.0 +2017-03-24 11:00:00,0.0,0.0,0.0,0.0 +2017-03-24 12:00:00,0.0,0.0,0.0,0.0 +2017-03-24 13:00:00,0.0,0.0,0.0,0.0 +2017-03-24 14:00:00,0.0,0.0,0.0,0.0 +2017-03-24 15:00:00,0.0,0.0,0.10917773,0.014963310777777778 +2017-03-24 16:00:00,41.877058,20.154963000000002,66.571563,42.31891655555555 +2017-03-24 17:00:00,90.411835,72.540759,94.59092,85.44068366666666 +2017-03-24 18:00:00,100.12938,73.823976,107.93223,93.89563833333334 +2017-03-24 19:00:00,97.416516,73.22175999999999,104.98174,91.6594182222222 +2017-03-24 20:00:00,94.625655,59.288031,114.66803,90.79280555555556 +2017-03-24 21:00:00,98.702367,39.794239,167.4396,103.19005122222222 +2017-03-24 22:00:00,58.585698,16.358405,132.8384,68.16050422222222 +2017-03-24 23:00:00,11.063531,2.1445151,38.293085,15.035272299999999 +2017-03-25 00:00:00,0.0,0.0,17.007347,3.8705505000000002 +2017-03-25 01:00:00,79.556274,7.7936247,264.9774,111.89384074444445 +2017-03-25 02:00:00,223.17628,55.510762,358.63543999999996,214.67501700000003 +2017-03-25 03:00:00,311.70854,93.326431,439.13873,278.3936934444444 +2017-03-25 04:00:00,387.80789999999996,127.02758,536.36334,341.7332988888889 +2017-03-25 05:00:00,432.48388,146.41869,559.83366,373.0576 +2017-03-25 06:00:00,345.83636,118.2599,499.94874000000004,327.4619433333334 +2017-03-25 07:00:00,42.873638,4.4122721,215.94415,70.19099206666665 +2017-03-25 08:00:00,0.084312674,0.0,11.004554,2.2952769526666668 +2017-03-25 09:00:00,0.0,0.0,0.0,0.0 +2017-03-25 10:00:00,0.0,0.0,0.0,0.0 +2017-03-25 11:00:00,0.0,0.0,1.1504708,0.1278300888888889 +2017-03-25 12:00:00,0.41432352,0.0,5.3030089,1.38115621 +2017-03-25 13:00:00,0.0,0.0,0.0,0.0 +2017-03-25 14:00:00,0.0,0.0,0.0,0.0 +2017-03-25 15:00:00,0.0,0.0,0.0,0.0 +2017-03-25 16:00:00,39.080751,26.696611,46.153938000000004,37.778618333333334 +2017-03-25 17:00:00,88.664834,62.437946,104.73785000000001,87.635355 +2017-03-25 18:00:00,74.00583900000001,47.722933,98.240249,75.82028211111111 +2017-03-25 19:00:00,16.569895,6.7237697,33.841745,17.870324744444442 +2017-03-25 20:00:00,18.536141999999998,8.2169217,34.513381,19.41709841111111 +2017-03-25 21:00:00,70.38287,61.242681,80.821403,70.958506 +2017-03-25 22:00:00,6.6710367999999995,1.3954314,20.810336000000003,8.563077755555558 +2017-03-25 23:00:00,0.0,0.0,0.070705511,0.010176890222222222 +2017-03-26 00:00:00,0.0,0.0,0.0,0.0 +2017-03-26 01:00:00,0.0,0.0,0.0,0.0 +2017-03-26 02:00:00,0.0,0.0,0.0,0.0 +2017-03-26 03:00:00,0.0,0.0,0.0,0.0 +2017-03-26 04:00:00,0.0,0.0,0.0,0.0 +2017-03-26 05:00:00,15.979609,0.0,193.46418,53.23240325555556 +2017-03-26 06:00:00,440.37678,93.747163,720.47883,426.78179811111113 +2017-03-26 07:00:00,519.5772400000001,211.43877999999998,642.48085,458.3549911111111 +2017-03-26 08:00:00,87.998771,11.240135,331.68512,121.98369555555554 +2017-03-26 09:00:00,14.301315,0.0,183.37017999999998,45.76954871111111 +2017-03-26 10:00:00,3.2823566,0.0,140.66053,30.23714779333333 +2017-03-26 11:00:00,0.0,0.0,53.949418,10.06864902 +2017-03-26 12:00:00,20.117632,2.9819985,78.3297,29.113282311111114 +2017-03-26 13:00:00,0.0,0.0,0.0,0.0 +2017-03-26 14:00:00,0.0,0.0,0.0,0.0 +2017-03-26 15:00:00,0.0,0.0,0.0,0.0 +2017-03-26 16:00:00,35.353564999999996,27.023571,43.721582000000005,34.41733844444445 +2017-03-26 17:00:00,104.08659999999999,88.739682,113.9535,102.93198966666665 +2017-03-26 18:00:00,96.758471,88.306719,100.6993,94.14449244444444 +2017-03-26 19:00:00,86.674561,67.682144,98.34090499999999,84.90602255555555 +2017-03-26 20:00:00,59.757313,37.511047000000005,83.293024,59.75998699999999 +2017-03-26 21:00:00,98.12924699999999,90.599358,108.66676000000001,96.973304 +2017-03-26 22:00:00,23.138071,8.189875200000001,48.63703700000001,25.535619466666667 +2017-03-26 23:00:00,0.0,0.0,0.6722089,0.11255499 +2017-03-27 00:00:00,0.0078887652,0.007182114,0.0088349701,0.007981815944444446 +2017-03-27 01:00:00,0.0011742413,0.0010646461,0.0013212872,0.0011880706555555556 +2017-03-27 02:00:00,0.0,0.0,0.0,0.0 +2017-03-27 03:00:00,0.0,0.0,0.0,0.0 +2017-03-27 04:00:00,0.0,0.0,0.0,0.0 +2017-03-27 05:00:00,0.0,0.0,0.0,0.0 +2017-03-27 06:00:00,0.0,0.0,0.0,0.0 +2017-03-27 07:00:00,100.8086,18.376186,185.22696,103.34378955555556 +2017-03-27 08:00:00,122.98463999999998,65.402659,144.47114,112.31297544444443 +2017-03-27 09:00:00,144.81187,38.127648,204.78228,130.92208722222222 +2017-03-27 10:00:00,153.19126,42.938984,201.25621999999998,135.01349555555555 +2017-03-27 11:00:00,164.62679,61.868871999999996,208.50808,140.41451455555554 +2017-03-27 12:00:00,62.460364000000006,42.486088,64.487416,54.15249611111111 +2017-03-27 13:00:00,0.0,0.0,0.0,0.0 +2017-03-27 14:00:00,0.0,0.0,0.0,0.0 +2017-03-27 15:00:00,0.0,0.0,0.0,0.0 +2017-03-27 16:00:00,15.579191,9.9418094,24.308438,16.551350233333334 +2017-03-27 17:00:00,31.904550000000004,29.669203,44.786032999999996,34.488665777777776 +2017-03-27 18:00:00,17.969893,12.251822,28.368937,19.993138333333334 +2017-03-27 19:00:00,43.835967999999994,26.802642000000002,62.012048,44.40911588888889 +2017-03-27 20:00:00,61.237304,43.931752,75.456985,60.795527444444446 +2017-03-27 21:00:00,7.4606291,3.2909918,14.299881999999998,7.988571833333334 +2017-03-27 22:00:00,0.0,0.0,0.0,0.0 +2017-03-27 23:00:00,0.0,0.0,0.0,0.0 +2017-03-28 00:00:00,0.0,0.0,0.0,0.0 +2017-03-28 01:00:00,0.0,0.0,0.0,0.0 +2017-03-28 02:00:00,0.0,0.0,0.0,0.0 +2017-03-28 03:00:00,0.0,0.0,0.0,0.0 +2017-03-28 04:00:00,0.0,0.0,0.0,0.0 +2017-03-28 05:00:00,0.0,0.0,0.0,0.0 +2017-03-28 06:00:00,0.0,0.0,0.0,0.0 +2017-03-28 07:00:00,0.0,0.0,0.0,0.0 +2017-03-28 08:00:00,0.0,0.0,0.0,0.0 +2017-03-28 09:00:00,0.0,0.0,0.0,0.0 +2017-03-28 10:00:00,0.0,0.0,0.0,0.0 +2017-03-28 11:00:00,0.0,0.0,0.0,0.0 +2017-03-28 12:00:00,0.0,0.0,0.0,0.0 +2017-03-28 13:00:00,0.0,0.0,0.0,0.0 +2017-03-28 14:00:00,0.0,0.0,0.0,0.0 +2017-03-28 15:00:00,0.0,0.0,0.0,0.0 +2017-03-28 16:00:00,2.7508369999999998,1.2901824,5.3734551999999995,2.8995065777777778 +2017-03-28 17:00:00,48.195579,32.719483,63.393636,48.56706311111111 +2017-03-28 18:00:00,70.35672799999999,61.395272,79.327227,70.56111733333334 +2017-03-28 19:00:00,50.964645,43.926735,59.932241,51.624914777777775 +2017-03-28 20:00:00,53.362521,46.21438,63.081447000000004,53.68185555555556 +2017-03-28 21:00:00,50.257899,42.250838,60.99356,50.726542 +2017-03-28 22:00:00,83.752901,76.031713,92.10767200000001,83.79187866666668 +2017-03-28 23:00:00,41.864023,37.105503,46.713179000000004,41.85659022222222 +2017-03-29 00:00:00,6.7250967,5.7225211,7.9402398000000005,6.757081744444445 +2017-03-29 01:00:00,0.56278355,0.4886503,0.64845648,0.5651517777777778 +2017-03-29 02:00:00,0.067993362,0.058739005,0.078216736,0.06823596266666666 +2017-03-29 03:00:00,0.00016988379,0.0,0.0005594752999999999,0.00022724047411111107 +2017-03-29 04:00:00,0.0,0.0,0.0,0.0 +2017-03-29 05:00:00,0.0,0.0,0.0,0.0 +2017-03-29 06:00:00,0.0,0.0,0.0,0.0 +2017-03-29 07:00:00,0.0,0.0,0.0,0.0 +2017-03-29 08:00:00,0.0,0.0,0.0,0.0 +2017-03-29 09:00:00,0.0,0.0,0.0,0.0 +2017-03-29 10:00:00,0.0,0.0,0.0,0.0 +2017-03-29 11:00:00,0.0,0.0,0.0,0.0 +2017-03-29 12:00:00,0.0,0.0,0.0,0.0 +2017-03-29 13:00:00,0.0,0.0,0.0,0.0 +2017-03-29 14:00:00,0.0,0.0,0.0,0.0 +2017-03-29 15:00:00,0.0,0.0,0.0,0.0 +2017-03-29 16:00:00,0.0,0.0,0.0,0.0 +2017-03-29 17:00:00,0.0,0.0,0.0,0.0 +2017-03-29 18:00:00,0.036621113000000004,0.015254338000000001,0.087697067,0.04117233822222223 +2017-03-29 19:00:00,0.043971522,0.031371421000000003,0.047402672,0.042730567000000004 +2017-03-29 20:00:00,0.40071509,0.37646799,0.41742967000000003,0.39782661999999996 +2017-03-29 21:00:00,0.0,0.0,0.0,0.0 +2017-03-29 22:00:00,0.017834701,0.014683003,0.024057941,0.018214486666666665 +2017-03-29 23:00:00,0.0054609197000000005,0.004820754,0.0061643637,0.0054698013 +2017-03-30 00:00:00,0.0,0.0,0.0,0.0 +2017-03-30 01:00:00,0.0,0.0,0.0,0.0 +2017-03-30 02:00:00,0.0,0.0,0.0,0.0 +2017-03-30 03:00:00,0.0,0.0,0.0,0.0 +2017-03-30 04:00:00,0.0,0.0,0.0,0.0 +2017-03-30 05:00:00,0.0,0.0,0.0,0.0 +2017-03-30 06:00:00,0.0,0.0,0.0,0.0 +2017-03-30 07:00:00,0.0,0.0,0.0,0.0 +2017-03-30 08:00:00,0.0,0.0,0.0,0.0 +2017-03-30 09:00:00,0.0,0.0,0.0,0.0 +2017-03-30 10:00:00,0.0,0.0,0.0,0.0 +2017-03-30 11:00:00,0.0,0.0,0.0,0.0 +2017-03-30 12:00:00,0.0,0.0,0.0,0.0 +2017-03-30 13:00:00,0.77918281,0.66190984,0.8494323,0.7646625455555556 +2017-03-30 14:00:00,5.3575932,5.069561200000001,5.7548718,5.391232755555556 +2017-03-30 15:00:00,11.274587,10.637247,12.27928,11.370049555555557 +2017-03-30 16:00:00,15.373862,14.540768,16.261454,15.369521888888888 +2017-03-30 17:00:00,16.094482,15.370548,16.849504,16.095939 +2017-03-30 18:00:00,15.967302,15.003094,17.014918,15.974961222222223 +2017-03-30 19:00:00,21.073401999999998,19.718374,22.528734999999998,21.07161011111111 +2017-03-30 20:00:00,23.363789,22.469436,24.233221,23.316436666666668 +2017-03-30 21:00:00,14.387849000000001,12.257738999999999,16.677337,14.41188822222222 +2017-03-30 22:00:00,13.762852,12.991281,15.000188,13.832965777777776 +2017-03-30 23:00:00,33.788998,28.951295000000002,39.69016,33.84044566666667 +2017-03-31 00:00:00,0.0,0.0,0.0,0.0 +2017-03-31 01:00:00,0.0,0.0,0.0,0.0 +2017-03-31 02:00:00,0.0,0.0,0.0,0.0 +2017-03-31 03:00:00,0.0,0.0,0.0,0.0 +2017-03-31 04:00:00,0.0,0.0,0.0,0.0 +2017-03-31 05:00:00,0.0,0.0,0.0,0.0 +2017-03-31 06:00:00,0.0,0.0,0.0,0.0 +2017-03-31 07:00:00,0.0,0.0,0.0,0.0 +2017-03-31 08:00:00,0.0,0.0,0.0,0.0 +2017-03-31 09:00:00,0.0,0.0,0.0,0.0 +2017-03-31 10:00:00,0.0,0.0,0.0,0.0 +2017-03-31 11:00:00,0.0,0.0,0.0,0.0 +2017-03-31 12:00:00,0.0,0.0,0.0,0.0 +2017-03-31 13:00:00,114.52186,92.581889,173.4109,124.39781266666667 +2017-03-31 14:00:00,415.25337,336.83250999999996,503.11447999999996,415.98521999999997 +2017-03-31 15:00:00,62.584659,34.072928,103.30924,64.55284044444446 +2017-03-31 16:00:00,25.934432,19.157404000000003,35.351215,26.250789666666666 +2017-03-31 17:00:00,2.1920196,1.646285,2.8965764999999997,2.223425633333333 +2017-03-31 18:00:00,0.039347039,0.021107663000000002,0.067020821,0.040148212 +2017-03-31 19:00:00,0.0,0.0,0.0,0.0 +2017-03-31 20:00:00,0.0,0.0,0.0,0.0 +2017-03-31 21:00:00,0.0,0.0,0.0,0.0 +2017-03-31 22:00:00,0.0,0.0,0.0,0.0 +2017-03-31 23:00:00,0.0,0.0,0.0,0.0 diff --git a/Analysis/TimeSeries_Data/Pacaya/NAM_Pacaya.csv b/Analysis/TimeSeries_Data/Pacaya/NAM_Pacaya.csv new file mode 100644 index 0000000..2a7b486 --- /dev/null +++ b/Analysis/TimeSeries_Data/Pacaya/NAM_Pacaya.csv @@ -0,0 +1,745 @@ +,TS_station_point,9pntmin,9pntmax,9ptmean +2017-03-01 00:00:00,0.0,0.0,0.0,0.0 +2017-03-01 01:00:00,0.0,0.0,0.0,0.0 +2017-03-01 02:00:00,0.0,0.0,0.0,0.0 +2017-03-01 03:00:00,0.0,0.0,0.0,0.0 +2017-03-01 04:00:00,0.0,0.0,0.0,0.0 +2017-03-01 05:00:00,2.2267984000000003,0.0,30.044943,7.15827831111111 +2017-03-01 06:00:00,16.468237000000002,16.093116000000002,19.176152,17.330197000000002 +2017-03-01 07:00:00,0.0,0.0,0.0,0.0 +2017-03-01 08:00:00,0.0,0.0,0.0,0.0 +2017-03-01 09:00:00,0.0,0.0,0.0,0.0 +2017-03-01 10:00:00,0.0,0.0,0.0,0.0 +2017-03-01 11:00:00,0.0,0.0,0.0,0.0 +2017-03-01 12:00:00,20.513498000000002,19.339299,22.499071,20.905209555555555 +2017-03-01 13:00:00,0.0,0.0,0.0,0.0 +2017-03-01 14:00:00,0.0,0.0,0.0,0.0 +2017-03-01 15:00:00,0.0,0.0,0.0,0.0 +2017-03-01 16:00:00,0.0,0.0,1.5185155000000001,0.45573998888888895 +2017-03-01 17:00:00,50.820592,46.678872999999996,56.461642000000005,51.092852444444446 +2017-03-01 18:00:00,0.35045624999999997,0.30386985,0.41367778,0.3574196233333333 +2017-03-01 19:00:00,0.0,0.0,0.0,0.0 +2017-03-01 20:00:00,0.0,0.0,0.0,0.0 +2017-03-01 21:00:00,0.0,0.0,0.0,0.0 +2017-03-01 22:00:00,0.0,0.0,0.0,0.0 +2017-03-01 23:00:00,210.78142,158.43779,242.32017,204.83173999999997 +2017-03-02 00:00:00,0.73731121,0.25292658,2.2471947,0.9396990788888888 +2017-03-02 01:00:00,0.0,0.0,0.0,0.0 +2017-03-02 02:00:00,0.0,0.0,0.0,0.0 +2017-03-02 03:00:00,0.0,0.0,0.0,0.0 +2017-03-02 04:00:00,0.0,0.0,0.0,0.0 +2017-03-02 05:00:00,83.99678300000001,21.091594999999998,122.62290999999999,76.41876733333332 +2017-03-02 06:00:00,12.650129999999999,6.6063249,15.889073999999999,12.105803766666668 +2017-03-02 07:00:00,0.0,0.0,0.0,0.0 +2017-03-02 08:00:00,0.0,0.0,0.0,0.0 +2017-03-02 09:00:00,0.0,0.0,0.0,0.0 +2017-03-02 10:00:00,0.0,0.0,0.0,0.0 +2017-03-02 11:00:00,0.0,0.0,0.0,0.0 +2017-03-02 12:00:00,26.727128,23.065184,45.978401999999996,28.767499333333333 +2017-03-02 13:00:00,10.799625,3.1716149000000002,25.335292,12.635715566666667 +2017-03-02 14:00:00,0.0,0.0,0.0,0.0 +2017-03-02 15:00:00,0.0,0.0,0.0,0.0 +2017-03-02 16:00:00,0.0,0.0,1.3856591,0.4494159666666666 +2017-03-02 17:00:00,11.08069,9.8539676,12.752289,11.149638066666666 +2017-03-02 18:00:00,1.0140924,0.7005019699999999,1.4015592000000001,1.0796281666666667 +2017-03-02 19:00:00,0.0,0.0,0.0,0.0 +2017-03-02 20:00:00,0.0,0.0,0.0,0.0 +2017-03-02 21:00:00,0.0,0.0,0.0,0.0 +2017-03-02 22:00:00,0.0,0.0,0.0,0.0 +2017-03-02 23:00:00,206.54635000000002,195.22493,219.64865,206.8922177777778 +2017-03-03 00:00:00,0.017613015,0.0050333462,0.042333809,0.021201779855555557 +2017-03-03 01:00:00,0.0,0.0,0.0,0.0 +2017-03-03 02:00:00,0.0,0.0,0.0,0.0 +2017-03-03 03:00:00,0.0,0.0,0.0,0.0 +2017-03-03 04:00:00,0.0,0.0,0.0,0.0 +2017-03-03 05:00:00,1042.7424,580.70966,1415.0393,981.2170666666667 +2017-03-03 06:00:00,155.70245,24.619063,403.07452,190.689979 +2017-03-03 07:00:00,0.0,0.0,0.0,0.0 +2017-03-03 08:00:00,0.0,0.0,0.0,0.0 +2017-03-03 09:00:00,0.0,0.0,0.0,0.0 +2017-03-03 10:00:00,0.0,0.0,0.0,0.0 +2017-03-03 11:00:00,614.2428600000001,419.60142,839.51163,574.7474633333334 +2017-03-03 12:00:00,435.64514,176.08324,724.6647099999999,454.6156666666667 +2017-03-03 13:00:00,0.0,0.0,0.0,0.0 +2017-03-03 14:00:00,0.0,0.0,0.0,0.0 +2017-03-03 15:00:00,0.0,0.0,0.0,0.0 +2017-03-03 16:00:00,30.447450999999997,10.108942,63.35316,34.495917222222225 +2017-03-03 17:00:00,23.670656,18.957806,26.984130999999998,23.023904666666667 +2017-03-03 18:00:00,2.4282904,0.40077646,8.722609899999998,3.5404544411111107 +2017-03-03 19:00:00,0.045232365,0.0,0.39525031,0.11930194166666667 +2017-03-03 20:00:00,0.0,0.0,0.0,0.0 +2017-03-03 21:00:00,0.0,0.0,0.0,0.0 +2017-03-03 22:00:00,0.0,0.0,0.0,0.0 +2017-03-03 23:00:00,175.93926,168.58492999999999,185.625,176.36697777777778 +2017-03-04 00:00:00,0.0,0.0,0.0,0.0 +2017-03-04 01:00:00,0.0,0.0,0.0,0.0 +2017-03-04 02:00:00,0.0,0.0,0.0,0.0 +2017-03-04 03:00:00,0.0,0.0,0.0,0.0 +2017-03-04 04:00:00,0.0,0.0,0.0,0.0 +2017-03-04 05:00:00,875.66103,544.76142,1008.4956999999999,798.3864577777778 +2017-03-04 06:00:00,13.234287,2.0549079999999997,48.809048,16.371055733333336 +2017-03-04 07:00:00,0.0,0.0,0.0,0.0 +2017-03-04 08:00:00,0.0,0.0,0.0,0.0 +2017-03-04 09:00:00,0.0,0.0,0.0,0.0 +2017-03-04 10:00:00,0.0,0.0,0.0,0.0 +2017-03-04 11:00:00,362.19732,273.95494,743.68145,411.1564888888889 +2017-03-04 12:00:00,32.759079,13.064991,87.909699,40.87803811111112 +2017-03-04 13:00:00,0.0,0.0,0.0,0.0 +2017-03-04 14:00:00,0.0,0.0,0.0,0.0 +2017-03-04 15:00:00,0.0,0.0,0.0,0.0 +2017-03-04 16:00:00,0.60668907,0.0,4.0712134,1.4492248666666667 +2017-03-04 17:00:00,15.840070999999998,14.08091,17.266000000000002,15.711148 +2017-03-04 18:00:00,2.2855925,2.2018473,2.392138,2.2935750444444447 +2017-03-04 19:00:00,0.0,0.0,0.0,0.0 +2017-03-04 20:00:00,0.0,0.0,0.0,0.0 +2017-03-04 21:00:00,0.0,0.0,0.0,0.0 +2017-03-04 22:00:00,0.0,0.0,0.0,0.0 +2017-03-04 23:00:00,117.73780000000001,103.57238000000001,122.98358,114.27094777777776 +2017-03-05 00:00:00,0.21069701999999998,0.20998739,0.22044883999999998,0.21474645555555555 +2017-03-05 01:00:00,0.0,0.0,0.0,0.0 +2017-03-05 02:00:00,0.0,0.0,0.0,0.0 +2017-03-05 03:00:00,0.0,0.0,0.0,0.0 +2017-03-05 04:00:00,0.0,0.0,0.0,0.0 +2017-03-05 05:00:00,478.88009999999997,323.65241,566.81689,456.2679022222222 +2017-03-05 06:00:00,0.1482978,0.14804786,0.35688873,0.1877646077777778 +2017-03-05 07:00:00,0.0,0.0,0.0,0.0 +2017-03-05 08:00:00,0.0,0.0,0.0,0.0 +2017-03-05 09:00:00,0.0,0.0,0.0,0.0 +2017-03-05 10:00:00,0.0,0.0,0.0,0.0 +2017-03-05 11:00:00,337.50385,146.48608000000002,712.6154399999999,358.97354777777775 +2017-03-05 12:00:00,1039.6001999999999,781.76096,1271.4058,1016.7737022222221 +2017-03-05 13:00:00,0.0,0.0,0.0,0.0 +2017-03-05 14:00:00,0.0,0.0,0.0,0.0 +2017-03-05 15:00:00,0.0,0.0,0.0,0.0 +2017-03-05 16:00:00,0.7717380899999999,0.0,3.0721371,1.2157663944444446 +2017-03-05 17:00:00,10.000322,9.0663061,11.847388,10.1159692 +2017-03-05 18:00:00,2.1223032,1.9579957,2.3195,2.1303296333333335 +2017-03-05 19:00:00,0.0,0.0,0.0,0.0 +2017-03-05 20:00:00,0.0,0.0,0.0,0.0 +2017-03-05 21:00:00,0.0,0.0,0.0,0.0 +2017-03-05 22:00:00,0.0,0.0,0.0,0.0 +2017-03-05 23:00:00,206.34323,189.64183000000003,216.47422,202.25978222222224 +2017-03-06 00:00:00,0.050503046999999995,0.027788801000000002,0.06790664,0.04936592566666667 +2017-03-06 01:00:00,0.0,0.0,0.0,0.0 +2017-03-06 02:00:00,0.0,0.0,0.0,0.0 +2017-03-06 03:00:00,0.0,0.0,0.0,0.0 +2017-03-06 04:00:00,0.0,0.0,0.0,0.0 +2017-03-06 05:00:00,56.352979000000005,26.688685,108.56948,58.165254222222224 +2017-03-06 06:00:00,139.59673999999998,81.705613,237.25851,150.21064066666668 +2017-03-06 07:00:00,0.0,0.0,0.0,0.0 +2017-03-06 08:00:00,0.0,0.0,0.0,0.0 +2017-03-06 09:00:00,0.0,0.0,0.0,0.0 +2017-03-06 10:00:00,0.0,0.0,0.0,0.0 +2017-03-06 11:00:00,5.560820700000001,0.91667306,18.513441,7.238663973333335 +2017-03-06 12:00:00,1035.8259,764.8720599999999,1203.6311,998.3636566666667 +2017-03-06 13:00:00,0.0,0.0,0.0,0.0 +2017-03-06 14:00:00,0.0,0.0,0.0,0.0 +2017-03-06 15:00:00,0.0,0.0,0.0,0.0 +2017-03-06 16:00:00,0.0,0.0,0.0,0.0 +2017-03-06 17:00:00,12.939197,11.759686,14.100808,12.939023666666666 +2017-03-06 18:00:00,1.0277208999999998,0.7939913200000001,1.4930946999999999,1.0935511588888887 +2017-03-06 19:00:00,0.0,0.0,0.0,0.0 +2017-03-06 20:00:00,0.0,0.0,0.0,0.0 +2017-03-06 21:00:00,0.0,0.0,0.0,0.0 +2017-03-06 22:00:00,0.0,0.0,0.0,0.0 +2017-03-06 23:00:00,110.30439000000001,56.516219,155.43214,109.56107888888889 +2017-03-07 00:00:00,0.0,0.0,0.0,0.0 +2017-03-07 01:00:00,0.0,0.0,0.0,0.0 +2017-03-07 02:00:00,0.0,0.0,0.0,0.0 +2017-03-07 03:00:00,0.0,0.0,0.0,0.0 +2017-03-07 04:00:00,0.0,0.0,0.0,0.0 +2017-03-07 05:00:00,79.49848800000001,16.251967999999998,201.69573,94.84123522222222 +2017-03-07 06:00:00,8.0700183,0.89918319,35.853504,11.05591899888889 +2017-03-07 07:00:00,0.0,0.0,0.0,0.0 +2017-03-07 08:00:00,0.0,0.0,0.0,0.0 +2017-03-07 09:00:00,0.0,0.0,0.0,0.0 +2017-03-07 10:00:00,0.0,0.0,0.0,0.0 +2017-03-07 11:00:00,9.1619604,3.0665317,21.826909,10.8548569 +2017-03-07 12:00:00,20.080981,12.249583000000001,40.202176,23.305519444444442 +2017-03-07 13:00:00,0.0,0.0,0.0,0.0 +2017-03-07 14:00:00,0.0,0.0,0.0,0.0 +2017-03-07 15:00:00,0.0,0.0,0.0,0.0 +2017-03-07 16:00:00,0.0,0.0,0.0,0.0 +2017-03-07 17:00:00,29.077786,21.872549,41.220828,29.232959666666666 +2017-03-07 18:00:00,1.9072538,1.2227641999999999,2.3837188,1.8655199111111114 +2017-03-07 19:00:00,0.0,0.0,0.0,0.0 +2017-03-07 20:00:00,0.0,0.0,0.0,0.0 +2017-03-07 21:00:00,0.0,0.0,0.0,0.0 +2017-03-07 22:00:00,0.0,0.0,0.0,0.0 +2017-03-07 23:00:00,46.658453,15.412605999999998,96.417534,51.72196211111111 +2017-03-08 00:00:00,0.19777798,0.11670102,0.424201,0.2260554922222222 +2017-03-08 01:00:00,0.0,0.0,0.0,0.0 +2017-03-08 02:00:00,0.0,0.0,0.0,0.0 +2017-03-08 03:00:00,0.0,0.0,0.0,0.0 +2017-03-08 04:00:00,0.0,0.0,0.0,0.0 +2017-03-08 05:00:00,12.007948,0.0,72.372866,21.395316731111112 +2017-03-08 06:00:00,16.792073000000002,13.780488,19.746755999999998,16.904249222222223 +2017-03-08 07:00:00,0.0,0.0,0.0,0.0 +2017-03-08 08:00:00,0.0,0.0,0.0,0.0 +2017-03-08 09:00:00,0.0,0.0,0.0,0.0 +2017-03-08 10:00:00,0.0,0.0,0.0,0.0 +2017-03-08 11:00:00,0.0,0.0,0.0,0.0 +2017-03-08 12:00:00,120.32239,77.65137,180.74099999999999,126.8918811111111 +2017-03-08 13:00:00,0.0,0.0,0.0,0.0 +2017-03-08 14:00:00,0.0,0.0,0.0,0.0 +2017-03-08 15:00:00,0.0,0.0,0.0,0.0 +2017-03-08 16:00:00,92.410803,44.55767,150.22028999999998,94.57630811111112 +2017-03-08 17:00:00,31.572948999999998,26.139291,35.002944,30.804998444444443 +2017-03-08 18:00:00,1.0188576,0.7952130500000001,1.3165684999999998,1.0728154633333336 +2017-03-08 19:00:00,0.0,0.0,0.013102027,0.0014557807777777778 +2017-03-08 20:00:00,0.0,0.0,0.0,0.0 +2017-03-08 21:00:00,0.0,0.0,0.0,0.0 +2017-03-08 22:00:00,0.0,0.0,0.0,0.0 +2017-03-08 23:00:00,179.64018,171.83460000000002,185.85002,179.01842666666664 +2017-03-09 00:00:00,0.0,0.0,0.0018357234,0.00044928891 +2017-03-09 01:00:00,0.0,0.0,0.0,0.0 +2017-03-09 02:00:00,0.0,0.0,0.0,0.0 +2017-03-09 03:00:00,0.0,0.0,0.0,0.0 +2017-03-09 04:00:00,0.0,0.0,0.0,0.0 +2017-03-09 05:00:00,259.80055,133.58612,461.00767,257.1391177777778 +2017-03-09 06:00:00,217.28728999999998,82.10527400000001,446.70879,236.1081448888889 +2017-03-09 07:00:00,0.0,0.0,0.0,0.0 +2017-03-09 08:00:00,0.0,0.0,0.0,0.0 +2017-03-09 09:00:00,0.0,0.0,0.0,0.0 +2017-03-09 10:00:00,0.0,0.0,0.0,0.0 +2017-03-09 11:00:00,0.0,0.0,0.0,0.0 +2017-03-09 12:00:00,18.018429,10.322232,24.224133000000002,17.779548 +2017-03-09 13:00:00,0.0,0.0,0.0,0.0 +2017-03-09 14:00:00,0.0,0.0,0.0,0.0 +2017-03-09 15:00:00,0.0,0.0,0.0,0.0 +2017-03-09 16:00:00,26.418415,9.883305199999999,52.574145,29.78524502222222 +2017-03-09 17:00:00,25.140986,20.789911999999998,29.8778,24.81622611111111 +2017-03-09 18:00:00,0.26945348999999996,0.22006195,0.54692953,0.30221368444444446 +2017-03-09 19:00:00,0.0,0.0,0.010191004,0.0011323337777777779 +2017-03-09 20:00:00,0.0,0.0,0.0,0.0 +2017-03-09 21:00:00,0.0,0.0,0.0,0.0 +2017-03-09 22:00:00,0.0,0.0,0.0,0.0 +2017-03-09 23:00:00,242.82465,230.17373999999998,257.19840999999997,243.14395555555555 +2017-03-10 00:00:00,0.13960158,0.12544645,0.15845976,0.14107746333333332 +2017-03-10 01:00:00,0.0,0.0,0.0,0.0 +2017-03-10 02:00:00,0.0,0.0,0.0,0.0 +2017-03-10 03:00:00,0.0,0.0,0.0,0.0 +2017-03-10 04:00:00,0.0,0.0,0.0,0.0 +2017-03-10 05:00:00,247.92203,133.75359,461.22988000000004,251.09904555555556 +2017-03-10 06:00:00,205.72232,64.337604,433.70892,226.87636755555556 +2017-03-10 07:00:00,0.0,0.0,0.0,0.0 +2017-03-10 08:00:00,0.0,0.0,0.0,0.0 +2017-03-10 09:00:00,0.0,0.0,0.0,0.0 +2017-03-10 10:00:00,0.0,0.0,0.0,0.0 +2017-03-10 11:00:00,0.0,0.0,0.0,0.0 +2017-03-10 12:00:00,7.7210861,6.8606746,14.037509,9.531446133333333 +2017-03-10 13:00:00,0.0,0.0,0.0,0.0 +2017-03-10 14:00:00,0.0,0.0,0.0,0.0 +2017-03-10 15:00:00,0.0,0.0,0.0,0.0 +2017-03-10 16:00:00,0.0,0.0,0.0,0.0 +2017-03-10 17:00:00,14.090339,13.199762,14.417302000000001,13.878777777777778 +2017-03-10 18:00:00,0.59703956,0.35056498999999997,0.9538799800000001,0.6268028055555557 +2017-03-10 19:00:00,0.0,0.0,0.0,0.0 +2017-03-10 20:00:00,0.0,0.0,0.0,0.0 +2017-03-10 21:00:00,0.0,0.0,0.0,0.0 +2017-03-10 22:00:00,0.0,0.0,0.0,0.0 +2017-03-10 23:00:00,202.41764,156.86572999999999,226.80756,196.31267 +2017-03-11 00:00:00,0.1364898,0.11680844,0.16138124999999998,0.13894895444444444 +2017-03-11 01:00:00,0.0,0.0,0.0,0.0 +2017-03-11 02:00:00,0.0,0.0,0.0,0.0 +2017-03-11 03:00:00,0.0,0.0,0.0,0.0 +2017-03-11 04:00:00,0.0,0.0,0.0,0.0 +2017-03-11 05:00:00,119.31417,50.271206,132.23470999999998,100.50190366666666 +2017-03-11 06:00:00,11.034504,4.7120502,15.800875000000001,10.793209233333334 +2017-03-11 07:00:00,0.0,0.0,0.0,0.0 +2017-03-11 08:00:00,0.0,0.0,0.0,0.0 +2017-03-11 09:00:00,0.0,0.0,0.0,0.0 +2017-03-11 10:00:00,0.0,0.0,0.0,0.0 +2017-03-11 11:00:00,0.0,0.0,0.0,0.0 +2017-03-11 12:00:00,23.985856,22.178607,26.877206,24.668968555555555 +2017-03-11 13:00:00,0.0,0.0,0.0,0.0 +2017-03-11 14:00:00,0.0,0.0,0.0,0.0 +2017-03-11 15:00:00,0.0,0.0,0.0,0.0 +2017-03-11 16:00:00,0.0,0.0,0.0,0.0 +2017-03-11 17:00:00,46.373737999999996,38.60598,53.122170000000004,45.25208711111111 +2017-03-11 18:00:00,0.16725271,0.1055493,0.232708,0.1686721677777778 +2017-03-11 19:00:00,0.0,0.0,0.0,0.0 +2017-03-11 20:00:00,0.0,0.0,0.0,0.0 +2017-03-11 21:00:00,0.0,0.0,0.0,0.0 +2017-03-11 22:00:00,0.0,0.0,0.0,0.0 +2017-03-11 23:00:00,17.072936,4.7922113,40.490497,19.862004933333335 +2017-03-12 00:00:00,0.63195472,0.19914036000000002,1.8256851,0.7544757922222224 +2017-03-12 01:00:00,0.0,0.0,0.0,0.0 +2017-03-12 02:00:00,0.0,0.0,0.0,0.0 +2017-03-12 03:00:00,0.0,0.0,0.0,0.0 +2017-03-12 04:00:00,0.0,0.0,0.0,0.0 +2017-03-12 05:00:00,19.905441,0.0,89.710651,34.300363322222225 +2017-03-12 06:00:00,0.44084879,0.0,3.7280518,1.1670095031111112 +2017-03-12 07:00:00,0.0,0.0,0.0,0.0 +2017-03-12 08:00:00,0.0,0.0,0.0,0.0 +2017-03-12 09:00:00,0.0,0.0,0.0,0.0 +2017-03-12 10:00:00,0.0,0.0,0.0,0.0 +2017-03-12 11:00:00,0.0,0.0,0.0,0.0 +2017-03-12 12:00:00,19.027071,15.717534999999998,22.850597999999998,19.763283777777776 +2017-03-12 13:00:00,0.0,0.0,0.0,0.0 +2017-03-12 14:00:00,0.0,0.0,0.0,0.0 +2017-03-12 15:00:00,0.0,0.0,0.0,0.0 +2017-03-12 16:00:00,0.0,0.0,0.0,0.0 +2017-03-12 17:00:00,19.014131,16.037546,20.25799,18.598841 +2017-03-12 18:00:00,0.63954087,0.20756646,1.7628473,0.7609407433333334 +2017-03-12 19:00:00,0.0,0.0,0.0,0.0 +2017-03-12 20:00:00,0.0,0.0,0.0,0.0 +2017-03-12 21:00:00,0.0,0.0,0.0,0.0 +2017-03-12 22:00:00,0.0,0.0,0.0,0.0 +2017-03-12 23:00:00,182.98297,110.72771999999999,244.08747,180.15826111111107 +2017-03-13 00:00:00,12.998802000000001,5.422420099999999,24.162182,13.746280166666669 +2017-03-13 01:00:00,0.0,0.0,0.0,0.0 +2017-03-13 02:00:00,0.0,0.0,0.0,0.0 +2017-03-13 03:00:00,0.0,0.0,0.0,0.0 +2017-03-13 04:00:00,0.0,0.0,0.0,0.0 +2017-03-13 05:00:00,0.0,0.0,0.0,0.0 +2017-03-13 06:00:00,0.0,0.0,0.0,0.0 +2017-03-13 07:00:00,0.0,0.0,0.0,0.0 +2017-03-13 08:00:00,0.0,0.0,0.0,0.0 +2017-03-13 09:00:00,0.0,0.0,0.0,0.0 +2017-03-13 10:00:00,0.0,0.0,0.0,0.0 +2017-03-13 11:00:00,0.0,0.0,6.5484901,0.9711844444444444 +2017-03-13 12:00:00,18.915549,15.751852,24.110308,20.004134333333333 +2017-03-13 13:00:00,0.0,0.0,0.0,0.0 +2017-03-13 14:00:00,0.0,0.0,0.0,0.0 +2017-03-13 15:00:00,0.0,0.0,0.0,0.0 +2017-03-13 16:00:00,0.0,0.0,0.0,0.0 +2017-03-13 17:00:00,20.943266,20.166463999999998,21.22478,20.787053333333333 +2017-03-13 18:00:00,0.5912185099999999,0.13640162,1.5934139,0.6736485933333334 +2017-03-13 19:00:00,0.0,0.0,0.0,0.0 +2017-03-13 20:00:00,0.0,0.0,0.0,0.0 +2017-03-13 21:00:00,0.0,0.0,0.0,0.0 +2017-03-13 22:00:00,0.0,0.0,0.0,0.0 +2017-03-13 23:00:00,0.93161748,0.0,6.0461439,2.044855008888889 +2017-03-14 00:00:00,1.8317496,0.19378966,9.799342500000002,3.857695251111111 +2017-03-14 01:00:00,0.0,0.0,0.0,0.0 +2017-03-14 02:00:00,0.0,0.0,0.0,0.0 +2017-03-14 03:00:00,0.0,0.0,0.0,0.0 +2017-03-14 04:00:00,0.0,0.0,0.0,0.0 +2017-03-14 05:00:00,0.0,0.0,7.3159958,1.8641764333333333 +2017-03-14 06:00:00,0.0,0.0,0.14145141,0.032571412555555554 +2017-03-14 07:00:00,0.0,0.0,0.0,0.0 +2017-03-14 08:00:00,0.0,0.0,0.0,0.0 +2017-03-14 09:00:00,0.0,0.0,0.0,0.0 +2017-03-14 10:00:00,0.0,0.0,0.0,0.0 +2017-03-14 11:00:00,0.0,0.0,0.0,0.0 +2017-03-14 12:00:00,30.312094000000002,28.779314999999997,30.775375999999998,29.99656422222222 +2017-03-14 13:00:00,0.0,0.0,0.0,0.0 +2017-03-14 14:00:00,0.0,0.0,0.0,0.0 +2017-03-14 15:00:00,0.0,0.0,0.0,0.0 +2017-03-14 16:00:00,0.0,0.0,0.0,0.0 +2017-03-14 17:00:00,17.973045,17.053057,18.436158,17.853888888888893 +2017-03-14 18:00:00,4.0076843,3.3883528,4.531958,3.945138033333334 +2017-03-14 19:00:00,0.0,0.0,0.0,0.0 +2017-03-14 20:00:00,0.0,0.0,0.0,0.0 +2017-03-14 21:00:00,0.0,0.0,0.0,0.0 +2017-03-14 22:00:00,0.0,0.0,0.0,0.0 +2017-03-14 23:00:00,0.0,0.0,0.0,0.0 +2017-03-15 00:00:00,0.10939463,0.10312211,0.11399416000000001,0.10933268333333333 +2017-03-15 01:00:00,0.0,0.0,0.0,0.0 +2017-03-15 02:00:00,0.0,0.0,0.0,0.0 +2017-03-15 03:00:00,0.0,0.0,0.0,0.0 +2017-03-15 04:00:00,0.0,0.0,0.0,0.0 +2017-03-15 05:00:00,4.94084,0.0,42.181546000000004,11.293196084444444 +2017-03-15 06:00:00,25.461693,17.846927,39.869214,27.060532555555554 +2017-03-15 07:00:00,0.0,0.0,0.0,0.0 +2017-03-15 08:00:00,0.0,0.0,0.0,0.0 +2017-03-15 09:00:00,0.0,0.0,0.0,0.0 +2017-03-15 10:00:00,0.0,0.0,0.0,0.0 +2017-03-15 11:00:00,0.0,0.0,0.0,0.0 +2017-03-15 12:00:00,19.035397,10.505262,26.609339,18.979623444444442 +2017-03-15 13:00:00,0.0,0.0,0.0,0.0 +2017-03-15 14:00:00,0.0,0.0,0.0,0.0 +2017-03-15 15:00:00,0.0,0.0,0.0,0.0 +2017-03-15 16:00:00,0.0,0.0,0.0,0.0 +2017-03-15 17:00:00,16.880924,16.353832999999998,17.401821,16.873975666666666 +2017-03-15 18:00:00,0.56709519,0.44667138,0.71582849,0.5742775344444444 +2017-03-15 19:00:00,0.0,0.0,0.0,0.0 +2017-03-15 20:00:00,0.0,0.0,0.0,0.0 +2017-03-15 21:00:00,0.0,0.0,0.0,0.0 +2017-03-15 22:00:00,0.0,0.0,0.0,0.0 +2017-03-15 23:00:00,313.31422999999995,279.45335,332.24537,307.60383111111116 +2017-03-16 00:00:00,10.122333999999999,3.0561198000000003,25.04891,11.087930822222223 +2017-03-16 01:00:00,0.0,0.0,0.0,0.0 +2017-03-16 02:00:00,0.0,0.0,0.0,0.0 +2017-03-16 03:00:00,0.0,0.0,0.0,0.0 +2017-03-16 04:00:00,0.0,0.0,0.0,0.0 +2017-03-16 05:00:00,317.72404,217.9719,455.65402,313.76227555555556 +2017-03-16 06:00:00,357.34184,173.36021,600.63985,379.41955333333334 +2017-03-16 07:00:00,0.0,0.0,0.0,0.0 +2017-03-16 08:00:00,0.0,0.0,0.0,0.0 +2017-03-16 09:00:00,0.0,0.0,0.0,0.0 +2017-03-16 10:00:00,0.0,0.0,0.0,0.0 +2017-03-16 11:00:00,90.39441599999999,70.900256,117.83178000000001,88.25251066666665 +2017-03-16 12:00:00,560.4302299999999,250.84149000000002,1027.3563,601.6745488888888 +2017-03-16 13:00:00,0.0,0.0,0.0,0.0 +2017-03-16 14:00:00,0.0,0.0,0.0,0.0 +2017-03-16 15:00:00,0.0,0.0,0.0,0.0 +2017-03-16 16:00:00,37.46252,18.309829,62.645493,39.210222 +2017-03-16 17:00:00,34.832232000000005,28.241690000000002,39.762348,34.28134777777778 +2017-03-16 18:00:00,29.940528999999998,12.372838,55.181663,32.416118777777776 +2017-03-16 19:00:00,3.2731325,0.90890677,8.2232273,4.000043585555556 +2017-03-16 20:00:00,0.0,0.0,0.0,0.0 +2017-03-16 21:00:00,0.0,0.0,0.0,0.0 +2017-03-16 22:00:00,185.80724,80.23539,316.00852,190.8499778888889 +2017-03-16 23:00:00,188.99178999999998,143.66984,219.15081999999998,184.44627 +2017-03-17 00:00:00,56.007146,11.328031000000001,140.16235999999998,69.79094377777777 +2017-03-17 01:00:00,9.2814043,0.87401122,37.486545,14.146659091111111 +2017-03-17 02:00:00,0.0,0.0,0.0,0.0 +2017-03-17 03:00:00,0.0,0.0,0.0,0.0 +2017-03-17 04:00:00,0.0,0.0,0.0,0.0 +2017-03-17 05:00:00,501.09025,373.64516,928.9927,551.2500577777778 +2017-03-17 06:00:00,232.44551,61.086073,538.0191100000001,257.62712266666665 +2017-03-17 07:00:00,0.0,0.0,0.0,0.0 +2017-03-17 08:00:00,0.0,0.0,0.0,0.0 +2017-03-17 09:00:00,0.0,0.0,0.0,0.0 +2017-03-17 10:00:00,0.0,0.0,0.0,0.0 +2017-03-17 11:00:00,337.2335,327.54266,428.39462,366.19132888888885 +2017-03-17 12:00:00,790.97849,587.76757,1066.889,785.9159144444444 +2017-03-17 13:00:00,0.58290885,0.0,4.0462319,1.366292067777778 +2017-03-17 14:00:00,0.0,0.0,0.0,0.0 +2017-03-17 15:00:00,0.0,0.0,0.0,0.0 +2017-03-17 16:00:00,17.404793,6.8742611,32.801654,19.08203302222222 +2017-03-17 17:00:00,13.22246,11.588259,14.400941,13.114757333333333 +2017-03-17 18:00:00,2.4279102,0.44665546,6.0807893,3.049534291111111 +2017-03-17 19:00:00,0.04801338,0.0,0.26851228000000005,0.09604956408888891 +2017-03-17 20:00:00,0.0,0.0,0.0,0.0 +2017-03-17 21:00:00,0.0,0.0,0.0,0.0 +2017-03-17 22:00:00,0.0,0.0,2.6295183,0.692894588888889 +2017-03-17 23:00:00,262.25916,249.30522,279.04913,262.96728 +2017-03-18 00:00:00,1.4940526,0.13900241,8.5294232,2.7991027355555556 +2017-03-18 01:00:00,0.78621042,0.0,10.661411,2.633662748888889 +2017-03-18 02:00:00,0.0,0.0,0.0,0.0 +2017-03-18 03:00:00,0.0,0.0,0.0,0.0 +2017-03-18 04:00:00,4.6822984000000005,1.2532868,11.029129,5.730051866666667 +2017-03-18 05:00:00,345.77308999999997,300.03072000000003,399.78165,346.88490444444443 +2017-03-18 06:00:00,607.4913,521.3670699999999,638.3488699999999,589.8186355555555 +2017-03-18 07:00:00,1.5786892000000001,0.8303712200000001,3.0880797,1.8270429255555554 +2017-03-18 08:00:00,0.0,0.0,0.0,0.0 +2017-03-18 09:00:00,0.0,0.0,0.0,0.0 +2017-03-18 10:00:00,0.0,0.0,0.0,0.0 +2017-03-18 11:00:00,280.44273,203.32641999999998,521.64204,313.6387111111111 +2017-03-18 12:00:00,841.12363,572.79592,1091.9997,815.6093922222223 +2017-03-18 13:00:00,50.976923,32.932585,59.281287,46.333516 +2017-03-18 14:00:00,0.0,0.0,0.0,0.0 +2017-03-18 15:00:00,0.0,0.0,0.0,0.0 +2017-03-18 16:00:00,26.965325,13.565075,40.284678,27.321192555555555 +2017-03-18 17:00:00,9.3495091,7.213655,11.18234,9.22111758888889 +2017-03-18 18:00:00,3.6175145,1.9136901000000002,6.1804872,3.956420422222222 +2017-03-18 19:00:00,0.0068754478,0.0,0.082612807,0.025539161866666667 +2017-03-18 20:00:00,0.0,0.0,0.0,0.0 +2017-03-18 21:00:00,0.0,0.0,0.0,0.0 +2017-03-18 22:00:00,0.0,0.0,0.0,0.0 +2017-03-18 23:00:00,247.9844,233.66994,266.74024,248.84366 +2017-03-19 00:00:00,0.13798871000000001,0.13561035000000002,0.15061977,0.14096615555555556 +2017-03-19 01:00:00,0.0,0.0,0.0,0.0 +2017-03-19 02:00:00,0.0,0.0,0.0,0.0 +2017-03-19 03:00:00,0.0,0.0,0.0,0.0 +2017-03-19 04:00:00,0.0,0.0,0.0,0.0 +2017-03-19 05:00:00,938.1307800000001,503.16524,1333.3828,891.7783133333334 +2017-03-19 06:00:00,1064.3846,626.20227,1322.6171,1042.6941188888889 +2017-03-19 07:00:00,0.0,0.0,0.0,0.0 +2017-03-19 08:00:00,0.0,0.0,0.0,0.0 +2017-03-19 09:00:00,0.0,0.0,0.0,0.0 +2017-03-19 10:00:00,0.0,0.0,0.0,0.0 +2017-03-19 11:00:00,0.0,0.0,0.0,0.0 +2017-03-19 12:00:00,25.825897,24.047989,28.152295000000002,26.170440444444445 +2017-03-19 13:00:00,0.0,0.0,0.0,0.0 +2017-03-19 14:00:00,0.0,0.0,0.0,0.0 +2017-03-19 15:00:00,0.0,0.0,0.0,0.0 +2017-03-19 16:00:00,0.0,0.0,0.0,0.0 +2017-03-19 17:00:00,11.828071,11.072134,12.855966,11.867875000000002 +2017-03-19 18:00:00,1.3441185,0.90311858,2.4625383000000003,1.5963723755555554 +2017-03-19 19:00:00,0.0,0.0,0.0062044756,0.0018124766333333332 +2017-03-19 20:00:00,0.0,0.0,0.0,0.0 +2017-03-19 21:00:00,0.0,0.0,0.0,0.0 +2017-03-19 22:00:00,7.4178142000000005,0.0,32.824908,12.20722098888889 +2017-03-19 23:00:00,185.80562999999998,177.74856,194.20587,185.83043444444445 +2017-03-20 00:00:00,42.917992999999996,7.595751,115.97946,55.97362133333334 +2017-03-20 01:00:00,6.6016751,0.51467663,29.776933,10.668632836666667 +2017-03-20 02:00:00,0.0,0.0,0.0,0.0 +2017-03-20 03:00:00,0.0,0.0,0.0,0.0 +2017-03-20 04:00:00,0.0,0.0,0.0,0.0 +2017-03-20 05:00:00,880.17754,495.98265,1400.2684,889.9348644444444 +2017-03-20 06:00:00,1093.4734999999998,683.63437,1553.5313,1136.6608711111112 +2017-03-20 07:00:00,0.0,0.0,0.0,0.0 +2017-03-20 08:00:00,0.0,0.0,0.0,0.0 +2017-03-20 09:00:00,0.0,0.0,0.0,0.0 +2017-03-20 10:00:00,0.0,0.0,0.0,0.0 +2017-03-20 11:00:00,474.60169,445.05979,542.1892300000001,484.07084444444445 +2017-03-20 12:00:00,1272.4301,1118.9596999999999,1398.9937,1253.2100666666665 +2017-03-20 13:00:00,0.22219824999999999,0.025924054,2.4356327,0.871225672 +2017-03-20 14:00:00,0.0,0.0,0.0,0.0 +2017-03-20 15:00:00,0.0,0.0,0.0,0.0 +2017-03-20 16:00:00,52.510163999999996,31.665670000000002,81.57655199999999,52.208524 +2017-03-20 17:00:00,17.544629,12.446091,21.628044,17.230119666666663 +2017-03-20 18:00:00,4.949763,2.1126627,8.993964,5.6174394777777765 +2017-03-20 19:00:00,0.12791577,0.011790368,0.5104912500000001,0.20889715500000003 +2017-03-20 20:00:00,0.0,0.0,0.0,0.0 +2017-03-20 21:00:00,0.0,0.0,0.0,0.0 +2017-03-20 22:00:00,0.0,0.0,0.0,0.0 +2017-03-20 23:00:00,145.02759,115.133,178.65886999999998,144.98070555555557 +2017-03-21 00:00:00,1.8175532,0.42799232,5.5654391,2.1501587122222223 +2017-03-21 01:00:00,0.0,0.0,0.0,0.0 +2017-03-21 02:00:00,0.0,0.0,0.0,0.0 +2017-03-21 03:00:00,0.0,0.0,0.0,0.0 +2017-03-21 04:00:00,0.0,0.0,0.0,0.0 +2017-03-21 05:00:00,,,, +2017-03-21 06:00:00,,,, +2017-03-21 07:00:00,,,, +2017-03-21 08:00:00,,,, +2017-03-21 09:00:00,,,, +2017-03-21 10:00:00,,,, +2017-03-21 11:00:00,,,, +2017-03-21 12:00:00,,,, +2017-03-21 13:00:00,,,, +2017-03-21 14:00:00,,,, +2017-03-21 15:00:00,,,, +2017-03-21 16:00:00,,,, +2017-03-21 17:00:00,,,, +2017-03-21 18:00:00,,,, +2017-03-21 19:00:00,,,, +2017-03-21 20:00:00,,,, +2017-03-21 21:00:00,,,, +2017-03-21 22:00:00,,,, +2017-03-21 23:00:00,,,, +2017-03-22 00:00:00,0.0,0.0,0.0,0.0 +2017-03-22 01:00:00,0.0,0.0,0.0,0.0 +2017-03-22 02:00:00,0.0,0.0,0.0,0.0 +2017-03-22 03:00:00,0.0,0.0,0.0,0.0 +2017-03-22 04:00:00,0.0,0.0,0.0,0.0 +2017-03-22 05:00:00,0.0,0.0,0.0,0.0 +2017-03-22 06:00:00,48.806804,48.806804,51.69589,50.14870211111112 +2017-03-22 07:00:00,0.0,0.0,0.0,0.0 +2017-03-22 08:00:00,0.0,0.0,0.0,0.0 +2017-03-22 09:00:00,0.0,0.0,0.0,0.0 +2017-03-22 10:00:00,0.0,0.0,0.0,0.0 +2017-03-22 11:00:00,0.0,0.0,0.0,0.0 +2017-03-22 12:00:00,12.482766999999999,6.509481,19.584491,12.722827155555557 +2017-03-22 13:00:00,0.0,0.0,0.0,0.0 +2017-03-22 14:00:00,0.0,0.0,0.0,0.0 +2017-03-22 15:00:00,0.0,0.0,0.0,0.0 +2017-03-22 16:00:00,0.0,0.0,0.0,0.0 +2017-03-22 17:00:00,14.534948,14.128161,15.22003,14.591457222222223 +2017-03-22 18:00:00,0.0,0.0,0.0,0.0 +2017-03-22 19:00:00,0.0,0.0,0.0,0.0 +2017-03-22 20:00:00,0.0,0.0,0.0,0.0 +2017-03-22 21:00:00,0.0,0.0,0.0,0.0 +2017-03-22 22:00:00,0.0,0.0,0.0,0.0 +2017-03-22 23:00:00,168.06991,128.89532,200.57864,164.72740555555555 +2017-03-23 00:00:00,100.34457,70.78343299999999,113.44958,95.52062166666667 +2017-03-23 01:00:00,0.0,0.0,0.0,0.0 +2017-03-23 02:00:00,0.0,0.0,0.0,0.0 +2017-03-23 03:00:00,0.0,0.0,0.0,0.0 +2017-03-23 04:00:00,0.0,0.0,0.0,0.0 +2017-03-23 05:00:00,0.0,0.0,0.0,0.0 +2017-03-23 06:00:00,56.630488,54.529912,65.38884900000001,57.76513766666666 +2017-03-23 07:00:00,0.0,0.0,0.19902274,0.022113637777777778 +2017-03-23 08:00:00,0.0,0.0,0.0,0.0 +2017-03-23 09:00:00,0.0,0.0,0.0,0.0 +2017-03-23 10:00:00,0.0,0.0,0.0,0.0 +2017-03-23 11:00:00,0.0,0.0,0.0,0.0 +2017-03-23 12:00:00,19.589683,18.24597,21.98969,19.846682666666666 +2017-03-23 13:00:00,0.0,0.0,0.0,0.0 +2017-03-23 14:00:00,0.0,0.0,0.0,0.0 +2017-03-23 15:00:00,0.0,0.0,0.0,0.0 +2017-03-23 16:00:00,0.0,0.0,0.0,0.0 +2017-03-23 17:00:00,23.429957,21.459104,24.636094,23.29501088888889 +2017-03-23 18:00:00,0.0062363434,0.0008827910099999999,0.026856473000000002,0.010710985545555557 +2017-03-23 19:00:00,0.0,0.0,0.0,0.0 +2017-03-23 20:00:00,0.0,0.0,0.0,0.0 +2017-03-23 21:00:00,0.0,0.0,0.0,0.0 +2017-03-23 22:00:00,0.0,0.0,0.0,0.0 +2017-03-23 23:00:00,0.0,0.0,0.0,0.0 +2017-03-24 00:00:00,0.25444569,0.25255844,0.26310909,0.2577701422222222 +2017-03-24 01:00:00,0.0,0.0,0.0,0.0 +2017-03-24 02:00:00,0.0,0.0,0.0,0.0 +2017-03-24 03:00:00,0.0,0.0,0.0,0.0 +2017-03-24 04:00:00,0.0,0.0,0.0,0.0 +2017-03-24 05:00:00,0.0,0.0,0.0,0.0 +2017-03-24 06:00:00,48.408689,48.408689,76.564094,56.287382 +2017-03-24 07:00:00,0.0,0.0,0.0,0.0 +2017-03-24 08:00:00,0.0,0.0,0.0,0.0 +2017-03-24 09:00:00,0.0,0.0,0.0,0.0 +2017-03-24 10:00:00,0.0,0.0,0.0,0.0 +2017-03-24 11:00:00,0.0,0.0,0.0,0.0 +2017-03-24 12:00:00,17.658167,16.831465,19.140722,17.712638777777777 +2017-03-24 13:00:00,0.0,0.0,0.0,0.0 +2017-03-24 14:00:00,0.0,0.0,0.0,0.0 +2017-03-24 15:00:00,0.0,0.0,0.0,0.0 +2017-03-24 16:00:00,0.0,0.0,0.0,0.0 +2017-03-24 17:00:00,13.919165,13.478534,14.041409,13.789165666666667 +2017-03-24 18:00:00,0.2073959,0.047224692,0.71940764,0.2605860042222223 +2017-03-24 19:00:00,0.0,0.0,0.0,0.0 +2017-03-24 20:00:00,0.0,0.0,0.0,0.0 +2017-03-24 21:00:00,0.0,0.0,0.0,0.0 +2017-03-24 22:00:00,0.0,0.0,0.0,0.0 +2017-03-24 23:00:00,0.0,0.0,0.0,0.0 +2017-03-25 00:00:00,0.043077452999999995,0.012608494,0.10091983,0.051032631777777775 +2017-03-25 01:00:00,0.0,0.0,0.0,0.0 +2017-03-25 02:00:00,0.0,0.0,0.0,0.0 +2017-03-25 03:00:00,0.0,0.0,0.0,0.0 +2017-03-25 04:00:00,0.0,0.0,0.0,0.0 +2017-03-25 05:00:00,65.951994,13.983529,106.55142000000001,63.42902266666667 +2017-03-25 06:00:00,2.535164,0.2976941,8.2680854,3.501963011111111 +2017-03-25 07:00:00,0.0,0.0,0.0,0.0 +2017-03-25 08:00:00,0.0,0.0,0.0,0.0 +2017-03-25 09:00:00,0.0,0.0,0.0,0.0 +2017-03-25 10:00:00,0.0,0.0,0.0,0.0 +2017-03-25 11:00:00,0.0,0.0,0.0,0.0 +2017-03-25 12:00:00,32.388943999999995,29.411332,35.543315,32.46464122222223 +2017-03-25 13:00:00,0.0,0.0,0.0,0.0 +2017-03-25 14:00:00,0.0,0.0,0.0,0.0 +2017-03-25 15:00:00,0.0,0.0,0.0,0.0 +2017-03-25 16:00:00,0.0,0.0,0.0,0.0 +2017-03-25 17:00:00,5.9183531,3.228381,10.027859000000001,6.128462244444444 +2017-03-25 18:00:00,12.873562,8.653391,17.811408,13.017046188888889 +2017-03-25 19:00:00,0.34124304,0.21105977,0.51003076,0.3505229411111112 +2017-03-25 20:00:00,0.0,0.0,0.0,0.0 +2017-03-25 21:00:00,0.0,0.0,0.0,0.0 +2017-03-25 22:00:00,0.0,0.0,0.0,0.0 +2017-03-25 23:00:00,0.0,0.0,0.0,0.0 +2017-03-26 00:00:00,0.0,0.0,0.0,0.0 +2017-03-26 01:00:00,0.0,0.0,0.0,0.0 +2017-03-26 02:00:00,0.0,0.0,0.0,0.0 +2017-03-26 03:00:00,0.0,0.0,0.0,0.0 +2017-03-26 04:00:00,0.0,0.0,0.0,0.0 +2017-03-26 05:00:00,0.0,0.0,0.0,0.0 +2017-03-26 06:00:00,0.0,0.0,0.0,0.0 +2017-03-26 07:00:00,0.0,0.0,0.0,0.0 +2017-03-26 08:00:00,0.0,0.0,0.0,0.0 +2017-03-26 09:00:00,0.0,0.0,0.0,0.0 +2017-03-26 10:00:00,0.0,0.0,0.0,0.0 +2017-03-26 11:00:00,0.0,0.0,15.501104,2.861294788888889 +2017-03-26 12:00:00,39.162132,32.988409999999995,41.799713999999994,38.62407822222221 +2017-03-26 13:00:00,0.0,0.0,0.0,0.0 +2017-03-26 14:00:00,0.0,0.0,0.0,0.0 +2017-03-26 15:00:00,0.0,0.0,0.0,0.0 +2017-03-26 16:00:00,0.0,0.0,0.0,0.0 +2017-03-26 17:00:00,4.4197936,2.4077628,7.63341,4.634735911111111 +2017-03-26 18:00:00,2.4923547,1.4353433999999998,3.9342384999999997,2.551616633333333 +2017-03-26 19:00:00,0.0,0.0,0.0,0.0 +2017-03-26 20:00:00,0.0,0.0,0.0,0.0 +2017-03-26 21:00:00,0.0,0.0,0.0,0.0 +2017-03-26 22:00:00,0.0,0.0,0.0,0.0 +2017-03-26 23:00:00,0.0,0.0,0.0,0.0 +2017-03-27 00:00:00,0.0,0.0,0.0,0.0 +2017-03-27 01:00:00,0.0,0.0,0.0,0.0 +2017-03-27 02:00:00,0.0,0.0,0.0,0.0 +2017-03-27 03:00:00,0.0,0.0,0.0,0.0 +2017-03-27 04:00:00,0.0,0.0,0.0,0.0 +2017-03-27 05:00:00,0.0,0.0,0.0,0.0 +2017-03-27 06:00:00,0.0,0.0,0.0,0.0 +2017-03-27 07:00:00,0.0,0.0,0.0,0.0 +2017-03-27 08:00:00,0.0,0.0,0.0,0.0 +2017-03-27 09:00:00,0.0,0.0,0.0,0.0 +2017-03-27 10:00:00,0.0,0.0,0.0,0.0 +2017-03-27 11:00:00,89.03769799999999,5.917964199999999,188.31870999999998,94.91239135555556 +2017-03-27 12:00:00,1.8180853000000001,0.040505032,9.3220797,3.3301656002222226 +2017-03-27 13:00:00,0.0,0.0,0.0,0.0 +2017-03-27 14:00:00,0.0,0.0,0.0,0.0 +2017-03-27 15:00:00,0.0,0.0,0.0,0.0 +2017-03-27 16:00:00,0.0,0.0,0.0,0.0 +2017-03-27 17:00:00,2.1197852,0.91904838,4.0380746,2.338783697777778 +2017-03-27 18:00:00,0.21008923000000002,0.073683161,0.50744347,0.23274654233333336 +2017-03-27 19:00:00,0.0,0.0,0.0,0.0 +2017-03-27 20:00:00,0.0,0.0,0.0,0.0 +2017-03-27 21:00:00,0.0,0.0,0.0,0.0 +2017-03-27 22:00:00,0.0,0.0,0.0,0.0 +2017-03-27 23:00:00,0.0,0.0,0.0,0.0 +2017-03-28 00:00:00,0.0,0.0,0.0,0.0 +2017-03-28 01:00:00,0.0020380078000000004,0.00082416063,0.0049322395,0.002346029781111111 +2017-03-28 02:00:00,0.0,0.0,0.0,0.0 +2017-03-28 03:00:00,0.0,0.0,0.0,0.0 +2017-03-28 04:00:00,0.0,0.0,0.0,0.0 +2017-03-28 05:00:00,0.0,0.0,0.0,0.0 +2017-03-28 06:00:00,0.0,0.0,0.0,0.0 +2017-03-28 07:00:00,0.0,0.0,0.0,0.0 +2017-03-28 08:00:00,0.0,0.0,0.0,0.0 +2017-03-28 09:00:00,0.0,0.0,0.0,0.0 +2017-03-28 10:00:00,0.0,0.0,0.0,0.0 +2017-03-28 11:00:00,0.0,0.0,0.0,0.0 +2017-03-28 12:00:00,0.0,0.0,0.0,0.0 +2017-03-28 13:00:00,0.0,0.0,0.0,0.0 +2017-03-28 14:00:00,0.0,0.0,0.0,0.0 +2017-03-28 15:00:00,0.0,0.0,0.0,0.0 +2017-03-28 16:00:00,0.0,0.0,0.0,0.0 +2017-03-28 17:00:00,0.0,0.0,0.0,0.0 +2017-03-28 18:00:00,0.25107258000000005,0.098519983,0.5288598,0.2800033758888889 +2017-03-28 19:00:00,0.35074845,0.20843528,0.54320577,0.36131274777777783 +2017-03-28 20:00:00,0.0,0.0,0.0010529946,0.0001169994 +2017-03-28 21:00:00,0.0,0.0,0.0,0.0 +2017-03-28 22:00:00,0.0,0.0,0.0,0.0 +2017-03-28 23:00:00,0.0,0.0,0.0,0.0 +2017-03-29 00:00:00,0.05104252,0.049516814,0.053095405,0.05129569266666667 +2017-03-29 01:00:00,0.030683584,0.029381694,0.032403133,0.03086047411111111 +2017-03-29 02:00:00,0.0084224165,0.0078598017,0.0091066248,0.008466453711111111 +2017-03-29 03:00:00,0.00013254621,0.00012219507,0.00014512705,0.00013333542 +2017-03-29 04:00:00,0.0,0.0,0.0,0.0 +2017-03-29 05:00:00,0.0,0.0,0.0,0.0 +2017-03-29 06:00:00,0.0,0.0,0.0,0.0 +2017-03-29 07:00:00,0.0,0.0,0.0,0.0 +2017-03-29 08:00:00,0.0,0.0,0.0,0.0 +2017-03-29 09:00:00,0.0,0.0,0.0,0.0 +2017-03-29 10:00:00,0.0,0.0,0.0,0.0 +2017-03-29 11:00:00,0.0,0.0,0.0,0.0 +2017-03-29 12:00:00,0.0,0.0,0.0,0.0 +2017-03-29 13:00:00,0.0,0.0,0.0,0.0 +2017-03-29 14:00:00,0.0,0.0,0.0,0.0 +2017-03-29 15:00:00,0.0,0.0,0.0,0.0 +2017-03-29 16:00:00,0.0,0.0,0.0,0.0 +2017-03-29 17:00:00,0.0,0.0,0.0,0.0 +2017-03-29 18:00:00,0.24655816,0.10338786,0.50443623,0.27822863555555555 +2017-03-29 19:00:00,0.34356074000000003,0.21516138999999998,0.50265385,0.34957354111111116 +2017-03-29 20:00:00,0.0,0.0,0.0019269562000000001,0.0003125816077777778 +2017-03-29 21:00:00,0.0,0.0,0.0,0.0 +2017-03-29 22:00:00,0.0,0.0,0.0,0.0 +2017-03-29 23:00:00,0.0,0.0,0.0,0.0 +2017-03-30 00:00:00,0.0,0.0,0.0,0.0 +2017-03-30 01:00:00,0.0,0.0,0.0,0.0 +2017-03-30 02:00:00,0.0,0.0,0.0,0.0 +2017-03-30 03:00:00,0.0,0.0,0.0,0.0 +2017-03-30 04:00:00,0.0,0.0,0.0,0.0 +2017-03-30 05:00:00,0.0,0.0,0.0,0.0 +2017-03-30 06:00:00,0.0,0.0,0.0,0.0 +2017-03-30 07:00:00,0.0,0.0,0.0,0.0 +2017-03-30 08:00:00,0.0,0.0,0.0,0.0 +2017-03-30 09:00:00,0.0,0.0,0.0,0.0 +2017-03-30 10:00:00,0.0,0.0,0.0,0.0 +2017-03-30 11:00:00,0.0,0.0,0.0,0.0 +2017-03-30 12:00:00,0.0,0.0,0.0,0.0 +2017-03-30 13:00:00,0.0,0.0,0.0,0.0 +2017-03-30 14:00:00,0.0,0.0,0.0,0.0 +2017-03-30 15:00:00,0.0,0.0,0.0,0.0 +2017-03-30 16:00:00,0.0,0.0,0.0,0.0 +2017-03-30 17:00:00,0.0,0.0,0.0,0.0 +2017-03-30 18:00:00,0.0,0.0,0.0,0.0 +2017-03-30 19:00:00,0.0,0.0,0.0,0.0 +2017-03-30 20:00:00,0.0,0.0,0.0,0.0 +2017-03-30 21:00:00,0.0,0.0,0.0,0.0 +2017-03-30 22:00:00,0.0,0.0,0.0,0.0 +2017-03-30 23:00:00,0.0,0.0,0.0,0.0 +2017-03-31 00:00:00,0.0,0.0,0.0,0.0 +2017-03-31 01:00:00,0.0,0.0,0.007223286,0.0008025873333333333 +2017-03-31 02:00:00,1.5396843,1.0752856,2.1110902,1.5297842666666668 +2017-03-31 03:00:00,5.4971847,4.5917053999999995,6.6014891,5.455763022222223 +2017-03-31 04:00:00,8.4701587,7.3471274,9.6340518,8.468513344444442 +2017-03-31 05:00:00,11.464720999999999,10.307438,12.725966,11.476623777777778 +2017-03-31 06:00:00,12.017403,11.125739,12.95518,12.017191222222221 +2017-03-31 07:00:00,11.551299,10.901009,12.22126,11.584038 +2017-03-31 08:00:00,30.190926,27.934651000000002,34.692479000000006,31.043857555555558 +2017-03-31 09:00:00,7.3242253999999996,7.0544206,7.5981106,7.324495988888889 +2017-03-31 10:00:00,6.6911966,6.4977894,6.8853606,6.690121755555555 +2017-03-31 11:00:00,7.2866887,7.0905153,7.4830732,7.285552222222224 +2017-03-31 12:00:00,2.2522891,2.2036829,2.3000541,2.252022466666667 +2017-03-31 13:00:00,0.59585437,0.5821953,0.60944268,0.5958003222222223 +2017-03-31 14:00:00,0.48585684,0.47013670999999996,0.50473301,0.48696146111111116 +2017-03-31 15:00:00,1.330302,1.2621202999999999,1.4112964000000001,1.3350539222222222 +2017-03-31 16:00:00,1.8159886,1.7423497,1.8941854999999999,1.8175995777777776 +2017-03-31 17:00:00,,,, +2017-03-31 18:00:00,,,, +2017-03-31 19:00:00,,,, +2017-03-31 20:00:00,,,, +2017-03-31 21:00:00,,,, +2017-03-31 22:00:00,,,, +2017-03-31 23:00:00,,,, diff --git a/Analysis/TimeSeries_Data/Pacaya/PacayaStats.html b/Analysis/TimeSeries_Data/Pacaya/PacayaStats.html new file mode 100644 index 0000000..db8161c --- /dev/null +++ b/Analysis/TimeSeries_Data/Pacaya/PacayaStats.html @@ -0,0 +1,328 @@ +Profile of Timeseries data for observations, NAM and ECMWF runs for Pacaya

Overview

Dataset info

Number of variables11
Number of observations744
Missing cells301 (3.7%)
Duplicate rows0 (0.0%)
Total size in memory64.1 KiB
Average record size in memory88.2 B

Variables types

Numeric3
Categorical0
Boolean0
Date1
URL0
Text (Unique)0
Rejected7
Unsupported0

Warnings

ECMWF_area has 313 (42.1%) zeros Zeros
ECMWF_max is highly correlated with ECMWF_area (ρ = 0.9676839911) Rejected
ECMWF_min is highly correlated with ECMWF_area (ρ = 0.9400209364) Rejected
ECMWF_raw is highly correlated with ECMWF_min (ρ = 0.9566621489) Rejected
NAM_area has 485 (65.2%) zeros Zeros
NAM_area has 26 (3.5%) missing values Missing
NAM_max is highly correlated with NAM_area (ρ = 0.9875072631) Rejected
NAM_min is highly correlated with NAM_max (ρ = 0.9341632255) Rejected
NAM_raw is highly correlated with NAM_min (ρ = 0.9776560567) Rejected
Pacaya_raw is highly correlated with Pacaya_KNN (ρ = 1) Rejected

Variables

ECMWF_area
Numeric

Distinct count432
Unique (%)58.1%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
Mean45.61527176
Minimum0
Maximum1521.795587
Zeros (%)42.1%
Mini histogram

Quantile statistics

Minimum0
5-th percentile0
Q10
Median0.2182587649
Q330.50056401
95-th percentile251.5787022
Maximum1521.795587
Range1521.795587
Interquartile range30.50056401

Descriptive statistics

Standard deviation131.6235305
Coef of variation2.885514554
Kurtosis50.2473497
Mean45.61527176
MAD64.64870695
Skewness6.133465654
Sum33937.76219
Variance17324.75379
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
Histogram
Histogram with variable size bins (bins=[0.00000000e+00 1.13620237e-04 4.19514526e-02 2.46050223e-01 1.00024664e+00 3.38918447e+00 2.67739840e+01 1.34729212e+02 5.67314998e+02 1.52179559e+03], "bayesian blocks" binning strategy used)
ValueCountFrequency (%) 
0 313 42.1%
 
10.2361036 1 0.1%
 
0.09102119876 1 0.1%
 
68.16050422 1 0.1%
 
0.03005372271 1 0.1%
 
134.4449289 1 0.1%
 
1.37569018 1 0.1%
 
2.159148644 1 0.1%
 
0.0054698013 1 0.1%
 
150.9065326 1 0.1%
 
Other values (422) 422 56.7%
 

Minimum 5 values

ValueCountFrequency (%) 
0 313 42.1%
 
0.0002272404741 1 0.1%
 
0.001188070656 1 0.1%
 
0.001909380667 1 0.1%
 
0.002218352667 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
1521.795587 1 0.1%
 
1288.244101 1 0.1%
 
1235.81548 1 0.1%
 
1186.23117 1 0.1%
 
735.0672422 1 0.1%
 

ECMWF_max
Highly correlated

This variable is highly correlated with ECMWF_area and should be ignored for analysis

Correlation0.9676839911

ECMWF_min
Highly correlated

This variable is highly correlated with ECMWF_area and should be ignored for analysis

Correlation0.9400209364

ECMWF_raw
Highly correlated

This variable is highly correlated with ECMWF_min and should be ignored for analysis

Correlation0.9566621489

NAM_area
Numeric

Distinct count235
Unique (%)31.6%
Missing (%)3.5%
Missing (n)26
Infinite (%)0.0%
Infinite (n)0
Mean34.54830049
Minimum0
Maximum1253.210067
Zeros (%)65.2%
Mini histogram

Quantile statistics

Minimum0
5-th percentile0
Q10
Median0
Q31.047407709
95-th percentile202.6455759
Maximum1253.210067
Range1253.210067
Interquartile range1.047407709

Descriptive statistics

Standard deviation138.2744638
Coef of variation4.002352121
Kurtosis35.4055605
Mean34.54830049
MAD58.25237722
Skewness5.671319953
Sum24805.67975
Variance19119.82733
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
ValueCountFrequency (%) 
0 485 65.2%
 
23.30551944 1 0.1%
 
815.6093922 1 0.1%
 
50.14870211 1 0.1%
 
24.81622611 1 0.1%
 
27.32119256 1 0.1%
 
29.99656422 1 0.1%
 
13.01704619 1 0.1%
 
366.1913289 1 0.1%
 
3.945138033 1 0.1%
 
Other values (224) 224 30.1%
 
(Missing) 26 3.5%
 

Minimum 5 values

ValueCountFrequency (%) 
0 485 65.2%
 
0.0001169994 1 0.1%
 
0.00013333542 1 0.1%
 
0.0003125816078 1 0.1%
 
0.00044928891 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
1253.210067 1 0.1%
 
1136.660871 1 0.1%
 
1042.694119 1 0.1%
 
1016.773702 1 0.1%
 
998.3636567 1 0.1%
 

NAM_max
Highly correlated

This variable is highly correlated with NAM_area and should be ignored for analysis

Correlation0.9875072631

NAM_min
Highly correlated

This variable is highly correlated with NAM_max and should be ignored for analysis

Correlation0.9341632255

NAM_raw
Highly correlated

This variable is highly correlated with NAM_min and should be ignored for analysis

Correlation0.9776560567

Pacaya_KNN
Numeric

Distinct count743
Unique (%)99.9%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
Mean21.01783916
Minimum0.0231584
Maximum170.4641306
Zeros (%)0.0%
Mini histogram

Quantile statistics

Minimum0.0231584
5-th percentile1.17173465
Q17.326031509
Median14.1534884
Q329.70035338
95-th percentile58.16833586
Maximum170.4641306
Range170.4409722
Interquartile range22.37432187

Descriptive statistics

Standard deviation19.76224573
Coef of variation0.9402605841
Kurtosis7.761032416
Mean21.01783916
MAD14.84795103
Skewness2.056618928
Sum15637.27234
Variance390.5463563
Memory size5.9 KiB
Histogram
Histogram with fixed size bins (bins=50)
Histogram
Histogram with variable size bins (bins=[2.31584000e-02 1.29453661e+01 2.92425566e+01 4.61172056e+01 7.56414278e+01 1.70464131e+02], "bayesian blocks" binning strategy used)
ValueCountFrequency (%) 
11.8596272 2 0.3%
 
10.81092109 1 0.1%
 
15.6911933 1 0.1%
 
6.796014191 1 0.1%
 
12.4721588 1 0.1%
 
7.603937292 1 0.1%
 
57.6475727 1 0.1%
 
1.081685 1 0.1%
 
1.9746767 1 0.1%
 
4.4817728 1 0.1%
 
Other values (733) 733 98.5%
 

Minimum 5 values

ValueCountFrequency (%) 
0.0231584 1 0.1%
 
0.0274355 1 0.1%
 
0.0540362 1 0.1%
 
0.0556739 1 0.1%
 
0.17618 1 0.1%
 

Maximum 5 values

ValueCountFrequency (%) 
170.4641306 1 0.1%
 
146.3089778 1 0.1%
 
122.4408995 1 0.1%
 
108.2513738 1 0.1%
 
96.0902588 1 0.1%
 

Pacaya_raw
Highly correlated

This variable is highly correlated with Pacaya_KNN and should be ignored for analysis

Correlation1

Timestamp
Date

Distinct count744
Unique (%)100.0%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
Minimum2017-03-01 00:00:00
Maximum2017-03-31 23:00:00
Mini histogram
Histogram
Histogram of 'Timestamp' (bins=N)

Correlations

Missing values

Sample

First rows

ECMWF_areaECMWF_maxECMWF_minECMWF_rawNAM_areaNAM_maxNAM_minNAM_rawPacaya_KNNPacaya_rawTimestamp
031.35681753.9819238.68523431.1993170.0000000.0000000.0000000.00000014.22788514.2278852017-03-01 00:00:00
125.48756230.81314615.87590928.8323350.0000000.0000000.0000000.00000018.83177718.8317772017-03-01 01:00:00
295.874860164.78972027.50717295.9311440.0000000.0000000.0000000.00000042.41084142.4108412017-03-01 02:00:00
367.179285157.0628108.26404253.6255650.0000000.0000000.0000000.00000039.61600339.6160032017-03-01 03:00:00
427.02115480.9210400.46286216.0782550.0000000.0000000.0000000.00000014.35926614.3592662017-03-01 04:00:00
53.37529311.0672920.1802051.5705057.15827830.0449430.0000002.22679825.426682NaN2017-03-01 05:00:00
60.2240290.6614640.0000000.08720917.33019719.17615216.09311616.46823742.25750242.2575022017-03-01 06:00:00
70.5927591.5585290.0000000.3467030.0000000.0000000.0000000.00000033.55579733.5557972017-03-01 07:00:00
82.41133110.0938270.1340570.1663450.0000000.0000000.0000000.00000048.57093048.5709302017-03-01 08:00:00
910.84343638.7029100.0000004.6303300.0000000.0000000.0000000.00000023.34829923.3482992017-03-01 09:00:00

Last rows

ECMWF_areaECMWF_maxECMWF_minECMWF_rawNAM_areaNAM_maxNAM_minNAM_rawPacaya_KNNPacaya_rawTimestamp
734415.985220503.114480336.832510415.2533700.4869610.5047330.4701370.48585741.88054441.8805442017-03-31 14:00:00
73564.552840103.30924034.07292862.5846591.3350541.4112961.2621201.33030242.41511842.4151182017-03-31 15:00:00
73626.25079035.35121519.15740425.9344321.8176001.8941851.7423501.81598957.64757357.6475732017-03-31 16:00:00
7372.2234262.8965761.6462852.192020NaNNaNNaNNaN37.49068237.4906822017-03-31 17:00:00
7380.0401480.0670210.0211080.039347NaNNaNNaNNaN19.20053019.2005302017-03-31 18:00:00
7390.0000000.0000000.0000000.000000NaNNaNNaNNaN14.81220914.8122092017-03-31 19:00:00
7400.0000000.0000000.0000000.000000NaNNaNNaNNaN11.92259111.9225912017-03-31 20:00:00
7410.0000000.0000000.0000000.000000NaNNaNNaNNaN9.2285599.2285592017-03-31 21:00:00
7420.0000000.0000000.0000000.000000NaNNaNNaNNaN7.7045767.7045762017-03-31 22:00:00
7430.0000000.0000000.0000000.000000NaNNaNNaNNaN7.0428817.0428812017-03-31 23:00:00
\ No newline at end of file diff --git a/Analysis/TimeSeries_Data/Pacaya/Pacaya_Timeseries_obs_model_raw_processed.csv b/Analysis/TimeSeries_Data/Pacaya/Pacaya_Timeseries_obs_model_raw_processed.csv new file mode 100644 index 0000000..9ff5dc6 --- /dev/null +++ b/Analysis/TimeSeries_Data/Pacaya/Pacaya_Timeseries_obs_model_raw_processed.csv @@ -0,0 +1,745 @@ +Timestamp,Pacaya_raw,Pacaya_KNN,ECMWF_raw,ECMWF_min,ECMWF_max,ECMWF_area,NAM_raw,NAM_min,NAM_max,NAM_area +2017-03-01 00:00:00,14.2278845,14.2278845,31.199316999999997,8.6852342,53.981923,31.356817022222216,0.0,0.0,0.0,0.0 +2017-03-01 01:00:00,18.8317772,18.8317772,28.832335,15.875909,30.813145999999996,25.487562444444443,0.0,0.0,0.0,0.0 +2017-03-01 02:00:00,42.4108412,42.4108412,95.93114399999999,27.507172,164.78972000000002,95.8748598888889,0.0,0.0,0.0,0.0 +2017-03-01 03:00:00,39.6160028,39.6160028,53.625565,8.2640418,157.06281,67.17928453333333,0.0,0.0,0.0,0.0 +2017-03-01 04:00:00,14.359266199999999,14.359266199999999,16.078255,0.46286248999999996,80.92103999999999,27.02115368222222,0.0,0.0,0.0,0.0 +2017-03-01 05:00:00,,25.42668189555998,1.5705050999999999,0.18020545999999998,11.067292,3.375293094444445,2.2267984000000003,0.0,30.044943,7.15827831111111 +2017-03-01 06:00:00,42.2575016,42.2575016,0.087208889,0.0,0.66146396,0.2240288386666667,16.468237000000002,16.093116000000002,19.176152,17.330197000000002 +2017-03-01 07:00:00,33.5557973,33.5557973,0.3467029,0.0,1.5585291000000001,0.5927590084444445,0.0,0.0,0.0,0.0 +2017-03-01 08:00:00,48.570930499999996,48.570930499999996,0.16634453,0.13405661000000002,10.093827000000001,2.4113308444444446,0.0,0.0,0.0,0.0 +2017-03-01 09:00:00,23.3482994,23.3482994,4.6303303,0.0,38.702909999999996,10.843436177777777,0.0,0.0,0.0,0.0 +2017-03-01 10:00:00,4.452310099999999,4.452310099999999,4.1380931,2.6697537000000002,17.04651,6.810694933333333,0.0,0.0,0.0,0.0 +2017-03-01 11:00:00,12.2208116,12.2208116,1.3327529999999999,0.23766279,3.7112213,1.687567851111111,0.0,0.0,0.0,0.0 +2017-03-01 12:00:00,17.0059961,17.0059961,7.851536800000001,3.8241750999999997,8.712563600000001,6.9983922666666665,20.513498000000002,19.339299,22.499071,20.905209555555555 +2017-03-01 13:00:00,16.8146555,16.8146555,13.556775,6.5029499,16.086042,12.42172031111111,0.0,0.0,0.0,0.0 +2017-03-01 14:00:00,29.1784955,29.1784955,18.836578,4.5246306,40.354105000000004,20.64647768888889,0.0,0.0,0.0,0.0 +2017-03-01 15:00:00,23.2083317,23.2083317,24.841866,3.4464636,88.45496600000001,34.15050462222223,0.0,0.0,0.0,0.0 +2017-03-01 16:00:00,26.0008805,26.0008805,40.37104,10.517584000000001,93.96393599999999,45.100648666666665,0.0,0.0,1.5185155000000001,0.45573998888888895 +2017-03-01 17:00:00,24.098938399999998,24.098938399999998,62.44819100000001,21.839969,108.74042999999999,63.001671333333334,50.820592,46.678872999999996,56.461642000000005,51.092852444444446 +2017-03-01 18:00:00,18.4332278,18.4332278,58.236266,19.020998000000002,109.04026,60.021693,0.35045624999999997,0.30386985,0.41367778,0.3574196233333333 +2017-03-01 19:00:00,3.9564845,3.9564845,141.15028999999998,31.419328000000004,364.30653,164.37962655555555,0.0,0.0,0.0,0.0 +2017-03-01 20:00:00,2.1404183,2.1404183,118.15617,19.29974,373.35689,150.90653255555557,0.0,0.0,0.0,0.0 +2017-03-01 21:00:00,2.6608412,2.6608412,27.442031,1.7181266,144.52737,46.34288783333333,0.0,0.0,0.0,0.0 +2017-03-01 22:00:00,1.3732433000000002,1.3732433000000002,0.7819848,0.0,19.394047,4.316502368888889,0.0,0.0,0.0,0.0 +2017-03-01 23:00:00,0.9396662,0.9396662,0.0,0.0,0.037103963,0.004122662555555556,210.78142,158.43779,242.32017,204.83173999999997 +2017-03-02 00:00:00,,9.520253946493629,0.0,0.0,43.108485,9.730240144444444,0.73731121,0.25292658,2.2471947,0.9396990788888888 +2017-03-02 01:00:00,,10.836144564580897,1.6330864,0.0,42.458236,10.124235506666666,0.0,0.0,0.0,0.0 +2017-03-02 02:00:00,,11.37078330315574,0.0,0.0,3.8591052,0.7686021122222222,0.0,0.0,0.0,0.0 +2017-03-02 03:00:00,,11.584391917971743,0.19659356,0.0,2.6493797,0.6655323788888889,0.0,0.0,0.0,0.0 +2017-03-02 04:00:00,,11.617837042486377,0.3323085,0.0,2.5968898,0.7343718877777777,0.0,0.0,0.0,0.0 +2017-03-02 05:00:00,,11.531797563578172,0.51122481,0.0,2.788599,0.9010865103333335,83.99678300000001,21.091594999999998,122.62290999999999,76.41876733333332 +2017-03-02 06:00:00,,11.355992654393637,0.11644136,0.0,0.59390061,0.20154767088888892,12.650129999999999,6.6063249,15.889073999999999,12.105803766666668 +2017-03-02 07:00:00,,11.104465226207699,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-02 08:00:00,,10.780643417106262,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-02 09:00:00,,10.377171505998986,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-02 10:00:00,,9.869101680307187,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-02 11:00:00,,9.187123884532712,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-02 12:00:00,,8.077051812076128,2.1524907,0.5828220000000001,3.9436476999999996,2.225684376666667,26.727128,23.065184,45.978401999999996,28.767499333333333 +2017-03-02 13:00:00,2.7387989,2.7387989,3.9854534999999998,1.1547095,7.2342964,4.118881233333333,10.799625,3.1716149000000002,25.335292,12.635715566666667 +2017-03-02 14:00:00,2.7768794,2.7768794,1.9163548999999998,0.2860954,6.5450777,2.613360981111111,0.0,0.0,0.0,0.0 +2017-03-02 15:00:00,6.861716599999999,6.861716599999999,1.0483383,0.0,10.726745999999999,2.810604322911111,0.0,0.0,0.0,0.0 +2017-03-02 16:00:00,13.515993799999999,13.515993799999999,4.9486962000000005,0.0,24.37331,7.7542095899999985,0.0,0.0,1.3856591,0.4494159666666666 +2017-03-02 17:00:00,6.399106099999999,6.399106099999999,24.01352,5.0244716,69.007088,29.044329566666665,11.08069,9.8539676,12.752289,11.149638066666666 +2017-03-02 18:00:00,6.813301099999999,6.813301099999999,34.130364,8.441365,86.581924,39.24382722222222,1.0140924,0.7005019699999999,1.4015592000000001,1.0796281666666667 +2017-03-02 19:00:00,6.1304756,6.1304756,140.28366,33.03889,346.04091,157.49549888888887,0.0,0.0,0.0,0.0 +2017-03-02 20:00:00,5.751515,5.751515,156.92783999999997,41.19474,364.18394,171.55051111111112,0.0,0.0,0.0,0.0 +2017-03-02 21:00:00,3.2079284,3.2079284,27.628712,5.0055532,113.52440999999999,40.87987603333333,0.0,0.0,0.0,0.0 +2017-03-02 22:00:00,0.7155239000000001,0.7155239000000001,0.0,0.0,5.7906809,1.192873418888889,0.0,0.0,0.0,0.0 +2017-03-02 23:00:00,0.46948729999999994,0.46948729999999994,0.0,0.0,0.0,0.0,206.54635000000002,195.22493,219.64865,206.8922177777778 +2017-03-03 00:00:00,,6.473667416887441,0.0,0.0,0.0,0.0,0.017613015,0.0050333462,0.042333809,0.021201779855555557 +2017-03-03 01:00:00,,7.448842012911448,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-03 02:00:00,,8.019598734745363,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-03 03:00:00,,8.152454571594248,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-03 04:00:00,,8.227204420092058,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-03 05:00:00,,8.098344657174419,0.0,0.0,0.0,0.0,1042.7424,580.70966,1415.0393,981.2170666666667 +2017-03-03 06:00:00,,8.319079603113686,0.0,0.0,0.0,0.0,155.70245,24.619063,403.07452,190.689979 +2017-03-03 07:00:00,,8.50570424270023,0.0,0.0,0.11758608000000001,0.01906119788888889,0.0,0.0,0.0,0.0 +2017-03-03 08:00:00,,8.653911037034323,0.0,0.0,0.19918270999999999,0.039780219111111105,0.0,0.0,0.0,0.0 +2017-03-03 09:00:00,,8.740055700689846,0.0,0.0,0.29680172,0.06966285444444445,0.0,0.0,0.0,0.0 +2017-03-03 10:00:00,,8.682511745322136,0.0074186621,0.0,0.090231907,0.024249674799999996,0.0,0.0,0.0,0.0 +2017-03-03 11:00:00,,8.05002565821416,0.0,0.0,0.0,0.0,614.2428600000001,419.60142,839.51163,574.7474633333334 +2017-03-03 12:00:00,1.1260301000000001,1.1260301000000001,0.18937767,0.0,1.288103,0.3955363255555555,435.64514,176.08324,724.6647099999999,454.6156666666667 +2017-03-03 13:00:00,3.3253022000000003,3.3253022000000003,0.077162511,0.0,0.7252642100000001,0.19951231465555555,0.0,0.0,0.0,0.0 +2017-03-03 14:00:00,20.547085100000004,20.547085100000004,0.0,0.0,0.13231731,0.030053722711111112,0.0,0.0,0.0,0.0 +2017-03-03 15:00:00,25.983931100000003,25.983931100000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-03 16:00:00,21.2889155,21.2889155,0.0,0.0,0.017184426,0.0019093806666666666,30.447450999999997,10.108942,63.35316,34.495917222222225 +2017-03-03 17:00:00,8.5005773,8.5005773,0.0,0.0,1.0749685999999998,0.11944095555555553,23.670656,18.957806,26.984130999999998,23.023904666666667 +2017-03-03 18:00:00,5.4213038000000005,5.4213038000000005,0.0,0.0,6.1038554000000005,1.2974425922222224,2.4282904,0.40077646,8.722609899999998,3.5404544411111107 +2017-03-03 19:00:00,9.4547522,9.4547522,3.1963955000000004,0.0,20.186684,5.863020587777778,0.045232365,0.0,0.39525031,0.11930194166666667 +2017-03-03 20:00:00,1.1264117,1.1264117,36.107918000000005,0.25981925,176.63441,57.53802961666666,0.0,0.0,0.0,0.0 +2017-03-03 21:00:00,,8.28714426613457,20.449164,0.0,133.17629,38.92831940111111,0.0,0.0,0.0,0.0 +2017-03-03 22:00:00,,8.895385200829628,2.5002169000000003,0.0,60.420669,14.379499223333333,0.0,0.0,0.0,0.0 +2017-03-03 23:00:00,,8.454977490607005,0.0,0.0,10.009368,2.0717370344444443,175.93926,168.58492999999999,185.625,176.36697777777778 +2017-03-04 00:00:00,1.9746767,1.9746767,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-04 01:00:00,,8.632664264738018,0.0,0.0,1.2120971,0.19375184,0.0,0.0,0.0,0.0 +2017-03-04 02:00:00,,9.853839198576578,0.0,0.0,0.885774,0.16102855066666666,0.0,0.0,0.0,0.0 +2017-03-04 03:00:00,,10.441691473535212,0.0,0.0,0.047505722,0.007210993766666667,0.0,0.0,0.0,0.0 +2017-03-04 04:00:00,,10.810921086027703,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-04 05:00:00,,11.0645005984165,0.0,0.0,0.0,0.0,875.66103,544.76142,1008.4956999999999,798.3864577777778 +2017-03-04 06:00:00,,11.274967138361989,0.0,0.0,0.0,0.0,13.234287,2.0549079999999997,48.809048,16.371055733333336 +2017-03-04 07:00:00,,11.399674982635267,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-04 08:00:00,,11.472192877952478,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-04 09:00:00,,11.48822342736019,0.0,0.0,0.49449578999999994,0.10248022555555554,0.0,0.0,0.0,0.0 +2017-03-04 10:00:00,,11.432355905465606,0.38047546000000004,0.0,2.2045108,0.6948713138888888,0.0,0.0,0.0,0.0 +2017-03-04 11:00:00,,11.266873411174695,1.614571,0.29005733,4.369509,1.9740029311111114,362.19732,273.95494,743.68145,411.1564888888889 +2017-03-04 12:00:00,,10.890374198208065,0.59248765,0.056243767,2.8400996,0.9772850865555553,32.759079,13.064991,87.909699,40.87803811111112 +2017-03-04 13:00:00,,9.976454844665511,0.32171279999999997,0.0,2.4867222,0.7030952814666667,0.0,0.0,0.0,0.0 +2017-03-04 14:00:00,2.0382767,2.0382767,0.33319815999999997,0.0,3.691755,0.9518110746666666,0.0,0.0,0.0,0.0 +2017-03-04 15:00:00,6.6342194,6.6342194,0.067820054,0.0,4.8293041,0.984157256,0.0,0.0,0.0,0.0 +2017-03-04 16:00:00,10.549848800000001,10.549848800000001,2.6774294,0.0,17.199538,4.990400774444444,0.60668907,0.0,4.0712134,1.4492248666666667 +2017-03-04 17:00:00,11.2609445,11.2609445,9.370822200000001,0.85530814,37.965932,13.368838926666667,15.840070999999998,14.08091,17.266000000000002,15.711148 +2017-03-04 18:00:00,35.645486600000005,35.645486600000005,14.618271,2.2924653,50.714545,19.287294711111112,2.2855925,2.2018473,2.392138,2.2935750444444447 +2017-03-04 19:00:00,23.226950600000002,23.226950600000002,20.132977,3.7571671999999996,61.300954,25.016614533333335,0.0,0.0,0.0,0.0 +2017-03-04 20:00:00,2.4326762000000004,2.4326762000000004,83.654297,12.167938999999999,282.47024999999996,109.7873271111111,0.0,0.0,0.0,0.0 +2017-03-04 21:00:00,1.8568099999999998,1.8568099999999998,78.236197,8.8592087,306.38259999999997,111.25728318888889,0.0,0.0,0.0,0.0 +2017-03-04 22:00:00,1.0393751,1.0393751,55.148848,2.1416479,253.88971,85.29881525555555,0.0,0.0,0.0,0.0 +2017-03-04 23:00:00,0.0540362,0.0540362,66.086934,5.28793,285.49973,98.11588677777777,117.73780000000001,103.57238000000001,122.98358,114.27094777777776 +2017-03-05 00:00:00,1.0794749,1.0794749,3.3181075,0.072199128,21.293938999999998,6.305041858666666,0.21069701999999998,0.20998739,0.22044883999999998,0.21474645555555555 +2017-03-05 01:00:00,0.37861880000000003,0.37861880000000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-05 02:00:00,,10.380763087832419,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-05 03:00:00,,12.770469902792016,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-05 04:00:00,,14.338700726295441,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-05 05:00:00,,15.565864989785702,0.0,0.0,0.0,0.0,478.88009999999997,323.65241,566.81689,456.2679022222222 +2017-03-05 06:00:00,,17.00970543219513,0.0,0.0,0.0,0.0,0.1482978,0.14804786,0.35688873,0.1877646077777778 +2017-03-05 07:00:00,,17.9255622612057,0.0,0.0,0.38251682000000004,0.085592632,0.0,0.0,0.0,0.0 +2017-03-05 08:00:00,,18.804279671301984,0.25172952,0.0,1.4681746,0.4625119515555556,0.0,0.0,0.0,0.0 +2017-03-05 09:00:00,,19.370077933279017,0.093705218,0.0050913784,0.40729094,0.14898619837777777,0.0,0.0,0.0,0.0 +2017-03-05 10:00:00,,19.776342117143333,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-05 11:00:00,,19.312671543528573,0.0,0.0,0.0,0.0,337.50385,146.48608000000002,712.6154399999999,358.97354777777775 +2017-03-05 12:00:00,7.433735,7.433735,1.8194946,0.36843519999999996,4.5123061,2.135973746666666,1039.6001999999999,781.76096,1271.4058,1016.7737022222221 +2017-03-05 13:00:00,19.3204478,19.3204478,0.6503920000000001,0.11106751,2.4140867999999998,0.9237906277777778,0.0,0.0,0.0,0.0 +2017-03-05 14:00:00,22.527477800000003,22.527477800000003,0.046078838999999996,0.0,0.48842378000000003,0.12048901744444446,0.0,0.0,0.0,0.0 +2017-03-05 15:00:00,35.4461006,35.4461006,0.0,0.0,0.077047211,0.009486757822222223,0.0,0.0,0.0,0.0 +2017-03-05 16:00:00,30.9992522,30.9992522,0.57122799,0.0,7.0386313000000005,1.7102150766666666,0.7717380899999999,0.0,3.0721371,1.2157663944444446 +2017-03-05 17:00:00,33.027790100000004,33.027790100000004,8.908135,1.1097036,35.815632,12.641810244444445,10.000322,9.0663061,11.847388,10.1159692 +2017-03-05 18:00:00,14.2980989,14.2980989,33.292985,8.1164299,79.275233,37.24775732222221,2.1223032,1.9579957,2.3195,2.1303296333333335 +2017-03-05 19:00:00,3.3476417,3.3476417,72.263771,29.562461,104.9151,69.48813044444445,0.0,0.0,0.0,0.0 +2017-03-05 20:00:00,33.22433,33.22433,391.47949,282.83798,406.55152,344.8725977777778,0.0,0.0,0.0,0.0 +2017-03-05 21:00:00,75.121625,75.121625,403.34612000000004,175.45056,520.3191,374.82626555555555,0.0,0.0,0.0,0.0 +2017-03-05 22:00:00,70.4555156,70.4555156,160.80316000000002,32.600692,420.82136,187.36757088888888,0.0,0.0,0.0,0.0 +2017-03-05 23:00:00,23.4362105,23.4362105,13.077963,0.8679072,63.163112000000005,20.833592044444444,206.34323,189.64183000000003,216.47422,202.25978222222224 +2017-03-06 00:00:00,39.89417329999999,39.89417329999999,0.0,0.0,0.49857999000000003,0.06383579611111112,0.050503046999999995,0.027788801000000002,0.06790664,0.04936592566666667 +2017-03-06 01:00:00,,30.809474252735566,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-06 02:00:00,,28.819287495176667,0.0,0.0,0.26588248,0.029542497777777774,0.0,0.0,0.0,0.0 +2017-03-06 03:00:00,,27.500438560234645,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-06 04:00:00,,26.33848818043041,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-06 05:00:00,,25.281131623683343,0.0,0.0,0.0,0.0,56.352979000000005,26.688685,108.56948,58.165254222222224 +2017-03-06 06:00:00,,24.3402892867929,0.0,0.0,0.0,0.0,139.59673999999998,81.705613,237.25851,150.21064066666668 +2017-03-06 07:00:00,,23.273346146766297,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-06 08:00:00,,21.82976216334464,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-06 09:00:00,,19.158054029066697,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-06 10:00:00,1.1220551,1.1220551,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-06 11:00:00,4.8949660999999995,4.8949660999999995,0.0,0.0,0.0,0.0,5.560820700000001,0.91667306,18.513441,7.238663973333335 +2017-03-06 12:00:00,15.691193300000002,15.691193300000002,1.365345,0.39766093,3.6322376000000003,1.6067830255555557,1035.8259,764.8720599999999,1203.6311,998.3636566666667 +2017-03-06 13:00:00,22.9187927,22.9187927,8.9862169,4.2451829,10.962896,8.31788451111111,0.0,0.0,0.0,0.0 +2017-03-06 14:00:00,28.0115945,28.0115945,10.019574,4.6875448,22.180970000000002,11.583056833333334,0.0,0.0,0.0,0.0 +2017-03-06 15:00:00,29.153755100000005,29.153755100000005,20.446301000000002,3.2931996,65.096203,26.526814333333338,0.0,0.0,0.0,0.0 +2017-03-06 16:00:00,34.0920566,34.0920566,47.535585,14.611533,94.07624,50.04475433333333,0.0,0.0,0.0,0.0 +2017-03-06 17:00:00,43.66644829999999,43.66644829999999,81.897371,40.027134999999994,103.93273,76.89045988888888,12.939197,11.759686,14.100808,12.939023666666666 +2017-03-06 18:00:00,17.7342161,17.7342161,103.95639,66.12685,113.25504000000001,94.34536333333332,1.0277208999999998,0.7939913200000001,1.4930946999999999,1.0935511588888887 +2017-03-06 19:00:00,21.7862039,21.7862039,106.81136000000001,79.899139,112.22284,96.80354822222222,0.0,0.0,0.0,0.0 +2017-03-06 20:00:00,29.581019899999998,29.581019899999998,222.28798,111.74897,282.566,209.1060788888889,0.0,0.0,0.0,0.0 +2017-03-06 21:00:00,7.9225805,7.9225805,400.51452,224.36455999999998,449.46396,366.5377555555555,0.0,0.0,0.0,0.0 +2017-03-06 22:00:00,25.1486723,25.1486723,155.82325,39.91733,373.40506000000005,175.87107655555556,0.0,0.0,0.0,0.0 +2017-03-06 23:00:00,55.228419499999994,55.228419499999994,7.7412924,0.33407446,55.147717,16.274659905555556,110.30439000000001,56.516219,155.43214,109.56107888888889 +2017-03-07 00:00:00,6.7279817,6.7279817,0.013876294,0.0,8.7649541,1.398090734888889,0.0,0.0,0.0,0.0 +2017-03-07 01:00:00,37.726923799999994,37.726923799999994,0.0,0.0,6.749467,0.7499407777777778,0.0,0.0,0.0,0.0 +2017-03-07 02:00:00,23.7613655,23.7613655,0.0,0.0,5.1742177,0.5749130777777778,0.0,0.0,0.0,0.0 +2017-03-07 03:00:00,39.7508189,39.7508189,0.0,0.0,0.71654546,0.07961616222222222,0.0,0.0,0.0,0.0 +2017-03-07 04:00:00,30.0819017,30.0819017,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-07 05:00:00,44.423622200000004,44.423622200000004,0.0,0.0,0.0,0.0,79.49848800000001,16.251967999999998,201.69573,94.84123522222222 +2017-03-07 06:00:00,9.598233800000001,9.598233800000001,0.0,0.0,0.0,0.0,8.0700183,0.89918319,35.853504,11.05591899888889 +2017-03-07 07:00:00,5.379455,5.379455,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-07 08:00:00,2.7878345,2.7878345,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-07 09:00:00,11.094916699999999,11.094916699999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-07 10:00:00,23.9869706,23.9869706,0.0,0.0,4.0051841,0.7765095811111111,0.0,0.0,0.0,0.0 +2017-03-07 11:00:00,27.3671039,27.3671039,2.9265263,0.0,28.487026,7.804365077777779,9.1619604,3.0665317,21.826909,10.8548569 +2017-03-07 12:00:00,23.6242439,23.6242439,8.6088803,5.5455248,16.913036,9.807763111111111,20.080981,12.249583000000001,40.202176,23.305519444444442 +2017-03-07 13:00:00,31.78538,31.78538,10.741824999999999,6.6576781,11.435936,9.412618588888888,0.0,0.0,0.0,0.0 +2017-03-07 14:00:00,16.703260099999998,16.703260099999998,29.769924,19.232466,30.563981000000002,26.175138444444443,0.0,0.0,0.0,0.0 +2017-03-07 15:00:00,8.3250095,8.3250095,69.679249,43.482468999999995,72.28602,61.10730100000001,0.0,0.0,0.0,0.0 +2017-03-07 16:00:00,7.3667006,7.3667006,97.260483,71.723,100.72445,86.58708077777777,0.0,0.0,0.0,0.0 +2017-03-07 17:00:00,6.634473799999999,6.634473799999999,84.749088,49.394431999999995,102.42017,78.36800255555555,29.077786,21.872549,41.220828,29.232959666666666 +2017-03-07 18:00:00,5.442975499999999,5.442975499999999,90.15615100000001,48.006881,115.39198999999999,84.39556233333332,1.9072538,1.2227641999999999,2.3837188,1.8655199111111114 +2017-03-07 19:00:00,3.8263112,3.8263112,92.043294,49.095313,117.26897,86.20529422222222,0.0,0.0,0.0,0.0 +2017-03-07 20:00:00,2.4208466,2.4208466,342.28299000000004,165.07144,434.86065,316.6779388888889,0.0,0.0,0.0,0.0 +2017-03-07 21:00:00,3.0172237999999996,3.0172237999999996,518.55651,318.23575,559.19244,463.54611555555556,0.0,0.0,0.0,0.0 +2017-03-07 22:00:00,51.4232156,51.4232156,285.59925999999996,84.817162,556.32839,297.78598244444447,0.0,0.0,0.0,0.0 +2017-03-07 23:00:00,37.5172823,37.5172823,85.61225,9.6047979,320.28905,118.77571154444445,46.658453,15.412605999999998,96.417534,51.72196211111111 +2017-03-08 00:00:00,,21.408814908452538,83.445258,9.266776,324.3775,118.70253311111112,0.19777798,0.11670102,0.424201,0.2260554922222222 +2017-03-08 01:00:00,,18.81763348352923,52.931515,11.359256,133.83629,61.77663211111111,0.0,0.0,0.0,0.0 +2017-03-08 02:00:00,,17.44169794363469,15.65903,4.1772983,26.912432000000003,15.819405477777776,0.0,0.0,0.0,0.0 +2017-03-08 03:00:00,,16.414601194734434,5.3897302,1.1838161999999999,11.57364,5.916797666666667,0.0,0.0,0.0,0.0 +2017-03-08 04:00:00,,15.498488110544743,3.212929,0.5495876399999999,8.723373,3.913859551111111,0.0,0.0,0.0,0.0 +2017-03-08 05:00:00,,14.528555186815629,2.3146849,0.36447196,6.9076582,2.9600451011111115,12.007948,0.0,72.372866,21.395316731111112 +2017-03-08 06:00:00,,13.667987241474231,2.6861544,0.5157572800000001,6.528820400000001,3.1154117233333327,16.792073000000002,13.780488,19.746755999999998,16.904249222222223 +2017-03-08 07:00:00,,12.908991974009343,3.0903934,0.7517252200000001,6.1841843,3.309428835555556,0.0,0.0,0.0,0.0 +2017-03-08 08:00:00,,11.997892571948626,2.9690859,0.81498081,5.3639250999999994,3.0640756677777774,0.0,0.0,0.0,0.0 +2017-03-08 09:00:00,,10.805974260076749,2.4540132000000003,0.59613694,5.030756299999999,2.6598437255555556,0.0,0.0,0.0,0.0 +2017-03-08 10:00:00,,9.292920484528054,2.0712116,0.43659651000000005,4.8721399,2.374694297777778,0.0,0.0,0.0,0.0 +2017-03-08 11:00:00,3.5783188999999997,3.5783188999999997,1.6547858999999998,0.29113571,4.5098309,2.0286711955555554,0.0,0.0,0.0,0.0 +2017-03-08 12:00:00,1.9772683999999998,1.9772683999999998,0.57562232,0.047304559999999996,2.7187261,0.9278926466666668,120.32239,77.65137,180.74099999999999,126.8918811111111 +2017-03-08 13:00:00,1.5667621999999999,1.5667621999999999,0.058821424,0.0,0.40818562999999997,0.12192205444444444,0.0,0.0,0.0,0.0 +2017-03-08 14:00:00,2.8084727000000003,2.8084727000000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-08 15:00:00,12.1220567,12.1220567,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-08 16:00:00,20.5381016,20.5381016,0.0,0.0,0.0,0.0,92.410803,44.55767,150.22028999999998,94.57630811111112 +2017-03-08 17:00:00,4.5695249,4.5695249,0.0,0.0,0.0,0.0,31.572948999999998,26.139291,35.002944,30.804998444444443 +2017-03-08 18:00:00,3.609785,3.609785,0.0,0.0,1.4697441999999998,0.1633049111111111,1.0188576,0.7952130500000001,1.3165684999999998,1.0728154633333336 +2017-03-08 19:00:00,2.4947339,2.4947339,0.0,0.0,4.536547700000001,0.8795085777777778,0.0,0.0,0.013102027,0.0014557807777777778 +2017-03-08 20:00:00,2.4186206,2.4186206,0.0,0.0,26.125435000000003,5.499604648888889,0.0,0.0,0.0,0.0 +2017-03-08 21:00:00,0.6076901,0.6076901,0.0,0.0,4.433688399999999,0.7659778533333333,0.0,0.0,0.0,0.0 +2017-03-08 22:00:00,,8.782541272356866,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-08 23:00:00,,10.995502337285217,0.0,0.0,0.0,0.0,179.64018,171.83460000000002,185.85002,179.01842666666664 +2017-03-09 00:00:00,15.7198133,15.7198133,0.0,0.0,0.0,0.0,0.0,0.0,0.0018357234,0.00044928891 +2017-03-09 01:00:00,,12.393522032834259,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-09 02:00:00,,12.439462199730086,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-09 03:00:00,,12.590841441279105,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-09 04:00:00,,12.938107176857246,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-09 05:00:00,,13.215498233483153,0.0,0.0,0.0,0.0,259.80055,133.58612,461.00767,257.1391177777778 +2017-03-09 06:00:00,,13.653016452722168,0.0,0.0,0.0,0.0,217.28728999999998,82.10527400000001,446.70879,236.1081448888889 +2017-03-09 07:00:00,,14.003847281001658,0.0,0.0,0.54413863,0.13510539600000002,0.0,0.0,0.0,0.0 +2017-03-09 08:00:00,,14.653177779264592,0.09157931700000001,0.0,0.8307204699999999,0.23492193866666666,0.0,0.0,0.0,0.0 +2017-03-09 09:00:00,,14.850327526159942,0.054030487,0.0,0.6070836199999999,0.16410455744444447,0.0,0.0,0.0,0.0 +2017-03-09 10:00:00,,14.80344151592412,0.0029928582000000002,0.0,0.37462129,0.09334547779999999,0.0,0.0,0.0,0.0 +2017-03-09 11:00:00,,14.572531021621783,0.0,0.0,0.22632356,0.05058260413333334,0.0,0.0,0.0,0.0 +2017-03-09 12:00:00,,12.934045280200221,0.08873745100000001,0.0,0.833299,0.22546223832222217,18.018429,10.322232,24.224133000000002,17.779548 +2017-03-09 13:00:00,1.1068706,1.1068706,0.044883816,0.0,0.29729492,0.09102119875555555,0.0,0.0,0.0,0.0 +2017-03-09 14:00:00,11.7964883,11.7964883,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-09 15:00:00,14.460819500000001,14.460819500000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-09 16:00:00,12.431613800000001,12.431613800000001,0.0,0.0,0.0,0.0,26.418415,9.883305199999999,52.574145,29.78524502222222 +2017-03-09 17:00:00,5.9549078,5.9549078,0.0,0.0,2.0129382,0.3185089944444444,25.140986,20.789911999999998,29.8778,24.81622611111111 +2017-03-09 18:00:00,28.2409838,28.2409838,1.4813679,0.0,12.828697,3.403075844444444,0.26945348999999996,0.22006195,0.54692953,0.30221368444444446 +2017-03-09 19:00:00,18.6218177,18.6218177,13.416502999999999,1.9417801,47.554581999999996,17.78366768888889,0.0,0.0,0.010191004,0.0011323337777777779 +2017-03-09 20:00:00,15.775415599999999,15.775415599999999,112.25796000000001,37.934933,216.50686,116.14084744444443,0.0,0.0,0.0,0.0 +2017-03-09 21:00:00,10.5425984,10.5425984,53.308981,10.271716000000001,182.68863,70.49923466666667,0.0,0.0,0.0,0.0 +2017-03-09 22:00:00,8.718502699999998,8.718502699999998,3.7687919,0.0,35.337471,9.317747484444446,0.0,0.0,0.0,0.0 +2017-03-09 23:00:00,3.5574421999999997,3.5574421999999997,0.0,0.0,0.019965174,0.0022183526666666666,242.82465,230.17373999999998,257.19840999999997,243.14395555555555 +2017-03-10 00:00:00,19.358814499999998,19.358814499999998,0.0,0.0,0.0,0.0,0.13960158,0.12544645,0.15845976,0.14107746333333332 +2017-03-10 01:00:00,,20.884499015244096,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-10 02:00:00,27.9532733,27.9532733,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-10 03:00:00,11.845905499999999,11.845905499999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-10 04:00:00,55.6051223,55.6051223,0.0,0.0,0.8415098599999999,0.09350109555555555,0.0,0.0,0.0,0.0 +2017-03-10 05:00:00,59.354644400000005,59.354644400000005,0.0,0.0,10.168732,2.0532857888888887,247.92203,133.75359,461.22988000000004,251.09904555555556 +2017-03-10 06:00:00,23.911986199999998,23.911986199999998,0.0,0.0,9.266908800000001,1.9322872,205.72232,64.337604,433.70892,226.87636755555556 +2017-03-10 07:00:00,,23.498502586424184,0.0,0.0,7.1585464,1.4173305222222221,0.0,0.0,0.0,0.0 +2017-03-10 08:00:00,1.2699728000000001,1.2699728000000001,0.0,0.0,5.6673484,1.0163360155555554,0.0,0.0,0.0,0.0 +2017-03-10 09:00:00,23.384233399999996,23.384233399999996,0.0,0.0,10.252471,2.1591486444444445,0.0,0.0,0.0,0.0 +2017-03-10 10:00:00,28.806642200000002,28.806642200000002,1.1615588000000001,0.22349687999999998,6.1890055,2.105312786666667,0.0,0.0,0.0,0.0 +2017-03-10 11:00:00,30.010097299999998,30.010097299999998,1.4806643,0.30576268,3.4479935,1.677752398888889,0.0,0.0,0.0,0.0 +2017-03-10 12:00:00,26.204352800000002,26.204352800000002,3.2583391,0.9474549099999999,5.6088425,3.298205178888889,7.7210861,6.8606746,14.037509,9.531446133333333 +2017-03-10 13:00:00,20.6290178,20.6290178,9.1887068,4.679604,10.191505,8.199403477777778,0.0,0.0,0.0,0.0 +2017-03-10 14:00:00,24.862011199999998,24.862011199999998,28.421870000000002,19.815314,28.688979,24.765166555555552,0.0,0.0,0.0,0.0 +2017-03-10 15:00:00,27.4937951,27.4937951,69.016045,23.296667,114.29538000000001,69.58529044444444,0.0,0.0,0.0,0.0 +2017-03-10 16:00:00,20.0513867,20.0513867,80.048179,32.972715,117.2937,77.27303044444444,0.0,0.0,0.0,0.0 +2017-03-10 17:00:00,23.9638838,23.9638838,109.05999,64.174303,120.39465,99.79152855555556,14.090339,13.199762,14.417302000000001,13.878777777777778 +2017-03-10 18:00:00,9.6183155,9.6183155,105.09909999999999,56.223907000000004,122.52976,97.27414577777778,0.59703956,0.35056498999999997,0.9538799800000001,0.6268028055555557 +2017-03-10 19:00:00,29.6975828,29.6975828,88.00197200000001,38.805909,125.71615,84.55246177777778,0.0,0.0,0.0,0.0 +2017-03-10 20:00:00,25.2432455,25.2432455,178.89135,53.24747,365.30341999999996,186.54044166666665,0.0,0.0,0.0,0.0 +2017-03-10 21:00:00,65.5573139,65.5573139,124.78972000000002,24.620977,367.47323,154.89682988888887,0.0,0.0,0.0,0.0 +2017-03-10 22:00:00,27.0315662,27.0315662,38.652997,1.9277659,194.30384,63.66212645555556,0.0,0.0,0.0,0.0 +2017-03-10 23:00:00,18.1007588,18.1007588,7.620532,0.0,82.53433,21.81067645555556,202.41764,156.86572999999999,226.80756,196.31267 +2017-03-11 00:00:00,38.9116805,38.9116805,72.501047,5.5053983,330.15205000000003,111.9163587,0.1364898,0.11680844,0.16138124999999998,0.13894895444444444 +2017-03-11 01:00:00,2.5596695,2.5596695,74.464209,7.5809470999999995,308.42025,109.94157212222223,0.0,0.0,0.0,0.0 +2017-03-11 02:00:00,,25.287739460403092,6.5930549,0.0,40.536204,12.554828828888889,0.0,0.0,0.0,0.0 +2017-03-11 03:00:00,,27.33883270481039,0.35005388,0.0,4.1010544,1.065322240888889,0.0,0.0,0.0,0.0 +2017-03-11 04:00:00,,28.268956646226783,4.771356999999999,1.5351549,7.6796814,4.717188822222223,0.0,0.0,0.0,0.0 +2017-03-11 05:00:00,,28.804420295772413,6.0227493999999995,3.4306565,6.4700334,5.361422466666666,119.31417,50.271206,132.23470999999998,100.50190366666666 +2017-03-11 06:00:00,,28.62063763575523,1.4193378,0.9592262100000001,1.5038373,1.2204586566666669,11.034504,4.7120502,15.800875000000001,10.793209233333334 +2017-03-11 07:00:00,,27.89845030789892,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-11 08:00:00,,25.386439442049774,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-11 09:00:00,0.3726722,0.3726722,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-11 10:00:00,7.699519400000001,7.699519400000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-11 11:00:00,29.7086651,29.7086651,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-11 12:00:00,35.250498799999995,35.250498799999995,0.0,0.0,0.58485625,0.11622724999999999,23.985856,22.178607,26.877206,24.668968555555555 +2017-03-11 13:00:00,44.546465600000005,44.546465600000005,6.2116615,2.6874866,10.461435999999999,6.431270855555556,0.0,0.0,0.0,0.0 +2017-03-11 14:00:00,38.3023289,38.3023289,4.385206500000001,0.6263873000000001,18.62958,6.688595268888888,0.0,0.0,0.0,0.0 +2017-03-11 15:00:00,50.2919783,50.2919783,4.8631123,0.0,37.416292,10.453095527777778,0.0,0.0,0.0,0.0 +2017-03-11 16:00:00,42.74684,42.74684,18.731518,3.4815969,59.354020999999996,23.820825477777774,0.0,0.0,0.0,0.0 +2017-03-11 17:00:00,51.0160961,51.0160961,50.056304000000004,15.529797,105.43669,53.58450322222223,46.373737999999996,38.60598,53.122170000000004,45.25208711111111 +2017-03-11 18:00:00,10.549260499999999,10.549260499999999,42.289259,12.819773999999999,92.398295,45.80805033333334,0.16725271,0.1055493,0.232708,0.1686721677777778 +2017-03-11 19:00:00,30.5604122,30.5604122,26.652086,7.3933752,66.643246,30.524842466666662,0.0,0.0,0.0,0.0 +2017-03-11 20:00:00,72.44686340000001,72.44686340000001,29.693481000000002,6.1994833,89.26956799999999,36.729306155555555,0.0,0.0,0.0,0.0 +2017-03-11 21:00:00,67.13567509999999,67.13567509999999,47.213747,8.909702,155.16607,60.33495155555555,0.0,0.0,0.0,0.0 +2017-03-11 22:00:00,43.194425,43.194425,78.676952,17.834169000000003,225.40579,94.38790222222222,0.0,0.0,0.0,0.0 +2017-03-11 23:00:00,13.992230599999997,13.992230599999997,234.54223,69.941278,501.24765,252.5468285555556,17.072936,4.7922113,40.490497,19.862004933333335 +2017-03-12 00:00:00,4.462358900000001,4.462358900000001,446.09528,87.76920700000001,1280.7617,544.456013,0.63195472,0.19914036000000002,1.8256851,0.7544757922222224 +2017-03-12 01:00:00,55.662203299999994,55.662203299999994,67.573077,0.54280542,422.44043999999997,129.69334383555554,0.0,0.0,0.0,0.0 +2017-03-12 02:00:00,31.3911395,31.3911395,0.0,0.0,18.715687,3.0389444077777776,0.0,0.0,0.0,0.0 +2017-03-12 03:00:00,64.28208620000001,64.28208620000001,0.0,0.0,1.7869521000000002,0.21248869111111113,0.0,0.0,0.0,0.0 +2017-03-12 04:00:00,47.672373799999995,47.672373799999995,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-12 05:00:00,50.0084972,50.0084972,0.0,0.0,0.0,0.0,19.905441,0.0,89.710651,34.300363322222225 +2017-03-12 06:00:00,26.695710499999997,26.695710499999997,0.0,0.0,0.0,0.0,0.44084879,0.0,3.7280518,1.1670095031111112 +2017-03-12 07:00:00,20.3909789,20.3909789,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-12 08:00:00,30.8616695,30.8616695,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-12 09:00:00,55.25042510000001,55.25042510000001,0.0,0.0,0.76975363,0.0855281811111111,0.0,0.0,0.0,0.0 +2017-03-12 10:00:00,41.996693900000004,41.996693900000004,0.0,0.0,6.5695131,1.13303777,0.0,0.0,0.0,0.0 +2017-03-12 11:00:00,27.0593117,27.0593117,0.0,0.0,21.333688,4.4720021999999995,0.0,0.0,0.0,0.0 +2017-03-12 12:00:00,18.9774212,18.9774212,4.290553500000001,0.46942557,18.6612,6.721390431111112,19.027071,15.717534999999998,22.850597999999998,19.763283777777776 +2017-03-12 13:00:00,12.223323800000001,12.223323800000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-12 14:00:00,18.268122199999997,18.268122199999997,15.761179,8.9240193,18.33259,13.640920922222223,0.0,0.0,0.0,0.0 +2017-03-12 15:00:00,40.115644399999994,40.115644399999994,97.54294999999999,67.52927600000001,101.3428,88.92806322222222,0.0,0.0,0.0,0.0 +2017-03-12 16:00:00,38.6861072,38.6861072,111.35922000000001,80.13520700000001,118.75862000000001,103.01405277777776,0.0,0.0,0.0,0.0 +2017-03-12 17:00:00,35.0127461,35.0127461,125.78801000000001,100.19022,133.28734,117.19992111111111,19.014131,16.037546,20.25799,18.598841 +2017-03-12 18:00:00,36.55316989999999,36.55316989999999,110.57577,83.555606,124.08591000000001,104.20877300000001,0.63954087,0.20756646,1.7628473,0.7609407433333334 +2017-03-12 19:00:00,25.2313205,25.2313205,89.030873,58.860765,101.06393,85.99710033333334,0.0,0.0,0.0,0.0 +2017-03-12 20:00:00,29.306617699999997,29.306617699999997,50.660576,27.323586,71.81276299999999,50.83985255555555,0.0,0.0,0.0,0.0 +2017-03-12 21:00:00,73.9435622,73.9435622,60.576065,22.917764000000002,111.22251,65.02809433333333,0.0,0.0,0.0,0.0 +2017-03-12 22:00:00,38.858495,38.858495,127.81121999999999,62.44824200000001,187.55933,128.18738711111112,0.0,0.0,0.0,0.0 +2017-03-12 23:00:00,6.270522799999999,6.270522799999999,233.56116,82.79834600000001,410.71002,246.09265288888886,182.98297,110.72771999999999,244.08747,180.15826111111107 +2017-03-13 00:00:00,10.352847800000001,10.352847800000001,1429.1676,862.59033,1480.091,1235.81548,12.998802000000001,5.422420099999999,24.162182,13.746280166666669 +2017-03-13 01:00:00,29.5078799,29.5078799,1887.8529,868.0407799999999,2059.7223,1521.7955866666664,0.0,0.0,0.0,0.0 +2017-03-13 02:00:00,46.1167973,46.1167973,876.0294299999999,333.00613999999996,1009.9402,735.0672422222221,0.0,0.0,0.0,0.0 +2017-03-13 03:00:00,9.016707199999999,9.016707199999999,510.99848,300.67632999999995,564.58596,419.26149888888887,0.0,0.0,0.0,0.0 +2017-03-13 04:00:00,0.0231584,0.0231584,273.98762,66.79983200000001,502.91105,269.19048155555555,0.0,0.0,0.0,0.0 +2017-03-13 05:00:00,,22.38006167266649,67.604604,4.5911715,242.70147,105.59578538888888,0.0,0.0,0.0,0.0 +2017-03-13 06:00:00,,23.812128796842078,167.67569,36.213896,339.41606,176.88520433333335,0.0,0.0,0.0,0.0 +2017-03-13 07:00:00,,23.715242873995788,209.46874,124.48407,235.06177,173.8254388888889,0.0,0.0,0.0,0.0 +2017-03-13 08:00:00,,22.81931145928329,130.12218,39.468418,172.13437,116.53847200000001,0.0,0.0,0.0,0.0 +2017-03-13 09:00:00,,20.86222658843775,90.677611,16.472501,184.08362,91.3266247777778,0.0,0.0,0.0,0.0 +2017-03-13 10:00:00,2.2257377,2.2257377,52.692918,6.4718561,154.80643,62.678883899999995,0.0,0.0,0.0,0.0 +2017-03-13 11:00:00,15.7463822,15.7463822,38.723934,3.2653465,144.45272,54.539316577777775,0.0,0.0,6.5484901,0.9711844444444444 +2017-03-13 12:00:00,10.19795,10.19795,8.8808893,1.1523193,28.854188999999998,11.904942366666667,18.915549,15.751852,24.110308,20.004134333333333 +2017-03-13 13:00:00,12.4721588,12.4721588,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-13 14:00:00,25.2163745,25.2163745,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-13 15:00:00,36.5618672,36.5618672,11.861059000000001,2.9002535,32.571505,14.12508218888889,0.0,0.0,0.0,0.0 +2017-03-13 16:00:00,32.508829999999996,32.508829999999996,28.859844000000002,10.228826,61.553539,31.74853088888889,0.0,0.0,0.0,0.0 +2017-03-13 17:00:00,24.7774073,24.7774073,72.340081,34.786714,111.46186,72.21428522222223,20.943266,20.166463999999998,21.22478,20.787053333333333 +2017-03-13 18:00:00,43.494935,43.494935,108.77984000000001,86.755754,115.34259999999999,103.8431141111111,0.5912185099999999,0.13640162,1.5934139,0.6736485933333334 +2017-03-13 19:00:00,54.348322700000004,54.348322700000004,103.63732999999999,61.055609,132.10975,100.4208108888889,0.0,0.0,0.0,0.0 +2017-03-13 20:00:00,31.5676295,31.5676295,20.897524999999998,10.307343,34.207067,21.672338555555555,0.0,0.0,0.0,0.0 +2017-03-13 21:00:00,41.563752799999996,41.563752799999996,38.921276,9.6900949,96.114745,47.14142998888889,0.0,0.0,0.0,0.0 +2017-03-13 22:00:00,66.36926329999999,66.36926329999999,377.07176,207.46329,510.06285,354.91014222222225,0.0,0.0,0.0,0.0 +2017-03-13 23:00:00,24.8191289,24.8191289,620.00612,403.29708,670.96564,565.0074011111111,0.93161748,0.0,6.0461439,2.044855008888889 +2017-03-14 00:00:00,4.9320449,4.9320449,1368.9462,694.66868,1625.4565,1186.23117,1.8317496,0.19378966,9.799342500000002,3.857695251111111 +2017-03-14 01:00:00,30.325171700000002,30.325171700000002,1469.5446,601.48997,1722.1897999999999,1288.2441011111111,0.0,0.0,0.0,0.0 +2017-03-14 02:00:00,55.2559106,55.2559106,441.49699,60.500312,1319.9539000000002,539.4893718888889,0.0,0.0,0.0,0.0 +2017-03-14 03:00:00,23.3894327,23.3894327,270.96726,31.577520999999997,760.00986,323.62170833333334,0.0,0.0,0.0,0.0 +2017-03-14 04:00:00,1.5345806,1.5345806,170.26665,16.088883000000003,561.89444,223.92341444444443,0.0,0.0,0.0,0.0 +2017-03-14 05:00:00,36.468677299999996,36.468677299999996,75.55724,1.4593134,480.13669,147.52428521111108,0.0,0.0,7.3159958,1.8641764333333333 +2017-03-14 06:00:00,31.747967300000003,31.747967300000003,7.667499599999999,0.0,125.82789000000001,30.492471191111115,0.0,0.0,0.14145141,0.032571412555555554 +2017-03-14 07:00:00,3.8961122,3.8961122,0.0,0.0,5.0561557,0.8705362722222222,0.0,0.0,0.0,0.0 +2017-03-14 08:00:00,0.5719151,0.5719151,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-14 09:00:00,1.6644994999999998,1.6644994999999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-14 10:00:00,11.302793300000001,11.302793300000001,0.0,0.0,0.73779938,0.08197770888888889,0.0,0.0,0.0,0.0 +2017-03-14 11:00:00,30.6414545,30.6414545,0.0,0.0,1.1090983,0.12323314444444446,0.0,0.0,0.0,0.0 +2017-03-14 12:00:00,27.488532199999998,27.488532199999998,0.0,0.0,1.3001924999999999,0.24142924,30.312094000000002,28.779314999999997,30.775375999999998,29.99656422222222 +2017-03-14 13:00:00,21.503899399999998,21.503899399999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-14 14:00:00,20.6212427,20.6212427,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-14 15:00:00,21.1225538,21.1225538,6.2894042,1.2138069999999999,19.90384,7.939544777777779,0.0,0.0,0.0,0.0 +2017-03-14 16:00:00,20.7937895,20.7937895,15.982537999999998,4.6616751,40.373259000000004,18.49589718888889,0.0,0.0,0.0,0.0 +2017-03-14 17:00:00,19.6134212,19.6134212,41.628326,17.433757,76.802884,44.69328688888889,17.973045,17.053057,18.436158,17.853888888888893 +2017-03-14 18:00:00,23.995047800000002,23.995047800000002,57.764231,26.308094999999998,100.47812,59.65383288888889,4.0076843,3.3883528,4.531958,3.945138033333334 +2017-03-14 19:00:00,17.166331699999997,17.166331699999997,51.535320000000006,26.33542,79.998194,52.45503022222223,0.0,0.0,0.0,0.0 +2017-03-14 20:00:00,38.8320851,38.8320851,52.534364,41.195261,56.451347,51.207722,0.0,0.0,0.0,0.0 +2017-03-14 21:00:00,54.4231799,54.4231799,82.512001,51.389165,103.87274,80.50611433333331,0.0,0.0,0.0,0.0 +2017-03-14 22:00:00,34.4673284,34.4673284,114.3715,67.50223100000001,145.09309,110.11776488888887,0.0,0.0,0.0,0.0 +2017-03-14 23:00:00,11.5573205,11.5573205,119.32942,43.017335,231.18989,131.5523912222222,0.0,0.0,0.0,0.0 +2017-03-15 00:00:00,16.8877478,16.8877478,15.351987,1.204381,61.423198000000006,22.490220133333334,0.10939463,0.10312211,0.11399416000000001,0.10933268333333333 +2017-03-15 01:00:00,3.1837127,3.1837127,680.91892,311.95072,737.92157,569.6225955555557,0.0,0.0,0.0,0.0 +2017-03-15 02:00:00,1.5775106,1.5775106,154.76397,50.582392,325.45757000000003,164.68636344444445,0.0,0.0,0.0,0.0 +2017-03-15 03:00:00,1.4061721999999999,1.4061721999999999,0.4070707,0.0,53.340187,10.2361036,0.0,0.0,0.0,0.0 +2017-03-15 04:00:00,1.1592133999999998,1.1592133999999998,0.0,0.0,3.8356269999999997,0.5394480444444444,0.0,0.0,0.0,0.0 +2017-03-15 05:00:00,1.081685,1.081685,0.0,0.0,0.0,0.0,4.94084,0.0,42.181546000000004,11.293196084444444 +2017-03-15 06:00:00,0.9253562,0.9253562,0.0,0.0,0.0,0.0,25.461693,17.846927,39.869214,27.060532555555554 +2017-03-15 07:00:00,0.39041659999999995,0.39041659999999995,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 08:00:00,0.4724288,0.4724288,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 09:00:00,0.8223401,0.8223401,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 10:00:00,2.6846912,2.6846912,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 11:00:00,6.2306137999999995,6.2306137999999995,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 12:00:00,8.660674400000001,8.660674400000001,0.0,0.0,0.0,0.0,19.035397,10.505262,26.609339,18.979623444444442 +2017-03-15 13:00:00,14.0703473,14.0703473,0.0,0.0,0.29322476,0.07376447777777778,0.0,0.0,0.0,0.0 +2017-03-15 14:00:00,20.4329867,20.4329867,0.0,0.0,0.10627921,0.024717723666666667,0.0,0.0,0.0,0.0 +2017-03-15 15:00:00,13.489075099999999,13.489075099999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 16:00:00,33.223789399999994,33.223789399999994,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-15 17:00:00,40.935829999999996,40.935829999999996,0.0,0.0,4.7928111,0.9670917411111112,16.880924,16.353832999999998,17.401821,16.873975666666666 +2017-03-15 18:00:00,17.851415,17.851415,1.0001779,0.0,10.348825999999999,2.6090942888888886,0.56709519,0.44667138,0.71582849,0.5742775344444444 +2017-03-15 19:00:00,7.8441617,7.8441617,3.0184679,0.0,17.543550999999997,5.106108789888889,0.0,0.0,0.0,0.0 +2017-03-15 20:00:00,28.972081699999997,28.972081699999997,17.389515000000003,0.045789655,79.848753,25.868674895,0.0,0.0,0.0,0.0 +2017-03-15 21:00:00,16.643062699999998,16.643062699999998,23.729215,0.0,125.77369000000002,38.95108935444445,0.0,0.0,0.0,0.0 +2017-03-15 22:00:00,11.8596272,11.8596272,30.724907,0.0,162.6508,50.68676120000001,0.0,0.0,0.0,0.0 +2017-03-15 23:00:00,28.2629099,28.2629099,23.870205000000002,1.39579,110.52631,36.60131261111111,313.31422999999995,279.45335,332.24537,307.60383111111116 +2017-03-16 00:00:00,,12.926660070775446,2.2688744,0.0,74.698306,16.267553662222227,10.122333999999999,3.0561198000000003,25.04891,11.087930822222223 +2017-03-16 01:00:00,1.3140317,1.3140317,0.0,0.0,8.2779861,1.4922731444444444,0.0,0.0,0.0,0.0 +2017-03-16 02:00:00,7.9400705,7.9400705,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 03:00:00,22.7854712,22.7854712,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 04:00:00,2.773445,2.773445,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 05:00:00,1.7417894,1.7417894,0.0,0.0,0.0,0.0,317.72404,217.9719,455.65402,313.76227555555556 +2017-03-16 06:00:00,,7.846932840055195,0.0,0.0,0.0,0.0,357.34184,173.36021,600.63985,379.41955333333334 +2017-03-16 07:00:00,,7.838041614400938,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 08:00:00,,6.950881197201061,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 09:00:00,0.19413110000000003,0.19413110000000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 10:00:00,1.4194328,1.4194328,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 11:00:00,2.3597906,2.3597906,0.0,0.0,0.0,0.0,90.39441599999999,70.900256,117.83178000000001,88.25251066666665 +2017-03-16 12:00:00,11.8596272,11.8596272,0.0,0.0,0.0,0.0,560.4302299999999,250.84149000000002,1027.3563,601.6745488888888 +2017-03-16 13:00:00,20.440984399999998,20.440984399999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 14:00:00,6.0705962,6.0705962,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 15:00:00,5.4673184,5.4673184,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 16:00:00,6.1126994,6.1126994,0.0,0.0,0.0,0.0,37.46252,18.309829,62.645493,39.210222 +2017-03-16 17:00:00,5.447204900000001,5.447204900000001,0.0,0.0,0.0,0.0,34.832232000000005,28.241690000000002,39.762348,34.28134777777778 +2017-03-16 18:00:00,1.6921178,1.6921178,0.0,0.0,0.0,0.0,29.940528999999998,12.372838,55.181663,32.416118777777776 +2017-03-16 19:00:00,1.5003638000000001,1.5003638000000001,0.0,0.0,0.0,0.0,3.2731325,0.90890677,8.2232273,4.000043585555556 +2017-03-16 20:00:00,0.6070223000000001,0.6070223000000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 21:00:00,,5.416407957414338,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-16 22:00:00,,6.082818892006621,0.0,0.0,0.0,0.0,185.80724,80.23539,316.00852,190.8499778888889 +2017-03-16 23:00:00,,6.326291058427343,0.0,0.0,0.0,0.0,188.99178999999998,143.66984,219.15081999999998,184.44627 +2017-03-17 00:00:00,,6.316499650669665,0.0,0.0,0.0,0.0,56.007146,11.328031000000001,140.16235999999998,69.79094377777777 +2017-03-17 01:00:00,,6.0077869658272,0.0,0.0,0.0,0.0,9.2814043,0.87401122,37.486545,14.146659091111111 +2017-03-17 02:00:00,3.9248117,3.9248117,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 03:00:00,3.5973512000000003,3.5973512000000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 04:00:00,1.6129993999999999,1.6129993999999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 05:00:00,,6.317817361838833,0.0,0.0,0.0,0.0,501.09025,373.64516,928.9927,551.2500577777778 +2017-03-17 06:00:00,,7.131340368626653,0.0,0.0,0.0,0.0,232.44551,61.086073,538.0191100000001,257.62712266666665 +2017-03-17 07:00:00,,7.340953224175668,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 08:00:00,,7.382784052685594,0.00021177478999999998,0.0,0.021000451,0.004064005661111111,0.0,0.0,0.0,0.0 +2017-03-17 09:00:00,,7.603937292182394,0.014034336,0.0,0.15322249,0.03845383921111111,0.0,0.0,0.0,0.0 +2017-03-17 10:00:00,,7.486475986593715,0.13587776,0.0,0.61919809,0.22581821833333338,0.0,0.0,0.0,0.0 +2017-03-17 11:00:00,,6.796014190622108,0.43527783,0.056327735,1.5141854000000001,0.633128569111111,337.2335,327.54266,428.39462,366.19132888888885 +2017-03-17 12:00:00,0.1764344,0.1764344,0.9897052000000001,0.14190759,3.5208144999999997,1.3986567777777776,790.97849,587.76757,1066.889,785.9159144444444 +2017-03-17 13:00:00,5.2748489,5.2748489,0.27498993,0.044157556,0.87105525,0.36934354244444445,0.58290885,0.0,4.0462319,1.366292067777778 +2017-03-17 14:00:00,15.263562799999999,15.263562799999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 15:00:00,14.079092300000001,14.079092300000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 16:00:00,13.9104251,13.9104251,0.0,0.0,2.3919230999999996,0.3939773888888889,17.404793,6.8742611,32.801654,19.08203302222222 +2017-03-17 17:00:00,13.0617149,13.0617149,15.79649,2.5343022,51.436225,20.215342555555555,13.22246,11.588259,14.400941,13.114757333333333 +2017-03-17 18:00:00,4.105483400000001,4.105483400000001,7.2073467,0.43822405,32.523567,10.853933374444445,2.4279102,0.44665546,6.0807893,3.049534291111111 +2017-03-17 19:00:00,1.9836284,1.9836284,0.73089063,0.0,10.321093,2.675055447888889,0.04801338,0.0,0.26851228000000005,0.09604956408888891 +2017-03-17 20:00:00,0.4966127,0.4966127,0.0,0.0,1.7405367,0.338925008,0.0,0.0,0.0,0.0 +2017-03-17 21:00:00,0.4657349,0.4657349,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-17 22:00:00,,6.0829530606515085,0.0,0.0,0.0,0.0,0.0,0.0,2.6295183,0.692894588888889 +2017-03-17 23:00:00,,6.429800331746077,0.0,0.0,0.0,0.0,262.25916,249.30522,279.04913,262.96728 +2017-03-18 00:00:00,0.8226899,0.8226899,0.0,0.0,0.0,0.0,1.4940526,0.13900241,8.5294232,2.7991027355555556 +2017-03-18 01:00:00,,7.225919348454853,0.0,0.0,0.0,0.0,0.78621042,0.0,10.661411,2.633662748888889 +2017-03-18 02:00:00,,8.573444392234176,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 03:00:00,,9.370049947442189,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 04:00:00,,9.951160581097485,0.0,0.0,0.0,0.0,4.6822984000000005,1.2532868,11.029129,5.730051866666667 +2017-03-18 05:00:00,,10.3438189155107,0.0,0.0,0.0,0.0,345.77308999999997,300.03072000000003,399.78165,346.88490444444443 +2017-03-18 06:00:00,,10.586383144589133,0.0,0.0,0.0,0.0,607.4913,521.3670699999999,638.3488699999999,589.8186355555555 +2017-03-18 07:00:00,,10.870952585668988,0.0,0.0,0.0,0.0,1.5786892000000001,0.8303712200000001,3.0880797,1.8270429255555554 +2017-03-18 08:00:00,,11.069515984430542,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 09:00:00,,11.134130672427583,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 10:00:00,,10.69441384747282,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 11:00:00,4.469180000000001,4.469180000000001,0.0,0.0,0.0,0.0,280.44273,203.32641999999998,521.64204,313.6387111111111 +2017-03-18 12:00:00,7.535781200000001,7.535781200000001,0.0,0.0,0.14015953,0.022513959666666666,841.12363,572.79592,1091.9997,815.6093922222223 +2017-03-18 13:00:00,7.617252799999999,7.617252799999999,0.0,0.0,0.069546871,0.014180373777777776,50.976923,32.932585,59.281287,46.333516 +2017-03-18 14:00:00,12.789268400000001,12.789268400000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 15:00:00,21.173386100000002,21.173386100000002,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-18 16:00:00,25.0245251,25.0245251,0.0,0.0,0.0,0.0,26.965325,13.565075,40.284678,27.321192555555555 +2017-03-18 17:00:00,47.8264766,47.8264766,0.0,0.0,1.3013201,0.14459112222222223,9.3495091,7.213655,11.18234,9.22111758888889 +2017-03-18 18:00:00,41.6896967,41.6896967,0.0,0.0,4.8966017,0.9166362988888888,3.6175145,1.9136901000000002,6.1804872,3.956420422222222 +2017-03-18 19:00:00,7.175185099999999,7.175185099999999,1.1606619,0.0,11.773589999999999,2.991162133333333,0.0068754478,0.0,0.082612807,0.025539161866666667 +2017-03-18 20:00:00,4.6686773,4.6686773,12.451687000000002,0.0,79.580066,22.324607604444445,0.0,0.0,0.0,0.0 +2017-03-18 21:00:00,15.281466199999999,15.281466199999999,12.175899000000001,0.0,93.928553,26.0402364,0.0,0.0,0.0,0.0 +2017-03-18 22:00:00,32.589125,32.589125,7.0248834,0.0,79.191545,20.741778622222224,0.0,0.0,0.0,0.0 +2017-03-18 23:00:00,1.7037089,1.7037089,4.3014261000000005,0.0,73.53313399999999,18.51786092111111,247.9844,233.66994,266.74024,248.84366 +2017-03-19 00:00:00,,11.548590712702552,0.0,0.0,2.6749511999999998,0.5349515446666666,0.13798871000000001,0.13561035000000002,0.15061977,0.14096615555555556 +2017-03-19 01:00:00,2.8189667000000003,2.8189667000000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 02:00:00,,11.326935901916501,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 03:00:00,,12.147899894947487,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 04:00:00,,12.346001416315282,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 05:00:00,,12.36716598874294,0.0,0.0,0.0,0.0,938.1307800000001,503.16524,1333.3828,891.7783133333334 +2017-03-19 06:00:00,,12.221111773187458,0.0,0.0,0.0,0.0,1064.3846,626.20227,1322.6171,1042.6941188888889 +2017-03-19 07:00:00,,11.840427669694783,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 08:00:00,,10.921064482829411,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 09:00:00,0.40292990000000006,0.40292990000000006,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 10:00:00,12.7022795,12.7022795,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 11:00:00,29.8493006,29.8493006,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 12:00:00,6.25793,6.25793,0.0,0.0,0.0,0.0,25.825897,24.047989,28.152295000000002,26.170440444444445 +2017-03-19 13:00:00,20.903292800000003,20.903292800000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 14:00:00,24.3673622,24.3673622,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 15:00:00,23.8288451,23.8288451,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 16:00:00,7.7441666,7.7441666,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-19 17:00:00,7.057986200000001,7.057986200000001,0.0,0.0,0.59189443,0.06576604777777778,11.828071,11.072134,12.855966,11.867875000000002 +2017-03-19 18:00:00,4.956769400000001,4.956769400000001,0.0,0.0,1.7448696000000001,0.1938744,1.3441185,0.90311858,2.4625383000000003,1.5963723755555554 +2017-03-19 19:00:00,2.8989278,2.8989278,0.0,0.0,3.0394183,0.4746584666666666,0.0,0.0,0.0062044756,0.0018124766333333332 +2017-03-19 20:00:00,2.2232572999999998,2.2232572999999998,0.0,0.0,12.362721,2.2007456555555556,0.0,0.0,0.0,0.0 +2017-03-19 21:00:00,1.2426883999999998,1.2426883999999998,0.0,0.0,2.1835438,0.3111247277777778,0.0,0.0,0.0,0.0 +2017-03-19 22:00:00,0.17618,0.17618,0.0,0.0,0.0,0.0,7.4178142000000005,0.0,32.824908,12.20722098888889 +2017-03-19 23:00:00,0.20982440000000002,0.20982440000000002,0.0,0.0,0.0,0.0,185.80562999999998,177.74856,194.20587,185.83043444444445 +2017-03-20 00:00:00,,7.281266361567549,0.0,0.0,0.0,0.0,42.917992999999996,7.595751,115.97946,55.97362133333334 +2017-03-20 01:00:00,,8.943704334431043,0.0,0.0,0.0,0.0,6.6016751,0.51467663,29.776933,10.668632836666667 +2017-03-20 02:00:00,,9.944380103018709,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 03:00:00,,10.805011931870114,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 04:00:00,,11.507141185412145,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 05:00:00,,11.874932841777927,0.0,0.0,0.0,0.0,880.17754,495.98265,1400.2684,889.9348644444444 +2017-03-20 06:00:00,,11.98268511841565,0.0,0.0,0.0,0.0,1093.4734999999998,683.63437,1553.5313,1136.6608711111112 +2017-03-20 07:00:00,,11.98603392635814,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 08:00:00,,12.214873446703939,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 09:00:00,,12.200357021851694,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 10:00:00,,11.973759246359206,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 11:00:00,,11.120794251882485,0.0,0.0,0.0,0.0,474.60169,445.05979,542.1892300000001,484.07084444444445 +2017-03-20 12:00:00,2.7272873,2.7272873,0.0,0.0,0.0,0.0,1272.4301,1118.9596999999999,1398.9937,1253.2100666666665 +2017-03-20 13:00:00,12.6940433,12.6940433,0.0,0.0,0.0,0.0,0.22219824999999999,0.025924054,2.4356327,0.871225672 +2017-03-20 14:00:00,9.2841134,9.2841134,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 15:00:00,8.912641699999998,8.912641699999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 16:00:00,15.5858399,15.5858399,0.0,0.0,0.0,0.0,52.510163999999996,31.665670000000002,81.57655199999999,52.208524 +2017-03-20 17:00:00,21.042719899999998,21.042719899999998,0.45080662000000005,0.0,5.9399476,1.3756901799999999,17.544629,12.446091,21.628044,17.230119666666663 +2017-03-20 18:00:00,28.8926294,28.8926294,0.0,0.0,3.2684725,0.6035412444444445,4.949763,2.1126627,8.993964,5.6174394777777765 +2017-03-20 19:00:00,7.5061595,7.5061595,0.0,0.0,0.21713745,0.024126383333333334,0.12791577,0.011790368,0.5104912500000001,0.20889715500000003 +2017-03-20 20:00:00,3.6345572,3.6345572,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 21:00:00,1.8075676999999999,1.8075676999999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 22:00:00,0.5351384,0.5351384,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-20 23:00:00,0.055673900000000005,0.055673900000000005,0.0,0.0,0.0,0.0,145.02759,115.133,178.65886999999998,144.98070555555557 +2017-03-21 00:00:00,27.663559399999997,27.663559399999997,0.0,0.0,0.0,0.0,1.8175532,0.42799232,5.5654391,2.1501587122222223 +2017-03-21 01:00:00,,17.178268260298942,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-21 02:00:00,,17.509729775307992,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-21 03:00:00,,18.173548654054525,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-21 04:00:00,,18.786427502142125,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-21 05:00:00,,19.239800258084816,0.0,0.0,0.0,0.0,,,, +2017-03-21 06:00:00,,19.389590725399852,0.0,0.0,0.0,0.0,,,, +2017-03-21 07:00:00,18.6300539,18.6300539,0.0,0.0,0.0,0.0,,,, +2017-03-21 08:00:00,13.3061138,13.3061138,0.0,0.0,0.0,0.0,,,, +2017-03-21 09:00:00,,18.19731872938381,0.0,0.0,0.0,0.0,,,, +2017-03-21 10:00:00,0.28932440000000004,0.28932440000000004,0.0,0.0,0.0,0.0,,,, +2017-03-21 11:00:00,5.802474500000001,5.802474500000001,0.0,0.0,0.0,0.0,,,, +2017-03-21 12:00:00,26.9559299,26.9559299,0.0,0.0,0.0,0.0,,,, +2017-03-21 13:00:00,44.930784499999994,44.930784499999994,0.0,0.0,0.0,0.0,,,, +2017-03-21 14:00:00,47.355709399999995,47.355709399999995,0.0,0.0,0.0,0.0,,,, +2017-03-21 15:00:00,34.31615120000001,34.31615120000001,21.127124,7.5099201,41.782449,22.508114588888887,,,, +2017-03-21 16:00:00,45.108912200000006,45.108912200000006,24.533516,7.563016,56.654808,27.546747200000002,,,, +2017-03-21 17:00:00,46.066044500000004,46.066044500000004,32.190575,9.601990299999999,73.640796,35.65356636666667,,,, +2017-03-21 18:00:00,26.9920706,26.9920706,55.209046,20.180837999999998,103.13647,57.05341377777778,,,, +2017-03-21 19:00:00,11.3349749,11.3349749,75.416465,33.057688,118.91501,74.5594848888889,,,, +2017-03-21 20:00:00,30.7326728,30.7326728,225.80969,120.79003,288.22501,213.68259666666665,,,, +2017-03-21 21:00:00,59.7653573,59.7653573,463.66482,271.65274,522.89886,420.7861077777778,,,, +2017-03-21 22:00:00,10.8574184,10.8574184,596.97923,445.77927,616.46284,536.649051111111,,,, +2017-03-21 23:00:00,9.798860000000001,9.798860000000001,435.76930000000004,215.45202,576.3496700000001,418.26265,,,, +2017-03-22 00:00:00,,32.48822018927855,448.35926,299.34992,462.99322,397.37420888888886,0.0,0.0,0.0,0.0 +2017-03-22 01:00:00,19.020239899999996,19.020239899999996,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 02:00:00,76.1612306,76.1612306,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 03:00:00,108.2513738,108.2513738,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 04:00:00,,52.88630076873603,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 05:00:00,,45.531510094194076,0.0,0.0,14.217716999999999,2.1575230555555556,0.0,0.0,0.0,0.0 +2017-03-22 06:00:00,,42.43590431515314,0.0,0.0,1.6442164000000001,0.22751511333333335,48.806804,48.806804,51.69589,50.14870211111112 +2017-03-22 07:00:00,,40.77035212387405,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 08:00:00,,40.608400801786566,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 09:00:00,,40.38174131334391,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 10:00:00,,40.11138386316771,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 11:00:00,,39.900960443145124,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 12:00:00,,39.663275431107316,0.0,0.0,0.0,0.0,12.482766999999999,6.509481,19.584491,12.722827155555557 +2017-03-22 13:00:00,,39.48863461878637,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 14:00:00,,39.26582017345808,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-22 15:00:00,,39.42438567112888,7.1851887,1.5913486000000001,21.522015,8.975412255555556,0.0,0.0,0.0,0.0 +2017-03-22 16:00:00,,39.925173514361404,40.153442000000005,16.318627,72.062496,41.45847022222222,0.0,0.0,0.0,0.0 +2017-03-22 17:00:00,,40.46311471824708,98.437849,78.201228,105.15634,92.78764022222224,14.534948,14.128161,15.22003,14.591457222222223 +2017-03-22 18:00:00,,41.2310702297528,109.25365,90.59046000000001,113.66675000000001,101.80797288888888,0.0,0.0,0.0,0.0 +2017-03-22 19:00:00,,42.26765825155948,100.5754,73.595984,107.91999,93.82718844444445,0.0,0.0,0.0,0.0 +2017-03-22 20:00:00,,43.11161014779626,144.77067,103.22598,155.61153,134.44492888888888,0.0,0.0,0.0,0.0 +2017-03-22 21:00:00,,44.186853948619145,352.41558,253.89189,397.95597,321.2358644444444,0.0,0.0,0.0,0.0 +2017-03-22 22:00:00,,46.11761397741471,467.34491,246.09562,579.6664,435.6353877777778,0.0,0.0,0.0,0.0 +2017-03-22 23:00:00,,50.603832676621074,283.3824,93.682844,503.74423,297.4025771111111,168.06991,128.89532,200.57864,164.72740555555555 +2017-03-23 00:00:00,72.67717490000001,72.67717490000001,412.68800999999996,345.28319,445.37077,402.3076433333333,100.34457,70.78343299999999,113.44958,95.52062166666667 +2017-03-23 01:00:00,,50.44782443688863,400.97183,125.52951999999999,490.29301999999996,352.7756322222222,0.0,0.0,0.0,0.0 +2017-03-23 02:00:00,,45.68973228806563,382.68516,109.7667,483.64405,339.1554022222222,0.0,0.0,0.0,0.0 +2017-03-23 03:00:00,,43.87061967979031,89.135523,11.178786,314.52040999999997,119.72865022222219,0.0,0.0,0.0,0.0 +2017-03-23 04:00:00,,42.72223899758858,2.8928309,0.0,36.213038,8.644825284444444,0.0,0.0,0.0,0.0 +2017-03-23 05:00:00,,41.763159940922165,0.0,0.0,0.13777915,0.015308794444444444,0.0,0.0,0.0,0.0 +2017-03-23 06:00:00,,40.40491765436948,0.0,0.0,0.0,0.0,56.630488,54.529912,65.38884900000001,57.76513766666666 +2017-03-23 07:00:00,,38.9487183078596,0.0,0.0,0.0,0.0,0.0,0.0,0.19902274,0.022113637777777778 +2017-03-23 08:00:00,,37.359949367295435,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 09:00:00,,35.11065514027195,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 10:00:00,,31.0888120939809,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 11:00:00,7.641818300000001,7.641818300000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 12:00:00,11.2431206,11.2431206,0.0,0.0,0.0,0.0,19.589683,18.24597,21.98969,19.846682666666666 +2017-03-23 13:00:00,23.745624499999998,23.745624499999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 14:00:00,32.014340000000004,32.014340000000004,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-23 15:00:00,35.7511739,35.7511739,13.170537,4.120656299999999,29.921398999999997,14.771988488888887,0.0,0.0,0.0,0.0 +2017-03-23 16:00:00,39.547632799999995,39.547632799999995,17.195247,4.6252408,44.521387999999995,20.187983288888887,0.0,0.0,0.0,0.0 +2017-03-23 17:00:00,17.2601417,17.2601417,18.452310999999998,4.2737229,51.873179,22.064262922222223,23.429957,21.459104,24.636094,23.29501088888889 +2017-03-23 18:00:00,12.952625,12.952625,51.689676,19.07057,96.835742,53.39049011111111,0.0062363434,0.0008827910099999999,0.026856473000000002,0.010710985545555557 +2017-03-23 19:00:00,69.76450159999999,69.76450159999999,81.214384,44.174663,106.07136999999999,78.00133733333332,0.0,0.0,0.0,0.0 +2017-03-23 20:00:00,146.3089778,146.3089778,139.96343,110.95652,152.94604,130.48551555555557,0.0,0.0,0.0,0.0 +2017-03-23 21:00:00,122.44089950000001,122.44089950000001,112.31042000000001,40.365765,213.42753,123.65227911111111,0.0,0.0,0.0,0.0 +2017-03-23 22:00:00,94.6146911,94.6146911,12.809694,1.4967492,59.129987,21.34045593333333,0.0,0.0,0.0,0.0 +2017-03-23 23:00:00,96.0902588,96.0902588,0.0,0.0,1.4180986,0.25067120555555555,0.0,0.0,0.0,0.0 +2017-03-24 00:00:00,2.6984605999999998,2.6984605999999998,39.790106,1.3947703999999999,156.62727999999998,60.689898288888884,0.25444569,0.25255844,0.26310909,0.2577701422222222 +2017-03-24 01:00:00,78.4055156,78.4055156,590.62295,437.95709,613.29314,537.3211455555555,0.0,0.0,0.0,0.0 +2017-03-24 02:00:00,88.3865339,88.3865339,143.10243,45.724039,278.45777,149.77164955555554,0.0,0.0,0.0,0.0 +2017-03-24 03:00:00,44.91660170000001,44.91660170000001,0.28988708,0.0,5.3725457,1.2867396199999999,0.0,0.0,0.0,0.0 +2017-03-24 04:00:00,13.254518300000003,13.254518300000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 05:00:00,4.7674799000000005,4.7674799000000005,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 06:00:00,0.22731439999999997,0.22731439999999997,0.0,0.0,0.0,0.0,48.408689,48.408689,76.564094,56.287382 +2017-03-24 07:00:00,,24.391880208473943,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 08:00:00,4.1085362000000005,4.1085362000000005,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 09:00:00,2.6500928,2.6500928,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 10:00:00,9.0708149,9.0708149,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 11:00:00,28.870115000000002,28.870115000000002,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 12:00:00,24.2221634,24.2221634,0.0,0.0,0.0,0.0,17.658167,16.831465,19.140722,17.712638777777777 +2017-03-24 13:00:00,35.2307828,35.2307828,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 14:00:00,47.753288899999994,47.753288899999994,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-24 15:00:00,41.501075,41.501075,0.0,0.0,0.10917773,0.014963310777777778,0.0,0.0,0.0,0.0 +2017-03-24 16:00:00,36.632495,36.632495,41.877058,20.154963000000002,66.571563,42.31891655555555,0.0,0.0,0.0,0.0 +2017-03-24 17:00:00,34.018280600000004,34.018280600000004,90.411835,72.540759,94.59092,85.44068366666666,13.919165,13.478534,14.041409,13.789165666666667 +2017-03-24 18:00:00,38.51317879999999,38.51317879999999,100.12938,73.823976,107.93223,93.89563833333334,0.2073959,0.047224692,0.71940764,0.2605860042222223 +2017-03-24 19:00:00,30.9375761,30.9375761,97.416516,73.22175999999999,104.98174,91.6594182222222,0.0,0.0,0.0,0.0 +2017-03-24 20:00:00,41.7066461,41.7066461,94.625655,59.288031,114.66803,90.79280555555556,0.0,0.0,0.0,0.0 +2017-03-24 21:00:00,10.2638873,10.2638873,98.702367,39.794239,167.4396,103.19005122222222,0.0,0.0,0.0,0.0 +2017-03-24 22:00:00,6.715468400000001,6.715468400000001,58.585698,16.358405,132.8384,68.16050422222222,0.0,0.0,0.0,0.0 +2017-03-24 23:00:00,4.475078900000001,4.475078900000001,11.063531,2.1445151,38.293085,15.035272299999999,0.0,0.0,0.0,0.0 +2017-03-25 00:00:00,5.199832700000001,5.199832700000001,0.0,0.0,17.007347,3.8705505000000002,0.043077452999999995,0.012608494,0.10091983,0.051032631777777775 +2017-03-25 01:00:00,2.5597649,2.5597649,79.556274,7.7936247,264.9774,111.89384074444445,0.0,0.0,0.0,0.0 +2017-03-25 02:00:00,28.0975022,28.0975022,223.17628,55.510762,358.63543999999996,214.67501700000003,0.0,0.0,0.0,0.0 +2017-03-25 03:00:00,57.51630229999999,57.51630229999999,311.70854,93.326431,439.13873,278.3936934444444,0.0,0.0,0.0,0.0 +2017-03-25 04:00:00,42.748684399999995,42.748684399999995,387.80789999999996,127.02758,536.36334,341.7332988888889,0.0,0.0,0.0,0.0 +2017-03-25 05:00:00,21.0599078,21.0599078,432.48388,146.41869,559.83366,373.0576,65.951994,13.983529,106.55142000000001,63.42902266666667 +2017-03-25 06:00:00,33.0457094,33.0457094,345.83636,118.2599,499.94874000000004,327.4619433333334,2.535164,0.2976941,8.2680854,3.501963011111111 +2017-03-25 07:00:00,25.8986117,25.8986117,42.873638,4.4122721,215.94415,70.19099206666665,0.0,0.0,0.0,0.0 +2017-03-25 08:00:00,36.4176701,36.4176701,0.084312674,0.0,11.004554,2.2952769526666668,0.0,0.0,0.0,0.0 +2017-03-25 09:00:00,4.0300856,4.0300856,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 10:00:00,3.4556822,3.4556822,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 11:00:00,9.1574222,9.1574222,0.0,0.0,1.1504708,0.1278300888888889,0.0,0.0,0.0,0.0 +2017-03-25 12:00:00,50.4111806,50.4111806,0.41432352,0.0,5.3030089,1.38115621,32.388943999999995,29.411332,35.543315,32.46464122222223 +2017-03-25 13:00:00,60.242071100000004,60.242071100000004,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 14:00:00,56.181831200000005,56.181831200000005,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 15:00:00,45.8466722,45.8466722,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-25 16:00:00,54.8127299,54.8127299,39.080751,26.696611,46.153938000000004,37.778618333333334,0.0,0.0,0.0,0.0 +2017-03-25 17:00:00,26.901313399999996,26.901313399999996,88.664834,62.437946,104.73785000000001,87.635355,5.9183531,3.228381,10.027859000000001,6.128462244444444 +2017-03-25 18:00:00,15.390174499999999,15.390174499999999,74.00583900000001,47.722933,98.240249,75.82028211111111,12.873562,8.653391,17.811408,13.017046188888889 +2017-03-25 19:00:00,12.1914761,12.1914761,16.569895,6.7237697,33.841745,17.870324744444442,0.34124304,0.21105977,0.51003076,0.3505229411111112 +2017-03-25 20:00:00,10.4828462,10.4828462,18.536141999999998,8.2169217,34.513381,19.41709841111111,0.0,0.0,0.0,0.0 +2017-03-25 21:00:00,8.1351794,8.1351794,70.38287,61.242681,80.821403,70.958506,0.0,0.0,0.0,0.0 +2017-03-25 22:00:00,7.0925050999999995,7.0925050999999995,6.6710367999999995,1.3954314,20.810336000000003,8.563077755555558,0.0,0.0,0.0,0.0 +2017-03-25 23:00:00,6.2683127,6.2683127,0.0,0.0,0.070705511,0.010176890222222222,0.0,0.0,0.0,0.0 +2017-03-26 00:00:00,4.4817728,4.4817728,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 01:00:00,3.7133894,3.7133894,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 02:00:00,3.7606282999999996,3.7606282999999996,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 03:00:00,2.6517623,2.6517623,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 04:00:00,14.6592356,14.6592356,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 05:00:00,21.1404572,21.1404572,15.979609,0.0,193.46418,53.23240325555556,0.0,0.0,0.0,0.0 +2017-03-26 06:00:00,17.0714405,17.0714405,440.37678,93.747163,720.47883,426.78179811111113,0.0,0.0,0.0,0.0 +2017-03-26 07:00:00,12.600646699999999,12.600646699999999,519.5772400000001,211.43877999999998,642.48085,458.3549911111111,0.0,0.0,0.0,0.0 +2017-03-26 08:00:00,27.3241262,27.3241262,87.998771,11.240135,331.68512,121.98369555555554,0.0,0.0,0.0,0.0 +2017-03-26 09:00:00,28.7800733,28.7800733,14.301315,0.0,183.37017999999998,45.76954871111111,0.0,0.0,0.0,0.0 +2017-03-26 10:00:00,52.313075,52.313075,3.2823566,0.0,140.66053,30.23714779333333,0.0,0.0,0.0,0.0 +2017-03-26 11:00:00,69.19892270000001,69.19892270000001,0.0,0.0,53.949418,10.06864902,0.0,0.0,15.501104,2.861294788888889 +2017-03-26 12:00:00,66.561065,66.561065,20.117632,2.9819985,78.3297,29.113282311111114,39.162132,32.988409999999995,41.799713999999994,38.62407822222221 +2017-03-26 13:00:00,62.3082284,62.3082284,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 14:00:00,63.0516806,63.0516806,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 15:00:00,65.08136329999999,65.08136329999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-26 16:00:00,58.26365,58.26365,35.353564999999996,27.023571,43.721582000000005,34.41733844444445,0.0,0.0,0.0,0.0 +2017-03-26 17:00:00,62.6430983,62.6430983,104.08659999999999,88.739682,113.9535,102.93198966666665,4.4197936,2.4077628,7.63341,4.634735911111111 +2017-03-26 18:00:00,22.8230906,22.8230906,96.758471,88.306719,100.6993,94.14449244444444,2.4923547,1.4353433999999998,3.9342384999999997,2.551616633333333 +2017-03-26 19:00:00,10.9591784,10.9591784,86.674561,67.682144,98.34090499999999,84.90602255555555,0.0,0.0,0.0,0.0 +2017-03-26 20:00:00,8.585642300000002,8.585642300000002,59.757313,37.511047000000005,83.293024,59.75998699999999,0.0,0.0,0.0,0.0 +2017-03-26 21:00:00,15.2708927,15.2708927,98.12924699999999,90.599358,108.66676000000001,96.973304,0.0,0.0,0.0,0.0 +2017-03-26 22:00:00,9.2909345,9.2909345,23.138071,8.189875200000001,48.63703700000001,25.535619466666667,0.0,0.0,0.0,0.0 +2017-03-26 23:00:00,4.713960500000001,4.713960500000001,0.0,0.0,0.6722089,0.11255499,0.0,0.0,0.0,0.0 +2017-03-27 00:00:00,4.0331383999999995,4.0331383999999995,0.0078887652,0.007182114,0.0088349701,0.007981815944444446,0.0,0.0,0.0,0.0 +2017-03-27 01:00:00,3.7573211000000004,3.7573211000000004,0.0011742413,0.0010646461,0.0013212872,0.0011880706555555556,0.0,0.0,0.0,0.0 +2017-03-27 02:00:00,9.5103545,9.5103545,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 03:00:00,14.6571845,14.6571845,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 04:00:00,3.6262733,3.6262733,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 05:00:00,9.1999388,9.1999388,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 06:00:00,14.961876199999999,14.961876199999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 07:00:00,11.7675344,11.7675344,100.8086,18.376186,185.22696,103.34378955555556,0.0,0.0,0.0,0.0 +2017-03-27 08:00:00,14.405837300000002,14.405837300000002,122.98463999999998,65.402659,144.47114,112.31297544444443,0.0,0.0,0.0,0.0 +2017-03-27 09:00:00,20.257339399999996,20.257339399999996,144.81187,38.127648,204.78228,130.92208722222222,0.0,0.0,0.0,0.0 +2017-03-27 10:00:00,38.963562200000005,38.963562200000005,153.19126,42.938984,201.25621999999998,135.01349555555555,0.0,0.0,0.0,0.0 +2017-03-27 11:00:00,42.604614500000004,42.604614500000004,164.62679,61.868871999999996,208.50808,140.41451455555554,89.03769799999999,5.917964199999999,188.31870999999998,94.91239135555556 +2017-03-27 12:00:00,57.763642700000005,57.763642700000005,62.460364000000006,42.486088,64.487416,54.15249611111111,1.8180853000000001,0.040505032,9.3220797,3.3301656002222226 +2017-03-27 13:00:00,52.7139299,52.7139299,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 14:00:00,51.4795811,51.4795811,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 15:00:00,48.4556555,48.4556555,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 16:00:00,50.8689416,50.8689416,15.579191,9.9418094,24.308438,16.551350233333334,0.0,0.0,0.0,0.0 +2017-03-27 17:00:00,48.7049039,48.7049039,31.904550000000004,29.669203,44.786032999999996,34.488665777777776,2.1197852,0.91904838,4.0380746,2.338783697777778 +2017-03-27 18:00:00,14.3407745,14.3407745,17.969893,12.251822,28.368937,19.993138333333334,0.21008923000000002,0.073683161,0.50744347,0.23274654233333336 +2017-03-27 19:00:00,9.8984894,9.8984894,43.835967999999994,26.802642000000002,62.012048,44.40911588888889,0.0,0.0,0.0,0.0 +2017-03-27 20:00:00,7.6978022,7.6978022,61.237304,43.931752,75.456985,60.795527444444446,0.0,0.0,0.0,0.0 +2017-03-27 21:00:00,6.332119400000001,6.332119400000001,7.4606291,3.2909918,14.299881999999998,7.988571833333334,0.0,0.0,0.0,0.0 +2017-03-27 22:00:00,5.5166561,5.5166561,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-27 23:00:00,4.801156099999999,4.801156099999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 00:00:00,5.9489294,5.9489294,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 01:00:00,3.7962761,3.7962761,0.0,0.0,0.0,0.0,0.0020380078000000004,0.00082416063,0.0049322395,0.002346029781111111 +2017-03-28 02:00:00,2.4118472,2.4118472,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 03:00:00,1.7370511999999998,1.7370511999999998,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 04:00:00,0.6498728,0.6498728,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 05:00:00,,17.073385028841574,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 06:00:00,,20.011903954054905,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 07:00:00,,20.99331645280798,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 08:00:00,3.5376467000000003,3.5376467000000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 09:00:00,28.5126989,28.5126989,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 10:00:00,73.53375559999999,73.53375559999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 11:00:00,21.367032199999997,21.367032199999997,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 12:00:00,15.9464678,15.9464678,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 13:00:00,38.6742299,38.6742299,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 14:00:00,63.4731101,63.4731101,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 15:00:00,70.4621777,70.4621777,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-28 16:00:00,58.809735499999995,58.809735499999995,2.7508369999999998,1.2901824,5.3734551999999995,2.8995065777777778,0.0,0.0,0.0,0.0 +2017-03-28 17:00:00,55.919862800000004,55.919862800000004,48.195579,32.719483,63.393636,48.56706311111111,0.0,0.0,0.0,0.0 +2017-03-28 18:00:00,26.7745745,26.7745745,70.35672799999999,61.395272,79.327227,70.56111733333334,0.25107258000000005,0.098519983,0.5288598,0.2800033758888889 +2017-03-28 19:00:00,13.9005989,13.9005989,50.964645,43.926735,59.932241,51.624914777777775,0.35074845,0.20843528,0.54320577,0.36131274777777783 +2017-03-28 20:00:00,11.297562199999998,11.297562199999998,53.362521,46.21438,63.081447000000004,53.68185555555556,0.0,0.0,0.0010529946,0.0001169994 +2017-03-28 21:00:00,8.5724294,8.5724294,50.257899,42.250838,60.99356,50.726542,0.0,0.0,0.0,0.0 +2017-03-28 22:00:00,7.6988516,7.6988516,83.752901,76.031713,92.10767200000001,83.79187866666668,0.0,0.0,0.0,0.0 +2017-03-28 23:00:00,6.3145499,6.3145499,41.864023,37.105503,46.713179000000004,41.85659022222222,0.0,0.0,0.0,0.0 +2017-03-29 00:00:00,3.2643416000000003,3.2643416000000003,6.7250967,5.7225211,7.9402398000000005,6.757081744444445,0.05104252,0.049516814,0.053095405,0.05129569266666667 +2017-03-29 01:00:00,5.7239762,5.7239762,0.56278355,0.4886503,0.64845648,0.5651517777777778,0.030683584,0.029381694,0.032403133,0.03086047411111111 +2017-03-29 02:00:00,5.6174939,5.6174939,0.067993362,0.058739005,0.078216736,0.06823596266666666,0.0084224165,0.0078598017,0.0091066248,0.008466453711111111 +2017-03-29 03:00:00,19.9926362,19.9926362,0.00016988379,0.0,0.0005594752999999999,0.00022724047411111107,0.00013254621,0.00012219507,0.00014512705,0.00013333542 +2017-03-29 04:00:00,3.4916638999999994,3.4916638999999994,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 05:00:00,0.0274355,0.0274355,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 06:00:00,,15.630435360146487,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 07:00:00,,18.022843449503235,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 08:00:00,,18.87206969158573,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 09:00:00,4.182980000000001,4.182980000000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 10:00:00,34.3195856,34.3195856,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 11:00:00,47.9777333,47.9777333,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 12:00:00,10.0623389,10.0623389,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 13:00:00,13.121212699999997,13.121212699999997,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 14:00:00,19.318985,19.318985,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 15:00:00,57.6436295,57.6436295,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 16:00:00,71.281775,71.281775,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 17:00:00,58.23975229999999,58.23975229999999,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 18:00:00,13.740183800000002,13.740183800000002,0.036621113000000004,0.015254338000000001,0.087697067,0.04117233822222223,0.24655816,0.10338786,0.50443623,0.27822863555555555 +2017-03-29 19:00:00,9.8899988,9.8899988,0.043971522,0.031371421000000003,0.047402672,0.042730567000000004,0.34356074000000003,0.21516138999999998,0.50265385,0.34957354111111116 +2017-03-29 20:00:00,8.2093688,8.2093688,0.40071509,0.37646799,0.41742967000000003,0.39782661999999996,0.0,0.0,0.0019269562000000001,0.0003125816077777778 +2017-03-29 21:00:00,6.6265238,6.6265238,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-29 22:00:00,5.916875,5.916875,0.017834701,0.014683003,0.024057941,0.018214486666666665,0.0,0.0,0.0,0.0 +2017-03-29 23:00:00,5.649755,5.649755,0.0054609197000000005,0.004820754,0.0061643637,0.0054698013,0.0,0.0,0.0,0.0 +2017-03-30 00:00:00,8.2299116,8.2299116,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 01:00:00,3.2742473,3.2742473,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 02:00:00,1.5397322,1.5397322,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 03:00:00,0.9148145000000001,0.9148145000000001,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 04:00:00,,12.749563987134355,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 05:00:00,,13.54691474565248,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 06:00:00,0.28568330000000003,0.28568330000000003,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 07:00:00,,16.57814651303806,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 08:00:00,,18.4546715738197,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 09:00:00,7.5604739,7.5604739,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 10:00:00,8.9507222,8.9507222,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 11:00:00,37.3848989,37.3848989,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 12:00:00,42.6986789,42.6986789,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-30 13:00:00,62.8573667,62.8573667,0.77918281,0.66190984,0.8494323,0.7646625455555556,0.0,0.0,0.0,0.0 +2017-03-30 14:00:00,70.16685109999999,70.16685109999999,5.3575932,5.069561200000001,5.7548718,5.391232755555556,0.0,0.0,0.0,0.0 +2017-03-30 15:00:00,41.4358055,41.4358055,11.274587,10.637247,12.27928,11.370049555555557,0.0,0.0,0.0,0.0 +2017-03-30 16:00:00,20.9653823,20.9653823,15.373862,14.540768,16.261454,15.369521888888888,0.0,0.0,0.0,0.0 +2017-03-30 17:00:00,19.5963923,19.5963923,16.094482,15.370548,16.849504,16.095939,0.0,0.0,0.0,0.0 +2017-03-30 18:00:00,15.365736199999999,15.365736199999999,15.967302,15.003094,17.014918,15.974961222222223,0.0,0.0,0.0,0.0 +2017-03-30 19:00:00,12.4626506,12.4626506,21.073401999999998,19.718374,22.528734999999998,21.07161011111111,0.0,0.0,0.0,0.0 +2017-03-30 20:00:00,10.633323800000001,10.633323800000001,23.363789,22.469436,24.233221,23.316436666666668,0.0,0.0,0.0,0.0 +2017-03-30 21:00:00,6.2365445,6.2365445,14.387849000000001,12.257738999999999,16.677337,14.41188822222222,0.0,0.0,0.0,0.0 +2017-03-30 22:00:00,5.5657394,5.5657394,13.762852,12.991281,15.000188,13.832965777777776,0.0,0.0,0.0,0.0 +2017-03-30 23:00:00,5.9472917,5.9472917,33.788998,28.951295000000002,39.69016,33.84044566666667,0.0,0.0,0.0,0.0 +2017-03-31 00:00:00,5.5123472,5.5123472,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 +2017-03-31 01:00:00,7.0308767,7.0308767,0.0,0.0,0.0,0.0,0.0,0.0,0.007223286,0.0008025873333333333 +2017-03-31 02:00:00,5.659120099999999,5.659120099999999,0.0,0.0,0.0,0.0,1.5396843,1.0752856,2.1110902,1.5297842666666668 +2017-03-31 03:00:00,12.7426655,12.7426655,0.0,0.0,0.0,0.0,5.4971847,4.5917053999999995,6.6014891,5.455763022222223 +2017-03-31 04:00:00,10.823153900000001,10.823153900000001,0.0,0.0,0.0,0.0,8.4701587,7.3471274,9.6340518,8.468513344444442 +2017-03-31 05:00:00,4.2308867,4.2308867,0.0,0.0,0.0,0.0,11.464720999999999,10.307438,12.725966,11.476623777777778 +2017-03-31 06:00:00,3.0762127999999995,3.0762127999999995,0.0,0.0,0.0,0.0,12.017403,11.125739,12.95518,12.017191222222221 +2017-03-31 07:00:00,9.6476828,9.6476828,0.0,0.0,0.0,0.0,11.551299,10.901009,12.22126,11.584038 +2017-03-31 08:00:00,13.576032199999998,13.576032199999998,0.0,0.0,0.0,0.0,30.190926,27.934651000000002,34.692479000000006,31.043857555555558 +2017-03-31 09:00:00,33.477012800000004,33.477012800000004,0.0,0.0,0.0,0.0,7.3242253999999996,7.0544206,7.5981106,7.324495988888889 +2017-03-31 10:00:00,170.46413059999998,170.46413059999998,0.0,0.0,0.0,0.0,6.6911966,6.4977894,6.8853606,6.690121755555555 +2017-03-31 11:00:00,36.531657200000005,36.531657200000005,0.0,0.0,0.0,0.0,7.2866887,7.0905153,7.4830732,7.285552222222224 +2017-03-31 12:00:00,37.5648551,37.5648551,0.0,0.0,0.0,0.0,2.2522891,2.2036829,2.3000541,2.252022466666667 +2017-03-31 13:00:00,63.7585628,63.7585628,114.52186,92.581889,173.4109,124.39781266666667,0.59585437,0.5821953,0.60944268,0.5958003222222223 +2017-03-31 14:00:00,41.8805444,41.8805444,415.25337,336.83250999999996,503.11447999999996,415.98521999999997,0.48585684,0.47013670999999996,0.50473301,0.48696146111111116 +2017-03-31 15:00:00,42.415118299999996,42.415118299999996,62.584659,34.072928,103.30924,64.55284044444446,1.330302,1.2621202999999999,1.4112964000000001,1.3350539222222222 +2017-03-31 16:00:00,57.647572700000005,57.647572700000005,25.934432,19.157404000000003,35.351215,26.250789666666666,1.8159886,1.7423497,1.8941854999999999,1.8175995777777776 +2017-03-31 17:00:00,37.4906816,37.4906816,2.1920196,1.646285,2.8965764999999997,2.223425633333333,,,, +2017-03-31 18:00:00,19.20053,19.20053,0.039347039,0.021107663000000002,0.067020821,0.040148212,,,, +2017-03-31 19:00:00,14.8122095,14.8122095,0.0,0.0,0.0,0.0,,,, +2017-03-31 20:00:00,11.9225912,11.9225912,0.0,0.0,0.0,0.0,,,, +2017-03-31 21:00:00,9.2285588,9.2285588,0.0,0.0,0.0,0.0,,,, +2017-03-31 22:00:00,7.704575599999999,7.704575599999999,0.0,0.0,0.0,0.0,,,, +2017-03-31 23:00:00,7.042881200000001,7.042881200000001,0.0,0.0,0.0,0.0,,,, diff --git a/Analysis/TimeSeries_Data/Pacaya/Pacaya_cleaned.csv b/Analysis/TimeSeries_Data/Pacaya/Pacaya_cleaned.csv new file mode 100644 index 0000000..641e2d1 --- /dev/null +++ b/Analysis/TimeSeries_Data/Pacaya/Pacaya_cleaned.csv @@ -0,0 +1,745 @@ +Timestamp,Pacaya_raw,Pacaya_KNN +2017-03-01 00:00:00,14.2278845,14.2278845 +2017-03-01 01:00:00,18.8317772,18.8317772 +2017-03-01 02:00:00,42.4108412,42.4108412 +2017-03-01 03:00:00,39.6160028,39.6160028 +2017-03-01 04:00:00,14.359266199999999,14.359266199999999 +2017-03-01 05:00:00,,25.42668189555998 +2017-03-01 06:00:00,42.2575016,42.2575016 +2017-03-01 07:00:00,33.5557973,33.5557973 +2017-03-01 08:00:00,48.570930499999996,48.570930499999996 +2017-03-01 09:00:00,23.3482994,23.3482994 +2017-03-01 10:00:00,4.452310099999999,4.452310099999999 +2017-03-01 11:00:00,12.2208116,12.2208116 +2017-03-01 12:00:00,17.0059961,17.0059961 +2017-03-01 13:00:00,16.8146555,16.8146555 +2017-03-01 14:00:00,29.1784955,29.1784955 +2017-03-01 15:00:00,23.2083317,23.2083317 +2017-03-01 16:00:00,26.0008805,26.0008805 +2017-03-01 17:00:00,24.098938399999998,24.098938399999998 +2017-03-01 18:00:00,18.4332278,18.4332278 +2017-03-01 19:00:00,3.9564845,3.9564845 +2017-03-01 20:00:00,2.1404183,2.1404183 +2017-03-01 21:00:00,2.6608412,2.6608412 +2017-03-01 22:00:00,1.3732433000000002,1.3732433000000002 +2017-03-01 23:00:00,0.9396662,0.9396662 +2017-03-02 00:00:00,,9.520253946493629 +2017-03-02 01:00:00,,10.836144564580897 +2017-03-02 02:00:00,,11.37078330315574 +2017-03-02 03:00:00,,11.584391917971743 +2017-03-02 04:00:00,,11.617837042486377 +2017-03-02 05:00:00,,11.531797563578172 +2017-03-02 06:00:00,,11.355992654393637 +2017-03-02 07:00:00,,11.104465226207699 +2017-03-02 08:00:00,,10.780643417106262 +2017-03-02 09:00:00,,10.377171505998986 +2017-03-02 10:00:00,,9.869101680307187 +2017-03-02 11:00:00,,9.187123884532712 +2017-03-02 12:00:00,,8.077051812076128 +2017-03-02 13:00:00,2.7387989,2.7387989 +2017-03-02 14:00:00,2.7768794,2.7768794 +2017-03-02 15:00:00,6.861716599999999,6.861716599999999 +2017-03-02 16:00:00,13.515993799999999,13.515993799999999 +2017-03-02 17:00:00,6.399106099999999,6.399106099999999 +2017-03-02 18:00:00,6.813301099999999,6.813301099999999 +2017-03-02 19:00:00,6.1304756,6.1304756 +2017-03-02 20:00:00,5.751515,5.751515 +2017-03-02 21:00:00,3.2079284,3.2079284 +2017-03-02 22:00:00,0.7155239000000001,0.7155239000000001 +2017-03-02 23:00:00,0.46948729999999994,0.46948729999999994 +2017-03-03 00:00:00,,6.473667416887441 +2017-03-03 01:00:00,,7.448842012911448 +2017-03-03 02:00:00,,8.019598734745363 +2017-03-03 03:00:00,,8.152454571594248 +2017-03-03 04:00:00,,8.227204420092058 +2017-03-03 05:00:00,,8.098344657174419 +2017-03-03 06:00:00,,8.319079603113686 +2017-03-03 07:00:00,,8.50570424270023 +2017-03-03 08:00:00,,8.653911037034323 +2017-03-03 09:00:00,,8.740055700689846 +2017-03-03 10:00:00,,8.682511745322136 +2017-03-03 11:00:00,,8.05002565821416 +2017-03-03 12:00:00,1.1260301000000001,1.1260301000000001 +2017-03-03 13:00:00,3.3253022000000003,3.3253022000000003 +2017-03-03 14:00:00,20.547085100000004,20.547085100000004 +2017-03-03 15:00:00,25.983931100000003,25.983931100000003 +2017-03-03 16:00:00,21.2889155,21.2889155 +2017-03-03 17:00:00,8.5005773,8.5005773 +2017-03-03 18:00:00,5.4213038000000005,5.4213038000000005 +2017-03-03 19:00:00,9.4547522,9.4547522 +2017-03-03 20:00:00,1.1264117,1.1264117 +2017-03-03 21:00:00,,8.28714426613457 +2017-03-03 22:00:00,,8.895385200829628 +2017-03-03 23:00:00,,8.454977490607005 +2017-03-04 00:00:00,1.9746767,1.9746767 +2017-03-04 01:00:00,,8.632664264738018 +2017-03-04 02:00:00,,9.853839198576578 +2017-03-04 03:00:00,,10.441691473535212 +2017-03-04 04:00:00,,10.810921086027703 +2017-03-04 05:00:00,,11.0645005984165 +2017-03-04 06:00:00,,11.274967138361989 +2017-03-04 07:00:00,,11.399674982635267 +2017-03-04 08:00:00,,11.472192877952478 +2017-03-04 09:00:00,,11.48822342736019 +2017-03-04 10:00:00,,11.432355905465606 +2017-03-04 11:00:00,,11.266873411174695 +2017-03-04 12:00:00,,10.890374198208065 +2017-03-04 13:00:00,,9.976454844665511 +2017-03-04 14:00:00,2.0382767,2.0382767 +2017-03-04 15:00:00,6.6342194,6.6342194 +2017-03-04 16:00:00,10.549848800000001,10.549848800000001 +2017-03-04 17:00:00,11.2609445,11.2609445 +2017-03-04 18:00:00,35.645486600000005,35.645486600000005 +2017-03-04 19:00:00,23.226950600000002,23.226950600000002 +2017-03-04 20:00:00,2.4326762000000004,2.4326762000000004 +2017-03-04 21:00:00,1.8568099999999998,1.8568099999999998 +2017-03-04 22:00:00,1.0393751,1.0393751 +2017-03-04 23:00:00,0.0540362,0.0540362 +2017-03-05 00:00:00,1.0794749,1.0794749 +2017-03-05 01:00:00,0.37861880000000003,0.37861880000000003 +2017-03-05 02:00:00,,10.380763087832419 +2017-03-05 03:00:00,,12.770469902792016 +2017-03-05 04:00:00,,14.338700726295441 +2017-03-05 05:00:00,,15.565864989785702 +2017-03-05 06:00:00,,17.00970543219513 +2017-03-05 07:00:00,,17.9255622612057 +2017-03-05 08:00:00,,18.804279671301984 +2017-03-05 09:00:00,,19.370077933279017 +2017-03-05 10:00:00,,19.776342117143333 +2017-03-05 11:00:00,,19.312671543528573 +2017-03-05 12:00:00,7.433735,7.433735 +2017-03-05 13:00:00,19.3204478,19.3204478 +2017-03-05 14:00:00,22.527477800000003,22.527477800000003 +2017-03-05 15:00:00,35.4461006,35.4461006 +2017-03-05 16:00:00,30.9992522,30.9992522 +2017-03-05 17:00:00,33.027790100000004,33.027790100000004 +2017-03-05 18:00:00,14.2980989,14.2980989 +2017-03-05 19:00:00,3.3476417,3.3476417 +2017-03-05 20:00:00,33.22433,33.22433 +2017-03-05 21:00:00,75.121625,75.121625 +2017-03-05 22:00:00,70.4555156,70.4555156 +2017-03-05 23:00:00,23.4362105,23.4362105 +2017-03-06 00:00:00,39.89417329999999,39.89417329999999 +2017-03-06 01:00:00,,30.809474252735566 +2017-03-06 02:00:00,,28.819287495176667 +2017-03-06 03:00:00,,27.500438560234645 +2017-03-06 04:00:00,,26.33848818043041 +2017-03-06 05:00:00,,25.281131623683343 +2017-03-06 06:00:00,,24.3402892867929 +2017-03-06 07:00:00,,23.273346146766297 +2017-03-06 08:00:00,,21.82976216334464 +2017-03-06 09:00:00,,19.158054029066697 +2017-03-06 10:00:00,1.1220551,1.1220551 +2017-03-06 11:00:00,4.8949660999999995,4.8949660999999995 +2017-03-06 12:00:00,15.691193300000002,15.691193300000002 +2017-03-06 13:00:00,22.9187927,22.9187927 +2017-03-06 14:00:00,28.0115945,28.0115945 +2017-03-06 15:00:00,29.153755100000005,29.153755100000005 +2017-03-06 16:00:00,34.0920566,34.0920566 +2017-03-06 17:00:00,43.66644829999999,43.66644829999999 +2017-03-06 18:00:00,17.7342161,17.7342161 +2017-03-06 19:00:00,21.7862039,21.7862039 +2017-03-06 20:00:00,29.581019899999998,29.581019899999998 +2017-03-06 21:00:00,7.9225805,7.9225805 +2017-03-06 22:00:00,25.1486723,25.1486723 +2017-03-06 23:00:00,55.228419499999994,55.228419499999994 +2017-03-07 00:00:00,6.7279817,6.7279817 +2017-03-07 01:00:00,37.726923799999994,37.726923799999994 +2017-03-07 02:00:00,23.7613655,23.7613655 +2017-03-07 03:00:00,39.7508189,39.7508189 +2017-03-07 04:00:00,30.0819017,30.0819017 +2017-03-07 05:00:00,44.423622200000004,44.423622200000004 +2017-03-07 06:00:00,9.598233800000001,9.598233800000001 +2017-03-07 07:00:00,5.379455,5.379455 +2017-03-07 08:00:00,2.7878345,2.7878345 +2017-03-07 09:00:00,11.094916699999999,11.094916699999999 +2017-03-07 10:00:00,23.9869706,23.9869706 +2017-03-07 11:00:00,27.3671039,27.3671039 +2017-03-07 12:00:00,23.6242439,23.6242439 +2017-03-07 13:00:00,31.78538,31.78538 +2017-03-07 14:00:00,16.703260099999998,16.703260099999998 +2017-03-07 15:00:00,8.3250095,8.3250095 +2017-03-07 16:00:00,7.3667006,7.3667006 +2017-03-07 17:00:00,6.634473799999999,6.634473799999999 +2017-03-07 18:00:00,5.442975499999999,5.442975499999999 +2017-03-07 19:00:00,3.8263112,3.8263112 +2017-03-07 20:00:00,2.4208466,2.4208466 +2017-03-07 21:00:00,3.0172237999999996,3.0172237999999996 +2017-03-07 22:00:00,51.4232156,51.4232156 +2017-03-07 23:00:00,37.5172823,37.5172823 +2017-03-08 00:00:00,,21.408814908452538 +2017-03-08 01:00:00,,18.81763348352923 +2017-03-08 02:00:00,,17.44169794363469 +2017-03-08 03:00:00,,16.414601194734434 +2017-03-08 04:00:00,,15.498488110544743 +2017-03-08 05:00:00,,14.528555186815629 +2017-03-08 06:00:00,,13.667987241474231 +2017-03-08 07:00:00,,12.908991974009343 +2017-03-08 08:00:00,,11.997892571948626 +2017-03-08 09:00:00,,10.805974260076749 +2017-03-08 10:00:00,,9.292920484528054 +2017-03-08 11:00:00,3.5783188999999997,3.5783188999999997 +2017-03-08 12:00:00,1.9772683999999998,1.9772683999999998 +2017-03-08 13:00:00,1.5667621999999999,1.5667621999999999 +2017-03-08 14:00:00,2.8084727000000003,2.8084727000000003 +2017-03-08 15:00:00,12.1220567,12.1220567 +2017-03-08 16:00:00,20.5381016,20.5381016 +2017-03-08 17:00:00,4.5695249,4.5695249 +2017-03-08 18:00:00,3.609785,3.609785 +2017-03-08 19:00:00,2.4947339,2.4947339 +2017-03-08 20:00:00,2.4186206,2.4186206 +2017-03-08 21:00:00,0.6076901,0.6076901 +2017-03-08 22:00:00,,8.782541272356866 +2017-03-08 23:00:00,,10.995502337285217 +2017-03-09 00:00:00,15.7198133,15.7198133 +2017-03-09 01:00:00,,12.393522032834259 +2017-03-09 02:00:00,,12.439462199730086 +2017-03-09 03:00:00,,12.590841441279105 +2017-03-09 04:00:00,,12.938107176857246 +2017-03-09 05:00:00,,13.215498233483153 +2017-03-09 06:00:00,,13.653016452722168 +2017-03-09 07:00:00,,14.003847281001658 +2017-03-09 08:00:00,,14.653177779264592 +2017-03-09 09:00:00,,14.850327526159942 +2017-03-09 10:00:00,,14.80344151592412 +2017-03-09 11:00:00,,14.572531021621783 +2017-03-09 12:00:00,,12.934045280200221 +2017-03-09 13:00:00,1.1068706,1.1068706 +2017-03-09 14:00:00,11.7964883,11.7964883 +2017-03-09 15:00:00,14.460819500000001,14.460819500000001 +2017-03-09 16:00:00,12.431613800000001,12.431613800000001 +2017-03-09 17:00:00,5.9549078,5.9549078 +2017-03-09 18:00:00,28.2409838,28.2409838 +2017-03-09 19:00:00,18.6218177,18.6218177 +2017-03-09 20:00:00,15.775415599999999,15.775415599999999 +2017-03-09 21:00:00,10.5425984,10.5425984 +2017-03-09 22:00:00,8.718502699999998,8.718502699999998 +2017-03-09 23:00:00,3.5574421999999997,3.5574421999999997 +2017-03-10 00:00:00,19.358814499999998,19.358814499999998 +2017-03-10 01:00:00,,20.884499015244096 +2017-03-10 02:00:00,27.9532733,27.9532733 +2017-03-10 03:00:00,11.845905499999999,11.845905499999999 +2017-03-10 04:00:00,55.6051223,55.6051223 +2017-03-10 05:00:00,59.354644400000005,59.354644400000005 +2017-03-10 06:00:00,23.911986199999998,23.911986199999998 +2017-03-10 07:00:00,,23.498502586424184 +2017-03-10 08:00:00,1.2699728000000001,1.2699728000000001 +2017-03-10 09:00:00,23.384233399999996,23.384233399999996 +2017-03-10 10:00:00,28.806642200000002,28.806642200000002 +2017-03-10 11:00:00,30.010097299999998,30.010097299999998 +2017-03-10 12:00:00,26.204352800000002,26.204352800000002 +2017-03-10 13:00:00,20.6290178,20.6290178 +2017-03-10 14:00:00,24.862011199999998,24.862011199999998 +2017-03-10 15:00:00,27.4937951,27.4937951 +2017-03-10 16:00:00,20.0513867,20.0513867 +2017-03-10 17:00:00,23.9638838,23.9638838 +2017-03-10 18:00:00,9.6183155,9.6183155 +2017-03-10 19:00:00,29.6975828,29.6975828 +2017-03-10 20:00:00,25.2432455,25.2432455 +2017-03-10 21:00:00,65.5573139,65.5573139 +2017-03-10 22:00:00,27.0315662,27.0315662 +2017-03-10 23:00:00,18.1007588,18.1007588 +2017-03-11 00:00:00,38.9116805,38.9116805 +2017-03-11 01:00:00,2.5596695,2.5596695 +2017-03-11 02:00:00,,25.287739460403092 +2017-03-11 03:00:00,,27.33883270481039 +2017-03-11 04:00:00,,28.268956646226783 +2017-03-11 05:00:00,,28.804420295772413 +2017-03-11 06:00:00,,28.62063763575523 +2017-03-11 07:00:00,,27.89845030789892 +2017-03-11 08:00:00,,25.386439442049774 +2017-03-11 09:00:00,0.3726722,0.3726722 +2017-03-11 10:00:00,7.699519400000001,7.699519400000001 +2017-03-11 11:00:00,29.7086651,29.7086651 +2017-03-11 12:00:00,35.250498799999995,35.250498799999995 +2017-03-11 13:00:00,44.546465600000005,44.546465600000005 +2017-03-11 14:00:00,38.3023289,38.3023289 +2017-03-11 15:00:00,50.2919783,50.2919783 +2017-03-11 16:00:00,42.74684,42.74684 +2017-03-11 17:00:00,51.0160961,51.0160961 +2017-03-11 18:00:00,10.549260499999999,10.549260499999999 +2017-03-11 19:00:00,30.5604122,30.5604122 +2017-03-11 20:00:00,72.44686340000001,72.44686340000001 +2017-03-11 21:00:00,67.13567509999999,67.13567509999999 +2017-03-11 22:00:00,43.194425,43.194425 +2017-03-11 23:00:00,13.992230599999997,13.992230599999997 +2017-03-12 00:00:00,4.462358900000001,4.462358900000001 +2017-03-12 01:00:00,55.662203299999994,55.662203299999994 +2017-03-12 02:00:00,31.3911395,31.3911395 +2017-03-12 03:00:00,64.28208620000001,64.28208620000001 +2017-03-12 04:00:00,47.672373799999995,47.672373799999995 +2017-03-12 05:00:00,50.0084972,50.0084972 +2017-03-12 06:00:00,26.695710499999997,26.695710499999997 +2017-03-12 07:00:00,20.3909789,20.3909789 +2017-03-12 08:00:00,30.8616695,30.8616695 +2017-03-12 09:00:00,55.25042510000001,55.25042510000001 +2017-03-12 10:00:00,41.996693900000004,41.996693900000004 +2017-03-12 11:00:00,27.0593117,27.0593117 +2017-03-12 12:00:00,18.9774212,18.9774212 +2017-03-12 13:00:00,12.223323800000001,12.223323800000001 +2017-03-12 14:00:00,18.268122199999997,18.268122199999997 +2017-03-12 15:00:00,40.115644399999994,40.115644399999994 +2017-03-12 16:00:00,38.6861072,38.6861072 +2017-03-12 17:00:00,35.0127461,35.0127461 +2017-03-12 18:00:00,36.55316989999999,36.55316989999999 +2017-03-12 19:00:00,25.2313205,25.2313205 +2017-03-12 20:00:00,29.306617699999997,29.306617699999997 +2017-03-12 21:00:00,73.9435622,73.9435622 +2017-03-12 22:00:00,38.858495,38.858495 +2017-03-12 23:00:00,6.270522799999999,6.270522799999999 +2017-03-13 00:00:00,10.352847800000001,10.352847800000001 +2017-03-13 01:00:00,29.5078799,29.5078799 +2017-03-13 02:00:00,46.1167973,46.1167973 +2017-03-13 03:00:00,9.016707199999999,9.016707199999999 +2017-03-13 04:00:00,0.0231584,0.0231584 +2017-03-13 05:00:00,,22.38006167266649 +2017-03-13 06:00:00,,23.812128796842078 +2017-03-13 07:00:00,,23.715242873995788 +2017-03-13 08:00:00,,22.81931145928329 +2017-03-13 09:00:00,,20.86222658843775 +2017-03-13 10:00:00,2.2257377,2.2257377 +2017-03-13 11:00:00,15.7463822,15.7463822 +2017-03-13 12:00:00,10.19795,10.19795 +2017-03-13 13:00:00,12.4721588,12.4721588 +2017-03-13 14:00:00,25.2163745,25.2163745 +2017-03-13 15:00:00,36.5618672,36.5618672 +2017-03-13 16:00:00,32.508829999999996,32.508829999999996 +2017-03-13 17:00:00,24.7774073,24.7774073 +2017-03-13 18:00:00,43.494935,43.494935 +2017-03-13 19:00:00,54.348322700000004,54.348322700000004 +2017-03-13 20:00:00,31.5676295,31.5676295 +2017-03-13 21:00:00,41.563752799999996,41.563752799999996 +2017-03-13 22:00:00,66.36926329999999,66.36926329999999 +2017-03-13 23:00:00,24.8191289,24.8191289 +2017-03-14 00:00:00,4.9320449,4.9320449 +2017-03-14 01:00:00,30.325171700000002,30.325171700000002 +2017-03-14 02:00:00,55.2559106,55.2559106 +2017-03-14 03:00:00,23.3894327,23.3894327 +2017-03-14 04:00:00,1.5345806,1.5345806 +2017-03-14 05:00:00,36.468677299999996,36.468677299999996 +2017-03-14 06:00:00,31.747967300000003,31.747967300000003 +2017-03-14 07:00:00,3.8961122,3.8961122 +2017-03-14 08:00:00,0.5719151,0.5719151 +2017-03-14 09:00:00,1.6644994999999998,1.6644994999999998 +2017-03-14 10:00:00,11.302793300000001,11.302793300000001 +2017-03-14 11:00:00,30.6414545,30.6414545 +2017-03-14 12:00:00,27.488532199999998,27.488532199999998 +2017-03-14 13:00:00,21.503899399999998,21.503899399999998 +2017-03-14 14:00:00,20.6212427,20.6212427 +2017-03-14 15:00:00,21.1225538,21.1225538 +2017-03-14 16:00:00,20.7937895,20.7937895 +2017-03-14 17:00:00,19.6134212,19.6134212 +2017-03-14 18:00:00,23.995047800000002,23.995047800000002 +2017-03-14 19:00:00,17.166331699999997,17.166331699999997 +2017-03-14 20:00:00,38.8320851,38.8320851 +2017-03-14 21:00:00,54.4231799,54.4231799 +2017-03-14 22:00:00,34.4673284,34.4673284 +2017-03-14 23:00:00,11.5573205,11.5573205 +2017-03-15 00:00:00,16.8877478,16.8877478 +2017-03-15 01:00:00,3.1837127,3.1837127 +2017-03-15 02:00:00,1.5775106,1.5775106 +2017-03-15 03:00:00,1.4061721999999999,1.4061721999999999 +2017-03-15 04:00:00,1.1592133999999998,1.1592133999999998 +2017-03-15 05:00:00,1.081685,1.081685 +2017-03-15 06:00:00,0.9253562,0.9253562 +2017-03-15 07:00:00,0.39041659999999995,0.39041659999999995 +2017-03-15 08:00:00,0.4724288,0.4724288 +2017-03-15 09:00:00,0.8223401,0.8223401 +2017-03-15 10:00:00,2.6846912,2.6846912 +2017-03-15 11:00:00,6.2306137999999995,6.2306137999999995 +2017-03-15 12:00:00,8.660674400000001,8.660674400000001 +2017-03-15 13:00:00,14.0703473,14.0703473 +2017-03-15 14:00:00,20.4329867,20.4329867 +2017-03-15 15:00:00,13.489075099999999,13.489075099999999 +2017-03-15 16:00:00,33.223789399999994,33.223789399999994 +2017-03-15 17:00:00,40.935829999999996,40.935829999999996 +2017-03-15 18:00:00,17.851415,17.851415 +2017-03-15 19:00:00,7.8441617,7.8441617 +2017-03-15 20:00:00,28.972081699999997,28.972081699999997 +2017-03-15 21:00:00,16.643062699999998,16.643062699999998 +2017-03-15 22:00:00,11.8596272,11.8596272 +2017-03-15 23:00:00,28.2629099,28.2629099 +2017-03-16 00:00:00,,12.926660070775446 +2017-03-16 01:00:00,1.3140317,1.3140317 +2017-03-16 02:00:00,7.9400705,7.9400705 +2017-03-16 03:00:00,22.7854712,22.7854712 +2017-03-16 04:00:00,2.773445,2.773445 +2017-03-16 05:00:00,1.7417894,1.7417894 +2017-03-16 06:00:00,,7.846932840055195 +2017-03-16 07:00:00,,7.838041614400938 +2017-03-16 08:00:00,,6.950881197201061 +2017-03-16 09:00:00,0.19413110000000003,0.19413110000000003 +2017-03-16 10:00:00,1.4194328,1.4194328 +2017-03-16 11:00:00,2.3597906,2.3597906 +2017-03-16 12:00:00,11.8596272,11.8596272 +2017-03-16 13:00:00,20.440984399999998,20.440984399999998 +2017-03-16 14:00:00,6.0705962,6.0705962 +2017-03-16 15:00:00,5.4673184,5.4673184 +2017-03-16 16:00:00,6.1126994,6.1126994 +2017-03-16 17:00:00,5.447204900000001,5.447204900000001 +2017-03-16 18:00:00,1.6921178,1.6921178 +2017-03-16 19:00:00,1.5003638000000001,1.5003638000000001 +2017-03-16 20:00:00,0.6070223000000001,0.6070223000000001 +2017-03-16 21:00:00,,5.416407957414338 +2017-03-16 22:00:00,,6.082818892006621 +2017-03-16 23:00:00,,6.326291058427343 +2017-03-17 00:00:00,,6.316499650669665 +2017-03-17 01:00:00,,6.0077869658272 +2017-03-17 02:00:00,3.9248117,3.9248117 +2017-03-17 03:00:00,3.5973512000000003,3.5973512000000003 +2017-03-17 04:00:00,1.6129993999999999,1.6129993999999999 +2017-03-17 05:00:00,,6.317817361838833 +2017-03-17 06:00:00,,7.131340368626653 +2017-03-17 07:00:00,,7.340953224175668 +2017-03-17 08:00:00,,7.382784052685594 +2017-03-17 09:00:00,,7.603937292182394 +2017-03-17 10:00:00,,7.486475986593715 +2017-03-17 11:00:00,,6.796014190622108 +2017-03-17 12:00:00,0.1764344,0.1764344 +2017-03-17 13:00:00,5.2748489,5.2748489 +2017-03-17 14:00:00,15.263562799999999,15.263562799999999 +2017-03-17 15:00:00,14.079092300000001,14.079092300000001 +2017-03-17 16:00:00,13.9104251,13.9104251 +2017-03-17 17:00:00,13.0617149,13.0617149 +2017-03-17 18:00:00,4.105483400000001,4.105483400000001 +2017-03-17 19:00:00,1.9836284,1.9836284 +2017-03-17 20:00:00,0.4966127,0.4966127 +2017-03-17 21:00:00,0.4657349,0.4657349 +2017-03-17 22:00:00,,6.0829530606515085 +2017-03-17 23:00:00,,6.429800331746077 +2017-03-18 00:00:00,0.8226899,0.8226899 +2017-03-18 01:00:00,,7.225919348454853 +2017-03-18 02:00:00,,8.573444392234176 +2017-03-18 03:00:00,,9.370049947442189 +2017-03-18 04:00:00,,9.951160581097485 +2017-03-18 05:00:00,,10.3438189155107 +2017-03-18 06:00:00,,10.586383144589133 +2017-03-18 07:00:00,,10.870952585668988 +2017-03-18 08:00:00,,11.069515984430542 +2017-03-18 09:00:00,,11.134130672427583 +2017-03-18 10:00:00,,10.69441384747282 +2017-03-18 11:00:00,4.469180000000001,4.469180000000001 +2017-03-18 12:00:00,7.535781200000001,7.535781200000001 +2017-03-18 13:00:00,7.617252799999999,7.617252799999999 +2017-03-18 14:00:00,12.789268400000001,12.789268400000001 +2017-03-18 15:00:00,21.173386100000002,21.173386100000002 +2017-03-18 16:00:00,25.0245251,25.0245251 +2017-03-18 17:00:00,47.8264766,47.8264766 +2017-03-18 18:00:00,41.6896967,41.6896967 +2017-03-18 19:00:00,7.175185099999999,7.175185099999999 +2017-03-18 20:00:00,4.6686773,4.6686773 +2017-03-18 21:00:00,15.281466199999999,15.281466199999999 +2017-03-18 22:00:00,32.589125,32.589125 +2017-03-18 23:00:00,1.7037089,1.7037089 +2017-03-19 00:00:00,,11.548590712702552 +2017-03-19 01:00:00,2.8189667000000003,2.8189667000000003 +2017-03-19 02:00:00,,11.326935901916501 +2017-03-19 03:00:00,,12.147899894947487 +2017-03-19 04:00:00,,12.346001416315282 +2017-03-19 05:00:00,,12.36716598874294 +2017-03-19 06:00:00,,12.221111773187458 +2017-03-19 07:00:00,,11.840427669694783 +2017-03-19 08:00:00,,10.921064482829411 +2017-03-19 09:00:00,0.40292990000000006,0.40292990000000006 +2017-03-19 10:00:00,12.7022795,12.7022795 +2017-03-19 11:00:00,29.8493006,29.8493006 +2017-03-19 12:00:00,6.25793,6.25793 +2017-03-19 13:00:00,20.903292800000003,20.903292800000003 +2017-03-19 14:00:00,24.3673622,24.3673622 +2017-03-19 15:00:00,23.8288451,23.8288451 +2017-03-19 16:00:00,7.7441666,7.7441666 +2017-03-19 17:00:00,7.057986200000001,7.057986200000001 +2017-03-19 18:00:00,4.956769400000001,4.956769400000001 +2017-03-19 19:00:00,2.8989278,2.8989278 +2017-03-19 20:00:00,2.2232572999999998,2.2232572999999998 +2017-03-19 21:00:00,1.2426883999999998,1.2426883999999998 +2017-03-19 22:00:00,0.17618,0.17618 +2017-03-19 23:00:00,0.20982440000000002,0.20982440000000002 +2017-03-20 00:00:00,,7.281266361567549 +2017-03-20 01:00:00,,8.943704334431043 +2017-03-20 02:00:00,,9.944380103018709 +2017-03-20 03:00:00,,10.805011931870114 +2017-03-20 04:00:00,,11.507141185412145 +2017-03-20 05:00:00,,11.874932841777927 +2017-03-20 06:00:00,,11.98268511841565 +2017-03-20 07:00:00,,11.98603392635814 +2017-03-20 08:00:00,,12.214873446703939 +2017-03-20 09:00:00,,12.200357021851694 +2017-03-20 10:00:00,,11.973759246359206 +2017-03-20 11:00:00,,11.120794251882485 +2017-03-20 12:00:00,2.7272873,2.7272873 +2017-03-20 13:00:00,12.6940433,12.6940433 +2017-03-20 14:00:00,9.2841134,9.2841134 +2017-03-20 15:00:00,8.912641699999998,8.912641699999998 +2017-03-20 16:00:00,15.5858399,15.5858399 +2017-03-20 17:00:00,21.042719899999998,21.042719899999998 +2017-03-20 18:00:00,28.8926294,28.8926294 +2017-03-20 19:00:00,7.5061595,7.5061595 +2017-03-20 20:00:00,3.6345572,3.6345572 +2017-03-20 21:00:00,1.8075676999999999,1.8075676999999999 +2017-03-20 22:00:00,0.5351384,0.5351384 +2017-03-20 23:00:00,0.055673900000000005,0.055673900000000005 +2017-03-21 00:00:00,27.663559399999997,27.663559399999997 +2017-03-21 01:00:00,,17.178268260298942 +2017-03-21 02:00:00,,17.509729775307992 +2017-03-21 03:00:00,,18.173548654054525 +2017-03-21 04:00:00,,18.786427502142125 +2017-03-21 05:00:00,,19.239800258084816 +2017-03-21 06:00:00,,19.389590725399852 +2017-03-21 07:00:00,18.6300539,18.6300539 +2017-03-21 08:00:00,13.3061138,13.3061138 +2017-03-21 09:00:00,,18.19731872938381 +2017-03-21 10:00:00,0.28932440000000004,0.28932440000000004 +2017-03-21 11:00:00,5.802474500000001,5.802474500000001 +2017-03-21 12:00:00,26.9559299,26.9559299 +2017-03-21 13:00:00,44.930784499999994,44.930784499999994 +2017-03-21 14:00:00,47.355709399999995,47.355709399999995 +2017-03-21 15:00:00,34.31615120000001,34.31615120000001 +2017-03-21 16:00:00,45.108912200000006,45.108912200000006 +2017-03-21 17:00:00,46.066044500000004,46.066044500000004 +2017-03-21 18:00:00,26.9920706,26.9920706 +2017-03-21 19:00:00,11.3349749,11.3349749 +2017-03-21 20:00:00,30.7326728,30.7326728 +2017-03-21 21:00:00,59.7653573,59.7653573 +2017-03-21 22:00:00,10.8574184,10.8574184 +2017-03-21 23:00:00,9.798860000000001,9.798860000000001 +2017-03-22 00:00:00,,32.48822018927855 +2017-03-22 01:00:00,19.020239899999996,19.020239899999996 +2017-03-22 02:00:00,76.1612306,76.1612306 +2017-03-22 03:00:00,108.2513738,108.2513738 +2017-03-22 04:00:00,,52.88630076873603 +2017-03-22 05:00:00,,45.531510094194076 +2017-03-22 06:00:00,,42.43590431515314 +2017-03-22 07:00:00,,40.77035212387405 +2017-03-22 08:00:00,,40.608400801786566 +2017-03-22 09:00:00,,40.38174131334391 +2017-03-22 10:00:00,,40.11138386316771 +2017-03-22 11:00:00,,39.900960443145124 +2017-03-22 12:00:00,,39.663275431107316 +2017-03-22 13:00:00,,39.48863461878637 +2017-03-22 14:00:00,,39.26582017345808 +2017-03-22 15:00:00,,39.42438567112888 +2017-03-22 16:00:00,,39.925173514361404 +2017-03-22 17:00:00,,40.46311471824708 +2017-03-22 18:00:00,,41.2310702297528 +2017-03-22 19:00:00,,42.26765825155948 +2017-03-22 20:00:00,,43.11161014779626 +2017-03-22 21:00:00,,44.186853948619145 +2017-03-22 22:00:00,,46.11761397741471 +2017-03-22 23:00:00,,50.603832676621074 +2017-03-23 00:00:00,72.67717490000001,72.67717490000001 +2017-03-23 01:00:00,,50.44782443688863 +2017-03-23 02:00:00,,45.68973228806563 +2017-03-23 03:00:00,,43.87061967979031 +2017-03-23 04:00:00,,42.72223899758858 +2017-03-23 05:00:00,,41.763159940922165 +2017-03-23 06:00:00,,40.40491765436948 +2017-03-23 07:00:00,,38.9487183078596 +2017-03-23 08:00:00,,37.359949367295435 +2017-03-23 09:00:00,,35.11065514027195 +2017-03-23 10:00:00,,31.0888120939809 +2017-03-23 11:00:00,7.641818300000001,7.641818300000001 +2017-03-23 12:00:00,11.2431206,11.2431206 +2017-03-23 13:00:00,23.745624499999998,23.745624499999998 +2017-03-23 14:00:00,32.014340000000004,32.014340000000004 +2017-03-23 15:00:00,35.7511739,35.7511739 +2017-03-23 16:00:00,39.547632799999995,39.547632799999995 +2017-03-23 17:00:00,17.2601417,17.2601417 +2017-03-23 18:00:00,12.952625,12.952625 +2017-03-23 19:00:00,69.76450159999999,69.76450159999999 +2017-03-23 20:00:00,146.3089778,146.3089778 +2017-03-23 21:00:00,122.44089950000001,122.44089950000001 +2017-03-23 22:00:00,94.6146911,94.6146911 +2017-03-23 23:00:00,96.0902588,96.0902588 +2017-03-24 00:00:00,2.6984605999999998,2.6984605999999998 +2017-03-24 01:00:00,78.4055156,78.4055156 +2017-03-24 02:00:00,88.3865339,88.3865339 +2017-03-24 03:00:00,44.91660170000001,44.91660170000001 +2017-03-24 04:00:00,13.254518300000003,13.254518300000003 +2017-03-24 05:00:00,4.7674799000000005,4.7674799000000005 +2017-03-24 06:00:00,0.22731439999999997,0.22731439999999997 +2017-03-24 07:00:00,,24.391880208473943 +2017-03-24 08:00:00,4.1085362000000005,4.1085362000000005 +2017-03-24 09:00:00,2.6500928,2.6500928 +2017-03-24 10:00:00,9.0708149,9.0708149 +2017-03-24 11:00:00,28.870115000000002,28.870115000000002 +2017-03-24 12:00:00,24.2221634,24.2221634 +2017-03-24 13:00:00,35.2307828,35.2307828 +2017-03-24 14:00:00,47.753288899999994,47.753288899999994 +2017-03-24 15:00:00,41.501075,41.501075 +2017-03-24 16:00:00,36.632495,36.632495 +2017-03-24 17:00:00,34.018280600000004,34.018280600000004 +2017-03-24 18:00:00,38.51317879999999,38.51317879999999 +2017-03-24 19:00:00,30.9375761,30.9375761 +2017-03-24 20:00:00,41.7066461,41.7066461 +2017-03-24 21:00:00,10.2638873,10.2638873 +2017-03-24 22:00:00,6.715468400000001,6.715468400000001 +2017-03-24 23:00:00,4.475078900000001,4.475078900000001 +2017-03-25 00:00:00,5.199832700000001,5.199832700000001 +2017-03-25 01:00:00,2.5597649,2.5597649 +2017-03-25 02:00:00,28.0975022,28.0975022 +2017-03-25 03:00:00,57.51630229999999,57.51630229999999 +2017-03-25 04:00:00,42.748684399999995,42.748684399999995 +2017-03-25 05:00:00,21.0599078,21.0599078 +2017-03-25 06:00:00,33.0457094,33.0457094 +2017-03-25 07:00:00,25.8986117,25.8986117 +2017-03-25 08:00:00,36.4176701,36.4176701 +2017-03-25 09:00:00,4.0300856,4.0300856 +2017-03-25 10:00:00,3.4556822,3.4556822 +2017-03-25 11:00:00,9.1574222,9.1574222 +2017-03-25 12:00:00,50.4111806,50.4111806 +2017-03-25 13:00:00,60.242071100000004,60.242071100000004 +2017-03-25 14:00:00,56.181831200000005,56.181831200000005 +2017-03-25 15:00:00,45.8466722,45.8466722 +2017-03-25 16:00:00,54.8127299,54.8127299 +2017-03-25 17:00:00,26.901313399999996,26.901313399999996 +2017-03-25 18:00:00,15.390174499999999,15.390174499999999 +2017-03-25 19:00:00,12.1914761,12.1914761 +2017-03-25 20:00:00,10.4828462,10.4828462 +2017-03-25 21:00:00,8.1351794,8.1351794 +2017-03-25 22:00:00,7.0925050999999995,7.0925050999999995 +2017-03-25 23:00:00,6.2683127,6.2683127 +2017-03-26 00:00:00,4.4817728,4.4817728 +2017-03-26 01:00:00,3.7133894,3.7133894 +2017-03-26 02:00:00,3.7606282999999996,3.7606282999999996 +2017-03-26 03:00:00,2.6517623,2.6517623 +2017-03-26 04:00:00,14.6592356,14.6592356 +2017-03-26 05:00:00,21.1404572,21.1404572 +2017-03-26 06:00:00,17.0714405,17.0714405 +2017-03-26 07:00:00,12.600646699999999,12.600646699999999 +2017-03-26 08:00:00,27.3241262,27.3241262 +2017-03-26 09:00:00,28.7800733,28.7800733 +2017-03-26 10:00:00,52.313075,52.313075 +2017-03-26 11:00:00,69.19892270000001,69.19892270000001 +2017-03-26 12:00:00,66.561065,66.561065 +2017-03-26 13:00:00,62.3082284,62.3082284 +2017-03-26 14:00:00,63.0516806,63.0516806 +2017-03-26 15:00:00,65.08136329999999,65.08136329999999 +2017-03-26 16:00:00,58.26365,58.26365 +2017-03-26 17:00:00,62.6430983,62.6430983 +2017-03-26 18:00:00,22.8230906,22.8230906 +2017-03-26 19:00:00,10.9591784,10.9591784 +2017-03-26 20:00:00,8.585642300000002,8.585642300000002 +2017-03-26 21:00:00,15.2708927,15.2708927 +2017-03-26 22:00:00,9.2909345,9.2909345 +2017-03-26 23:00:00,4.713960500000001,4.713960500000001 +2017-03-27 00:00:00,4.0331383999999995,4.0331383999999995 +2017-03-27 01:00:00,3.7573211000000004,3.7573211000000004 +2017-03-27 02:00:00,9.5103545,9.5103545 +2017-03-27 03:00:00,14.6571845,14.6571845 +2017-03-27 04:00:00,3.6262733,3.6262733 +2017-03-27 05:00:00,9.1999388,9.1999388 +2017-03-27 06:00:00,14.961876199999999,14.961876199999999 +2017-03-27 07:00:00,11.7675344,11.7675344 +2017-03-27 08:00:00,14.405837300000002,14.405837300000002 +2017-03-27 09:00:00,20.257339399999996,20.257339399999996 +2017-03-27 10:00:00,38.963562200000005,38.963562200000005 +2017-03-27 11:00:00,42.604614500000004,42.604614500000004 +2017-03-27 12:00:00,57.763642700000005,57.763642700000005 +2017-03-27 13:00:00,52.7139299,52.7139299 +2017-03-27 14:00:00,51.4795811,51.4795811 +2017-03-27 15:00:00,48.4556555,48.4556555 +2017-03-27 16:00:00,50.8689416,50.8689416 +2017-03-27 17:00:00,48.7049039,48.7049039 +2017-03-27 18:00:00,14.3407745,14.3407745 +2017-03-27 19:00:00,9.8984894,9.8984894 +2017-03-27 20:00:00,7.6978022,7.6978022 +2017-03-27 21:00:00,6.332119400000001,6.332119400000001 +2017-03-27 22:00:00,5.5166561,5.5166561 +2017-03-27 23:00:00,4.801156099999999,4.801156099999999 +2017-03-28 00:00:00,5.9489294,5.9489294 +2017-03-28 01:00:00,3.7962761,3.7962761 +2017-03-28 02:00:00,2.4118472,2.4118472 +2017-03-28 03:00:00,1.7370511999999998,1.7370511999999998 +2017-03-28 04:00:00,0.6498728,0.6498728 +2017-03-28 05:00:00,,17.073385028841574 +2017-03-28 06:00:00,,20.011903954054905 +2017-03-28 07:00:00,,20.99331645280798 +2017-03-28 08:00:00,3.5376467000000003,3.5376467000000003 +2017-03-28 09:00:00,28.5126989,28.5126989 +2017-03-28 10:00:00,73.53375559999999,73.53375559999999 +2017-03-28 11:00:00,21.367032199999997,21.367032199999997 +2017-03-28 12:00:00,15.9464678,15.9464678 +2017-03-28 13:00:00,38.6742299,38.6742299 +2017-03-28 14:00:00,63.4731101,63.4731101 +2017-03-28 15:00:00,70.4621777,70.4621777 +2017-03-28 16:00:00,58.809735499999995,58.809735499999995 +2017-03-28 17:00:00,55.919862800000004,55.919862800000004 +2017-03-28 18:00:00,26.7745745,26.7745745 +2017-03-28 19:00:00,13.9005989,13.9005989 +2017-03-28 20:00:00,11.297562199999998,11.297562199999998 +2017-03-28 21:00:00,8.5724294,8.5724294 +2017-03-28 22:00:00,7.6988516,7.6988516 +2017-03-28 23:00:00,6.3145499,6.3145499 +2017-03-29 00:00:00,3.2643416000000003,3.2643416000000003 +2017-03-29 01:00:00,5.7239762,5.7239762 +2017-03-29 02:00:00,5.6174939,5.6174939 +2017-03-29 03:00:00,19.9926362,19.9926362 +2017-03-29 04:00:00,3.4916638999999994,3.4916638999999994 +2017-03-29 05:00:00,0.0274355,0.0274355 +2017-03-29 06:00:00,,15.630435360146487 +2017-03-29 07:00:00,,18.022843449503235 +2017-03-29 08:00:00,,18.87206969158573 +2017-03-29 09:00:00,4.182980000000001,4.182980000000001 +2017-03-29 10:00:00,34.3195856,34.3195856 +2017-03-29 11:00:00,47.9777333,47.9777333 +2017-03-29 12:00:00,10.0623389,10.0623389 +2017-03-29 13:00:00,13.121212699999997,13.121212699999997 +2017-03-29 14:00:00,19.318985,19.318985 +2017-03-29 15:00:00,57.6436295,57.6436295 +2017-03-29 16:00:00,71.281775,71.281775 +2017-03-29 17:00:00,58.23975229999999,58.23975229999999 +2017-03-29 18:00:00,13.740183800000002,13.740183800000002 +2017-03-29 19:00:00,9.8899988,9.8899988 +2017-03-29 20:00:00,8.2093688,8.2093688 +2017-03-29 21:00:00,6.6265238,6.6265238 +2017-03-29 22:00:00,5.916875,5.916875 +2017-03-29 23:00:00,5.649755,5.649755 +2017-03-30 00:00:00,8.2299116,8.2299116 +2017-03-30 01:00:00,3.2742473,3.2742473 +2017-03-30 02:00:00,1.5397322,1.5397322 +2017-03-30 03:00:00,0.9148145000000001,0.9148145000000001 +2017-03-30 04:00:00,,12.749563987134355 +2017-03-30 05:00:00,,13.54691474565248 +2017-03-30 06:00:00,0.28568330000000003,0.28568330000000003 +2017-03-30 07:00:00,,16.57814651303806 +2017-03-30 08:00:00,,18.4546715738197 +2017-03-30 09:00:00,7.5604739,7.5604739 +2017-03-30 10:00:00,8.9507222,8.9507222 +2017-03-30 11:00:00,37.3848989,37.3848989 +2017-03-30 12:00:00,42.6986789,42.6986789 +2017-03-30 13:00:00,62.8573667,62.8573667 +2017-03-30 14:00:00,70.16685109999999,70.16685109999999 +2017-03-30 15:00:00,41.4358055,41.4358055 +2017-03-30 16:00:00,20.9653823,20.9653823 +2017-03-30 17:00:00,19.5963923,19.5963923 +2017-03-30 18:00:00,15.365736199999999,15.365736199999999 +2017-03-30 19:00:00,12.4626506,12.4626506 +2017-03-30 20:00:00,10.633323800000001,10.633323800000001 +2017-03-30 21:00:00,6.2365445,6.2365445 +2017-03-30 22:00:00,5.5657394,5.5657394 +2017-03-30 23:00:00,5.9472917,5.9472917 +2017-03-31 00:00:00,5.5123472,5.5123472 +2017-03-31 01:00:00,7.0308767,7.0308767 +2017-03-31 02:00:00,5.659120099999999,5.659120099999999 +2017-03-31 03:00:00,12.7426655,12.7426655 +2017-03-31 04:00:00,10.823153900000001,10.823153900000001 +2017-03-31 05:00:00,4.2308867,4.2308867 +2017-03-31 06:00:00,3.0762127999999995,3.0762127999999995 +2017-03-31 07:00:00,9.6476828,9.6476828 +2017-03-31 08:00:00,13.576032199999998,13.576032199999998 +2017-03-31 09:00:00,33.477012800000004,33.477012800000004 +2017-03-31 10:00:00,170.46413059999998,170.46413059999998 +2017-03-31 11:00:00,36.531657200000005,36.531657200000005 +2017-03-31 12:00:00,37.5648551,37.5648551 +2017-03-31 13:00:00,63.7585628,63.7585628 +2017-03-31 14:00:00,41.8805444,41.8805444 +2017-03-31 15:00:00,42.415118299999996,42.415118299999996 +2017-03-31 16:00:00,57.647572700000005,57.647572700000005 +2017-03-31 17:00:00,37.4906816,37.4906816 +2017-03-31 18:00:00,19.20053,19.20053 +2017-03-31 19:00:00,14.8122095,14.8122095 +2017-03-31 20:00:00,11.9225912,11.9225912 +2017-03-31 21:00:00,9.2285588,9.2285588 +2017-03-31 22:00:00,7.704575599999999,7.704575599999999 +2017-03-31 23:00:00,7.042881200000001,7.042881200000001 diff --git a/Analysis/TimeSeries_Data/Pacaya/Pacayanormalised_stats.html b/Analysis/TimeSeries_Data/Pacaya/Pacayanormalised_stats.html new file mode 100644 index 0000000..abf5aaf --- /dev/null +++ b/Analysis/TimeSeries_Data/Pacaya/Pacayanormalised_stats.html @@ -0,0 +1,1556 @@ + + + + + + + Profile report + + + + + + + + + + + + + + + +
+
+

Overview

+
+
+
+

Dataset info

+ + + + + + + + + + + + + + + + + + + + + + + +
Number of variables4
Number of observations744
Total Missing (%)0.9%
Total size in memory23.4 KiB
Average record size in memory32.2 B
+
+
+

Variables types

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Numeric3
Categorical0
Boolean0
Date1
Text (Unique)0
Rejected0
Unsupported0
+
+
+ +

Warnings

+
  • NAM has 26 / 3.5% missing values Missing
  • NAM has 485 / 65.2% zeros Zeros
  • ECMWF has 313 / 42.1% zeros Zeros
+
+
+
+

Variables

+
+
+
+

Timestamp
+ Date +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count744
Unique (%)100.0%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
+
+
+ + + + + + + + + +
Minimum2017-03-01 00:00:00
Maximum2017-03-31 23:00:00
+
+
+
+
+ +
+ +
+ +
+
+
+

Observations
+ Numeric +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count743
Unique (%)99.9%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
+ +
+
+ + + + + + + + + + + + + + + + + + +
Mean0.12318
Minimum0
Maximum1
Zeros (%)0.1%
+
+
+
+
+ + +
+ +
+ + +
+
+
+

Quantile statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Minimum0
5-th percentile0.0067389
Q10.042847
Median0.082905
Q30.17412
95-th percentile0.34115
Maximum1
Range1
Interquartile range0.13127
+
+
+

Descriptive statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Standard deviation0.11595
Coef of variation0.9413
Kurtosis7.761
Mean0.12318
MAD0.087115
Skewness2.0566
Sum91.645
Variance0.013444
Memory size5.9 KiB
+
+
+
+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.0694461469400137820.3% +
 
+
0.373944149562883210.1% +
 
+
0.002618671404175433510.1% +
 
+
0.247794545260168410.1% +
 
+
0.1360305154372969410.1% +
 
+
0.0634412373093756610.1% +
 
+
0.037015518736873310.1% +
 
+
0.0289461561754691910.1% +
 
+
0.1524147730718001810.1% +
 
+
0.177785968413996210.1% +
 
+
Other values (733)73398.5% +
 
+
+
+
+

Minimum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.010.1% +
 
+
2.509431825453999e-0510.1% +
 
+
0.0001811641860606566210.1% +
 
+
0.0001907727911915771710.1% +
 
+
0.000897798211456106710.1% +
 
+
+

Maximum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.563638538081514210.1% +
 
+
0.634989427735733210.1% +
 
+
0.718241274500310610.1% +
 
+
0.85827848498977310.1% +
 
+
1.010.1% +
 
+
+
+
+
+
+
+

NAM
+ Numeric +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count235
Unique (%)31.6%
Missing (%)3.5%
Missing (n)26
Infinite (%)0.0%
Infinite (n)0
+ +
+
+ + + + + + + + + + + + + + + + + + +
Mean0.027568
Minimum0
Maximum1
Zeros (%)65.2%
+
+
+
+
+ + +
+ +
+ + +
+
+
+

Quantile statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Minimum0
5-th percentile0
Q10
Median0
Q30.00083578
95-th percentile0.1617
Maximum1
Range1
Interquartile range0.00083578
+
+
+

Descriptive statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Standard deviation0.11034
Coef of variation4.0024
Kurtosis35.406
Mean0.027568
MAD0.046483
Skewness5.6713
Sum19.794
Variance0.012174
Memory size5.9 KiB
+
+
+
+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.048565.2% +
 
+
0.01374878811219252210.1% +
 
+
0.01096885552733351310.1% +
 
+
0.001220692609608253610.1% +
 
+
0.01382864490236300710.1% +
 
+
1.8720163869662856e-0610.1% +
 
+
1.4462672153234643e-0610.1% +
 
+
2.0378995146916315e-0510.1% +
 
+
0.0229550496748323810.1% +
 
+
0.0002411516572383458610.1% +
 
+
Other values (224)22430.1% +
 
+
(Missing)263.5% +
 
+
+
+
+

Minimum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.048565.2% +
 
+
9.335976713879999e-0810.1% +
 
+
1.063951076890488e-0710.1% +
 
+
2.494247501611551e-0710.1% +
 
+
3.5851045403348443e-0710.1% +
 
+
+

Maximum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.796645098233331710.1% +
 
+
0.811335409175792510.1% +
 
+
0.832018626902897610.1% +
 
+
0.906999473866694110.1% +
 
+
1.010.1% +
 
+
+
+
+
+
+
+

ECMWF
+ Numeric +

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Distinct count432
Unique (%)58.1%
Missing (%)0.0%
Missing (n)0
Infinite (%)0.0%
Infinite (n)0
+ +
+
+ + + + + + + + + + + + + + + + + + +
Mean0.029975
Minimum0
Maximum1
Zeros (%)42.1%
+
+
+
+
+ + +
+ +
+ + +
+
+
+

Quantile statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Minimum0
5-th percentile0
Q10
Median0.00014342
Q30.020042
95-th percentile0.16532
Maximum1
Range1
Interquartile range0.020042
+
+
+

Descriptive statistics

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Standard deviation0.086492
Coef of variation2.8855
Kurtosis50.247
Mean0.029975
MAD0.042482
Skewness6.1335
Sum22.301
Variance0.0074809
Memory size5.9 KiB
+
+
+
+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.031342.1% +
 
+
0.02482502818665903810.1% +
 
+
0.000258889822221034910.1% +
 
+
0.001714484068523181510.1% +
 
+
0.007471469660692375510.1% +
 
+
0.2643637863443577510.1% +
 
+
0.2151812938626036510.1% +
 
+
0.0090898974205053610.1% +
 
+
0.00459877287592606910.1% +
 
+
0.03191431460088023410.1% +
 
+
Other values (422)42256.7% +
 
+
+
+
+

Minimum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.031342.1% +
 
+
1.4932391452708669e-0710.1% +
 
+
7.8070318114005e-0710.1% +
 
+
1.2546893179319596e-0610.1% +
 
+
1.457720528369868e-0610.1% +
 
+
+

Maximum 5 values

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ValueCountFrequency (%) 
0.483026267563510110.1% +
 
+
0.779494421191163210.1% +
 
+
0.812077187519595810.1% +
 
+
0.84652900323681110.1% +
 
+
0.999999999999999910.1% +
 
+
+
+
+
+
+
+

Correlations

+
+
+ + +
+
+

Sample

+
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ObservationsNAMECMWF
Timestamp
2017-03-01 00:00:000.0833410.00.020605
2017-03-01 01:00:000.1103530.00.016748
2017-03-01 02:00:000.2486940.00.063001
2017-03-01 03:00:000.2322970.00.044145
2017-03-01 04:00:000.0841120.00.017756
+
+
+
+ + \ No newline at end of file diff --git a/Analysis/Timeseries.py b/Analysis/Timeseries.py new file mode 100644 index 0000000..189d159 --- /dev/null +++ b/Analysis/Timeseries.py @@ -0,0 +1,362 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- +"""Timeseries Analysis +.. module:: Timeseries + :platform: Unix + :synopis: +.. moduleauther: CEMAC (UoL) +.. description: This module was developed by CEMAC as part of the UNRESP + Project. This script takes CALPUFF concrec data from 2 models and compares + with observations. + :copyright: © 2019 University of Leeds. + :license: BSD-2 Clause. +Example: + To use:: + coming soon +.. CEMAC_UNRESPForcastingSystem: + https://github.com/cemac/UNRESPForcastingSystem +""" +import os +import glob +import matplotlib as mpl +import pandas as pd +import warnings +import numpy as np +import matplotlib.pyplot as plt +from sklearn import neighbors +from statistics import mode +from datetime import datetime +import pandas_profiling +import maptoolkit as mtk +warnings.filterwarnings("ignore") +# University System python may be broken +# If some one insists on using it... +BACKEND = mpl.get_backend() +if BACKEND == 'Qt4Agg' and sys.version_info[0] == 2: + # Fix the backend + print('swapping to Agg Backend') + mpl.pyplot.switch_backend('Agg') + +# --------------------------------------------------------------------------- # +# Data information: Emission Type, Stations, Model runs # +# # +# --------------------------------------------------------------------------- # + +# Emission +Em = "SO2" +# Default location of xy ascii file +XYFILE = "../data/xy_masaya.dat" +# observations +obs = '/scratch/Projects/UNRESP_Data/OBS' +# stations and coordinates +station1 = ['ElPanama', (-86.2058, 11.972)] +station2 = ['Pacaya', (-86.3013, 11.9553)] +station = station1 +# Models +ECMWF = '/scratch/Projects/UNRESP_Data/ECMWF' +NAM = '/scratch/Projects/UNRESP_Data/NAM' +# Unit Testing +Stage1 = False +Stage2 = False +Stage3 = False +Stage4 = False + + +# --------------------------------------------------------------------------- # +# Stage 1: Extract Observational data # +# # +# --------------------------------------------------------------------------- # + + +def ExtractTimeSeries(obs, station, Em): + """ExtractTimeSeries + Description + Args: + obs(str): path to observation csvs + station(str): station name string + Em(str): Emmission SO2 only for now + Returns: + TS_raw(DataFrame): Raw data full of nans + unit(str): units of data e.g. ug/m3 + TS_KNN(DataFrame): Missing values predicted by KNN + """ + # Reading and use datetime index + # Tell it the weird format... + def dateparse(x): return pd.datetime.strptime(x, '%d/%m/%Y %H:%M') + df = pd.read_csv(glob.glob(obs + '/' + station + '*.csv')[0], index_col=0, + parse_dates=True, date_parser=dateparse) + if Em == "SO2" and station == 'ElPanama': + data = df[[df.columns[2]]] + # Fill missing hours + data = data.asfreq('H') + # extract units + unit = df[[df.columns[1]]] + unit = unit.dropna().iloc[0][0] + elif Em == "SO2" and station == 'Pacaya': + # Pacaya file formatted completely different + data = df[[df.columns[0]]] + data = data.asfreq('H') + unit = 'ug/m3' + else: + print('Current set up for SO2 only') + return + # Select March + TS_raw = data['2017-03'] + # KNN Regressor (i.e. using fancy stats to fill in nans) + # Use whole data set to train on minus the nans + train = data.dropna() + # Works on numpy arrays + y = train.as_matrix() + # Correspoing x values + X = train.index.values + # Whole time + T = data.index.values + n_neighbors = 48 # use surrounding 2 days + weights = 'distance' # Near values are weighted higher + # Use scikit learns knn + knn = neighbors.KNeighborsRegressor(n_neighbors, weights=weights) + # Generate predicted values + y_ = knn.fit(X.reshape(-1, 1), y.reshape(-1, 1)).predict(T.reshape(-1, 1)) + TS_KNN_ALL = data + TS_KNN_ALL['KNN'] = y_ + # Extract March + TS_KNN = TS_KNN_ALL['2017-03'] + return TS_raw, unit, TS_KNN + + +def plot_obs(observations, unit, station): + """ + Description + Args: + TS_KNN(dataframe): Dataframe indexed by time with raw values and KNN + values + unit(str): unit string for y label + station(str): Station name string for title + Returns: + Scatter plot of Timeseries with KNN filled missing values. + """ + observations[station[0] + '_KNN'].plot(style='.') + observations[station[0] + '_raw'].plot(style='.') + plt.legend() + plt.title('SO2 data for March (' + station + ')') + plt.ylabel(unit) + plt.tight_layout() + + +if Stage1 is True: + TS_raw, unit, TS_KNN = ExtractTimeSeries(obs, station[0], Em) + observations = TS_KNN.rename(columns={TS_KNN.columns[0]: station[0] + '_raw', + 'KNN': station[0] + '_KNN'}) + observations.to_csv(station[0] + '_cleaned.csv') + # plot_obs(TS_KNN, unit, station) + print('Extracted Observational Data') + print('Please Note KNN filled data, is questionable in large data gaps') + +# --------------------------------------------------------------------------- # +# Stage 2: Extract Model data # +# # +# --------------------------------------------------------------------------- # + + +def conc_array(ny, nx, file_path): + """conc_array + description: + create an array of concentrations + args: + ny (int): number of x points + nx (int): number of y points + file_path (str): filename + returns: + conc (array): array of concentrations in ug/m^3 + """ + # Read in concentration data: + f = open(file_path, 'r') + lines = f.read().splitlines() + f.close() + # Process concentration data into desired format: + conc = np.array([float(X) for X in lines]) * 100**3 # ug/cm^3 -> ug/m^3 + concAry = np.reshape(conc, (ny, nx)) # Reshape data onto latlon grid + return concAry + + +def concfiles(n_conc_files, conc_dir, SOX='SO2'): + """concfiles + description: generate list of concentration files + n_conc_files (int): number of concentration files e.g. 48 or 24 + conc_dir (str): path to directory containing conc files + SOX (str): SO species, default = 'SO2' + modified to not assert files (will make missing files show up) + returns: + filenames (list): list of filenames e.g. concrec0100.dat + file_paths (list): list of filepaths e.g + """ + filenames = [] + file_paths = [] + if SOX == 'SO2': + concrecx = 'concrec0100' + elif SOX == 'SO4': + concrecx = 'concrec0200' + else: + concrecx = 'concrec0100' + print("WARNING: SOX option not valid setting to 'SO2'") + print("Options available are 'SO2' or 'SO4'") + for i in range(n_conc_files): + # Ensure e.g. '1' is converted to '01' + f_name = concrecx + str('{:02}'.format(i + 1)) + '.dat' + filenames.append(f_name) + f_path = os.path.join(conc_dir, f_name) + file_paths.append(f_path) + return filenames, file_paths + + +def FindNearestLatLon(lat, lon, glat, glon): + """ + description: + return index Array(lat, lon) closest match to station lat lon + args: + lat (float): latitude + lon (float): longitude + glat (array): latitude array + glon (array): longitude array + returns: + ilat (int): index for latitude + ilon (int): index for longitude + """ + # Find the closes point + ilat = (np.abs(glat - lat)).argmin(axis=0) + ilon = (np.abs(glon - lon)).argmin(axis=1) + if hasattr(ilat, "__len__"): + ilat = mode(ilat) + if hasattr(ilon, "__len__"): + ilon = mode(ilon) + return ilat, ilon + + +def ExtractModelData(loc, model, XYFILE, Em): + """ExtractModelData + Description: extract data from concrec files (uses custom maptoolkit) + Args: + loc(Array): Lat Lon of Station + station(str): Station string for labeling data + model(str): Model string NAM or ECMWF + Returns: + calpuff_ts_df(DataFrame): Time series at that point + calpuff_ts_array(Array): Numpy array area centered on station + """ + # Generate xy grid + (glat, glon, latMin, latMax, lonMin, lonMax, ny, nx) = mtk.genxy(XYFILE) + # For each day + for day in glob.glob(model + '/*'): + conc_dir = day + filenames, filePaths = concfiles(24, conc_dir, SOX='SO2') + for i, fname in enumerate(filePaths): + try: + conc = conc_array(ny, nx, fname) + except FileNotFoundError: + conc = np.zeros_like(conc) + conc[:] = np.nan + if 'concall' in locals(): + concall = np.dstack((concall, conc)) + else: + concall = conc + # Convention: T, Y, X + concall = concall.T + # Now use loc to locate corresponding grid points + # Extract only that point + ilat, ilon = FindNearestLatLon(loc[1], loc[0], glat, glon) + TS_station_point = concall[:, ilon, ilat] + # Build array of points surrounding that point (9 points) + TS_array = concall[:, ilon - 1:ilon + 2, ilat - 1:ilat + 2] + TS_flat = TS_array.reshape(744, 9) + # Average Array + df = pd.DataFrame() + df['TS_station_point'] = TS_station_point + df['9pntmin'] = TS_flat.min(axis=1) + df['9pntmax'] = TS_flat.max(axis=1) + df['9ptmean'] = TS_flat.mean(axis=1) + march = pd.date_range(start='2017-03-01', end='2017-04-01', freq='H')[0:-1] + df.index = march + # Gen 1D Timte array + # Gen X, Y for conc array + # Gen data frame (time, conc, conc av, conc max, conc mean) + # return calpuff_ts_df, calpuff_ts_array, T, X, Y + return df, TS_array, glat, glon + + +if Stage2 is True: + ecmwf_df, E_TS_array, glat, glon = ExtractModelData(station[1], ECMWF, + XYFILE, Em) + nam_df, n_TS_array, glat, glon = ExtractModelData(station[1], NAM, + XYFILE, Em) + nam_df.to_csv('NAM_' + station[0] + '.csv') + ecmwf_df.to_csv('ECMWF_' + station[0] + '.csv') + print('Extracted Model Data') + +# --------------------------------------------------------------------------- # +# Stage 3: Statistics # +# # +# --------------------------------------------------------------------------- # + + +def gencsvfile(station, ecmwf_df, nam_df, observations): + """gencsvfile + Combine all data extractions into 1 DataFrame + """ + All = observations + All['ECMWF_raw'] = ecmwf_df.TS_station_point + All['ECMWF_min'] = ecmwf_df['9pntmin'] + All['ECMWF_max'] = ecmwf_df['9pntmax'] + All['ECMWF_area'] = ecmwf_df['9ptmean'] + All['NAM_raw'] = nam_df.TS_station_point + All['NAM_min'] = nam_df['9pntmin'] + All['NAM_max'] = nam_df['9pntmax'] + All['NAM_area'] = nam_df['9ptmean'] + All.to_csv(station + 'Timeseries_obs_model_raw_processed.csv') + + +def RMSE(df, p, x): + RMSE = ((df.p - df.x) ** 2).mean() ** .5 + return RMSE + + +# Genetate a HTML page of Full statistical report +def gen_stats(station): + """gen stats + """ + All = pd.read_csv(station + '_Timeseries_obs_model_raw_processed.csv', + index_col=0, parse_dates=True) + profile = All.profile_report(title='Profile of Timeseries data for ' + + 'observations, NAM and ECMWF runs for ' + + station[0]) + profile.to_file(output_file=station[0] + "Stats.html") + + +if Stage3 is True: + gen_stats(station[0]) + print('HTMLfile generated') + +# --------------------------------------------------------------------------- # +# Stage 4: Plotting # +# # +# --------------------------------------------------------------------------- # + + +if Stage4 is True: + ecmwf_df['TS_station_point'].plot(style='X') + nam_df['TS_station_point'].plot(style='.') + TS_KNN['KNN'].plot(style='v') + plt.title(station[0] + ' SO2 Concs (KNN interpolated observations,' + + ' raw model data)') + plt.ylabel('SO2 conc ug/m3') + plt.legend(['ECMWF', 'NAM', 'Obs']) + plt.xlabel('Date (hourly data)') + plt.show() + ecmwf_df['9ptmean'].plot(style='X') + nam_df['9ptmean'].plot(style='.') + TS_KNN['KNN'].plot(style='v') + plt.title(station[0] + ' SO2 Concs (KNN interpolated observations,\n approx' + + ' area model values') + plt.ylabel('SO2 conc ug/m3') + plt.legend(['ECMWF', 'NAM', 'Obs']) + plt.xlabel('Date (hourly data)') + print('Stage4') diff --git a/Analysis/maptoolkit.py b/Analysis/maptoolkit.py new file mode 120000 index 0000000..1be1752 --- /dev/null +++ b/Analysis/maptoolkit.py @@ -0,0 +1 @@ +../Python/maptoolkit.py \ No newline at end of file diff --git a/CALPUFF_EXE/README.md b/CALPUFF_EXE/README.md index 4c79a07..46aea02 100644 --- a/CALPUFF_EXE/README.md +++ b/CALPUFF_EXE/README.md @@ -6,10 +6,10 @@ Directory for the CALPUFF executables ## Build (recommended) -If your system has intel compilers ./Run_ext.sh will check if the executables exist here, -and build them here if not. +If your system has intel compilers ./Run_ext.sh will check if the executables exist here, and build them here if not. ## Prebuilt option (available on request) + The current set up uses proprietary intel compilers, if these are not available the executables must be place here alongside the relevant libraries in the libraries folder. Runing ./Run_ext.sh will add to the library path and use the prebuilt executables. ## Future diff --git a/CALPUFF_EXE/libraries/README.md b/CALPUFF_EXE/libraries/README.md index 21b92e9..8b82ab6 100644 --- a/CALPUFF_EXE/libraries/README.md +++ b/CALPUFF_EXE/libraries/README.md @@ -1,3 +1,3 @@ -# libraries +# Libraries -For prebuilt option only. Required library files to be place here. +If pre-built executables have been used additional library files will also be required and be place here. diff --git a/CALPUFF_INP/README.md b/CALPUFF_INP/README.md new file mode 100644 index 0000000..32bf1cc --- /dev/null +++ b/CALPUFF_INP/README.md @@ -0,0 +1,15 @@ +# USER editable INPUT FILES + +All user-editable input files for the various parts of the CALPUFF system are stored in subdirectory `CALPUFF_INP`. + +* Template versions of these files have been set up specifically for the Masaya case and are version controlled. + +* Various run-specific fields (e.g. run date) are then filled in at run-time. + +Information on each input file can be found in the WIKI. + +* [TERREL](https://github.com/cemac/UNRESPForecastingSystem/wiki/terrel.inp) +* [ctgproc](https://github.com/cemac/UNRESPForecastingSystem/wiki/ctgproc.inp) +* [makegeo.inp](https://github.com/cemac/UNRESPForecastingSystem/wiki/makegeo.inp) +* [calmet.inp](https://github.com/cemac/UNRESPForecastingSystem/wiki/calmet.inp) +* [calpuf.inp](https://github.com/cemac/UNRESPForecastingSystem/wiki/calpuf.inp) diff --git a/CALPUFF_MODS/CALMET/README.md b/CALPUFF_MODS/CALMET/README.md new file mode 100644 index 0000000..36357b2 --- /dev/null +++ b/CALPUFF_MODS/CALMET/README.md @@ -0,0 +1,3 @@ +* If using a 100m resolution, increase `mxnx` and `mxny` to `901` and `541` respectively +in params.met +* In params.met, change `mxnz` from `12` to `27` and `mxnzi` from `12` to `50`. diff --git a/CALPUFF_SRC/CALMET/params.met b/CALPUFF_MODS/CALMET/params.met similarity index 100% rename from CALPUFF_SRC/CALMET/params.met rename to CALPUFF_MODS/CALMET/params.met diff --git a/CALPUFF_MODS/CALPUFF/README.md b/CALPUFF_MODS/CALPUFF/README.md new file mode 100644 index 0000000..346ba18 --- /dev/null +++ b/CALPUFF_MODS/CALPUFF/README.md @@ -0,0 +1,17 @@ +* If using a 100m resolution, increase `mxnx` and `mxny` to `901` and `541` respectively +in params.puf +* In params.puf, change `mxnz` from `12` to `27` and `mxrec` from `10000` to `20000`. +* In calpuff.for, near the end of subroutine `comp` (e.g. just after the call +to FOGOUT), insert the following lines of code to write out the hourly +concentrations to individual file: +```fortran +do ispec=1,nspec +write ( infile ,10000 ) ispec , nn +10000 format (’concrec’ ,I2.2,I4.4, ’.dat’) +open (50,file=infile) +do i=1,nrec +write (50, *) chirec(i,ispec) +end do +end do +close (50) +``` diff --git a/CALPUFF_SRC/CALPUFF/calpuff.for b/CALPUFF_MODS/CALPUFF/calpuff.for similarity index 100% rename from CALPUFF_SRC/CALPUFF/calpuff.for rename to CALPUFF_MODS/CALPUFF/calpuff.for diff --git a/CALPUFF_SRC/CALPUFF/params.puf b/CALPUFF_MODS/CALPUFF/params.puf similarity index 100% rename from CALPUFF_SRC/CALPUFF/params.puf rename to CALPUFF_MODS/CALPUFF/params.puf diff --git a/CALPUFF_MODS/CTGPROC/README.md b/CALPUFF_MODS/CTGPROC/README.md new file mode 100644 index 0000000..1d9c3d1 --- /dev/null +++ b/CALPUFF_MODS/CTGPROC/README.md @@ -0,0 +1,7 @@ +If using a 100m resolution, increase `mxnx` and `mxny` to `901` and `541` respectively +in params.ctg + +* In params.ctg, comment out the ‘Lahey F95 Compiler’ block and +uncomment the ‘INTEL Compiler’ block. +* In control.ctg, add the missing variable `lll` to the `/CONTROL/` common +block. diff --git a/CALPUFF_SRC/CTGPROC/control.ctg b/CALPUFF_MODS/CTGPROC/control.ctg similarity index 100% rename from CALPUFF_SRC/CTGPROC/control.ctg rename to CALPUFF_MODS/CTGPROC/control.ctg diff --git a/CALPUFF_SRC/CTGPROC/ctgproc.for b/CALPUFF_MODS/CTGPROC/ctgproc.for similarity index 100% rename from CALPUFF_SRC/CTGPROC/ctgproc.for rename to CALPUFF_MODS/CTGPROC/ctgproc.for diff --git a/CALPUFF_SRC/CTGPROC/params.ctg b/CALPUFF_MODS/CTGPROC/params.ctg similarity index 100% rename from CALPUFF_SRC/CTGPROC/params.ctg rename to CALPUFF_MODS/CTGPROC/params.ctg diff --git a/CALPUFF_MODS/MAKEGEO/README.md b/CALPUFF_MODS/MAKEGEO/README.md new file mode 100644 index 0000000..b0cf8d6 --- /dev/null +++ b/CALPUFF_MODS/MAKEGEO/README.md @@ -0,0 +1,6 @@ +If using a 100m resolution, increase `mxnx` and `mxny` to `901` and `541` respectively +in params.geo + +* In subroutine `comline` (calutils.for), comment out the call to `getcl` and +uncomment the Sun compiler block (this seems to work for both the intel +and pgi compilers). diff --git a/CALPUFF_SRC/MAKEGEO/calutils.for b/CALPUFF_MODS/MAKEGEO/calutils.for similarity index 100% rename from CALPUFF_SRC/MAKEGEO/calutils.for rename to CALPUFF_MODS/MAKEGEO/calutils.for diff --git a/CALPUFF_SRC/MAKEGEO/params.geo b/CALPUFF_MODS/MAKEGEO/params.geo similarity index 100% rename from CALPUFF_SRC/MAKEGEO/params.geo rename to CALPUFF_MODS/MAKEGEO/params.geo diff --git a/CALPUFF_MODS/TERREL/README.md b/CALPUFF_MODS/TERREL/README.md new file mode 100644 index 0000000..3c7c756 --- /dev/null +++ b/CALPUFF_MODS/TERREL/README.md @@ -0,0 +1,9 @@ +In terrel.for, delete the `flen` argument in the line `inquire(file=datafil(k),exist=lexist,flen=isize)`. +This is a Lahey-specific argument. + +* params.trl, comment out the ‘Lahey F95 Compiler’ block and +uncomment the ‘Compaq DF Compiler’ block. +* In `setsrtm()` (terrel.for), remove ‘access=caccess’ from the open statement +(otherwise TERREL crashes when trying to read in the first +line of an SRTM3 data file with a "sequential-access I/O to unit open +for direct access" error) diff --git a/CALPUFF_SRC/TERREL/params.trl b/CALPUFF_MODS/TERREL/params.trl similarity index 100% rename from CALPUFF_SRC/TERREL/params.trl rename to CALPUFF_MODS/TERREL/params.trl diff --git a/CALPUFF_SRC/TERREL/terrel.for b/CALPUFF_MODS/TERREL/terrel.for similarity index 100% rename from CALPUFF_SRC/TERREL/terrel.for rename to CALPUFF_MODS/TERREL/terrel.for diff --git a/CALPUFF_SRC/CALMET/calmet.dat.aux b/CALPUFF_OUT/README.md similarity index 100% rename from CALPUFF_SRC/CALMET/calmet.dat.aux rename to CALPUFF_OUT/README.md diff --git a/CALPUFF_SRC/CALMET/auxdat.met b/CALPUFF_SRC/CALMET/auxdat.met deleted file mode 100644 index 78b1bf2..0000000 --- a/CALPUFF_SRC/CALMET/auxdat.met +++ /dev/null @@ -1,27 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /AUXDAT/ -- Control and Current data for CALMET -c the auxiliary meteorological -c data file -c---------------------------------------------------------------------- - - real qcup(mxnx,mxny),zuptop(mxnx,mxny),zupbot(mxnx,mxny) - real qc3d(mxnx,mxny,mxnz) - - common/AUXDAT/qcup,zuptop,zupbot,qc3d,threshqc - -c --- COMMON BLOCK /AUXDAT/ Variables: -c QCUP(mxnx,mxny) - real - Liquid cloud water mixing ratio -c averaged over all cloud layers -c above CALMET domain top (g/kg) -c ZUPTOP(mxnx,mxny) - real - Top of liquid cloud layer -c above CALMET domain top (mAGL) -c (Zero if no water) -c ZUPBOT(mxnx,mxny) - real - Bottom of liquid cloud layer -c above CALMET domain top (mAGL) -c (Zero if no water) -c QC3D(mxnx,mxny,mxnz) - real - Liquid cloud water mixing ratio -c for 3D CALMET grid (g/kg) -c THRESHQC - real - Threshold liquid cloud water -c mixing ratio (g/kg) for using -c values above CALMET top - diff --git a/CALPUFF_SRC/CALMET/auxutils.for b/CALPUFF_SRC/CALMET/auxutils.for deleted file mode 100644 index 714cc36..0000000 --- a/CALPUFF_SRC/CALMET/auxutils.for +++ /dev/null @@ -1,764 +0,0 @@ -c----------------------------------------------------------------------- - subroutine outauxhd -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 OUTAUXHD -c -c --- PURPOSE: Write header records to CALMET AUXiliary output file -c -c --- INPUTS: -c common block /AUXVAR/ -c naux2d, naux3d, -c auxnam2d(mxaux), auxnam3d(mxaux), -c auxunit2d(mxaux), auxunit3d(mxaux), -c auxtyp2d(mxaux), auxtyp3d(mxaux), -c common block /GEN/ -c ibyrn,ibmon,ibdyn,ibhrn,ibsecn,ieyrn,iemon,iedyn, -c iehrn,iesecn,axtz,irlg -c common block /GRID/ -c nx, ny, nz, dgrid, zface(mxnz+1), xorigr, yorigr -c common block /MAP/ -c iutmzn,feast,fnorth, -c rnlat0,relon0,xlat1,xlat2, -c pmap,utmhem,datum,daten -c common block /MM4HDO/ -c ioutmm5 -c common block /QA/ -c ver, level, ncommout -c common block /OUTPT/ -c ioaux -c Parameters: MXNX, MXNY, MXNZ, MXNZP1, MXLEV, IOAUX, IO6, IOX -c -c --- OUTPUT: -c common block /AUXVAR/ -c naux2d, naux3d, -c auxnam2d(mxaux), auxnam3d(mxaux), -c auxunit2d(mxaux), auxunit3d(mxaux), -c auxtyp2d(mxaux), auxtyp3d(mxaux), -c lauxout -c -c --- OUTAUXHD called by: SETUP -c --- OUTAUXHD calls: WRTR1D, WRTR2D, WRTI2D -c----------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - - include 'auxvar.met' - include 'gen.met' - include 'grid.met' - include 'map.met' - include 'mm4hdo.met' - include 'qa.met' - include 'outpt.met' - -c --- Local Variables - character*8 clabel - character*16 dataset,dataver - character*33 blank33 - character*64 datamod - character*132 comment1,blank - - data idum/0/ - data blank33/' '/ - -c --- Configure output documentation -c --- Note: Dataset version 1.0 did NOT have compression option -c --- Timestamp moved before CNAME+Data to be consistent -c --- with CALPUFF compression subroutine - data dataset/'CALMET.AUX'/, dataver/'1.1'/ - data datamod/'Generic file structure with compression'/ - data comment1/'Produced by CALMET Version: '/ - -c --- Set blank (132 characters) - blank(1:33)=blank33 - blank(34:66)=blank33 - blank(67:99)=blank33 - blank(100:132)=blank33 - - -c --- Create specific configuration placing cloud water mixing ratio -c --- in both 2D and 3D arrays, with compression - naux2d=3 - - auxnam2d(1)='CLDMRUP' - auxunit2d(1)='G/KG' - auxtyp2d(1)='RC4' - - auxnam2d(2)='ZCLDBOT' - auxunit2d(2)='MAGL' - auxtyp2d(2)='RC4' - - auxnam2d(3)='ZCLDTOP' - auxunit2d(3)='MAGL' - auxtyp2d(3)='RC4' - - naux3d=1 - auxnam3d(1)='CLDMR3D' - auxunit3d(1)='G/KG' - auxtyp3d(1)='RC4' - -c --- Determine if cloud water is available - if(ioutmm5.EQ.81 .OR. ioutmm5.EQ.82 .OR. - & ioutmm5.EQ.91 .OR. ioutmm5.EQ.92) then - lauxout=.false. - return - else - lauxout=.true. - endif - -c --- Construct the version-level comment string - j=29 - do i=1,12 - if(ver(i:i).NE.' ') then - comment1(j:j)=ver(i:i) - j=j+1 - endif - enddo - j=j+1 - comment1(j:j+7)=' Level: ' - j=j+8 - do i=1,8 - if(level(i:i).NE.' ') then - comment1(j:j)=level(i:i) - j=j+1 - endif - enddo - -c --- Record #1 - File Declaration -- 24 words - write(ioaux) dataset,dataver,datamod - -c --- Record #2 - Number of comment lines -- 1 word - ncom=ncommout+1 - write(ioaux) ncom - -c --- Record #3 to NCOM+2 (Comment record section) -- 33 words each - write(ioaux) comment1 -c --- Go to beginning of the scratch file with the control file image - REWIND(iox) -c --- Loop over records - do i=1,ncommout - comment1=blank - read(iox,'(a132)') comment1 - write(ioaux) comment1 - enddo - -c --- record #NCOM+3 - run control parameters -- 36 words - write(ioaux) ibyrn,ibmon,ibdyn,ibhrn,ibsecn, - 1 ieyrn,iemon,iedyn,iehrn,iesecn,axtz,irlg, - 2 nx, ny, nz, dgrid, xorigr, yorigr, - 3 pmap,datum,daten,feast,fnorth,utmhem,iutmzn, - 4 rnlat0,relon0,xlat1,xlat2,naux2d,naux3d - -c --- record #NCOM+4 - cell face heights (NZ + 1 words) - nzp1=nz+1 - clabel='ZFACE' - call wrtr1d(ioaux,zface,nzp1,clabel,idum,idum,idum,idum) - -c --- record #NCOM+5 - Names, units and types of 2D variables -c --- (2+naux2d*5 words) - clabel='2D_VARS' - write(ioaux) clabel,(auxnam2d(k),k=1,naux2d), - & (auxunit2d(k),k=1,naux2d), - & (auxtyp2d(k),k=1,naux2d) - -c --- record #NCOM+6 - Names, units and types of 3D variables -c --- (2+naux3d*5 words) - clabel='3D_VARS' - write(ioaux) clabel,(auxnam3d(k),k=1,naux3d), - & (auxunit3d(k),k=1,naux3d), - & (auxtyp3d(k),k=1,naux3d) - - return - end - -c----------------------------------------------------------------------- - subroutine auxout(ndathrb,nsecb,ndathre,nsece, - 1 nx,ny,nz,ifull,io) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 AUXOUT -c -c --- PURPOSE: Write auxiliary meteorological output fields -c -c --- INPUTS: -c NDATHRB - integer - Beginning Date and hour (YYYYJJJHH) -c in LST (explicit) -c NSECB - integer - Beginning seconds in LST (explicit) -c NDATHRE - integer - Ending Date and hour (YYYYJJJHH) -c in LST (explicit) -c NSECE - integer - Ending seconds in LST (explicit) -c NX, NY - integers - No. X, Y grid cells -c NZ - integer - No. vertical layers -c IFULL - integer - Flag for size of arrays -c 0 = nx,ny < mxnx,mxny -c 1 = nx,ny = mxnx,mxny -c IO - integer - Fortran unit no. of output file -c -c Common block /AUXDAT/ -c QCUP(mxnx,mxny),ZUPTOP(mxnx,mxny),ZUPBOT(mxnx,mxny) -c QC3D(mxnx,mxny,mxnz) -c Common block /AUXVAR/ -c naux2d, naux3d, -c auxnam2d(mxaux), auxnam3d(mxaux), -c auxtyp2d(mxaux), auxtyp3d(mxaux) -c lauxout -c Parameters: MXNX, MXNY, MXNZ, MXAUX -c -c --- OUTPUT: none -c -c --- AUXOUT called by: COMP -c --- AUXOUT calls: XTRACT, COMPRS, -c----------------------------------------------------------------------- -c -c --- include parameters and commons - include 'params.met' - parameter(mxnxy=mxnx*mxny) - - include 'auxdat.met' - include 'auxvar.met' - - character*12 clab12 - real xbuf1(mxnx,mxny),xbuf2(mxnx,mxny) - -c --- Test for Output - if(.NOT.lauxout) return - -c --- Timestamp is written before each variable, followed by the -c --- variable name and then the data array - - nxy=nx*ny - -c --- Write 2D fields - iout=0 - do k=1,naux2d - - if(auxnam2d(k).EQ.'CLDMRUP ') then -c --- Average in-cloud LWC above model top: QCUP() -c --- Expect real*4 - if(auxtyp2d(k).NE.'RC4 ' .AND. auxtyp2d(k).NE.'R_4 ') then - write(io6,*) 'ERROR in AUXOUT -- Invalid 2D type' - write(io6,*) 'Variable: ',auxnam2d(k) - write(io6,*) 'Expected: type RC4 or R_4' - write(io6,*) 'Found : ',auxtyp2d(k) - endif - iout=iout+1 -c --- Timestamp - write(io) ndathrb,nsecb,ndathre,nsece -c --- Data - clab12=' ' - clab12(1:8)=auxnam2d(k) - if(ifull.EQ.1)then - if(auxtyp2d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(qcup,mxnxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp2d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,qcup,nx,ny) - endif - else - call XTRACT(io6,qcup,mxnx,mxny,nx,ny,xbuf1) - if(auxtyp2d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(xbuf1,nxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp2d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,xbuf1,nx,ny) - endif - endif - - elseif(auxnam2d(k).EQ.'ZCLDBOT ') then -c --- Bottom of cloud LWC above model top: ZUPBOT() -c --- Expect real*4 - if(auxtyp2d(k).NE.'RC4 ' .AND. auxtyp2d(k).NE.'R_4 ') then - write(io6,*) 'ERROR in AUXOUT -- Invalid 2D type' - write(io6,*) 'Variable: ',auxnam2d(k) - write(io6,*) 'Expected: type RC4 or R_4' - write(io6,*) 'Found : ',auxtyp2d(k) - endif - iout=iout+1 -c --- Timestamp - write(io) ndathrb,nsecb,ndathre,nsece -c --- Data - clab12=' ' - clab12(1:8)=auxnam2d(k) - if(ifull.EQ.1)then - if(auxtyp2d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(zupbot,mxnxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp2d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,zupbot,nx,ny) - endif - else - call XTRACT(io6,zupbot,mxnx,mxny,nx,ny,xbuf1) - if(auxtyp2d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(xbuf1,nxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp2d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,xbuf1,nx,ny) - endif - endif - - elseif(auxnam2d(k).EQ.'ZCLDTOP ') then -c --- Bottom of cloud LWC above model top: ZUPTOP() -c --- Expect real*4 - if(auxtyp2d(k).NE.'RC4 ' .AND. auxtyp2d(k).NE.'R_4 ') then - write(io6,*) 'ERROR in AUXOUT -- Invalid 2D type' - write(io6,*) 'Variable: ',auxnam2d(k) - write(io6,*) 'Expected: type RC4 or R_4' - write(io6,*) 'Found : ',auxtyp2d(k) - endif - iout=iout+1 -c --- Timestamp - write(io) ndathrb,nsecb,ndathre,nsece -c --- Data - clab12=' ' - clab12(1:8)=auxnam2d(k) - if(ifull.EQ.1)then - if(auxtyp2d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(zuptop,mxnxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp2d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,zuptop,nx,ny) - endif - else - call XTRACT(io6,zuptop,mxnx,mxny,nx,ny,xbuf1) - if(auxtyp2d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(xbuf1,nxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp2d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,xbuf1,nx,ny) - endif - endif - endif - - enddo - - if(iout.NE.naux2d) then - write(io6,*) 'ERROR in AUXOUT -- 2D variable names not found' - write(io6,*) 'Expected: ',naux2d - write(io6,*) 'Found : ',iout - stop 'Halted in AUXOUT -- see list file.' - endif - -c --- Write 3D fields - iout=0 - do k=1,naux3d - if(auxnam3d(k).EQ.'CLDMR3D ') then -c --- Layered in-cloud LWC as 3D field: QC3D() -c --- Expect real*4 - if(auxtyp3d(k).NE.'RC4 ' .AND. auxtyp3d(k).NE.'R_4 ') then - write(io6,*) 'ERROR in AUXOUT -- Invalid 3D type' - write(io6,*) 'Variable: ',auxnam3d(k) - write(io6,*) 'Expected: type RC4 or R_4' - write(io6,*) 'Found : ',auxtyp3d(k) - endif - iout=iout+1 -c --- Timestamp - write(io) ndathrb,nsecb,ndathre,nsece -c --- Data - do i=1,nz - clab12=' ' - clab12(1:8)=auxnam3d(k) - write(clab12(9:12),'(i4.4)')i - if(ifull.EQ.1)then - if(auxtyp3d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(qc3d(1,1,i),mxnxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp3d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,qc3d(1,1,i),nx,ny) - endif - else - call XTRACT(io6,qc3d(1,1,i),mxnx,mxny,nx,ny,xbuf1) - if(auxtyp3d(k).EQ.'RC4 ')then -c --- Compressed real*4 data records - call COMPRS(xbuf1,nxy,xbuf2,mxnxy, - & clab12,io,io6) - elseif(auxtyp3d(k).EQ.'R_4 ')then -c --- Uncompressed real*4 data record - call WRDAT(io,clab12,xbuf1,nx,ny) - endif - endif - enddo - endif - enddo - - if(iout.NE.naux3d) then - write(io6,*) 'ERROR in AUXOUT -- 3D variable names not found' - write(io6,*) 'Expected: ',naux3d - write(io6,*) 'Found : ',iout - stop 'Halted in AUXOUT -- see list file.' - endif - - return - end - -c----------------------------------------------------------------------- - subroutine xtract(iolst,datarr,nxmax,nymax,nxact,nyact,outarr) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 XTRACT -c J. Scire -c -c --- PURPOSE: Extract the active portion of a 2-D array -c -c --- INPUTS: -c IOLST - integer - File unit for list-file -c DATARR(nxmax,nymax) - real - Full data array -c NXMAX - integer - First dimension of data array -c NYMAX - integer - Second dimension of data array -c NXACT - integer - Number of active elements of the -c array (first dimension) -c NYACT - integer - Number of active elements of the -c array (second dimension) -c -c --- OUTPUT: -c OUTARR(nxact,nyact) - real - Output array consisting only -c of the active elements of the -c full input array -c -c --- XTRACT called by: AUXOUT -c --- XTRACT calls: none -c----------------------------------------------------------------------- -c - real datarr(nxmax,nymax),outarr(nxact,nyact) -c -c --- Check that values of array dimensions are reasonable - if(nxact.le.0.or.nxact.gt.nxmax.or. - 1 nyact.le.0.or.nyact.gt.nymax)then - write(iolst,*)'ERROR in subr. XTRACT -- Invalid values ', - 1 'of array dimensions input -- NXACT = ',nxact,' NYACT = ', - 2 nyact,' NXMAX = ',nxmax,' NYMAX = ',nymax - write(*,*) - stop 'Halted in XTRACT -- see list file.' - endif -c -c --- Extract the active portion of the input data array - do j=1,nyact - do i=1,nxact - outarr(i,j)=datarr(i,j) - enddo - enddo -c - return - end - -c----------------------------------------------------------------------- - subroutine comprs(xdat,nwords,xwork,nwork,clab12,io,io6) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 COMPRS -c J. Scire -c -c --- PURPOSE: Compress an array reals by replacing strings of zero -c values with a negative code indicating the number of -c zero values -c -c --- INPUTS: -c XDAT(nwords) - real array - Array of uncompressed data to be -c output -c NWORDS - integer - Number of values in data array -c XWORK(nwork) - real array - Work array to temporarily store -c compressed array -c NWORK - integer - Dimension of work array - NWORK -c must be >= NWORDS -c CLAB12 - char*12 - Character record header -c IO - integer - Unit number of output file -c IO6 - integer - Unit number of output list file -c -c --- OUTPUT: none -c -c --- COMPRS called by: AUXOUT -c --- COMPRS calls: WRDAT -c----------------------------------------------------------------------- -c - real xdat(nwords),xwork(nwork) - character*12 clab12 -c -c --- Check that work array is sized large enough - if(nwork.lt.nwords)then - write(io6,*)'ERROR in Subr. COMPRS -- Work array ', - 1 'dimension is too small -- NWORK = ',nwork,' NWORDS = ', - 2 nwords - write(*,*) - stop 'Halted in COMPRS -- see list file.' - endif -c -c --- Replace all zeroes with negative coded integer - nzero=0 - ii=0 - do 100 i=1,nwords -c - if(xdat(i).eq.0.0)then - nzero=nzero+1 - go to 100 - else if(xdat(i).lt.0.0)then - write(io6,*)'ERROR in Subr. COMPRS -- Negative value ', - 1 'encountered with COMPRESS option on -- I = ',i, - 2 ' XDAT(i) = ',xdat(i) - write(io6,*)'COMPRESS option cannot be used when data ', - 1 'values are negative' - write(*,*) - stop 'Halted in COMPRS -- see list file.' - endif -c - if(nzero.eq.0)then - ii=ii+1 - xwork(ii)=xdat(i) - else - ii=ii+1 - xwork(ii)=-(float(nzero)+0.0001) - nzero=0 - ii=ii+1 - xwork(ii)=xdat(i) - endif -100 continue -c - if(nzero.gt.0)then - ii=ii+1 - xwork(ii)=-(float(nzero)+0.0001) - endif -c -c --- Write the data records (header, compressed data record) - write(io)ii - call WRDAT(io,clab12,xwork,ii,1) -c - return - end - -c----------------------------------------------------------------------- - subroutine wrdat(iounit,cnam12,outarr,nx,ny) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 WRDAT -c J. Scire -c -c --- PURPOSE: Write a gridded 2D real array -c (one 12-character identifier and a 2-D data array) -c -c --- INPUTS: -c IOUNIT - integer - Fortran unit no. of output file -c CNAM12 - character*12 - Variable name -c OUTARR(nx,ny) - real array - Array of data -c NX - integer - Number of grid points in the -c X direction -c NY - integer - Number of grid points in the -c Y direction -c -c --- OUTPUT: none -c -c --- WRDAT called by: AUXOUT, COMPRS -c --- WRDAT calls: none -c----------------------------------------------------------------------- -c - real outarr(nx,ny) - character*12 cnam12 -c - write(iounit)cnam12,outarr -c - return - end - -c----------------------------------------------------------------------- - subroutine wrint(iounit,cnam12,ioutarr,nx,ny) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 WRINT -c J. Scire -c -c --- PURPOSE: Write a gridded 2D integer array -c (one 12-character identifier and a 2-D data array) -c -c --- INPUTS: -c IOUNIT - integer - Fortran unit no. of output file -c CNAM12 - character*12 - Variable name -c IOUTARI(nx,ny) - int. array - Array of data -c NX - integer - Number of grid points in the -c X direction -c NY - integer - Number of grid points in the -c Y direction -c -c --- OUTPUT: none -c -c --- WRINT called by: AUXOUT -c --- WRINT calls: none -c----------------------------------------------------------------------- -c - integer ioutarr(nx,ny) - character*12 cnam12 -c - write(iounit)cnam12,ioutarr -c - return - end - -c----------------------------------------------------------------------- - subroutine prfvar(iolst,ldb,nz1,nz2,array1,zface1,zface2,thresh, - & array2,zupbot,zuptop,avgup) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 PRFVAR -c D. Strimaitis -c -c --- PURPOSE: Process vertical profile of a real variable from one set -c of layers to another set of layers. -c The array variable is assumed to be constant across each -c layer explicitly defined by a set of interface heights. -c Values in input layers that overlap an output layer are -c averaged. -c Above the last output layer, a threshold screen is -c applied to the input values and the min/max heights -c where the threshold is exceeded are determined. The -c average of the variable between these heights is then -c computed. -c -c --- INPUTS: -c IOLIST - integer - Fortran unit no. of list file -c LDB - logical - Debug output flag -c NZ1 - integer - Number of layers in input profile -c NZ2 - integer - Number of layers in output profile -c ARRAY1(nz1) - real array - Profile of input data -c ZFACE1(nz1+1) - real array - Interface heights in input (m) -c ZFACE2(nz2+1) - real array - Interface heights in output (m) -c THRESH - real - Threshold for reporting average aloft -c -c --- OUTPUT: -c ARRAY2(nz2) - real array - Profile of output data -c ZUPBOT - real - Bottom of layer aloft (m) -c ZUPTOP - real - Top of layer aloft (m) -c AVGUP - real - Average of variable aloft -c -c --- PRFVAR called by: -c --- PRFVAR calls: none -c----------------------------------------------------------------------- -c - real array1(*), zface1(*) - real array2(*), zface2(*) - logical ldb - -c --- Step through output profile layers and fill output array2 - - do kout=1,nz2 - zbot=zface2(kout) - ztop=zface2(kout+1) - array2(kout)=0.0 - dz2=ztop-zbot - -c --- Loop over input profile layers - do k=1,nz1 -c --- Process layers that are above local ground - if(zface1(k+1).GT.0.0) then - zhi=zface1(k+1) - zlo=zface1(k) - if(zlo.LE.0.0) zlo=0.0 -c --- Use Input layer if it overlaps output layer - if(zhi.GT.zbot .AND. zlo.LT.ztop) then - hupper=AMIN1(ztop,zhi) - hlower=AMAX1(zbot,zlo) - array2(kout)=array2(kout)+ - & array1(k)*(hupper-hlower)/dz2 - endif - endif - enddo - enddo - -c --- Construct layer information aloft - zupbot=zface1(nz1+1) - zuptop=0.0 - avgup=0.0 - zwt=0.0 -c --- Loop over layers in input profile - do k=1,nz1 - if(zface1(k+1).GT.zface2(nz2+1) .AND. - & array1(k).GE.thresh) then - deltaz=zface1(k+1)-zface1(k) - avgup=avgup+array1(k)*deltaz - zwt=zwt+deltaz - zupbot=AMIN1(zupbot,zface1(k)) - zuptop=AMAX1(zuptop,zface1(k+1)) - endif - enddo - if(zwt.GT.0.0) avgup=avgup/zwt -c --- Restore zero markers if threshold is not exceeded (compression) - if(avgup.LT.thresh) then - zupbot=0.0 - zuptop=0.0 - avgup=0.0 - zwt=0.0 - endif - - if(LDB) then - write(iolst,*) - write(iolst,*)'PRFVAR: Configuration Data' - write(iolst,*)' nz1,nz2,thresh = ',nz1,nz2,thresh - write(iolst,*)'PRFVAR: Input Profile Data' - write(iolst,*)' zface1(bottom) = ',zface1(1) - do k=1,nz1 - write(iolst,*)' zface1, array1 = ',zface1(k+1), array1(k) - enddo - write(iolst,*)'PRFVAR: Output Profile Data' - write(iolst,*)' zface2(bottom) = ',zface2(1) - do k=1,nz2 - write(iolst,*)' zface2, array2 = ',zface2(k+1), array2(k) - enddo - write(iolst,*)'PRFVAR: Layers Aloft' - write(iolst,*)' zbot,ztop,avg = ',zupbot,zuptop,avgup - endif - - return - end - -c----------------------------------------------------------------------- - subroutine z2face(iolst,ldb,nz,z,zface) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.4.2 Level: 121203 Z2FACE -c D. Strimaitis -c -c --- PURPOSE: Construct interface heights from layer heights assuming -c interfaces lie midway between the layer heights. -c -c --- INPUTS: -c IOLIST - integer - Fortran unit no. of list file -c LDB - logical - Debug output flag -c NZ - integer - Number of layers -c Z(nz) - real array - Layer heights (m) -c -c --- OUTPUT: -c ZFACE(nz+1) - real array - Interface heights (m) -c -c --- Z2FACE called by: -c --- Z2FACE calls: none -c----------------------------------------------------------------------- - real z(*), zface(*) - -c --- First layer - if(z(1).LE.0) then - zface(1)=z(1)-1.0 - else - zface(1)=0.0 - endif - -c --- Loop over intermediate layer heights (AGL) - do k=2,nz -c --- Approximate layer faces as halfway between points - zface(k)=0.5*(z(k-1)+z(k)) - enddo - -c --- Top face - zface(nz+1)=2.0*z(nz)-zface(nz) - - return - end diff --git a/CALPUFF_SRC/CALMET/auxvar.met b/CALPUFF_SRC/CALMET/auxvar.met deleted file mode 100644 index 629470f..0000000 --- a/CALPUFF_SRC/CALMET/auxvar.met +++ /dev/null @@ -1,33 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /AUX/ -- Auxiliary Output Config CALMET -c---------------------------------------------------------------------- -c - character*8 auxnam2d(mxaux), auxnam3d(mxaux) - character*8 auxunit2d(mxaux), auxunit3d(mxaux) - character*4 auxtyp2d(mxaux), auxtyp3d(mxaux) - logical lauxout - - common block /AUXVAR/ - 1 naux2d, naux3d,lauxout, - 2 auxnam2d, auxnam3d, - 3 auxunit2d, auxunit3d, - 4 auxtyp2d, auxtyp3d -c -c --- COMMON BLOCK /AUX/ Variables: -c NAUX2D - integer - Number of 2D variables -c NAUX3D - integer - Number of 3D variables -c LAUXOUT - logical - Output control (T/F) -c AUXNAM2D(mxaux) - C*8 array - 2D variable names in AUX output -c AUXNAM3D(mxaux) - C*8 array - 3D variable names in AUX output -c AUXUNIT2D(mxaux)- C*8 array - 2D variable units in AUX output -c AUXUNIT3D(mxaux)- C*8 array - 3D variable units in AUX output -c AUXTYP2D(mxaux) - C*4 array - 2D variable types in AUX output -c AUXTYP3D(mxaux) - C*4 array - 3D variable types in AUX output -c---------------------------------------------------------------------- -c --- Notes: 1. Variable names are upper case -c 2. Variable units are upper case -c 'G/M3 ' for example -c 3. Variable types allowed are -c 'R_4 ' for single-precision reals -c 'RC4 ' for single-precision reals, with compression -c 'I_4 ' for 4-byte integers diff --git a/CALPUFF_SRC/CALMET/blockdat.crd b/CALPUFF_SRC/CALMET/blockdat.crd deleted file mode 100644 index c87c405..0000000 --- a/CALPUFF_SRC/CALMET/blockdat.crd +++ /dev/null @@ -1,1374 +0,0 @@ - BLOCK DATA DATUMS -c -c************************************************************ -c -c --- BUILD manufactored BLOCK DATA routine -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - INCLUDE 'nima.crd' - data kmax,nudat /234,132/ -c -c --- Set date-stamp for this BLOCK DATA file - data dateb /'02-21-2003 '/ -c --- Set checking date stamp here - data dstamp /'02-21-2003 '/ -c - data datum / - *'WGS-84 : WGS 84 ', - *'WGS-84 : EMG 96 ', - *'WGS-84 : GRS 80 ', - *'WGS-72 : WGS 72 ', - *'NWS : 6370KM Sphere ', - *'ESRI REFERENCE : Normal Sphere (6371) ', - *'ADINDAN : Clarke 1880 ', - *'AFGOOYE : Krassovsky 1940 ', - *'ARC 1950 : Clarke 1880 ', - *'ARC 1960 : Clarke 1880 ', - *'AYABELLE LIGHTHOUSE : Clarke 1880 ', - *'BISSAU : International 1924 ', - *'CAPE : Clarke 1880 ', - *'CARTHAGE : Clarke 1880 ', - *'DABOLA : Clarke 1880 ', - *'EUROPEAN 1950 : International 1924 ', - *'LEIGON : Clarke 1880 ', - *'LIBERIA 1964 : Clarke 1880 ', - *'MASSAWA : Bessel 1841 ', - *'MERCHICH : Clarke 1880 ', - *'MINNA : Clarke 1880 ', - *'M-PORALOKO : Clarke 1880 ', - *'NORTH SAHARA 1959 : Clarke 1880 ', - *'OLD EGYPTIAN 1907 : Helmert 1906 ', - *'POINT 58 : Clarke 1880 ', - *'POINTE NOIRE 1948 : Clarke 1880 ', - *'SCHWARZECK : Bessel 1841 ', - *'SIERRA LEONE 1960 : Clarke 1880 ', - *'TANANARIVE OBSERVATORY 1925 : International 1924 ', - *'VOIROL 1874 : Clarke 1880 ', - *'VOIROL 1960 : Clarke 1880 ', - *'AIN EL ABD 1970 : International 1924 ', - *'BUKIT RIMPAH : Bessel 1841 ', - *'DJAKARTA (BATAVIA) : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'GUNUNG SEGARA : Bessel 1841 ', - *'HERAT NORTH : International 1924 ', - *'HONG KONG 1963 : International 1924 ', - *'HU-TZU-SHAN : International 1924 ', - *'INDIAN : Everest (1830) ', - *'INDIAN : Everest (1956) ', - *'INDIAN : Everest ', - *'INDIAN 1954 : Everest (1830) ', - *'INDIAN 1960 : Everest (1830) ', - *'INDIAN 1975 : Everest (1830) ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'KANDAWALA : Everest (1830) ', - *'KERTAU 1948 : Everest (1948) ', - *'KOREAN GEODETIC SYSTEM 1995 : WGS 84 ', - *'NAHRWAN : Clarke 1880 ', - *'OMAN : Clarke 1880 ', - *'PULKOVO 1942 : Krassovsky 1940 ', - *'QATAR NATIONAL : International 1924 ', - *'SOUTH ASIA : Modified Fischer 1960', - *'TIMBALAI 1948 : Everest ', - *'TOKYO : Bessel 1841 ', - *'AUSTRALIAN GEODETIC 1966 : Australian National ', - *'AUSTRALIAN GEODETIC 1984 : Australian National ', - *'COORD SYSTEM 1937 OF ESTONIA : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'EUROPEAN 1979 : International 1924 ', - *'HERMANNSKOGEL : Bessel 1841 ', - *'IRELAND 1965 : Modified Airy ', - *'ORD SURV OF GREAT BRITAIN 36 : Airy ', - *'ROME 1940 : International 1924 ', - *'S-42 (PULKOVO 1942) : Krassovsky 1940 ', - *'S-JTSK : Bessel 1841 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'NORTH AMERICAN 1927 : Clarke 1866 ', - *'NORTH AMERICAN 1983 : GRS 80 ', - *'BOGOTA OBSERVATORY : International 1924 ', - *'CAMPO INCHAUSPE 1969 : International 1924 ', - *'CHUA ASTRO : International 1924 ', - *'CORREGO ALEGRE : International 1924 ', - *'PROVISIONAL S. AMERICAN 1956 : International 1924 ', - *'PROVISIONAL S. CHILEAN 1963 : International 1924 ', - *'SOUTH AMERICAN 1969 : South American 1969 ', - *'SIRGAS : GRS 80 ', - *'YACARE : International 1924 ', - *'ZANDERIJ : International 1924 ', - *'ANTIGUA ISLAND ASTRO 1943 : Clarke 1880 ', - *'ASCENSION ISLAND 1958 : International 1924 ', - *'ASTRO DOS 71/4 : International 1924 ', - *'BERMUDA 1957 : Clarke 1866 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'DECEPTION ISLAND : Clarke 1880 ', - *'FORT THOMAS 1955 : Clarke 1880 ', - *'GRACIOSA BASE SW 1948 : International 1924 ', - *'HJORSEY 1955 : International 1924 ', - *'ISTS 061 ASTRO 1968 : International 1924 ', - *'L. C. 5 ASTRO 1961 : Clarke 1866 ', - *'MONTSERRAT ISLAND ASTRO 1958 : Clarke 1880 ', - *'NAPARIMA, BWI : International 1924 ', - *'OBSERVAT. METEOROLOGICO 1939 : International 1924 ', - *'PICO DE LAS NIEVES : International 1924 ', - *'PORTO SANTO 1936 : International 1924 ', - *'PUERTO RICO : Clarke 1866 ', - *'QORNOQ : International 1924 ', - *'SAO BRAZ : International 1924 ', - *'SAPPER HILL 1943 : International 1924 ', - *'SELVAGEM GRANDE 1938 : International 1924 ', - *'TRISTAN ASTRO 1968 : International 1924 ', - *'ANNA 1 ASTRO 1965 : Australian National ', - *'GAN 1970 : International 1924 ', - *'ISTS 073 ASTRO 1969 : International 1924 ', - *'KERGUELEN ISLAND 1949 : International 1924 ', - *'MAHE 1971 : Clarke 1880 ', - *'REUNION : International 1924 ', - *'AMERICAN SAMOA 1962 : Clarke 1866 ', - *'ASTRO BEACON E 1945 : International 1924 ', - *'ASTRO TERN ISLAND (FRIG) 61 : International 1924 ', - *'ASTRONOMICAL STATION 1952 : International 1924 ', - *'BELLEVUE (IGN) : International 1924 ', - *'CAMP AREA ASTRO : International 1924 ', - *'CANTON ASTRO 1966 : International 1924 ', - *'CHATHAM ISLAND ASTRO 1971 : International 1924 ', - *'DOS 1968 : International 1924 ', - *'EASTER ISLAND 1967 : International 1924 ', - *'GEODETIC DATUM 1949 : International 1924 ', - *'GUAM 1963 : Clarke 1866 ', - *'GUX l ASTRO : International 1924 ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'JOHNSTON ISLAND 1961 : International 1924 ', - *'KUSAIE ASTRO 1951 : International 1924 ', - *'LUZON : Clarke 1866 ', - *'MIDWAY ASTRO 1961 : International 1924 ', - *'OLD HAWAIIAN : Clarke 1866 ', - *'PITCAIRN ASTRO 1967 : International 1924 ', - *'SANTO (DOS) 1965 : International 1924 ', - *'VITI LEVU 1916 : Clarke 1880 ', - *'WAKE-ENIWETOK 1960 : Hough ', - *'WAKE ISLAND ASTRO 1952 : International 1924 '/ - data datcod / - *'WGS-84 ','WGS-96 ','WGS-G ','WGS-72 ','NWS-84 ', - *'ESR-S ','ADI-M ','ADI-E ','ADI-F ','ADI-A ', - *'ADI-C ','ADI-D ','ADI-B ','AFG ','ARF-M ', - *'ARF-A ','ARF-H ','ARF-B ','ARF-C ','ARF-D ', - *'ARF-E ','ARF-F ','ARF-G ','ARS-M ','ARS-A ', - *'ARS-B ','PHA ','BID ','CAP ','CGE ', - *'DAL ','EUR-F ','EUR-T ','LEH ','LIB ', - *'MAS ','MER ','MIN-A ','MIN-B ','MPO ', - *'NSD ','OEG ','PTB ','PTN ','SCK ', - *'SRL ','TAN ','VOI ','VOR ','AIN-A ', - *'AIN-B ','BUR ','BAT ','EUR-H ','EUR-S ', - *'GSE ','HEN ','HKD ','HTN ','IND-B ', - *'IND-I ','IND-P ','INF-A ','ING-A ','ING-B ', - *'INH-A ','INH-A1 ','IDN ','KAN ','KEA ', - *'KGS ','NAH-A ','NAH-B ','NAH-C ','FAH ', - *'PUK ','QAT ','SOA ','TIL ','TOY-M ', - *'TOY-A ','TOY-C ','TOY-B ','TOY-B1 ','AUA ', - *'AUG ','EST ','EUR-M ','EUR-A ','EUR-E ', - *'EUR-G ','EUR-K ','EUR-B ','EUR-I ','EUR-J ', - *'EUR-L ','EUR-C ','EUR-D ','EUS ','HER ', - *'IRL ','OGB-M ','OGB-A ','OGB-B ','OGB-C ', - *'OGB-D ','MOD ','SPK-A ','SPK-B ','SPK-C ', - *'SPK-D ','SPK-E ','SPK-F ','SPK-G ','CCD ', - *'CAC ','NAS-C ','NAS-B ','NAS-A ','NAS-D ', - *'NAS-V ','NAS-W ','NAS-Q ','NAS-R ','NAS-E ', - *'NAS-F ','NAS-G ','NAS-H ','NAS-I ','NAS-J ', - *'NAS-O ','NAS-P ','NAS-N ','NAS-T ','NAS-U ', - *'NAS-L ','NAR-A ','NAR-E ','NAR-B ','NAR-C ', - *'NAR-H ','NAR-D ','BOO ','CAI ','CHU ', - *'COA ','PRP-M ','PRP-A ','PRP-B ','PRP-C ', - *'PRP-D ','PRP-E ','PRP-F ','PRP-G ','PRP-H ', - *'HIT ','SAN-M ','SAN-A ','SAN-B ','SAN-C ', - *'SAN-D ','SAN-E ','SAN-F ','SAN-J ','SAN-G ', - *'SAN-H ','SAN-I ','SAN-K ','SAN-L ','SIR ', - *'YAC ','ZAN ','AIA ','ASC ','SHB ', - *'BER ','CAC ','DID ','FOT ','GRA ', - *'HJO ','ISG ','LCF ','ASM ','NAP ', - *'FLO ','PLN ','POS ','PUR ','QUO ', - *'SAO ','SAP ','SGM ','TDC ','ANO ', - *'GAA ','IST ','KEG ','MIK ','REU ', - *'AMA ','ATF ','TRN ','ASQ ','IBE ', - *'CAZ ','CAO ','CHI ','GIZ ','EAS ', - *'GEO ','GUA ','DOB ','IDN ','JOH ', - *'KUS ','LUZ-A ','LUZ-B ','MID ','OHA-M ', - *'OHA-A ','OHA-B ','OHA-C ','OHA-D ','OHI-M ', - *'OHI-A ','OHI-B ','OHI-C ','OHI-D ','PIT ', - *'SAE ','MVS ','ENW ','WAK '/ - data atlas / - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'AUSTRALIA ', - *'AUSTRALIA ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN '/ - data geodat1 / - *'Global coverage [WGS-84 reference ellipsoid and geoid] ', - *'Global coverage [WGS-EGM96 geoid for the Earth Gravitational', - *'Global coverage [GRS-80 ITRF reference ellipsoid] ', - *'Global coverage [WGS-72 reference ellipsoid and geoid] ', - *'Global Sphere (WGS84) ', - *'Global Reference Sphere ', - *'MEAN FOR Ethiopia, Sudan ', - *'Burkina Faso ', - *'Cameroon ', - *'Ethiopia ', - *'Mali ', - *'Senegal ', - *'Sudan ', - *'Somalia ', - *'MEAN FOR Botswana, Lesotho, Malawi, Swaziland, Zaire, Zambia', - *'Botswana ', - *'Burundi ', - *'Lesotho ', - *'Malawi ', - *'Swaziland ', - *'Zaire ', - *'Zambia ', - *'Zimbabwe ', - *'MEAN FOR Kenya, Tanzania ', - *'Kenya ', - *'Tanzania ', - *'Djibouti ', - *'Guinea-Bissau ', - *'South Africa ', - *'Tunisia ', - *'Guinea ', - *'Egypt ', - *'Tunisia ', - *'Ghana ', - *'Liberia ', - *'Eritrea ', - *'Morocco ', - *'Cameroon ', - *'Nigeria ', - *'Gabon ', - *'Algeria ', - *'Egypt ', - *'Burkina Faso, Niger ', - *'Congo ', - *'Namibia ', - *'Sierra Leone ', - *'Madagascar ', - *'Tunisia, Algeria ', - *'Algeria ', - *'Bahrain Island ', - *'Saudi Arabia ', - *'Bangka and Belitung Islands (Indonesia) ', - *'Sumatra (Indonesia) ', - *'Iran ', - *'Iraq, Israel, Jordan, Kuwait, Lebanon, Saudi Arabia, Syria ', - *'Kalimantan (Indonesia) ', - *'Afghanistan ', - *'Hong Kong ', - *'Taiwan ', - *'Bangladesh ', - *'India, Nepal ', - *'Pakistan ', - *'Thailand ', - *'Vietnam (near 16N) ', - *'Con Son Island (Vietnam) ', - *'Thailand ', - *'Thailand ', - *'Indonesia ', - *'Sri Lanka ', - *'West Malaysia, Singapore ', - *'South Korea ', - *'Masirah Island (Oman) ', - *'United Arab Emirates ', - *'Saudi Arabia ', - *'Oman ', - *'Russia ', - *'Qatar ', - *'Singapore ', - *'Brunei, East Malaysia (Sarawak and Sabah) ', - *'MEAN FOR Japan, Okinawa, South Korea ', - *'Japan ', - *'Okinawa ', - *'South Korea ', - *'South Korea ', - *'Australia, Tasmania ', - *'Australia, Tasmania ', - *'Estonia ', - *'MEAN FOR Austria, Belgium, Denmark, Finland, France, Federal', - *'MEAN FOR Austria, Denmark, France, Federal Republic of Germa', - *'Cyprus ', - *'England, Channel Islands, Scotland, Shetland Islands ', - *'England, Ireland, Scotland, Shetland Islands ', - *'Greece ', - *'Sardinia (Italy) ', - *'Sicily (Italy) ', - *'Malta ', - *'Norway, Finland ', - *'Portugal, Spain ', - *'MEAN FOR Austria, Finland, Netherlands, Norway, Spain, Swede', - *'Yugoslavia (Prior to 1990), Slovenia, Croatia, Bosnia and He', - *'Ireland ', - *'MEAN FOR England, Isle of Man, Scotland, Shetland Islands, W', - *'England ', - *'England, Isle of Man, Wales ', - *'Scotland, Shetland Islands ', - *'Wales ', - *'Sardinia ', - *'Hungary ', - *'Poland ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Latvia ', - *'Kazakhstan ', - *'Albania ', - *'Romania ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Florida, Bahamas ', - *'MEAN FOR CONTIGUOUS US(CONUS) ', - *'MEAN FOR Arizona, Arkansas, California, Colorado, Idaho, Iow', - *'MEAN FOR Alabama, Connecticut, Delaware, District of Columbi', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands (East of 180W) ', - *'Aleutian Islands (West of 180W) ', - *'Bahamas (Excluding San Salvador Island) ', - *'San Salvador Island ', - *'MEAN FOR Canada (Including Newfoundland) ', - *'Alberta, British Columbia ', - *'MEAN FOR Newfoundland, New Brunswick, Nova Scotia, Quebec ', - *'Manitoba, Ontario ', - *'Northwest Territories, Saskatchewan ', - *'Yukon ', - *'Canal Zone ', - *'MEAN FOR Antigua Island, Barbados, Barbuda, Caicos Islands, ', - *'MEAN FOR Belize, Costa Rica, El Salvador, Guatemala, Hondura', - *'Cuba ', - *'Greenland (Hayes Peninsula) ', - *'Mexico ', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands ', - *'Canada ', - *'CONTIGUOUS US (CONUS) ', - *'Hawaii ', - *'Mexico, Central America ', - *'Colombia ', - *'Argentina ', - *'Paraguay ', - *'Brazil ', - *'MEAN FOR Bolivia, Chile, Colombia, Ecuador, Guyana, Peru, Ve', - *'Bolivia ', - *'Northern Chile (near 19S) ', - *'Southern Chile (near 43S) ', - *'Colombia ', - *'Ecuador ', - *'Guyana ', - *'Peru ', - *'Venezuela ', - *'Southern Chile (near 53S) ', - *'MEAN FOR Argentina, Bolivia, Brazil, Chile, Colombia, Ecuado', - *'Argentina ', - *'Bolivia ', - *'Brazil ', - *'Chile ', - *'Colombia ', - *'Ecuador (Excluding Galapagos Islands) ', - *'Baltra, Galapagos Islands ', - *'Guyana ', - *'Paraguay ', - *'Peru ', - *'Trinidad and Tobago ', - *'Venezuela ', - *'South America ', - *'Uruguay ', - *'Suriname ', - *'Antigua, Leeward Islands ', - *'Ascension Island ', - *'St. Helena Island ', - *'Bermuda Islands ', - *'Bahamas, Florida ', - *'Deception Island (Antarctica) ', - *'Nevis, St. Kitts, Leeward Islands ', - *'Faial, Graciosa, Pico, Sao Jorge, Terceira Islands (Azores) ', - *'Iceland ', - *'South Georgia Island ', - *'Cayman Brac Island ', - *'Montserrat, Leeward Islands ', - *'Trinidad and Tobago ', - *'Corvo and Flores Islands (Azores) ', - *'Canary Islands ', - *'Porto Santo, Madeira Islands ', - *'Puerto Rico, Virgin Islands ', - *'South Greenland ', - *'Sao Miguel, Santa Maria Islands (Azores) ', - *'East Falkland Island ', - *'Salvage Islands ', - *'Tristan da Cunha ', - *'Cocos Islands ', - *'Republic of Maldives ', - *'Diego Garcia ', - *'Kerguelen Island ', - *'Mahe Island ', - *'Mascarene Islands ', - *'American Samoa Islands ', - *'Iwo Jima ', - *'Tern Island ', - *'Marcus Island ', - *'Efate and Erromango Islands ', - *'Camp McMurdo Area (Antarctica) ', - *'Phoenix Islands ', - *'Chatham Island (New Zealand) ', - *'Gizo Island (New Georgia Islands) ', - *'Easter Island ', - *'New Zealand ', - *'Guam ', - *'Guadalcanal Island ', - *'Indonesia ', - *'Johnston Island ', - *'Caroline Islands, Federal States of Micronesia ', - *'Philippines (Excluding Mindanao Island) ', - *'Mindanao Island ', - *'Midway Islands ', - *'MEAN FOR Hawaiian Islands ', - *'Hawaii ', - *'Kauai ', - *'Maui ', - *'Oahu ', - *'Old Hawaiian (Mean) ', - *'Old Hawaiian Hawaii ', - *'Old Hawaiian Kauai ', - *'Old Hawaiian Maui ', - *'Old Hawaiian Oahu ', - *'Pitcairn Island ', - *'Espirito Santo Island ', - *'Viti Levu Island (Fiji Islands) ', - *'Marshall Islands ', - *'Wake Atoll '/ - data geodat2 / - *' ', - *' Model (EGM) vertical datum] ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *', Zimbabwe ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' Republic of Germany (Prior to 1 January 1993), Gibraltar, G', - *'ny (Prior to 1 January 1993), Netherlands, Switzerland ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'n, Switzerland ', - *'rzegovina, Serbia ', - *' ', - *'ales ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'a, Kansas, Montana, Nebraska, Nevada, New Mexico, North Dako', - *'a, Florida, Georgia, Illinois, Indiana, Kentucky, Louisiana,', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'Cuba, Dominican Republic, Grand Cayman, Jamaica, Turks Islan', - *'s, Nicaragua ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'nezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'r, Guyana, Paraguay, Peru, Trinidad and Tobago, Venezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data geodat3 / - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'reece, Italy, Luxembourg, Netherlands, Norway, Portugal, Spa', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ta, Oklahoma, Oregon, South Dakota, Texas, Utah, Washington,', - *' Maine, Maryland, Massachusetts, Michigan, Minnesota, Missis', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ds ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data dattyp / - * 1, 2, 3, 4, 5, - * 6, 7, 7, 7, 7, - * 7, 7, 7, 8, 9, - * 9, 9, 9, 9, 9, - * 9, 9, 9, 10, 10, - * 10, 11, 12, 13, 14, - * 15, 16, 16, 17, 18, - * 19, 20, 21, 21, 22, - * 23, 24, 25, 26, 27, - * 28, 29, 30, 31, 32, - * 32, 33, 34, 35, 35, - * 36, 37, 38, 39, 40, - * 41, 42, 43, 44, 44, - * 45, 45, 46, 47, 48, - * 49, 50, 50, 50, 51, - * 52, 53, 54, 55, 56, - * 56, 56, 56, 56, 57, - * 58, 59, 60, 60, 60, - * 60, 60, 60, 60, 60, - * 60, 60, 60, 61, 62, - * 63, 64, 64, 64, 64, - * 64, 65, 66, 66, 66, - * 66, 66, 66, 66, 67, - * 68, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 70, 70, 70, 70, - * 70, 70, 71, 72, 73, - * 74, 75, 75, 75, 75, - * 75, 75, 75, 75, 75, - * 76, 77, 77, 77, 77, - * 77, 77, 77, 77, 77, - * 77, 77, 77, 77, 78, - * 79, 80, 81, 82, 83, - * 84, 85, 86, 87, 88, - * 89, 90, 91, 92, 93, - * 94, 95, 96, 97, 98, - * 99, 100, 101, 102, 103, - * 104, 105, 106, 107, 108, - * 109, 110, 111, 112, 113, - * 114, 115, 116, 117, 118, - * 119, 120, 121, 122, 123, - * 124, 125, 125, 126, 127, - * 127, 127, 127, 127, 128, - * 128, 128, 128, 128, 128, - * 129, 130, 131, 132/ - data dradim / - *.6378137D+07,.6378137D+07,.6378137D+07,.6378135D+07,.6370000D+07, - *.6370997D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378245D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6377397D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378200D+07,.6378249D+07,.6378249D+07,.6377484D+07, - *.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6377397D+07,.6377397D+07,.6378388D+07,.6378388D+07, - *.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377276D+07, - *.6377301D+07,.6377310D+07,.6377276D+07,.6377276D+07,.6377276D+07, - *.6377276D+07,.6377276D+07,.6378160D+07,.6377276D+07,.6377304D+07, - *.6378137D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378245D+07,.6378388D+07,.6378155D+07,.6377299D+07,.6377397D+07, - *.6377397D+07,.6377397D+07,.6377397D+07,.6377397D+07,.6378160D+07, - *.6378160D+07,.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377397D+07, - *.6377340D+07,.6377563D+07,.6377563D+07,.6377563D+07,.6377563D+07, - *.6377563D+07,.6378388D+07,.6378245D+07,.6378245D+07,.6378245D+07, - *.6378245D+07,.6378245D+07,.6378245D+07,.6378245D+07,.6377397D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378137D+07,.6378137D+07,.6378137D+07,.6378137D+07, - *.6378137D+07,.6378137D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378137D+07, - *.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07,.6378388D+07, - *.6378206D+07,.6378206D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378206D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378160D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07, - *.6378206D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378388D+07,.6378160D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378206D+07,.6378388D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378249D+07,.6378270D+07,.6378388D+07/ - data dflat / - *.2982572D+03,.2982572D+03,.2982572D+03,.2982600D+03,.1000000D+21, - *.1000000D+21,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2983000D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2991528D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2983000D+03,.2934650D+03,.2934650D+03,.2991528D+03, - *.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2991528D+03,.2991528D+03,.2970000D+03,.2970000D+03, - *.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.2982470D+03,.3008017D+03,.3008017D+03, - *.2982572D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2983000D+03,.2970000D+03,.2983000D+03,.3008017D+03,.2991528D+03, - *.2991528D+03,.2991528D+03,.2991528D+03,.2991528D+03,.2982500D+03, - *.2982500D+03,.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2991528D+03, - *.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03, - *.2993250D+03,.2970000D+03,.2983000D+03,.2983000D+03,.2983000D+03, - *.2983000D+03,.2983000D+03,.2983000D+03,.2983000D+03,.2991528D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2982572D+03,.2982572D+03,.2982572D+03,.2982572D+03, - *.2982572D+03,.2982572D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982572D+03, - *.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03, - *.2949787D+03,.2949787D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2949787D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2982500D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03, - *.2949787D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2970000D+03,.2982470D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2949787D+03,.2970000D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03/ - data dec2 / - *.6694380D-02,.6694380D-02,.6694380D-02,.6694318D-02,.0000000D+00, - *.0000000D+00,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6693422D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6674372D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6693422D-02,.6803511D-02,.6803511D-02,.6674372D-02, - *.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6674372D-02,.6674372D-02,.6722670D-02,.6722670D-02, - *.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6694609D-02,.6637847D-02,.6637847D-02, - *.6694380D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6693422D-02,.6722670D-02,.6693422D-02,.6637847D-02,.6674372D-02, - *.6674372D-02,.6674372D-02,.6674372D-02,.6674372D-02,.6694542D-02, - *.6694542D-02,.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6674372D-02, - *.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02, - *.6670540D-02,.6722670D-02,.6693422D-02,.6693422D-02,.6693422D-02, - *.6693422D-02,.6693422D-02,.6693422D-02,.6693422D-02,.6674372D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6694380D-02,.6694380D-02,.6694380D-02,.6694380D-02, - *.6694380D-02,.6694380D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694380D-02, - *.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02, - *.6768658D-02,.6768658D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6768658D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6694542D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02, - *.6768658D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6722670D-02,.6694609D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6768658D-02,.6722670D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02/ - data dxmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -166.000, -118.000, -134.000, -165.000, - * -123.000, -128.000, -161.000, -43.000, -143.000, - * -138.000, -153.000, -125.000, -161.000, -134.000, - * -169.000, -147.000, -142.000, -160.000, -157.000, - * -175.000, -79.000, -173.000, -136.000, -263.000, - * -83.000, -130.000, -112.000, -130.000, -90.000, - * 639.000, 31.000, -81.000, -92.000, -74.000, - * -186.000, -130.000, -106.000, -148.000, 616.000, - * -88.000, -189.000, -73.000, -123.000, -150.000, - * -143.000, -384.000, -377.000, -117.000, -103.000, - * -403.000, -333.000, -156.000, -637.000, 282.000, - * 295.000, 283.000, 217.000, 198.000, 182.000, - * 209.000, 210.000, -24.000, -97.000, -11.000, - * 0.000, -247.000, -249.000, -243.000, -346.000, - * 28.000, -128.000, 7.000, -679.000, -148.000, - * -148.000, -158.000, -146.000, -147.000, -133.000, - * -134.000, 374.000, -87.000, -87.000, -104.000, - * -86.000, -86.000, -84.000, -97.000, -97.000, - * -107.000, -87.000, -84.000, -86.000, 682.000, - * 506.000, 375.000, 371.000, 371.000, 384.000, - * 370.000, -225.000, 28.000, 23.000, 26.000, - * 24.000, 15.000, 24.000, 28.000, 589.000, - * -2.000, -8.000, -8.000, -9.000, -5.000, - * -2.000, 2.000, -4.000, 1.000, -10.000, - * -7.000, -22.000, -9.000, 4.000, -7.000, - * 0.000, -3.000, 0.000, -9.000, 11.000, - * -12.000, 0.000, -2.000, 0.000, 0.000, - * 1.000, 0.000, 307.000, -148.000, -134.000, - * -206.000, -288.000, -270.000, -270.000, -305.000, - * -282.000, -278.000, -298.000, -279.000, -295.000, - * 16.000, -57.000, -62.000, -61.000, -60.000, - * -75.000, -44.000, -48.000, -47.000, -53.000, - * -61.000, -58.000, -45.000, -45.000, 0.000, - * -155.000, -265.000, -270.000, -205.000, -320.000, - * -73.000, -2.000, 260.000, -7.000, -104.000, - * -73.000, -794.000, 42.000, 174.000, -10.000, - * -425.000, -307.000, -499.000, 11.000, 164.000, - * -203.000, -355.000, -289.000, -632.000, -491.000, - * -133.000, 208.000, 145.000, 41.000, 94.000, - * -115.000, 145.000, 114.000, 124.000, -127.000, - * -104.000, 298.000, 175.000, 230.000, 211.000, - * 84.000, -100.000, 252.000, -24.000, 189.000, - * 647.000, -133.000, -133.000, 912.000, 61.000, - * 89.000, 45.000, 65.000, 58.000, 201.000, - * 229.000, 185.000, 205.000, 198.000, 185.000, - * 170.000, 51.000, 102.000, 276.000/ - data dymod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -15.000, -14.000, -2.000, -11.000, - * -20.000, -18.000, -14.000, -163.000, -90.000, - * -105.000, -5.000, -108.000, -73.000, -105.000, - * -19.000, -74.000, -96.000, -6.000, -2.000, - * -23.000, -129.000, 253.000, -108.000, 6.000, - * 37.000, -117.000, -77.000, 29.000, 40.000, - * 405.000, 146.000, -84.000, -93.000, -130.000, - * -93.000, 110.000, -129.000, 51.000, 97.000, - * 4.000, -242.000, -247.000, -206.000, -250.000, - * -236.000, 664.000, 681.000, -132.000, -106.000, - * 684.000, -222.000, -271.000, -549.000, 726.000, - * 736.000, 682.000, 823.000, 881.000, 915.000, - * 818.000, 814.000, -15.000, 787.000, 851.000, - * 0.000, -148.000, -156.000, -192.000, -1.000, - * -130.000, -283.000, -10.000, 669.000, 507.000, - * 507.000, 507.000, 507.000, 506.000, -48.000, - * -48.000, 150.000, -98.000, -96.000, -101.000, - * -96.000, -96.000, -95.000, -103.000, -88.000, - * -88.000, -95.000, -107.000, -98.000, -203.000, - * -122.000, -111.000, -112.000, -111.000, -111.000, - * -108.000, -65.000, -121.000, -124.000, -121.000, - * -124.000, -130.000, -130.000, -121.000, 76.000, - * 151.000, 160.000, 159.000, 161.000, 135.000, - * 152.000, 204.000, 154.000, 140.000, 158.000, - * 162.000, 160.000, 157.000, 159.000, 139.000, - * 125.000, 142.000, 125.000, 152.000, 114.000, - * 130.000, 0.000, 0.000, 0.000, 0.000, - * 1.000, 0.000, 304.000, 136.000, 229.000, - * 172.000, 175.000, 188.000, 183.000, 243.000, - * 169.000, 171.000, 159.000, 175.000, 173.000, - * 196.000, 1.000, -1.000, 2.000, -2.000, - * -1.000, 6.000, 3.000, 26.000, 3.000, - * 2.000, 0.000, 12.000, 8.000, 0.000, - * 171.000, 120.000, 13.000, 107.000, 550.000, - * 213.000, 151.000, 12.000, 215.000, 167.000, - * 46.000, 119.000, 124.000, 359.000, 375.000, - * -169.000, -92.000, -249.000, 72.000, 138.000, - * 141.000, 21.000, -124.000, 438.000, -22.000, - * -321.000, -435.000, -187.000, -220.000, -948.000, - * 118.000, 75.000, -116.000, -234.000, -769.000, - * -129.000, -304.000, -38.000, -199.000, 147.000, - * -22.000, -248.000, -209.000, -15.000, -79.000, - * 1777.000, -77.000, -79.000, -58.000, -285.000, - * -279.000, -290.000, -290.000, -283.000, -228.000, - * -222.000, -233.000, -233.000, -226.000, 165.000, - * 42.000, 391.000, 52.000, -57.000/ - data dzmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, 204.000, 218.000, 210.000, 206.000, - * 220.000, 224.000, 205.000, 45.000, -294.000, - * -289.000, -292.000, -295.000, -317.000, -295.000, - * -278.000, -283.000, -293.000, -302.000, -299.000, - * -303.000, 145.000, 27.000, -292.000, 431.000, - * 124.000, -151.000, -145.000, 364.000, 88.000, - * 60.000, 47.000, 115.000, 122.000, 42.000, - * 310.000, -13.000, 165.000, -291.000, -251.000, - * 101.000, -91.000, 227.000, 219.000, -1.000, - * 7.000, -48.000, -50.000, -164.000, -141.000, - * 41.000, 114.000, -189.000, -203.000, 254.000, - * 257.000, 231.000, 299.000, 317.000, 344.000, - * 290.000, 289.000, 5.000, 86.000, 5.000, - * 0.000, 369.000, 381.000, 477.000, 224.000, - * -95.000, 22.000, -26.000, -48.000, 685.000, - * 685.000, 676.000, 687.000, 687.000, 148.000, - * 149.000, 588.000, -121.000, -120.000, -140.000, - * -120.000, -120.000, -130.000, -120.000, -135.000, - * -149.000, -120.000, -120.000, -119.000, 480.000, - * 611.000, 431.000, 434.000, 434.000, 425.000, - * 434.000, 9.000, -77.000, -82.000, -78.000, - * -82.000, -84.000, -92.000, -77.000, 480.000, - * 181.000, 176.000, 175.000, 179.000, 172.000, - * 149.000, 105.000, 178.000, 165.000, 187.000, - * 188.000, 190.000, 184.000, 188.000, 181.000, - * 201.000, 183.000, 194.000, 178.000, 195.000, - * 190.000, 0.000, 4.000, 0.000, 0.000, - * -1.000, 0.000, -318.000, 90.000, -29.000, - * -6.000, -376.000, -388.000, -390.000, -442.000, - * -371.000, -367.000, -369.000, -379.000, -371.000, - * 93.000, -41.000, -37.000, -48.000, -41.000, - * -44.000, -36.000, -44.000, -42.000, -47.000, - * -33.000, -44.000, -33.000, -33.000, 0.000, - * 37.000, -358.000, 62.000, 53.000, -494.000, - * 296.000, 181.000, -147.000, 225.000, -38.000, - * -86.000, -298.000, 147.000, 365.000, 165.000, - * 81.000, 127.000, 314.000, -101.000, -189.000, - * 53.000, 72.000, 60.000, -609.000, 435.000, - * 50.000, -229.000, 103.000, -134.000, -1262.000, - * 426.000, -272.000, -333.000, -25.000, 472.000, - * 239.000, -375.000, 113.000, -752.000, 111.000, - * 209.000, 259.000, -751.000, 5.000, -202.000, - * -1124.000, -51.000, -72.000, 1227.000, -181.000, - * -183.000, -172.000, -190.000, -182.000, -346.000, - * -348.000, -337.000, -355.000, -347.000, 42.000, - * 84.000, -36.000, -38.000, 149.000/ - END diff --git a/CALPUFF_SRC/CALMET/breez.met b/CALPUFF_SRC/CALMET/breez.met deleted file mode 100644 index f025b90..0000000 --- a/CALPUFF_SRC/CALMET/breez.met +++ /dev/null @@ -1,9 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /BREEZ/ -- Lake Breeze common block CALMET -c---------------------------------------------------------------------- -c - logical llbreze - COMMON /Breez/ xbcst(mxbox),xecst(mxbox),ybcst(mxbox), - 1 yecst(mxbox),nlb(mxbox),iboxid(mxbox,mxwnd), - 2 xg1(mxbox),xg2(mxbox),yg1(mxbox),yg2(mxbox), - 3 llbreze,nbox diff --git a/CALPUFF_SRC/CALMET/calmet.for b/CALPUFF_SRC/CALMET/calmet.for deleted file mode 100644 index a5d80c2..0000000 --- a/CALPUFF_SRC/CALMET/calmet.for +++ /dev/null @@ -1,40198 +0,0 @@ -c----------------------------------------------------------------------- - program calmet -c----------------------------------------------------------------------- -c --- CALMET -- Diagnostic meteorological model for the CALPUFF, -c --- CALGRID, and MESOPUFF-II models -c----------------------------------------------------------------------- -c -c Copyright (c) 2014-2015 by Exponent, Inc. -c -c --- CALMET Version: 6.5.0 Level: 150223 MAIN -c -c --- CALMET MOD6- Developed by: -c Joe Scire and Francoise Robe -c Earth Tech, Inc. -c Concord, MA -c --- e-mail: jscire@alum.mit.edu -c -c --- Original CALMET written by: -c J. Scire, R. Yamartino -c EARTH TECH/Sigma Research -c 196 Baker Avenue -c Concord, MA 01742 -c tel: (978) 371-4200 -c fax: (978) 371-2468 -c and -c S. Douglas, R. Kessler -c Systems Applications, Inc. -c 101 Lucas Valley Road -c San Rafael, CA 94903 -c -c Modifications made by -c M. Fernau, X. Zhang, J. Scire, F. Robe, and -c D. Strimaitis -c EARTH TECH/Sigma Research -c -c----------------------------------------------------------------------- -c --- Model Change Bulletin Updates Included: MCB-A (040716) -c MCB-B (051216) -c MCB-C (070501) -c MCB-D (070623) -c MCB-E (080512) -c MCB-F (110212) -c MCB-G (110421) -c----------------------------------------------------------------------- -c -c --- v6.4.2 to v6.5.0, Level: 150223 -c - Trap and report error opening files (not found) -c NEW: OPEN_ERR (in CALUTILS v7.0.0) -c MODIFIED: SETUP, OPENOT, RDHD5, RDHD51, RDHD52, RDHD53, -c RDHDMET, RDMM4 -c - Fix lines that exceed FORTRAN fixed-format limit (72). -c These lines are active only when overwater convective mixing -c heights are simulated with the Batchvarova-Gryning option. -c MODIFIED: WATER, WATERP -c - Change write-statement format from 104 to 105 when reporting -c information to list file from subhourly 3D.DAT file (when -c imm53d=3) -c MODIFIED: RDHD53 -c --- v6.4.1, Level: 140716 to v6.4.2, Level: 140912 -c - Fix bug in setting the S./N. hemisphere when extrapolating -c the wind direction in the vertical above the surface using -c the similarity extrapolation option (IEXTRP=4 or -4) for -c surface-station data. This may produce a wind rotation error -c when using UTM coordinates if the latitude variable XLAT1 -c is not consistent with the station location. -c Modified: SIMILT -c --- v6.4.0, Level: 121203 to v6.4.1, Level: 140716 -c - Enhance string-processing when checking for the dataset -c version of the input 3D.DAT file. Previous code halted when -c reading a 3D.DAT file prepared by CALTAPM because the dataset -c version was not properly compared to known values. -c Modified: PARAMS.MET -c RDHD53, RDMM5 -c --- v6.334, Level 110421 to v6.4.0, Level: 121203 -c - Add wind direction rotation for the Polar Stereographic -c projection option; initialize LCCIGF logical -c Modified: PARAMS.MET, IGF.MET -c RDMM4, RDMM5, RDOW, RDS, RDUP, READCF -c RDSN, RDUPN, RDUPN2, READHD, RDHDMET, RDCALMET -c - Bug Fix: time zone read statement for dataset v2.1 SURF.DAT -c or v2.1 PRECIP.DAT was missing in branch for headers with -c full location information (CALMET halts ...) -c Modified: RDHD -c - Add logic to pass 3D.DAT liquid water info to AUX file -c 1 Average M3D LWC to CALMET layers (3D output to AUX file) -c 2 Average M3D LWC>threshqc above CALMET top and report as 2D -c fields of cloud bottom, cloud top, and average cloud LWC -c 3 Allow more than 99 M3D input files -c New: AUXDAT.MET, AUXVAR.MET -c OUTAUXHD, AUXOUT, COMPRS, XTRACT, WRDAT, WRINT -c Z2FACE, PRFVAR -c Modified: OUTPT.MET -c BLOCK DATA, READFN, SETUP, OPENOT, COMP, -c RDMM5, OUTHD -c - Add checks for recognized 3D.DAT dataset versions -c 2.0, 2.1, 2.11, 2.12, 2.13, 3.0, 3.1 -c and halt with error message if 3D.DAT is generated by a -c processor version with known errors. -c Modified: RDHD53 -c - Revise logic for selecting format of M3D data records -c starting with 3D.DAT version 2.0 -c Modified: RDMM5 -c - Set model version string to character*12 for all i/o -c Modified: QA.MET -c RDHDMET, READCF, OUTHD -c -c --- v6.333 Level 110324 to v6.334 Level 110421 -c --- Modifications by J.Scire: -c (1) Bug Fix: ensure that the same sounding is used to calculate the -c lapse rate at the top of the convective mixing height during its -c growth and in the BG mixing height calculation and that used to -c define the whole temperature profile. -c Modified: MIXHT, MIXHTST -c (2) Bug Fix: For NPSTA=-1 (CALMET preciptation interpolated from -c prognostic precipitation field) overwrite user-defined SIGMAP -c to ensure that the interpolation always includes the 4 nearest -c progn. gridpoints to any CALMET gridpoint (and only those 4) -c to ensure consistency of CALMET and prgn. precipitation fields) -c Modified: RDHD4, RDHD5, READHD -c -c --- v6.332 level 110212 to v6.333 Level 110324 -c --- Modifications by F.Robe: -c (1) When 3D.DAT lowest level is above lowest CALMET level(s) -c during a nightime warming (e.g. warm front), allow the same -c warming at lower CALMET levels as warming at the lowest 3D.DAT -c level -c Modified: STULL -c -c --- v6.331 Level 101206 to v6.332 Level 110212 -c --- Modifications by F.Robe: -c (1) Bug Fix: pass old convective mixing height overwater to -c mixhmc rather than old mixing height (as it was intended -c since v6.229 but was not done owing to a typo) -c Modified: WATER -c (2) Make relaxation of convective mixing height to equilibrium -c value an option (to insure backward compatibility with MOD5) -c (default:On-IZICRLX=1; compatibility with v5.8:off-IZICRLX=0) -c Modified: CALMET.INP, READCF,MIXHMC, MIXHBG, ZIPARM.MET, -c BLOCK DATA -c (3) Add IZICRLX=0 to the MREG check: -c IZICRLX 0 Do NOT use convective mixing height relaxation -c to equilibrium value -c Modified: READCF -c (4) Allow user to set the ZIc relaxation time -c (default: TZICRLX=800s) -c Modified: CALMET.INP, READCF,MIXHMC, MIXHBG, ZIPARM.MET, -c BLOCK DATA -c (5) in MIXHBG, make relaxation ZicBG value consistent with the -c calculation of the threshold flux -c Modified : MIXHBG -c (6) Updated CALUTILS.FOR to version v2.58 (110225) -c - Add control file variable type 5 (character array) and -c retain commas in string returned so that array of -c variable values can be parsed -c Modified: READIN, ALTONU, SETVAR -c -c --- v6.330 Level 101006 to v6.331 Level 101206 -c --- Modifications by F.Robe: -c (1) Bug fix: correctly convert beginning year read from -c MOD5-CALMET.INP for runs starying on Jan1, at 0 LST -c (2) Harmonize input/output cloud option: sub-hourly input/output -c for both formatted and unformatted with beg/ending times -c Option to read in old hourly cloud.dat with ending times -c does not exist any longer - CLOUD.DAT must be with same -c frequency as CALMET -c Modified: COMP, OUTCLD, new RDCLDN -c -c --- V6.329 Level 100719 to v6.330 Level 101006 -c --- Modifications by C. Escoffier: -c (1) Change in CALMET.INP the variable ICLOUD into two new -c variables: MCLOUD and ICLDOUT to distinguished between -c outputing a CLOUD.DAT and the method of clouds computation -c or input into CALMET -c Modified: CALMET.INP, met1.met -c Modified subroutine: BLOCK data,comp,elustr,elustr2,heatflx, -c missfc,openot,pgtstb,rdhd5,rdmm4,rdmm5,readcf,readhd,stheor, -c radflx,wrfiles,outcld -c --- V6.328 Level 090615 to v6.329 Level 100719 -c --- Modifications by F. Robe: -c (1) Relax convective mixing height to equilibrium value based on -c THRESHW (or THRESHL) and turbulence timescale of 800s when the -c buoyancy flux is positive but lower than the threshold. -c This change can affect Zi and w* prior results for cases where -c THRESHW>0 and/or THRESHL>0 during weakly convective times -c Modified: MIXHMC, MIXHBG -c (2) Bug fix: Grow overwater convective mixing height from previous -c hour convective mixing height, not from previous hour mixing -c height -c Modified: WATER,WATERP -c -c --- V6.327 Level 090511 to V6.328 Level 090615 -c (1) Read and store header record data from 3D.DAT files for 2nd, -c 3rd, ... 3D.DAT file read in a single CALMET run. Previously, -c header record data were skipped except in first 3D.DAT file. -c (Note: this change exists in MOD5 since v5.728) -c Subr. modified: RDHD5, RDHD51, RDHD52, RDHD53 -c -c --- V6.326 Level 080709 to V6.327 Level 090511 -c (1) Initialize nscmm5 if it is not read from 3D.DAT header -c record (does not affect results but could stop execution -c if the compiler checks for non-initialized variables) -c Modified: RDHD53 -c (2) Initialize qc and qr when those variables are not in the -c MM5 records (does not affect results but could stop execution -c if the compiler checks for non-initialized variables) -c Modified: RDMM5 -c (3) Revised write statements 1089-1090 to add more information -c to error warnings and reflect explicit times with seconds -c Modified: PREPDI, TEMP3D, TEMP3D_BACK -c (4) Remove Format statements 1089 and 1090 in CGAMMA subroutine -c as they are not used -c Modified: CGAMMA -c (5) Update documentation in UPMET.MET to reflect time differences -c in seconds rather than hours -c Modified: UPMET.MET -c (6) Include more information to output error messages -c Modified: READHD, COMP -c (7) Store dataset beginning time as specified in UP.DAT header V2.0 -c and do not shift it by 1 hour -c Modified: READHDU -c (8) Update documentation on the following four routines to the -c correct model version number: -c Modified: AIRDEN_NS, T2D_NSP, PSIUC, SURFVAR_BACK -c (9) Updated CALUTILS.FOR to version v2.571 (090511) -c - Increase control file line length to 200 characters -c - Activate CPU clock using F95 system routine -c - Add routine to reformat a date string -c - New : FMT_DATE -c - Modified: PARAMS.CAL, READIN, DATETM -c Reformat date reported to list file -c Modified: FIN -c Reset control-file line-length limit to 200 -c Modified: TFERCF -c (10) Check that CALMET grid is within the prognostic sub-domain -c Modified: RDHD5, RDHD4, PARAMS.MET, INOUT (new subroutine) -c (11) Create QA plot file qametg.bna (CALMET domain boundary) -c Modified: READCF -c -c --- V6.325 Level 080512 to V6.326 Level 080709 -c (1) Modify timecheck in RDMM5 for the case of multiple overlapping -c MM5 input data files to avoid the simulation to stop one -c short (in the case of hourly M3Dfiles only). -c Results are not affected by this fix if the fields -c at the last overlapping hour are identical in both files -c otherwise they may differ for that hour (and only that one). -c If MM5 files overlap, the earlier file is read to the end -c and overlapping times are skipped in the subsequent file. -c Modified: RDMM5 -c (2) Fixed typo in error message -c Modified: RDMM5 -c (3) Only call cloud4 if new valid data (icloud=4 option) -c (Improve efficiency- No result change)- -c Modified: RDMM5 -c (4) Corrected level on comment line identifying Version V6.325 -c -c --- v6.324 Level 080421 to V6.325 Level 080512 -c (1) Bug fix: Update values of gridpoint locations in the call to -c cinterp and r2interp2- Affects computation of prognostic -c ceiling heights (3D.DAT only - IPROG>5 and ICLOUD=3,4) -c Modified: RDMM5 -c (2) Apply temperature interpolation overwater at CALMET levels -c below lowest M3D level to actual temperature array when -c ITWPROG=2 -c Modified: RDMM5 -c -c --- V6.323 Level 080411 to v6.324 Level 080421 -c (1) Allow different map projections and datums for the IGF-CALMET -c and current CALMET simulations -c Modified: RDHDMET,RDCALMET. -c (2) Compute current CALMET x,y coordinates in RDHDMET and store -c them in GRID.MET for use in RDCALMET only. -c Modified: RDHDMET, GRID.MET, RDCALMET -c !!!!Note that computing CALMET gridpoints (x,y) only once for all -c instead of recomputing them in 10 subroutines -c READHD, MICROI,RDMM4,RDMM5,RDHD4,RDHD5,RDHDMET,RDCALMET, -c INTER2 and INTERP cannot be implemented because the tiny decimal -c changes with respect to previous versions this implies can induce -c tiny differences in results, which for large grids, can induce -c not so tiny changes in CALPUFF (tested in internal version v6.322) -c (3) Correct typo (clabxp instead of clabxi) - Does not affect -c results -c Modified: RDHDMET -c (4) Updated CALUTILS from v2.55 Level 070327 to v2.56 Level 080407 -c Control file entries in exponential notation were not correct -c if decimal point was missing (2e-02 was read as 0.2e-02). -c Modified: ALTONU -c --- v6.321 Level 080325 to V6.323 Level 080411 (F.Robe) -c (1) Bug fix: check values of prognostic ceiling heights at both -c times t1 and t2 before performing a time interpolation. -c (suggested by Bruno Santos) -c Modified: RDMM5 -c (2) Remove un-necessary unity exponent in COARE stability functions -c to avoid potential numerical problems (no change in results) -c Modified: PSIUD, PSIU -c (3) Only print out IGF-CALMET ending times in LST file if IGF-CALMET -c version 2.1 (undefined ending times otherwise which might stop -c compilation/execution on some platforms) -no change in results) -c --- v6.322 - internal developer version Level 080326 - (F.Robe) -c --- v6.32 Level 080205 to v6.321 Level 080325 - (F.Robe) -c --- (1) Bug fix: Remove nsecdt from calling list to rdupn2 (only affects -c runs with UP.DAT files Version 2.2 and code V6.32 Level 080205) -c Modified: COMP -c (2) Modify write statements to LST files to 1) reflect the precipitation -c dataset name 2) align values with text in LST file -c Does not affect results -c Modified: READHD -c (3) Check precip. station IDs based on LFCPRC not LFCSFC. -c Modified: READHD -c (4) Save isec1, isec2 to make sure their values are saved from one -c timestep to the next. Otherwise can assume wrong values and -c cause crash with some compilers. -c Modified: RDMM5 -c (5) Correct typo that stops a run with a SURF.DAT or PRECIP.DAT file -c stating in its header that the surf./precip. records end on the last -c day of the year at hour 24. -c Modified: RDHD -c --- V6.31 Level 071207 to v6.32 Level 080205 -c (1) Allow sub-hourly prognostic timesteps (MM5/M3D format only) -c (instantaneous records only and timesteps >= CALMET timestep) -c Note: 3D.DAT version 3.0 has explicit beginning and end times -c with seconds. For instantaneous records: beginning time=end time -c New input parameter: ISTEPPGS (pgn timestep in seconds) -c Modified: RDMM5, RDHD5, RDHD53, READCF,READHD,MM4HDO.MET CALMET.INP -c (2) Allow new format for upper air soundings (dataveru=2.2) where -c - Beg.time=end time for instantaneous soundings -c - Otherwise, sounding is assumed to be a time-averaged -c profile, valid for the entire period defined by the -c beginning and end times (no time interpolation -c and no adiabatic adjustment). -c - Note that all previous formats of UP.DAT (end time or -c explicit beg./end times) are assumed to be instantaneous -c soundings even if the beginning and end times differ -c Modified: COMP, RDUPN2 (new), UPMET.MET, RDUP, RDUPN, RDHDU -c CGAMMA -c (3) Compare upper air sounding times with ending time of CALMET -c timestep to streamline checking process (Up/MM5, etc) -c Does not affect results unless the CALMET timestep is -c longer than the upper air sounding frequency (but this is -c no longer an option) -c Modified: COMP, RDUPN, GAMMAC, PREPDI, TEMP3D, TEMP3D_BACK -c (4) Add QA checks to ensure that 1) there is no gap in the -c surface and precipitation data records and 2) that their -c frequency is at least hourly -c Modified: RDSN, RDPN -c (5) Add QA checks to ensure that the data frequency is not higher -c than CALMET sampling (CALMET timestep>= time between new data) -c Modified: RDSN, RDPN, COMP -c (6) Remove GMT time from RDMM4 and RDMM5 calling lists (never useD) -c Modified: DIAGNO, RDMM4, RDMM5 -c (7) Check availability of precipitation and SST data if user -c wants to use them (could be blank if not available or not good -c in original prognostic datasets e.g. for RUC data) -c Modified: RDHD53, RDHD5, READHD -c -c --- v6.302 Level 070929 to V6.31 Level 071207 -c (1) Bug fix in READCF: Perform coordinate conversion of -c precipitation stations locations based on the presence of -c precipitation data rather than that of upper air data when -c the precipitation station coordinates are included in the -c CALMET.INP file (Ken Richmond) -c Modified: READCF -c (2) Keep searching for a first valid MM5 record through -c successive MM5 files (and do not stop after the first file) -c Modified: RDMM5 -c (3) Enforce bounds on dtinc value -c Modified: RDMM5 -c (4) Make sure that the current and future MM5 timesteps are always -c in memory and never the previous and current timesteps -c (except for the last simulation timestep) for consistency with -c MOD5,proper computing of previous hour prognostic temperature -c soundings, proper initialization of Stull surface temperature -c cooling, and to avoid the potential of not having the proper -c records to compute the last -c timesteps correctly. -c Modified: RDMM5 -c (5) In NOOBS mode using MM4 temperature fields (ITPROG>0), -c use the current hour soundings for computing the convective -c mixing height growth at the first timestep in the unlikely -c event that the first hour of a simulation is convective -c (subsequent timesteps keep using the previous hour soundings) -c Modified: RDMM4 -c (6) Set RH to 100% overwater when there are no overwater -c stations (i.e. no SEA.DAT file) to be consistent with default -c RH value overwater in the rest of the code and when there is -c a SEA.DAT file (with missing RH obs) (in noobs-RH mode). -c Modified: SURFVAR -c (7) In NOOBS mode (ITPROG=2)initialize surface temperatures -c with default value instead of not-yet defined prognostic -c temperatures (no change in the results but old formulation -c could stop run on some platforms) -c Modified: SURFVAR -c (8) COORDLIB from v1.98 Level 060911 to v1.99 Level 070921 -c - Conversion of point in S. hemisphere to UTM-N returned coord. -c as UTM-S instead, for conversions from all map projections -c except lat/lon. -c - Initialization of a few work arrays were missing. These have -c no effect on results. -c Modified: COORDS, PJINIT -c -c --- V6.301 Level 070927 to V6.302 Level 070929 (JSS) -c (1) Modification to RDR1D, RDI1D, RDR2D, RDI2D -c - Add CALMET Version to routine header -c - Add valid range check for MTVER variable -c - Add error message write for invalid MTVER -c (2) Modify calls to RDR1D, RDI1D, RDR2D, RDI2D to -c include IO6 in argument list -c - Routines modified: RDHDMET, RDMET2, RDCLD -c (3) Update PARAMS.MET file to include documentation on new -c parameters (MXNXI, MXNYI, MXNZI, MXIGF) -c (4) Update documentation on routines being called/called by -c - READHD, RDCLD, RDHDMET -c (5) Update documentation on parameters required in routine -c - READHD -c -c --- V6.3 Level 070717 to V6.301 Level 070927 (F. Robe) -c (1) Extend IGF-CALMET capability to read in hourly and sub-hourly -c MOD6 fields -c Modified: RDHDMET, RDCALMET,RDMET2,RDCL,IGF.MET -c Updated: RDR1D, RDI1D, RDR2D, RDI2D -c (copied from PRTMET 4.48 Level 070720) -c -c --- V6.223 Level 070702 to V6.3 Level 070717 -c --- Changes to create EPA regulatory option to replicate results -c --- from CALMET v5.53c Level 070501, as modified by MCB-D updates, -c --- with hourly timesteps -c (1) Introduce an option to use nearest-station surface met data -c for surface-layer temperature and density instead of the -c fully interpolated 2D fields, set by ICOARE -c (ICOARE Not 0 sets ISFCMET=0, to use full 2D fields -c ICOARE = 0 sets ISFCMET=1, to use surface stn/prognostic) -c Also, apply TEMP3D fix for noobs temp mode (ITPROG>0) to -c TEMP3D_back (temperature adjustment to adiabatic up to -c the convective mixing height was done up to an un-defined -c height zic i.e. 0 or random height depending on compiler)- -c New : AIRDEN_NS, T2D_NSP, SURFVAR_back, TEMP3D_back -c Modified: WPARM.MET -c READCF, COMP, DIAGNO, STHEOR -c (2) Introduce an option to use surface-layer stability correction -c profiles from CALMET version 5.53 in ELUSTR, ELUSTR2, SIMILT, -c when using the OCD overwater option set by ICOARE -c (ICOARE Not 0 sets IPSIFCN=0, to use CALMET/COARE profile PSIU -c ICOARE = 0 sets IPSIFCN=1, to use CALMET v5.53 profile PSIU -c New : PSIUC -c Modified: WPARM.MET -c READCF, SIMILT, ELUSTR, ELUSTR2, -c STHEOR, COMP, DIAGNO, WIND1, WATER2, WATER2P -c (3) Add precision to the product Vk*g in DELTAT by replacing data -c statement with the explicit product -c Modified: DELTAT -c (4) Establish an EPA Regulatory Conformance switch that tests -c control-file inputs for several model configuration variables: -c IMIXH -1 Maul-Carson convective mixing height -c over land; OCD mixing height overwater -c ICOARE 0 OCD deltaT method for overwater fluxes -c THRESHL 0.0 Threshold buoyancy flux over land needed -c to sustain convective mixing height growth -c ISURFT > 0 in OBS mode (pick one representative station) -c -2 in NOOBS mode (itprog=2) (average all -c surface prognostic temperatures to get -c a single representative sf. temp) -c IUPT > 0 in OBS mode (pick one representative station) -c -2 in NOOBS mode (ITPROG>0) (average all surface -c prognostic temperatures to get a single -c representative sf. temp) -c -c This switch, MREG, becomes a mandatory input -c Reset default buoyancy flux over land to 0.0 W/m3 -c Modified: BLOCK DATA, READCF, GEN.MET -c (5) Revert to using the domain characteristic (IUPT) upper air -c station to compute convective mixing height growth at all -c gridpoints when IUPT>0 (e.g. in regulatory mode) but keep using -c nearest upper station otherwise (IUPT=-1) -c Modified: MIXHT,MIXHTST,COMP,ELUSTR2,STHEOR -c (6) Use average surface Temperature to calculate the Froude -c adjustement for ISURFT=-2 -c Modified: FRADJ -c (7) Use the previous hour prognostic lapse rate rather than the current -c hour lapse rate to compute mixing height growth when prognostic -c temperatures are used (ITPROG>0) -c Modified: RDMM5 -c (8) Shift simulation ending hour by 1 hour and compute the runlength -c in subhourly timesteps if the input file is of MOD5 format -c Modified: READCF -c (9) Make sure the 2 MM5 records read in are the current time and the -c following time, in all cases (i.e. whether the first MM5 record is -c at the beginning of or prior to the beginning of the simulation) -c Modified: RDMM5 -c (10) Compute and pass on the ending GMT time to COARE (rather than the -c beginning GMT time) -c Modified: COMP -c -c --- V6.222 Level 070404 to V6.223 Level 070702 -c --- Modifications by F.Robe -c (1) Correct array index of tgrada (nwat instead of ns) in WATER2 -c (2) Correct array index of xowsta in WIND1 (only a pb if barriers -c are used) -c (3) Replace calls to r2interp by calls to r2interp2 to interpolate -c rh850,ccp,qctot,and ceil4 in RDMM5 as r2interp2 is designed for -c 2D arrays while r2interp is for a slice of a 3D array (does not -c affect the results but cleaner)- Modified: RDMM5 -c (4) Replace calls to r2interp by calls to r2interp2 to interpolate -c rhop, rh850, rh, and ccp in RDMM4 (does not -c affect the results but cleaner)- Modified: RDMM4 -c (5) Interpolate ceiling height from cloud=4 option with cinterp -c rather than r2interp (using modified cinterp for 2D arrays) -c Technical enhancement (affect icloud=4 ceiling height results -c if partly cloudy sky) -c (6) Modify Cinterp to take into account the 2D nature of the ceiling -c height arrays (does not affect the results but cleaner) -c Modified: CINTERP,RDMM4,RDMM5 -c (7) Restrict spatial interpolation of ccp to icloud=4 option (do not -c affect results but can stop execution with some compilers. Fix -c needed for Versions 6.217 and up) -c Modified: RDMM5 -c (8) Initialize ldwat sooner in the code to avoid non-initialization -c if no water stations (with results depending on default value -c assigned to ldwat by compiler) -c Modified: TEMP3D -c (9) only readjust extrapolation weights for valid calm wind data -c (results were correct before because no weight was given -c to unvalid data but ws10 was not defined in that case which -c might cause execution to stop with some compilers) -c Modified: WIND1 -c (10) Use proper year variable name in Y2K test - Modified: RDHDU -c (11) Update roughness legnth and log profile coefficients for surface -c stations located on a water gridcell -c Modified: WIND1 -c (12) assign z0 value sooner in the code so that filled in even when -c no valid overwater stations - Modified: WATER -c (13) Define ws10 also when buoy anemometer height is 10m otherwise -c undefined for use in DELTAT method (ICOARE=0) and for the -c computation of u* in neutral conditions when observations are -c missing. Also affects runs with ITWPROG=2 and ICOARE=10 when -c lowest M3D level is at 10m -c Modified: WATER2,WATER2P -c (14) Set buoyancy flux to 0 when missing OW data (neutral) -c Modified: WATER2 -c (15) Only fill in indx array when valid MM5 records (not when skipping) -c (useless and besides, index not definied when skipping records) -c Modified RDMM5 -c (16) Pass on proper value of ilapse to MIXHMC and MIXHBG if overwater -c gradients are computed from 3D.DAT data (gradient was undefined -c if itwprog=2) -c Modified: WATER, WATERP, WATER2, WATER2P -c (17) Read the MM5 land use into ILU4 array in RDHD51 and RDHD52. -c This is already done in RDHD53. -c (18) Allow initial HTOLD convective mixing height to be less than -c ZIMIN in MIXHT2 and MIXHT2ST -c (19) Convective velocity (wstar) overwater strictly based on convective -c mixing height if ziconv is computed -c Modified: WATER, WATERP -c (20) Echo all input parameter values, even those not listed in input file -c (for which default values are then used) -c Modified: READCF -c (21) Initialize temp2d,irh2d and rho to ensure they are also defined when -c iwfcod=0 (obj. analysis only) (and add iall=2 option to skip -c upwind averaging of temperature during that initialization) -c Modified: DIAGNO, SURFVAR -c (22) Make sure vertical extrapolation is not done for iextrp=1 -c Modifed: DIAGNO -c (23) Read axtz as formatted variable if surf.dat is formatted (LL proj) -c Modified: RDHD -c (24) Default value for THRESHL reset to 0 for consistency with older -c CALMET versions and regulatory assumptions -c Modified: READCF -c -c --- V6.221 Level 070327 to V6.222 Level 070404 -c --- Modifications by F.Robe -c (1) Initialize the following variables (non-initialization of -c thse variables do not affect results but may cause execution -c to stop with some compilers: -c - nlevag1,TZ,ZL, TZ1,ZL1 in RDMM4, RDMM5 -c - dt_wrm in BULK_FLUX to avoid execution stop with some -c compilers when jwarm=0 (COARE option) -c - um,vm in PREPDI -c (2) Supply ceiling height values to RADFLX subroutine in observation -c mode (otherwise wrong long wave flux passed on to COARE if COARE -c option selected)- Modified: COMP, DIAGNO, RADFLX -c (3) Fill in gridded cloud array with observations for icloud=0,1 -c to provide correct cloud data to RADFLX (otherwise wrong long -c wave flux passed on to COARE if COARE option selected) -c Modified: COMP, OUTCLD -c (4) Pass on values of dptt to WATER, WATERP, WATER2 and WATER2P -c via tjump internal common for call to MIXHMC (otherwise -c undefined/un-initialized) -c (5) Include COORDLIB Version: 1.98 Level: 060911 which has the -c following Changes that allow a higher level of FORTRAN error -c checking: -c - Replace the constant 4 with an I*4 variable (IUNIT4) in -c calls to GTPZ0 from COORDS (to/from lat-lon). -c - Set GTPZ0 argument LENGTH=100 (for direct access files -c that are not used). -c - Replace constant 0 with I*4 variable (INSPHZERO) -c in argument 1 of SPHDZ0 call in GTPZ0 -c - Change FUNCTION ADJLZ0 argument name and reassign to LON -c within(sub is called with a computed argument that should -c not be changed within subroutine) -c - SAVE9 is undefined first time in PJINIT; set to zero in DATA -c (6) Decode beginning date of precipitation record in 2.1 format -c for proper debug writing (debug mode only) -c (7) bug fix: in noobs temp mode (ITPROG>0) , adjust temperatures -c to adiabatic profile up to the convective mixing height -c (it was done up to an un-defined height i.e. 0 or random -c height depending on compiler)- Modified: TEMP3D -c -c -c --- V6.220 Level 070206 to V6.221 Level 070327 -c --- Modifications by Zhong Wu and F.Robe -c (1) Initialize cloud fraction arrays and indices in CLOUD4 -c (2) Use proper year variable names for format2.1 in Y2K test -c (bug fix but will only stop runs with some compilers; does not -c affect results if run starts) - Modified: RDHDU -c (3) Include 'grid.met' in MIXHTST and MIXHT2ST for debug output -c call to OUT (otherwise debug output can be very large depending -c on default values for nx,ny) -c (4) Add ldbhr to OUTPT.MET and include OUTPT.MET in mixhtst and -c mixht2st (Was not defined in those subroutines earlier on) -c Modified: COMP, ELUSTR2,MIXHTST, MIXHT2ST, OUTPT.MET -c (5) Print out requested variables in list file on hourly basis -c (i.e. use nsecb for test instead of isecb) -c (6) CALUTILS from v2.54 Level 061020 to v2.55 Level 070327 -c Fixed format bug in subroutine BASRUTC for the case of -c time zone zero (output string was 'UTC+0 0' instead of -c 'UTC+0000' -c Modified: UTCBASR, BASRUTC -c --- Modifications suggested by B. Brashers (FRR): -c (7) Modify computation of prognostic density RHOP in RDMM5 -c such that it is properly (re)initialized at each timestep, -c is always computed at the surface, and is not forced to increase -c The non-initialization of RHOP could produce wrong values -c with some compilers (e.g. PGI in Linux) -c (8) Initialize beginning/ending times of surface and precipitaion -c records (2.1 versions datasets with explicit beg/ending times -c with seconds) Modified: COMP - -c --- V6.219 Level 070123 to V6.220 Level 070206 -c --- Modifications by F. Robe -c (1) Define lcalgrdi as logical and perform tests on False/true -c rather than 0/1 in RDHDMET (relevant for IGF-CALMET runs) -c (2) Compute ceiling height based on predicted high, middle, and -c low cloud fractions for the ICLOUD=4 cloud option instead of -c using a single default value of 8,000ft when no prognostic -c cloud data is available(CLOUD4/RDMM5/RDMM4 subroutines) -c -c --- V6.218 Level 070113 to V6.219 Level 070123 -c --- Modifications by F. Robe -c (1) When ITWPROG=2, compute the nearest M3D water gridpoints to -c all CALMET gridpoints (not just CALMET water gridpoints) to -c avoid failure in WATER2P when the nearest CALMET gridpoint -c to a buoy is inland - Changes to RDHD5 - -c -c --- V6.217 Level 061230 to V6.218 Level 070113 -c --- Modifications by F. Robe -c (1) Allow the use of spatially varying surface temperature in -c the computation of terrain-induced circulations (instead of -c using a single domain representative surface temperature Tinf). -c Option triggered by ISURFT=-1 (default value) -c Additionally, ISURFT=-2 triggers the computation of domain-average -c sf temperature when prognostic temperatures are used (ITPROG=2). -c Not recommended but exists for consistency with previous versions -c and with MOD5 results) -c Modified: DIAGNO,TOPOF2, FRADJ, SLOPE, CGAMMA2, PREPDI, -c READCF, CALMET.INP -c (2) Allow the use of spatially varying surface lapse rate in -c the computation of terrain-induced circulations (instead of -c using a single domain representative lapse rate ). -c Option triggered by IUPT=-1 (default value) -c Additionally, IUPT=-2 triggers the computation of domain-average -c lapse rate when prognostic temperatures are used (ITPROG>0). -c Not recommended but exists for consistency with previous versions -c and with MOD5 results) -c Modified: DIAGNO, TOPOF2, FRADJ, CGAMMA2, DIAGI,CGAMMA -c PREPDI, READCF, COMP, MIXHT, MIXHTST, STHEOR, ELUSTR2, -c CALMET.INP, MEt1.MET -c (3) Removed obsolete common /S1/ in subroutine SLOPE and /T1/ in TOPOF2 -c (4) Reformatted header comments in subroutines TOPOF2, FRADJ -c (5) Reworded description of ISURFT,IUPT, IDIOPT1,IDIOPT2,IDIOPT3. -c IUPWND and ZUPWND in CALMET.INP and READCF output comments -c (6) Removed variable BETA2 which was never used -c (7) Bug fix: correct date comparison in RDMM4 s.t. ok at midnight -c -c --- V6.216 Level 061230 to V6.217 Level 061231 -c --- Modifications by F. Robe -c (1) Implemented new NOOBS cloud cover computation method, using -c prognostic RH, based on MM5toGrads algorithm -c New CLOUD4 subroutine and ICLOUD=4 value for this option -c Changes to CALMET.INP, ELUSTR, ELUSTR2, HEATFX, PGTSTB, RDHD5 -c RDMM4, RDMM5, CLOUD3 (old name: cloud), CLOUD4 (new),READCF -c (2) Renamed CLOUD subroutine CLOUD3 subroutine -c (3) Modified QCKSRT3 to sort 7 arrays -c -c --- V6.215 Level 061020 to V6.216 Level 061230 -c --- Modifications by F. Robe -c (1) Bug fix in RDMM4: correct record dates comparison so that -c the MM4 fields used in CALMET are properly updated on an -c hourly basis -c (2) Bug fix in RDMM4 such that prognostic surface temperature -c is computed correctly (affects all runs using MM4 temperatures) -c (3) Bug fix in PROGRD: Check ending hour (instead of beg. hour) -c against progn. record hour (to be consistent with MOD5) -c (4) Bug fix in PROGRD: make sure to skip reading progn. records -c for subhourly CALMET timesteps -c (5) pass nsece to PROGRD instead of nsecb to have consistent -c notations. -c (6) Fixed typo in RDUPN (introduced in V6.215) -c (7) Ensure that precipitable water remains within algorithm range -c of applicability (RADFLX) -c -c --- V6.214 Level 060528 to V6.215 Level 061020 -c --- Modifications by DGS -c (1) Test of time span for UP.DAT files did not fully account for -c time shift between base time zone and UTC, causing an -c unnecessary halt -c Modified: RDHDU -c (2) CGAMMA updated for begin time processing of UP.DAT with -c seconds (interpolation factor assumed difference between -c soundings was still in hours, not seconds, so interpolation -c resulted in using second sounding) -c Modified: CGAMMA, PREPDI -c (3) Fix diagnostic write statements that use old hour-ending -c variable names; activate hour-ending times for MESOPAC -c output option and restrict output to NSECDT=3600 -c Modified: COMP, READCF -c (4) UP.DAT dataset version 2.1 snapshot soundings (begin time = -c end time) are given new begin times that precede the snapshot -c time by 1 CALMET step. If the CALMET step is 1 hour, then a -c sounding at 12Z is given a begin time of 11Z, and is -c therefore used for the CALMET period from 11Z to 12Z. If the -c step is 900s (15 minutes), the sounding is given a begin time -c of 11Z+2700s (11:45Z) and is used for the CALMET period from -c 11:45Z to 12Z. Treatment of average soundings (begin time < -c end time) is not altered, and care should be exercised in -c using such soundings when the averaging period is not equal to -c the CALMET step. Older UP.DAT files (no begin time) are also -c treated as snapshots. -c Modified: RDUP, RDUPN, COMP -c (5) CALUTILS from v2.52 Level 060519 to v2.54 Level 061020 -c Move GLOBE1 to COORDLIB -c Allow negative increments in INCRS -c Modified: INCRS -c Removed: GLOBE1 -c (6) COORDLIB from v1.95 Level 050126 to v1.97 Level 060626 -c Add Albers Conical Equal Area projection -c Add GLOBE1 (from CALUTILS) -c -c --- v6.213 Level 060525 to V6.214 Level 060528 -c --- Modifications by F. Robe -c --- Changes contributed by Ken Richmond, Geomatrix Consultants) -c (1) Use SST in celsius rather than kelvins for call to COARE -c Modified: WATERP -c (2) Set wave height and period to missing when there are no buoy data -c Modified: WATER2P -c --- Additional changes: -c (1) Overwater, clear up the confusion between buoyancy flux and sensible heat flux -c Make sure to use the buoyancy flux to compute the convective velocity scale. -c QH used to refer to the buoyancy flux when computed by deltaT method and to -c the sensible heat flux when computed by COARE -c Modified: DeltaT, WATER -c (2) Overwater, store the buoyancy flux into the sensible heat flux array QH -c (common block metgrd.met): this was already the case when deltaT method -c was used (i.e . historically). The Sensible heat flux array QH is truly a -c buoyancy flux array (= sensible heat flux overland but not overwater where -c effect of moisture on buoyancy is not negligible) -c Modified: WATER -c (3) Compute the buoyancy flux in terms of after call to DeltaT -c to pass on to mixing height subroutines -c Modified: WATER2, WATER2P -c (4) Skip definition of qe in water/waterp and of thstar,qh,qe WATER2, WATER2P -c as never used -c modified : WATER,WATERP,WATER2,WATER2P -c -c --- v6.212 Level 060519 to v6.213 Level 060525 -c --- Modifications by DGS -c (1) Impose a minimum RH of 1% when computing the precipitable -c water (wp) in RADFLX. IRH=0 resulted in wp=0.0, which then -c makes LOG10(wp) undefined (error stops run). -c Modified: RADFLX -c (2) Add GRID.CMN to MIXHT2ST for debug output call to OUT -c (Change contributed by Bart Brashers, Geomatrix Consultants) -c Modified: MIXHT2ST -c (3) Change nsec1 (not initialized) to isec1 (initialized to 0) in -c call to DELTSEC. -c (nsec1 problem identified by Bart Brashers, Geomatrix -c Consultants) -c Modified: RDMM5 -c -c --- v6.211 Level 060414 to v6.212 Level 060519 -c --- Modifications by DGS -c (1) Revise placement of QA test on input date of simulation -c (QA on MOD5 control file failed) -c Modified: READCF -c (2) Reset character*4 CTIME array from (1,4) to (70) to -c match character*70 ABTZ declaration -c Modified: READCF -c (3) CALUTILS from v2.51 Level 051019 to v2.52 Level 060519 -c Variable names in control file are not processed correctly -c if there are too many characters (including blanks) to the -c left of the "=" sign (run stops in setup phase). -c Modified: READIN -c -c --- v6.210 Level 060408 to v6.211 Level 060414 -c --- Modifications by DGS -c (1) IGF CALMET file produced a read error when no precip stations -c are in the file because I2DMET was not set. -c Modified: RDHDMET -c -c --- v6.209 Level 060331 to v6.210 Level 060408 -c --- Modifications by F.Robe -c (1) Add user-input parameter IRHPROG to allow use of prognostic -c RH in noobs=0,1 cases (stored in MET1.MET) and change internal -c array name irhprog(mxnx,mxny) to irhpg(mxnx,mxny) -c IRHPROG=0 : use RH from SURF.DAT file (default) -c IRHPROG=1 : use prognostic RH (from M4/MM5/3D.DAT files) -c Modified: READCF, SURFVAR,RDMM4,RDMM5,BLOCK DATA, MET1.MET -c -c --- v6.208 Level 060329 to v6.209 Level 060331 -c --- Modifications by DGS -c (1) Revise error report text for runs that do not start before -c 5AM -c Modified: COMP -c -c --- v6.207 Level 060328 to v6.208 Level 060329 -c --- Modifications by DGS -c (1) Fix date matching test on precip.dat file dates for old -c file format (MOD5) -c Modified: COMP -c (2) Revise end-of-run text to list file -c Modified: FIN -c -c --- v6.206 Level 060322 to v6.207 Level 060328 -c --- Modifications by DGS -c (1) Modify test for start of MM4 data records -c Modified: READHD -c -c --- v6.205 Level 060309 to v6.206 Level 060322 -c --- Modifications by F.Robe -c (1) Replace mod5 nhrz and ihrgmt by mod6 nhrzb (COMP) -c (2) Store previous hour prognostic temperature profile in TZO (RDMM5) -c instead of '2-hour-ago' progn. temp.(important for mixing height -c growth when prognostic lapse rates are used itprog=1,2; itwprog=1) -c (3) Fixed typo in WATER that used the overwater (OW) Tair from -c the last OW station in the list with the Tair-Tsea difference -c from the nearest OW station when computing Tsea for the -c nearest OW station.(V5.719 Level 060314 by DGS) -c Modified: WATER, WATER2 -c (4) Make sure SST is above -3C (WATER/WATER2/WATERP/WATERP2) -c (5) Allow for round-off error when checking for missing ZOWSTA (WATER) -c (6) Add a check for missing Tairow before call to COARE and -c replace by default Tair if missing (WATER) -c (7) Set default prognostic ocean land use category ILUOC3D=16, -c corresponding to MM5 ocean LU cat (BLOCK DATA)(also in V5.720) -c (8) Extrapolate prognostic temperatures from lowest level to -c the surface over water using either the prognostic SST -c if available or an adiabatic profile at night (no surface -c cooling at night over water) (RDMM5,RDMM4) (also in V5.720) -c (9) Fill in values of ILU4(mxnxp,mxnyp) no matter ITWPROG value -c (RDHD53)(also in V5.720) -c (10) Assign ocean LU to zero elevation MM5 gridpoints for old -c format files from which prognostic landuse is not read in -c (RDHD52)(also in V5.720) -c (11) Fix date second matching test on calmet/sea.dat (RDOW) -c (12) Add check for negative log arguments in mixhbg (also in v5.722) -c -c --- v6.204 Level 060304 to v6.205 Level 060309 (internal) -c --- Modifications by F.Robe (internal 060308) -c (1) Modified MIXHBG : Replace Tk by dummy variable tsf -c in call to mixdt2 otherwise mixdt2 overwrites Tk with MM5 -c surface temperature (not ok for all options e.g. overwater) -c (also in V5.718 Level 060305) -c (2) Fix date matching test on beginning times MM5/CALMET in READHD -c (3) Fix date matching test on calmet/surf.dat dates for old surf.dat -c file format (Subroutine COMP) -c (4) Fix date matching test on calmet/sea.dat (RDOW) -c (5) Change argument type from real to integer in call to delsec (RDMM5) -c (6) Do not compute nowtz (MOD5 variable) as nhr,njul and nyr are no -c longer updated (COMP) -c (7) replace nhr by nhrb in day loop (COMP) -c -c --- Modifications by D. Strimaitis (internal 060309) -c (8) COORDLIB from v1.95 Level 050126 to v1.96 Level 051010 -c (9) CALUTILS from v2.5 Level 041123 to v2.51 Level 051019 -c (10) Filnames changed from c*70 to c*132 (for CALUTILS V2.3 -c and later) -c Modified: FILNAM.MET , READFN, WRFILES -c -c --- v6.203 Level 060301 to v6.204 Level 060304 -c --- Modifications by F.Robe -c (1) Convert argument of min/sign function from single to double -c precision to avoid compiler warnings in Linux -c Modified: COARE original subroutines ASL,PSIUT,PSIT,ZETA,PSIUD,PSITD -c -c --- v6.202 Level 060219 to v6.203 Level 060301 -c --- Modifications by F.Robe -c (1) Replace numerical integration of the BG equations for mixing height -c growth by an analytical integration method ("false images") to -c optimize accuracy/CPU time (also in V5.716 Level 060228) -c ( MIXHBG + new function FBG) -c (2) Test whether convective growth based on net surface buoyancy flux -c (wt-wto) (i.e. consider threshold too) in MIXHMC -c (3) Calculate values for Tht and THTP even when negative net flux (ilapse=1) -c as they are needed in mixht/mixht2 in that case too (MIXHBG,MIXHMC) -c -c --- Version 6.201 Level 060218 to Version 6.202 Level 060219 -c --- Modified by F.Robe -c (1) Correct interpolation of sine solar angle between 1800s -c and 3600sec (subroutine COMP) -c (2) Delete wrong definition of onedte and twodte in MIXHMC -c -c --- Version 6.2 Level 060215 to Version 6.201 Level 060218 -c --- Modified by F.Robe -c (1) Add QA output file of SEA.DAT station locations -c (also in V5.714 Level 060217 by D. Strimaitis) -c Modified: PARAMS.MET, OUTPT.MET -c Modified: BLOCK DATA, SETUP -c New : QAPLOT1 -c (2) Add check for different datum code when testing header of -c SEA.DAT file (also in V5.714 Level 060217 by D. Strimaitis) -c Modified: RDHDOW -c (3) Use dgrid instead of dx,dy (not yet defined) in microi to -c compute grid points latitude, longitude and solar angle -c Modified: MICROI -c -c --- 5.711 Level 060106 to Version 6.2 Level 060215 (Merged MOD5-MOD6) -c --- Modified by F.Robe -c (1) Merge with V5.6 Level 041208 changes: -c - Implement hour-ending and explicit beginning/ending times with seconds -c in SURF.DAT, PRECIP.DAT and UP.DAT, CALMET.DAT, CALMET.INP (stored -c in GEN.MET); -c - call new explicit time subroutines (RDSN,RDUN,RDPN) according to -c Dataset version numbers (which are stored in MET1.MET) -c - Time zones in input and output are relative to UTC and formatted -c as character*8 variables. Internally, the "CALMET" convention -c (opposite to UTC) is still used. -c - First line of CALMET.INP indicates that new 2.1 format i.e. -c New parameters: IEYR,IEMO,IEHR,IESEC,IBSEC, ABTZ -c IRLG and IBTZ are no longer input (computed internally). -C CALMET can still read pre-2.1 CALMET.INP files -c - New CALUTILS V2.5 (041123) (with utcbasr and basrutc subroutines) -c - Changes to RDHD, RDHDU, READCF,READCF, OUTHD,OUTHR, -c WRTR2D, WRTI2D. WRTR1D, WRTI1D, GEN.MET, MET1.MET -c UPMET.MET,CALMET.INP -c (2) Merge with V6.01 Level 051206 changes: -c - Implement sub-hourly timestep in all pre-MMS subroutines -c - Still hourly solar angle -c -c (3) Specific post-v5.711/V6.01 changes: -c - Compare timestep beginning time with SEA.DAT records taking into account -c that the latter are still in hour-ending time format -c (also in v6.02 level 060206) -c - Replace real argument deltas/deltskip by integer ndeltas/ndeltskip -c in call to deltsec in subroutines RDMM4/5 (also in V6.03 Level 060207) -c - solar angle computed on hourly basis (25 values) and linearly -c interpolated to half-time steps (COMP,SOLAR and GEN.MET) -c - Bug fix: Use solar angle at nearest CALMET gridpoint to -c determine sunrise/sunset in RDMM4/RDMM5 (rather than -c solar angle on CALMET grid which could have caused -c array dimension mismatch if NXP> MXNX and/or -c NYP>MXNY) (also in V5.712 Level 060213 and v6.04 Level 060213) -c - Bug fix: time-index of sinalp shifted by 1 hour in RDMM4/RDMM5 -c (also in V5.713 Level 060215 and V6.05 Level 060215) -c -c --- version 5.7 Level 051230 to Version 5.711 Level 060106 -c (1) Allow initial guess field to be built up from existing -c CALMET.DAT files -c Different format/resolution/options IGF-CALMET.DAT files -c allowed but with hourly records only. Overlapping periods -c are resolved. -c Same map projection and datum for IGF and current CALMET -c New subroutines: RDHDMET, RDCALMET,RDMET2,R2INTERPI -c Imported from PRTMET: RDR1D,RDI1D,RDI2D -c Modified: READCF,READFN,WRFILES, READHD, SETUP,RDR2D,DIAGNO, SETUP -c Modified PARAMS.MET: add MXIGF(max number of igf-calmet files) -c and io18=18 (file unit for IGFCALMEt files) and -c mxnxi,mxnyi,mxnzi (max dimensions for IGF-CALMET) -c Modified WPARM.MET: add igfmet (flag to use coarse CALMET -c files as IGF) -c Modified FILNAM.MET: add IGFDAT filenames -c New IGF.MET: parameters and variables related to IGF-CALMET -c -c --- Version 5.614 Level 051218 to version 5.7 Level 051230 -c --- Modifications by J. Scire -c (1) MIXHMC: Correct check of max mixing ht, add checks of range -c of WT and debug write statements, update comments -c (2) Common /OVRWAT/ Update comment on THRESHW default to -c 0.05 W/m2/m -c (3) BULK_FLUX: Introduce STI change to COARE warm layer -c algorithm (minimum stress of 0.002) -c (4) ASL: Introduce STI change to COARE evaporative cooling/ -c net absorption eqn (coefficient of 0.137 changed to 0.060) -c (5) READCF: Change default values for COARE IWARM and ICOOL -c options to OFF -c -c --- Version 5.613 Level 051227 to Version 5.614 Level 051228 -c --- Modifications by F. Robe -c (1) Use actual SST sensor depth in COARE if available. -c Modified: WATER,WATERP,WATER2,WATER2P,COARE -c (2) Change the default SST sensor depth from 0.05m (floating -c sensor) to 0.6m when SEA.DAT is used(NDBC moored buoy SST -c sensor depth). Keep 0.05m if SST come from prognostic model -c Modified: WATER,WATERP,WATER2,WATER2P,COARE -c (3) Change missing value indicator from -999. to 9999. for -c wave height and period initialization in RDHDOW -c -c --- Version 5.612 Level 051214 to Version 5.613 Level 051227 -c --- Modifications by F. Robe -c (1) Add option to read in SEA.DAT files versions 2.11. -c Added features: time zone, Air Temp Sensor Height, Water Temp -c Sensor Depth + format changes . Initialize values in RDHDOW -c Modified: RDHDOW,RDOW and OVRWAT.MET -c (2) Use actual Tair sensor height instead of anemometer height -c in call to COARE if available (SEA.DAT versions 2.11+). -c Modified: WATER, WATER2 -c -c --- Version 5.611 Level 051113 to Version 5.612 Level 051214 -c --- Modifications by F. Robe and D. Strimaitis -c (1) Replace call to water2p by call to water2 when itwprog<2 in -c subroutine STHEOR -c (2) Use double precision argument for PSIUD (elustr) -c (3) Use only one iteration for the computation of surface fluxes -c in ASL subroutine (COARE module) to insure numerical stability -c -c --- Version 5.61 Level 051111 to Version 5.611 Level 051113 -c --- Modifications by F. Robe -c (1) Allow use of prognostic overwater deltaT for offshore BL -c computations (only possible for 3D.DAT version 2.0 and higher -c if SST is part of datasets i.e. for MM5 but not RUC or ETA) -c - New input parameter ITWPROG -c ITWPROG = 0 : deltaT from SEA.DAT -c = 2 : prognostic deltaT (from 3D.DAT) -c - New input parameter: ILUOC3D (Land use category flagging ocean -c land use in 3D.DAT dataset - only used for ITWPROG=2) -c - Modified: READCF, WATER, WATER2, READHD, RDHD5,RDHD53, -c RDMM5,COMP,DIAGNO, DELTAT -c OVRWAT.MET,MM4HDO.MET,CALMET.INP -c - New subroutines: WATERP and WATER2P -c - New include file: M3DMET.MET -c (2) Remove zimin from MIXHMC calling list ( MIXHMC,WATER, WATER2, -c MIXHT,MIXHTST,MIXHT2, MIXHT2ST) -c (3) Replace index+1 by index1 in call to STULL (RDMM5,RDMM4) -c only affects prognostic datasets with redundant lowest levels -c (this fix was only partially implemented before) -c -c --- Version 5.6g Level 051109 to Version 5.61 Level 051111 -c --- Modifications by D. Strimaitis -c (1) Change missing value indicator from -999. to 9999. for -c wave height and period in SEA.DAT dataset 2.1 format. -c Stop processing if wave period is zero. -c Modified: RDOW -c (2) Reset defaults as follows: -c ICOARE = 10 (not 0) -c IMXHT = 1 (not -1) -c Modified: READCF -c (3) Use a free-format read for the number of comment records -c in the 3D.DAT file -c Modified: RDHD53 -c (4) Store rverow as an array to check each SEA.DAT file -c Modified: OVRWAT.MET -c Modified: RDHDOW, RDOW -c (5) Change in RDMM5 to fix an errant test in IFIRSTPG -c -c --- Version 5.6f Level 050824 to Version 5.6g Level 051109 -c (V5.6g includes all changes made in parallel versions -c 5.552/5.553/5.554) -c --- Modifications by F. Robe -c (1) Allow new 3D.DAT format (version 2.1) with new format for -c liquid and frozen moisture variables (changes to RDMM5) -c (2) Bug fix for last timestep at end of leap year in RDMM5 -c --- Modifications by D. Strimaitis -c (3) Correct QA test for IEXTRP=1 that requires BIAS(2+)=1 so that no -c warning is made if the bias is already set properly. -c Skip BIAS/IEXTRP checks if surface obs are not used -c Modified: READCF -c -c --- Version 5.6e Level 050520 to Version 5.6f Level 050824 -c Modified by D. Strimaitis -c (1) Check for missing Tair-Tsea before calling COARE -c Modified: WATER2 -c -c --- Version 5.6d Level 050428 to Version 5.6e Level 050520 -c Modified by D. Strimaitis -c (1) Fix typo: ZIOBS should be IZIOBS -c Modified: WATER -c (2) Restore IPROG constraints before call to RDHD5 -c Modified: READHD -c (3) Replace common /charney/ with /charnock/ -- an old section of -c code was used in version 5.6c that partially reversed changes -c made in version 5.6a -c Modified: COARE -c -c --- Version 5.6c Level 050419 to Version 5.6d Level 050428 -c Modified by F.Robe -c (1) - Fix log profile coefficients and OW mixing heights when multiple -c overwater stations (RDOW-WATER) -c (2) - Declare tstar,qstar as real*8 in water2 (for COARE) -c (3) - Remove npsta from calling list to rdhd5 -c -c --- Version 5.6b Level 050412 to Version 5.6c Level 050419 -c Modified by F.Robe -c (1) - Add user-input to select warm layer COARE options -c IWARM and ICOOL for warm layer and cool skin computations -c (new CALMET.INP and OVRWAT.MET) -c (2) - Move overwater surface flux input parameters (icoare,dshelf) -c to Input Group 6 => new CALMET.INP (compatible with -c pre-MMS codes (pre-050328) but not intermediate MMS codes) -c (2) - Ensure that the warm layer COARE option is applied -c independently to each overwater gridpoint (Changes to -c subroutines COARE, BULK_FLUX, WATER2) -c (3) - Remove 6AM deadline for start of warm layer integration -c (subroutine bulk_flux) -c --- Version 5.6a Level 050331 to Version 5.6b Level 050412 -c Modified by F. Robe -c (1) Add checks in AVEMIX and AVETMP to ensure upwind averaging -c of mixing heights and temperatures is done over gridpoints -c within cone of influence and mnmdav-side square only. -c -c --- Version 5.6 Level 050328 to Version 5.6a Level 050331 -c Modified by D. Strimaitis -c (1) Fix typo that causes DSHELF variable to be zero in all calls to -c the COARE module, and correct all references to Charnock -c Modified: OVRWAT.MET, COARE, ASL -c -c (2) Correct QA test for IEXTRP<0 that requires BIAS(1)=-1 so that no -c warning is made if the bias is already set properly. -c Modified: READCF -c -c --- Version 5.551 Level 050310 to Version 5.6 Level 050328 -c -c *** MMS - COARE modifications by F.Robe: -c (1) Add option to use the Coupled Ocean Atmosphere Response Experiment -c (COARE) bulk flux model for computing Zo, u*, L and QH overwater -c User-input ICOARE paramete with values of 0,10,11,12 corresponding -c to: 0=deltaT method, 10,11,12=COARE method with COARE wave options -c 0,1,2 respectively. -c -c (2) Add option to use measured wave properties with COARE. Dominant -c Wave period and wave height are read in from SEA.DAT files (new -c SEA.DAT format VErsion 2.1) -c Use of equilibrium properties vs. observed properties is flagged -c by positive/negative ICOARE input parameter (in CALMET.INP) -c Computations dones in New Subroutine COARE (original -c COARE 2.6 bw flux model and associated subroutines -c (self-contained set of subroutines to allow easy updates)) -c -c (3) New subroutine DELTAT which isolates the deltaT computations -c that used to be in the WATER/WATER2 subroutines. Either DELTAT -c or COARE are called depending on values of ICOARE -c -c (4) Modification of the original COARE code for shallow water: -c A shallow water corrective factor of the Charnock parameter -c is introduced to reflect higher values of charn in shallow -c waters. A typical ength scale for the coastal region is introduced -c (dshelf, reflecting the coastal shelf extent) such that charn varies -c between the shallow water value and the deep sea value depending -c on the distance to the nearest coast (DCOAST(i,j))- -c dshelf is a new user input in CALMET.INP -DCOAST is computed -c in new subroutine SETCOAST and stored in GRID.MET -c -c (5) Debug option to write out the distance to the coast -c Gridded 2D field in GRD format - Default filename DCST.GRD -c New input parameter (LDBCST) and filename (DCSTGD) in CALMET.INP -c -c (6) New subroutine RADFLX to compute downward long wave radiative flux -c at the surface (only called when COARE option is selected) -c -c (7) Invert T*,Q* assignments in subroutine bulk_flux (COARE) otherwise -c tstar takes a e+92 value when qstar is assigned so tstar -c must be assigned AFTER qstar. It does not make any sense but -c I can't find out why (common and declaration apparently match) -c -c (8) Change SEA.DAT version number (2.1) to reflect changes in the -c data (removed: xowlon, added: observed wave properties twave,hwave). -c Twave=dominant wave period; hwave=significant wave height -c lat/lon of overwater stations are computed internally. -c Internally, xowlon is East longitude (no longer west longitude, -c except in old SEA.DAT files) -c -c (9) Subroutine MICROI: compute mapping parameters from (x,Y) CALMET -c to N.LAt, E.Long, store them in MAP.MET, and N.LAt, E.Long in -c GRID.MET- Compute gridded value of Coriolis parameter -c as a function of the latitude at each gridpoint. FCORIOL is no longer -c an input but if an old CALMET.INP is used, the gridded values will all -c be overwritten by the single user-input value. Stored in ZIPARM.MET -c Also made cmech an array and tore in ZIPARM.MET -c -c (10) Initialize important COARE constants and conversion factors -c in subroutine bulk_flux rather than in subroutine ASL, otherwise -c crash when warm layer calculations (bug already in original COARE -c program) -c -c -c -c *** MMS - Convective Mixing Height modifications by F.Robe -c -c (1) New convective boundary layer parameterization following -c Batchvarova and Gryning (1991,1994). -c -c (2) Convective mixing height parameterizations applied to overwater -c cells as well land cells -c -c (3) New convective boundary layer input parameters: -c IMIXH = 1: Maul-Carson for land and water cells -c =-1: Maul-Carson for land cells only - Original -c OCD mixing height overwater (i.e. pre-MMS version) -c = 2: Batchvarova and Gryning for land and water cells -c =-2: Batchvarova and Gryning for land cells only - Original -c OCD mixing height overwater -c Stored in HFLUX.MET -c -c THRESHW: threshold buoyancy energy flux per meter of marine -c boundary layer required for Mixing Growth overwater -c (default: 0.05 W/m2 /m)- Stored in OVRWAT.MET -c -c THRESHL: threshold buoyancy energy flux per meter of land -c boundary layer required for Mixing Growth over land -c (default: 0.05 W/m2 /m)- Stored in ZIPARM.MET -c -c ITWPROG: Flag to use either SEA.DAT (or default constant) -c overwater lapse rates or prognostic lapse rates -c above the current OW mixing height -c = 0 : use SEA.DAT air/sea temperatures and lapse rates -c for the marine BL growth -c = 1 : use SEA.DAT air/sea temperatures and MM5 lapse rates -c Stored in OVRWAT.MET -c -c (4) Use Tz2,zl2 to initialize tz0,zl0 in rdmm5 instead of tz1,zl1 -c (important if mixht2/mixdt2 are called at first time step, which -c could now occur if convective overwater boundary layer -c -c -c *** MMS - Vertical wind extrapolation modifications by F.Robe -c -c (1) Scale surface observations (land and water) from anenometer height -c to first CALMET level using user-defined extrapolation technique -c (iextrp>1) and or, if non (iextrp=1)e, using a neutral log profile -c Changes to DIAGNO, WIND1,SIMILT,DIAGI,RDOW,ELUSTR2,WATER2 -c -c (2) Use consistent similarity relations throughout the code -c (Paulson (1970) and Dyer 91974) for the unstable surface layer, -c coupled with a free convection relation for large z/L -c (Gratchev et al, 2000) and new relations for stable atm. -c (Beljaars and Holtslag, 1991) -c => use COARE stabitily functions PSIU and PSIT except with -c factor 16 instead of 15 for the Kansas unstable function (following -c Dyer's fit -c for COARE, add a user-input switch to use original COARE PSIU/PSIT -c (with factor 15) or, more correct, PSIUD,PSITD with factor 16 -c new PSIUT/D everywhere EXCEPT in subroutine DELTAT (original OCD psiu/psit) -c Changes to subroutines ELUSTR, ELUSTR2, SIMILT -c -c (3) Bug fix in WATER2: winds used for OCD (DELTAT) technique were assumed -c to be at 10m but were in fact at anemometer height. now winds are -c scaled to 10m using log profile (note:this was not the case -c for call to DeltaT in subroutine WATER) -c -c (4) Bug fix in DIAGNO: do not extrapolate missing data (iextrp=2), -c -c -c *** Other modifications (F.Robe): -c -c (1) Subr RDMM5-RDMM4: use previous hour sounding to compute lapse rate above -c previous hour mixing height (used in MIXDT2 - itprog>0 mode) to avoid -c unrealistic overgrowth of mixing height.This will change results -c obtained with previous versions. -c -c (2) Bug fix in RDOW: xkm, ykm must be real*4 not real*8 in call to GLOBE -c -c (3) Explicity common D1/D3/D4/D6 replaced by "include D1-3-4-6.met" in -c all relevant subroutines -c -c (4) Better spatial interpolation of surface temperature, -c RH and ipcode (may change results: arrays temp2d,irh2d,ipcode2d). -c and consistent use of the surface variables throughout the code -c Required changing subroutine calling order in COMP. -c -c (5) Add a computation flag in SURFVAR to avoid computing IRH2D and -c IPCODE2D at every call to the subroutine (2 calls to surface are -c needed for temperatures temp2d only) -c -c (6) Use temp2d rather than tprog/tempk in ELUSTR, ELUSTR2, WSTARR -c -c (7) SURFVAR: use OTEMPK rather than TEMPK in SURFVAR as the former -c is the original data with missing values and the latter, T data -c with missing replaced by nearest station value (not ok for spatial -c interpolation). otempk stored in MET2.MET -c -c (8) Remove ioutmm5 restriction on NPSTA=-1 as surface precipitation is -c is always part of the M3D record even if rainfall profiles (qr) -c are not -c -c (9) Correct name CTITLE3 to CTITLE3D in /MM4HDO/. Dataset title -c for 3D.DAT was not declared as character field due to typo. -c -c -c --- V5.55 Level 050217 to V5.551 Level 050310 -c --- Modifications by D. Strimaitis -c (1) Modify output format statements to allow surface station IDs -c to be at least 6 digits long -c Modified: READCF -c -c --- V5.549 Level 050128 to V5.55 Level 050217 -c --- Modified by F.Robe -c - Properly initialize call to barier in INTER2 -c - Only call barier when nbar> 0 in inter2, interp, wind1 -c -c --- V5.548c Level 050125 to V5.549 Level 050128 -c (1) COORDLIB updated to stop UTM conversions with a DATUM that is -c not mapped to the list in the USGS UTM subroutine. An example -c is the sphere datum NWS-84 (Earth radius 6370km), since only -c the sphere datum ESR-S (Earth radius 6371km) is available. -c Unmapped datums had defaulted to the Clarke 1866 spheroid. -c LAZA Projection: removed assignment of 6370 km earth -c radius (NWS-84 datum) when a value less than 6000 km is -c found. This assignment can override a requested radius -c of 6371 (ESR-S datum) if the NWS-84 datum is used with -c any valid projection prior to the request for ESR-S. -c LAZA(NWS-84) coordinate distances from the projection -c origin are about 0.016% smaller than LAZA(ESR-S). -c Error message and version strings added to COORDS calls and new -c subroutine COORDSVER to report COORDS version documentation. -c (Version 1.95, Level 050126) -c -c (2) Added call to COORDSVER to access the COORDS version info and -c passed string to list file and comment section of output files. -c Modified: READCF, OUTHD -c -c --- Version V5.548b Level 050113 to V5.548c Level 050125 -c --- Modified by F.Robe -c (1) Save it1,it2 in subroutine RDMM5 -c -c --- Version V5.548a Level 050101 to V5.548b Level 050113 -c --- Modified by F.Robe -c (1) Make sure no duplicate prognostic levels are used in subroutines -c STULL0, STULL (subroutines RDMM4, RDMM5 -c -c --- Version V5.548 Level 041101 to V5.548a Level 050101 -c --- Modified by F.Robe -c (1) Apply KBAR (vertical limitation to barriers) to step 2 field -c as well. Changes to INTER2,INTERP -c (2) Rationalize storage of barrier parameters in commons: a) removed -c NBAR, XYBAR and KBAR from WPARM, b) added kbar to D3.MET, -c c) replaced internal common /d3/ by include external D3.MET -c in subroutines bariers and diagno (and changed variable names -c accordingly), d) include d3.met in block data, readcf,diagi -c and wind 1 subroutines -c (3) Cleaned up old comments -c -c --- Version V5.547 Level 041016 to V5.548 Level 041101 -c --- Modified by F.Robe -c (1) Implement barriers in initial guess field -c Valid for spatially varying initial guess fields based on -c observations (changes to WIND1) -c (2) Introduce user-input KBAR, the level up to which barriers are -c applied in the initial guess field (no change to step 2 barriers yet) -c (changes to CALMET.INP,WPARM.MET,READCF,WIND1) -c -c --- Version V5.546a Level 041001 to V5.547 Level 041016 -c --- Modified by F.Robe -c (1) DIAGNO: define water cell by SEA.DAT/landuse and not by -c zero terrain elevation (htopo=0) (iextrp=2) -c (2) Bug fix in MIXHT: RHO is 2D not 1D . (Change in MIXHT,COMP) -c (3) Allow multiple 3D.DAT (consecutive or overlapping files) -c Only one 3D.DAT file is open at any time. -c Changes to RDHD5,RDHD5123,RDHD4,RDMM5,RDMM4,READCF,READFN, -c SETUP,WRFILE,OPENOT -c New NM3D and M3DDAT parameters in CALMET.INP, MM4HDO.MET,FILNAM.MET -c New MXM3D in PARAMS.MET, NFM3D in internal common PROGSTEP -c (4) Remove NOOBS from WATER's argument list as not needed -c (change to WATER,COMP) -c (5) Bug fix in RDOW: xkm, ykm must be real*4 not real*8 in call -c to GLOBE -c -c --- Version V5.546a Level 041001 to V5.547 Level 041010 -c --- Modified by F.Robe -c (1) Bug fix in DIAGNO: define water cell by SEA.DAT/landuse and -c not by htopo=0 (iextrp=2) -c (2) Bug fix in MIXHT: RHO is 2D not 1D . (Change in MIXHT,COMP) -c (3) Allow multiple 3D.DAT (consecutive or overlapping files) -c Only one 3D.DAT file is open at any time. -c Changes to RDHD5,RDHD5123,RDHD4,RDMM5,RDMM4,READCF,READFN, -c SETUP,WRFILE,OPENOT -c New NM3D and M3DDAT parameters in CALMET.INP, MM4HDO.MET,FILNAM.MET -c New MXM3D in PARAMS.MET, NFM3D in internal common PROGSTEP -c (4) Remove NOOBS from WATER's argument list as not needed -c (change to WATER,COMP) -c -c --- Version V5.546 Level 040924 to V5.546a Level 041001 -c --- Modified by C. Czaja -c (1) Correction added according to mail from F. Robe -c dated 4/27/2004, asking to comment the line nowsta=0 -c when noobs=2, sea.dat can be accepted in READCF subroutine. -c --- Version V5.545 Level 040612 to V5.546 Level 040924 -c --- Modifications by D. Strimaitis -c (1) Reset the pressure check in subroutine RDMM4 from 8500 -c to 850 (i.e., millibars) -c (2) Add stop in READCF if DATUM in control file is UNKNOWN -c (3) COORDLIB updated to respond to UTM conversion across the -c equator from S. hemisphere to N. hemisphere, when the S. -c hemisphere zone is forced. Also fixed a problem with the -c conversion to/from spherical NWS-84 datum when using UTM -c projection (USGS program input array conflicts). -c (Version: 1.93, Level: 040713) -c --- Modifications by F. Robe -c (4) Computation of the relative positions of MM5 gridpoints -c moved from subroutine interpqr to rdhd4 & rdhd5,and stored in -c MM4HDO.MET as X04, Y04 (with units correction (bug fix)) -c -c --- Version 5.544 Level 040109 to V5.545 Level 040612 -c --- Modifications by F.Robe -c (1) STULL updated to avoid possible exponential overflow - -c --- Version 5.543, Level 031215 to Version 5.544, Level 040109 -c --- Modifications by D. Strimaitis -c (1) COORDLIB updated to respond to projection parameter -c changes when both the projection type and datum do not -c change -c (Version: 1.92, Level: 031201) -c -c --- Version 5.542, Level 031126 to Version 5.543, Level 031215 -c --- Modifications by D. Strimaitis -c (1) Place call to SETCOM after call to READHD in SETUP -c as station locations may be read from headers -c (2) Left-justify station name in RDHD, RDHDU -c (3) Add station ID and name to RDHDU arg list -c -c --- Version 5.541, Level 031106 to Version 5.542, Level 031126 -c --- Modifications by J. Scire -c (1) Changes to accomodate new (Version 2.0) data set structure -c for 3D.DAT file. Modifications to RDHD5, RDHD51, RDHD52, -c common block /MM4HDO/. New routine RDHD53. -c (2) Write 3D.DAT/MM5.DAT/MM4.DAT grid point coordinates -c (X, Y, long, lat) to a QA file (QA3D.DAT). Modifications -c to RDHD4, RDHD51, RDHD52, RDHD53. Add a new parameter (IO4) -c to the PARAMS.MET file. -c (3) Fix array dimensioning problems in READHD, RDHD and common -c block /MET1/. Subr. READHD/RDHD: Change calls to RDHD to -c include character arrays for latitude/longitude in the -c argument list. /MET1/ common block: Fix an error in the -c dimension of the precipitation lat/long arrays. -c -c --- Version 5.54, Level 031017 to Version 5.541, Level 031106 -c --- Modifications by K. Morrison -c (1) Subr. READCF - correction to the variable type definitions -c of IAVET and TGDEFA -c -c --- Version 5.531, Level 030905 to Version 5.54, Level 031017 -c --- Modifications by D.Strimaitis -c (1) Allow location data for surface, upper, and precip stations -c to be missing from control file if they are provided in the -c corresponding data files. Accept lat/lon coordinates for met -c station locations provided in met file (no other type) -c Modified: MET1.MET, READCF, READHD, RDHD, RDHDU -c (2) WGS-72 DATUM bug for UTM calls fixed in COORDLIB -c (Version: 1.91, Level: 031017) -c -c --- Version 5.53, Level 030709 to Version 5.531, Level 030905 -c (1) Bug fix in interpqr -c (2) DATUMs updated in COORDLIB (Version: 1.9, Level: 030905) -c (3) Default DATUMs reset -c -c --- Version 5.52, Level 030528 to Version 5.53, Level 030709 -c --- Modifications by F.Robe -c (1) Subr RDMM5 -RDMM4: bug fix - removal of a spurious statement -c -c --- Version 5.51, Level 030515 to Version 5.52, Level 030528 -c --- Modifications by J. Scire, D. Strimaitis -c (1) CALUTILS library updated to Version: 2.2, Level: 030528 -c (2) COORDLIB library updated to Version: 1.15, Level: 030528 -c (3) COORDLIB common block /blockdat.crd/ updated -c --- Modifications by F.Robe (Version 5.511, Level 030526 change) -c (4) Subr. RDMM5 - correction to ensure a smooth transition from -c Dec 31 to January 1 (if period straddles these dates) -c -c --- Version 5.5, Level 030402 to Version 5.51, Level 030515 -c --- Modifications by J. Scire -c (1) Subr. RDMM5 - correction to ensure IGF is defined when -c conducting a 1-hour run -c (2) Subr. READCF - correction to the variable type definition -c of IAVET -c (3) Subr. WATER - eliminate check to skip mixing height -c calculations over water when NOOBS = 1 or 2 -c (4) Subrs. RDMM4 and RDMM5 - introduce changes to check -c MM4 or MM5/3D.DAT grid point I,J vs. values expected. -c (5) Insert correct level numbers in Subrs. R2INTERP2, CINTERP, -c SURFVAR, INTERPQR, CLOUD, SOLAR (comment), and -c TEMP3D (comment) corresponding to No-Obs changes made to -c Level 030119 -c --- Modifications by D. Strimaitis -c (6) Subr. READGE - fix to read/QA header records for LCC map -c projection -c (7) Subr. RDHD4, RDHD51, RDHD52 and Common block /MM4HDO.MET): -c Add MM4/MM5 grid points to list file (LPRT) output -c (8) Subr. RDHD4, RDHD51, RDHD52, BLOCK DATA and Common -c block /MM4HDO.MET): Assign DATUM for MM4/MM5 file -c datum3d = 'NWS-84 ' -c -c --- Version 5.4, Level 030214 to Version 5.5, Level 030402 -c --- D. Strimaitis -c (1) Replace common utility subroutines with the CALUTILS group -c of subroutines configured for LF95 compilation -c CALUTILS.FOR (Version 2.1, Level 030402) -c (2) Change UNDER0 call to generic UNDRFLW, and place compiler- -c specific implementation routines there -c (3) Move Y2K processing of system date into subroutine DATETM -c and change rdate from (MM-DD-YY) to (MM-DD-YYYY) -c (4) Change UP.DAT format to accept i8 rather than i5 field for -c station ID -c (5) Implement full coordinate conversion and documentation -c - COORDLIB.FOR (Version 1.14, Level 030402) -c - Control file input for map, datum info -c - New header for SURF.DAT, GEO.DAT, UP.DAT, SEA.DAT, -c PRECIP.DAT input files and CALMET.DAT output file -c - LLCONF replaced with LLCC -c - Removed input for Lat/Lon of SW corner of cell 1,1 -c - (XMAP0,YMAP0) = (XORIGR,YORIGR) / 1000 -c (6) Restructure CALMET.DAT headers to include the entire input -c control file as 'comments' (a132), and recast variables -c explicitly written to the header to capture related info -c not contained in the control file. -c -c --- Version 5.3, Level 030119 to Version 5.4, Level 030214 -c --- C. Escoffier-Cjaza -c (1) Correction to RDMM5: precipitation initilalized with the -c current hour -c -c --- Version 5.2, Level 000602d to Version 5.3, Level 030119 -c --- F. Robe -c -c NO-OBS Mode -c noobs= 0 : surface and upper air observations are available -c 1 : only surface observations are available -c MM5 data is used to supply upper air info -c 2 : no observations - MM5 data is used in lieu of obs. -c -c 2D arrays of solar angle, rho, heat flux, relative humidity, -c precip code -c Changes to GEN.MET, HEATFX, ELUSTR, ELUSTR2, R2INTERP2(new), -c INTERPQR(new), AIRDEN, RDMM5, OUTHR, COMP, DIAGNO, -c PARAMS.MET (version#), WSTARR -c 2-D arrays of RHO, QSW, IPCODE, RH, SF TEMP require changes in -c PRTMET and CALPUFF (also must accept npsta=-1, nssta=0) -c -c Flag NPSTA = -1 if MM5 data are to be used for precipitation -c -c New flag in input file to compute 3D temperature based on MM5 -c also computes gamma (itprog>=1) and tinf (itprog=2) from MM5 data -c ITPROG = 0 - 3D temperature from sfc and upper air obs. -c = 1 - Upper air temp from MM5 data and surface from obs. -c = 2 - 3D temperature from MM5 data (2D sf air density also -c from MM5) -c Changes to TEMP3D, MET1.MET, block data, READCF, CALMET.INP, -c CGAMMA2 -c -c New MIXHT2 and MIXDT2: mixing height based on progn. T if -c ITPROG=1,2; -c vertical temperature profiles at MM5 gridpoints are used -c instead of upper air soundings -c -c Additional option ICLOUD=3 to compute cloud cover from MM5 rel. -c humidity and ceiling height from MM5 qc -c New CLOUD and CINTERP subroutines -c Changes to RDHD5, RDMM5, READHD, READCF, COMP, DIAGNO, PGTSTB, -c HEATFX, ELUSTR, ELUSTR2, STHEOR -c -c Additional changes to OPENOT, RDWT, CGAMMA2 for NOOBS -c -c Allow non hourly MM5 input -c Changes to RDHD5, RDMM5, BLOCK DATA, COMP, READCF,TEMP3D -c GEN.MET, MM4HDO.MET, CALMET.INP (new ISTEPPG) -c -c Default values for all new input parameters -c NOOBS = 0 -c ITPROG = 0 -c ISTEPPG = 1 -c -c Binary output is modified => new PRTMET.FOR and new CALPUFF.FOR -c -c (1) Level 020211 -c - RDMM5: bug fix to account for date change -c -c (2) Level 020710 -c - Bug fix (xbuf instead of xubf) -c -c (3) Level 021022 -c - Bug fix in RDMM5: new way to check on istepmm5 (RDMM5) -c - Allow only for MM5 timestep of 12 hours maximum (READCF) -c -c (4) Level 021028 -c - Fix bug in bug fix of v021022 (RDMM5) for isteppg -c -c (5) Level 021105 -c - allow vertical interpolation of surface wind obs. with -c NOOBS=1 -c (changes in DIAGNO, INTER2, READCF, STHEOR, ELUSTR2) -c - new subroutines MIXHTST and MIXHTST2 to compute mixing hts -c at surface stations (short version (one (i,j) ) of MIXHT -c and MIXHT2 -c - bug fix in missfc -c - correct cloud formula: based on RH at 850mb rather than sfc -c - bug fix in RDMM5 use IRHPROG not RHPROG (typo) -c -c (6) Level 030106 -c - Vertical extrapolation of prog T from lowest prog level -c down to lowest CALMET level (in subroutine RDMM5) -c Daytime: assume dry adiabatic profile -c Nightime: assume exponential profile (Stull, 1983) -c - Allow for more than 1 MM5 levels below ground (occurs -c with ETA-M3D data) (in RDMM5) -c - Correct vertical profile used in MIXDT2 (MM5 Temp profile) -c to reflect extrapolation and use of only above sfc -c MM5 levels -c -c (7) Level 030119 -c - NOOBS version for MM4 as well (hourly records only) -c -c --- Version 5.2, Level 000602c to Version 5.2, Level 000602d -c -c (1) Add option to read new prognostic data format (3D.DAT file -c format). Code is backward-compatible with MM4.DAT and -c MM5.DAT formats. (Zhong Wu) -c Changes include: -c (a) Modify RDHD5 and RDMM5 routines -c (b) Add RDHD51 (read original format) -c and RDHD52 (read 3D.DAT format) -c (This version contains the V5.2, L0011 modifications, -c added to 000602c by J. Scire) -c (2) Modify default land use categories to be consistent with -c new (010206) version of MAKEGEO. (J. Scire) -c Changes to BLOCK DATA: -c (a) Default water land use 50, 54, and 55; -c (b) z0 for snow changed to 0.05 m -c (3) Modify READGE to skip UTM zone check if using Lambert -c Conformal coordinates -c -c --- Version 5.2, Level 000602b to Version 5.2, Level 000602c -c --- J. Scire (1/12/2001) -c -c (1) Add code in Subr. DIAGI to set FEXTRP array (used in wind -c module) to FEXTR2 array (variable used for input of -c user-defined wind extrapolation factors). (Piotr Staniaszek) -c -c --- Version 5.2, Level 000602a to Version 5.2, Level 000602b -c --- J. Scire (9/24/2000) -c -c (1) Add option to read radiation parameters from control file -c (Modifications to BLOCK DATA, MICRO, READCF) -c (2) Default value of ICALM set to zero (BLOCK DATA) -c -c --- Version 5.2, Level 000602 to Version 5.2, Level 000602a -c -c (1) Subr. RDP - old PRECIP.DAT 1-24 is changed to 0-23 hour format -c -c --- Version 5.1, Level 991104a to Version 5.2, Level 000602 -c -c (1) Subr. WIND1 - corrects extropolation of winds when -c using the power law option (K. Richmond). -c -c --- Version 5.1, Level 991104 to Version 5.1, Level 991104a -c -c (a1/5.1) Logic added to 3 coordinate routines (MAPG2L, LL2UTM, -c and UTM2LL) to accommodate -180 to +180 longitude boundary -c -c --- Version 5.0, Level 990228 to Version 5.1, Level 991104 -c -c (1) Implement Y2K logic (YYYY format for year). Add new subr. -c YR4, YR4C, QAYR4. Modifications to CGAMMA, COMP, DEDAT, FIN, -c INCR, MISSFC, OUT, PREPDI, RDHD, RDHD4, RDHD5, RDHDU, RDMM4, -c RDMM5, RDOW, RDP, RDS, RDUP, READCF, READHD, RDCLD -c (2) Allow either new or old MM5 header format. Modifications to -c RDMM5. -c (3) Allow increments greater than 8760 hours in INCR. -c (4) Write error messages to list file as well as screen (READFN, -c YR4, QAYR4) -c -c---------------------------------------------------------------------- -c - logical lflag -c -c --- include QA common block - include 'qa.met' -c -c --- Lahey F77 compiler -- set underflows ( < 10**-38 ) to zero - lflag=.true. - call UNDRFLW(lflag) -c -c --- set version and level number of program - ver='6.5.0' - level='150223' -c -c --- (1) setup phase -- initialization & program setup operations - itest=2 - call setup(itest) -c -c --- Skip COMPUTATIONAL phase and STOP program execution if in TEST -c --- mode - if(itest.eq.1)go to 999 -c -c --- (2) computational phase -- basic time loop with scientific modules - call comp -c -c --- (3) termination phase -- program termination functions -999 continue - call fin(itest) -c - stop - end -c----------------------------------------------------------------------- - BLOCK DATA -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 121203 BLOCK DATA -c --- J. Scire, Earth Tech, Inc. -c --- modified by M. Fernau, J. Scire , F.Robe -c -c -c --- v6.4.0, Level 121203 -c - Add THRESHQC in /AUXDAT/ for cloud liquid water processing -c - Add IAUXLWC in /OUTPT/ for cloud liquid water AUX file -c -c --- include parameters - include 'params.met' -c - include 'flags.met' - include 'gen.met' - include 'geo.met' - include 'grid.met' - include 'hflux.met' - include 'metgrd.met' - include 'outpt.met' - include 'ovrwat.met' - include 'qa.met' - include 'wparm.met' - include 'ziparm.met' - include 'breez.met' - include 'lon.met' - include 'map.met' - include 'tmp.met' - include 'met1.met' - include 'filnam.met' - include 'mm4hdo.met' - include 'd3.met' - -c --- v6.4.0, Level 121203 - include 'auxdat.met' - - common /tjump/ dptt(mxnx,mxny) - data dptt/mxxy*0./ - -c --- v6.4.0, Level 121203 -c --- AUXDAT common block - data threshqc/0.005/ -c -c --- GEN common block - data irtype/1/,lcalgrd/.true./,nendhr/0/ - data mreg/-1/ - data nsecdt/3600/ -c -c --- GEO common block - data nlu/14/, - 1 ilucat/ 10, 20, -20, 30, 40, 50, 54, 55, 60, 61, 62, - 1 70, 80, 90, 38*0/, - 2 z0lu /1.0, .25, .25, .05, 1.0,.001,.001,.001, 1.0, 1.0, .20, - 2 .05, .20, .05, 38*0./, - 3 alblu /.18, .15, .15, .25, .10, .10, .10, .10, .10, .10, .10, - 3 .30, .30, .70, 38*0./, - 4 bowlu /1.5, 1.0, 0.5, 1.0, 1.0, 0.0, 0.0, 0.0, 0.5, 0.5, 0.1, - 4 1.0, 0.5, 0.5, 38*0./, - 5 hcglu /.25, .15, .15, .15, .15, 1.0, 1.0, 1.0, .25, .25, .25, - 5 .15, .15, .15, 38*0./, - 6 qflu / 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., - 6 0., 0., 0., 38*0./, - 7 xlailu/0.2, 3., 3., 0.5, 7., 0., 0., 0., 2., 2., 1., - 7 .05, 0., 0., 38*0./, - 7 iwat1/55/,iwat2/55/ -c -c --- GRID common block - data xlat0/9999./,xlon0/9999./ -c -c --- HFLUX common block - data ha1/990./,ha2/-30./,hb1/-0.75/, hb2/3.4/ - data hc1/5.31e-13/,hc2/60./,hc3/0.12/ - -c --- OUTPT common block - data lsave/.true./,lprint/.false./,iprinf/1/ - data ldb/.false./,nn1/1/,nn2/1/,ldbcst/.false./ - data iuvout/mxnz*0/,iwout/mxnz*0/,itout/mxnz*0/,imtout/8*0/ - data iformo/1/ - data iqaplot/1/ - -c --- v6.4.0, Level 121203 - data iauxlwc/1/ -c -c --- METGRD common block - data ztemp/mxxyz*283.0/ -c -c --- OVRWAT common block - data iowbeg/mxows*0/,iowend/mxows*0/ - data ziminw/50./,zimaxw/3000./,constw/0.16/ -c -c --- ZIPARM common block - data constb/1.41/,conste/0.15/,constn/2400./,dptmin/0.001/ - data dzzi/200./,zimax/3000./,zimin/50./ - data iavezi/1/,mnmdav/1/,hafang/30./,ilevzi/1/ -c --- 110212 - data izicrlx/1/,tzicrlx/800./ - -c --- 050328: f is computed as a function of the latitude unless given by -c the user in CALMET.INP- Initializing f to 999. serves as a flag to -c trigger the internal computation -c data fcoriol/1.e-4/ - data fcoriol/999./ -c -c --- QA common block - data rcpu/0.0/ -c -c --- WPARM common block - data iwfcod/1/,ifradj/1/,ikine/0/,iobr/0/ - data iextrp/-4/,fextr2/mxnz*0.0/,rmin/0.1/,rmin2/4./ - data lvary/.false./,iupwnd/-1/ - data iprog/0/ - data alpha/0.1/,idiopt/5*0/ - data zupt/200./,zupwnd/1.,1000./ - data divlim/5.e-6/,niter/50/,nsmth/2,mxnzm1*4/,critfn/1.0/ - data ioutd/0/,nzprn2/1/,ipr0/0/,ipr1/0/,ipr2/0/,ipr3/0/ - data ipr4/0/,ipr5/0/,ipr6/0/,ipr7/0/,ipr8/0/ - data bias/mxnz*0.0/ - data islope/1/,icalm/0/ -c -c --- D3 common block - data nbar/0/ -c -c --- FLAGS common block - data lmesg /.true./, iomesg /6/ -c -c --- BREEZ common block - data llbreze /.false./ -c -c --- LON common block - data dlongs /mxss*0.0/, dlongu /mxus*0.0/ -c -c --- MAP common block - data pmap/'UTM '/ - data datum/'WGS-84 '/ - data utmhem/'N '/ - data iutmzn/-999/ - data xlat1 /-999./, xlat2 /-999./ - data rlon0 /-999./, rlat0 /-999./ - data relon0 /-999./, rnlat0 /-999./ - data feast/0.0/, fnorth/0.0/ -c --- Derived variables - data lutm/.false./, llcc/.false./, lps/.false./ - data lem/.false./, llaza/.false./, lttm/.false./ -c -c --- TMP common block - data irad /1/ - data iavet /1/ - data numwb /0/ - data tgdefb /-.0098/ - data tgdefa /-.0045/ - data jwat1/999/,jwat2/999/ -c *** data trad /20./ - data tradkm/500./ - data numts /5/ -c -c --- MET1 common block - data nflagp /2/,sigmap/100.0/,cutp /0.01/ - data iforms/2/,iformp/2/,iformc/2/ - data noobs /0/ - data itprog /0/ -ccec101006 --- no default for icloud, mcloud, icldout - data icloud/999/ - data mcloud/999/ - data icldout/999/ - data irhprog/0/ -c -c frr (09/01) non hourly prognostic data -c --- MM4HDO common block - data isteppg /1/ - data datum3d/'NWS-84 '/ - data iluoc3d/16/ -c -c --- FILNAM common block - (UPDAT,SEADAT,m3ddat initialized in READFN) - data metinp/'calmet.inp'/,geodat/'geo.dat'/,srfdat/'surf.dat'/, - 1 prcdat/'precip.dat'/,diadat/'diag.dat'/,prgdat/'prog.dat'/, - 2 mm4dat/'mm4.dat'/,wtdat/'wt.dat'/,clddat/'cloud.dat'/ - data metlst/'calmet.lst'/,metdat/'calmet.dat'/, - 1 pacdat/'pacout.dat'/,tstprt/'test.dat'/,tstout/'test.out'/, - 2 tstkin/'test.kin'/,tstfrd/'test.frd'/,tstslp/'test.slp'/, - 3 dcstgd/'dcst.grd'/ - end - -c----------------------------------------------------------------------- -c --- BRING IN CALPUFF SYSTEM UTILITY SUBROUTINES - include 'calutils.for' - include 'coordlib.for' -c----------------------------------------------------------------------- - -c --- v6.4.0, Level 121203 -c --- AUX-FILE SUBROUTINES - include 'auxutils.for' - -c----------------------------------------------------------------------- - subroutine adjust(u,v,phi,htopo,hbar,ub,vb) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 ADJUST -c -c --- include parameters - include 'params.met' - include 'd6.met' -c -c--NEW:frr (12/96) - D5 replaced by grid.met -c COMMON /D5/ NX,NY,NZ,DX,DY,dz(mxnz),NZPRNT - include 'grid.met' -c frr 040630 : include 'd6.met' replaces explicity common -c COMMON /D6/ IRD,IWR,IFILE,irdp - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*) - DIMENSION PHI(mxnx,mxny,*),HTOPO(mxnx,*) - DIMENSION UB(mxny,2,*),VB(mxnx,2,*) -C -C THIS ROUTINE ADJUSTS SURFACE WINDS FOR TERRAIN EFFECTS -C -C INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C HTOPO (R ARRAY) - GRIDDED TERRAIN HEIGHTS -C HBAR (R ARRAY) - MODEL LEVELS -C UB (R ARRAY) - U-COMPONENT BOUNDARY VALUES -C VB (R ARRAY) - V-COMPONENT BOUNDARY VALUES -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C OUTPUTS: U (R ARRAY) - X-DIRECTION WIND COMPONENTS WITH -C ADJUSTED SURFACE LAYER WINDS -C V (R ARRAY) - Y-DIRECTION WIND COMPONENTS WITH -C ADJUSTED SURFACE LAYER WINDS -C -C ITERATION CRITERIA -C - DATA ITMAX,EPSI,OVREL/75,0.02,1.5/ - KK = 1 -C -C COMPUTE TERRAIN GRADIENTS AND INITIAL POTENTIAL -C - DXI=0.5/DX - DYI=0.5/DY - FX=DXI/(HBAR) - FY=DYI/(HBAR) - DO 20 J=1,NY - DO 20 I=1,NX - HTOIM1=HTOPO(I,J) - HTOJM1=HTOPO(I,J) - IF(I.GT.1) HTOIM1=HTOPO(I-1,J) - IF(J.GT.1) HTOJM1=HTOPO(I,J-1) - HTOIP1=HTOPO(I,J) - HTOJP1=HTOPO(I,J) - IF(I.LT.NX) HTOIP1=HTOPO(I+1,J) - IF(J.LT.NY) HTOJP1=HTOPO(I,J+1) - DHDX=(HTOIP1-HTOIM1)*FX - DHDY=(HTOJP1-HTOJM1)*FY - PHI(I,J,2)=(U(I,J,KK)*DHDX+V(I,J,KK)*DHDY) - 20 CONTINUE -C -C SET BOUNDARY VALUES FOR PHI -C - DO 30 J=1,NY - UB(J,1,1)=PHI(1,J,KK) - UB(J,2,1)=PHI(NX,J,KK) - 30 CONTINUE - DO 35 I=1,NX - VB(I,1,1)=PHI(I,1,KK) - VB(I,2,1)=PHI(I,NY,KK) - 35 CONTINUE -C -C SOLVE POISSON EQUATION BY GAUSS-SEIDEL METHOD FOR -C VELOCITY POTENTIAL -C - DXSQ=DX*DX - DYSQ=DY*DY - DSQ=DXSQ*DYSQ - FACT=1.0/(2.0*(DXSQ+DYSQ)) - DO 100 IT=1,ITMAX - DO 90 IDIR=1,4 - ERROR=-1.0E+09 - DO 50 JJ=1,NY - DO 50 II=1,NX - GO TO (71,72,73,74),IDIR - 71 I=II - J=JJ - GO TO 75 - 72 I=NX-II+1 - J=JJ - GO TO 75 - 73 I=II - J=NY-JJ+1 - GO TO 75 - 74 I=NX-II+1 - J=NY-JJ+1 - 75 CONTINUE - XOLD=PHI(I,J,KK) - PHIIM1=UB(J,1,1) - IF(I.GT.1)PHIIM1=PHI(I-1,J,KK) - PHIJM1=VB(I,1,1) - IF(J.GT.1)PHIJM1=PHI(I,J-1,KK) - PHIIP1=UB(J,2,1) - IF(I.LT.NX)PHIIP1=PHI(I+1,J,KK) - PHIJP1=VB(I,2,1) - IF(J.LT.NY)PHIJP1=PHI(I,J+1,KK) - XX=DYSQ*(PHIIP1+PHIIM1) - YY=DXSQ*(PHIJP1+PHIJM1) - PHI(I,J,KK) = (1.-OVREL)*PHI(I,J,KK) - 1 + OVREL*FACT*(XX+YY-DSQ*PHI(I,J,2)) - IF(I.EQ.1) UB(J,1,1)=PHI(1,J,KK) - IF(I.EQ.NX) UB(J,2,1)=PHI(NX,J,KK) - IF(J.EQ.1) VB(I,1,1)=PHI(I,1,KK) - IF(J.EQ.NY) VB(I,2,1)=PHI(I,NY,KK) - IF(XOLD.EQ.0.) GO TO 50 - IF(ABS(XOLD).LT.1.0E-10) GO TO 50 - ERR=ABS((PHI(I,J,KK)-XOLD)/XOLD) - ERROR=AMAX1(ERR,ERROR) - 50 CONTINUE - 90 CONTINUE - IF (ERROR.LE.EPSI) GO TO 150 - 100 CONTINUE - 150 CONTINUE -C -C COMPUTE WIND COMPONENTS FROM VELOCITY POTENTIAL -C - DO 170 J=1,NY - DO 170 I=1,NX - PHIIM1=UB(J,1,1) - PHIJM1=VB(I,1,1) - PHIIP1=UB(J,2,1) - PHIJP1=VB(I,2,1) - IF(I.GT.1) PHIIM1=PHI(I-1,J,KK) - IF(J.GT.1) PHIJM1=PHI(I,J-1,KK) - IF(I.LT.NX) PHIIP1=PHI(I+1,J,KK) - IF(J.LT.NY) PHIJP1=PHI(I,J+1,KK) - U(I,J,KK)=(PHIIP1-PHIIM1)*DXI+U(I,J,KK) - V(I,J,KK)=(PHIJP1-PHIJM1)*DYI+V(I,J,KK) - 170 CONTINUE - 200 CONTINUE -C -C RESET BOUNDARY ARRAY -C - DO 300 K=1,2 - DO 250 J=1,NY - 250 UB(J,K,1)=0. - DO 260 I=1,NX - 260 VB(I,K,1)=0. - 300 CONTINUE - RETURN - END -c----------------------------------------------------------------------- - subroutine airden(pres,temp2d,rho) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 AIRDEN -c --- J. Scire, SRC -c Modified by F.Robe, Earth Tech, to allow 2D arrays -c -c --- PURPOSE: Compute the air density (kg/m**3) using the ideal -c gas law -c --- UPDATES -c - V5.6 050328 (Frr) -c - Remove nssta from calling list (not used) -c - Use 2D temperature field rather than temp at sf. stations -c -c --- Note: 2-D field of surface pressure should be computed and used -c (first compute sea level pressure at all stations, interpolate -c spatially, then refine by taking gridpoint eleveation into -c account) -c -c --- INPUTS: -c PRES(mxss) - real array - Surface pressure (mb) -c TEMP2D(mxnx,mxny)) - real array - Surface Air temperature (deg. K) -c Parameters: MXSS, NEARS,NX,NY -c -c --- OUTPUT: -c RHO(mxnx,mxny) - real array - Air density (kg/m**3) -c -c --- AIRDEN called by: DIAGNO, COMP -c --- AIRDEN calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'grid.met' -c - real pres(mxss) - real temp2d(mxnx,mxny),rho(mxnx,mxny) - -c --- 2-D density -c --- constant 0.3484321 = 100 kg / (m * sec**2) per mb divided by -c --- (287 m**2 / (deg K * sec**2)) -c --- use p at nearest stations (should be improved) - do 200 j=1,ny - do 200 i=1,nx - nsta = nears(i,j) - rho(i,j)=0.3484321*pres(nsta)/temp2d(i,j) -200 continue - -c - return - end -c----------------------------------------------------------------------- - subroutine avemix(nx,ny,mnmdav,hafang,dgrid,u,v,zi,ziconv) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050412 AVEMIX -c --- R. Yamartino, SRC -c -c --- PURPOSE: Calculate the average mixing height (m) at each grid -c point based on an average over MIXHT values at the -c grid point and grid points upwind. -c -c --- UPDATES: -c Level 901130 to V5.6b Level 050412 (F.Robe) -c (1) Add check to ensure upwind averaging of mixing heights -c is done over gridpoints within cone of influence and -c mnmdav square around (i,j) only -c -c -c --- INPUTS: -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c MNMDAV - integer - Max. grid cell search radius -c (outside of HAFANG cone region) -c for mixing depth averaging. -c HAFANG - real - Half-angle (degrees) of upwind -c looking cone for averaging. -c DGRID - real - Grid size (m) -c U(mxnx,mxny) - real array - U component of wind (m/s) -c V(mxnx,mxny) - real array - V component of wind (m/s) -c ZI(mxnx,mxny) - real array - Mixing height (m) from MIXHT -c ZICONV(mxnx,mxny) - real array - Conv. Mix. hgt.(m) from MIXHT -c -c Parameters: mxnx, mxny, io6 -c -c --- OUTPUT: -c ZI(mxnx,mxny) - real array - Mixing height (m) -- ave. of -c local and upwind heights. -c ZICONV(mxnx,mxny) - real array - Conv. Mix. hgt.(m)-- ave. of -c local and upwind heights. -c -c --- AVEMIX called by: COMP -c --- AVEMIX calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real u(mxnx,mxny),v(mxnx,mxny) - real zi(mxnx,mxny),ziconv(mxnx,mxny) - real ziave(mxnx,mxny),zicave(mxnx,mxny) -c $$$ include a weight array for test purposes 4/16/90. -c $$$ real wtij(mxnx,mxny) -c - data dtime/3600./,one/1.0/,zero/0.0/,degrad/0.01745329/ -c -c --- Define dtdx for Courant number purposes. - dtdx = dtime / dgrid -c -c --- Define the tangent of the half-angle. - tanang= tan(degrad * hafang) -c - -c --- Loop over grid cells - do 100 i=1,nx - ip1 = i + mnmdav - im1 = i - mnmdav -c - do 100 j=1,ny - jp1 = j + mnmdav - jm1 = j - mnmdav -c -c - etax = u(i,j) * dtdx - etay = v(i,j) * dtdx - eta2 = etax*etax + etay*etay -c - if(eta2.gt.zero) then - eta = sqrt(eta2) - etai = one / eta -c eta2i = one / eta2 - else - eta = zero - etai = zero -c eta2i = zero - endif -c - ietax = int(etax) - ietay = int(etay) - icwx = int(etay * tanang) - icwy = int(etax * tanang) -c -c --- Note that (iu,ju) is the location of the most upwind cell that -c could have contributed during the time step dt. The cells -c (ia,ja) and (ib,jb) are at the same upwind distance but are at -c a crosswind distance equal in magnitude to the upwind distance -c times the tangent of the half-angle (HAFANG). -c Thus, (i,j), (ia,ja), and (ib,jb) form the vertices of a -c triangle having a 2*HAFANG (degree) opening angle at (i,j). -c - iu = i - ietax - ju = j - ietay -c - ia = iu + icwx - ib = iu - icwx -c - ja = ju - icwy - jb = ju + icwy -c -c --- Wind direction +/- halfang (050412): - if (i.ne.ia) then - alphaa=270.-atan2(float(j-ja),float(i-ia))/degrad - alphaa=amod(alphaa,360.) - else - if(j.ge.ja) alphaa=180. - if(j.lt.ja) alphaa=0. - endif - if (i.ne.ib) then - alphab=270.-atan2(float(j-jb),float(i-ib))/degrad - alphab=amod(alphab,360.) - else - if(j.ge.jb) alphab=180. - if(j.lt.jb) alphab=0. - endif - -c --- Now set the search window: ki from kilow to kihgh -c kj from kjlow to kjhgh - kilow = min0(ia,ib,im1) - kilow = max0(kilow,1) -c - kihgh = max0(ia,ib,ip1) - kihgh = min0(kihgh,nx) -c - kjlow = min0(ja,jb,jm1) - kjlow = max0(kjlow,1) -c - kjhgh = max0(ja,jb,jp1) - kjhgh = min0(kjhgh,ny) -c -c --- Loop over the nearby neighbor cells, K. - sumwt = zero - zibar = zero - zicbar = zero -c -c $$$ include a weight array for test purposes 4/16/90. -c $$$ do 10 ki=1,nx -c $$$ do 10 kj=1,ny -c $10 wtij(ki,kj) = zero -c - do 50 ki=kilow,kihgh - irel = i - ki -c - do 50 kj=kjlow,kjhgh - jrel = j - kj -c - wt = one -c --- The local cell always gets a weight of one - if(irel.eq.0 .and. jrel.eq.0) go to 45 -c - -c --- 050412 - Check if the gridpoint is within mnmdav of (i,j) -c --- (square) -If so, skip the check on the upwind cone (as might -c --- be outside of the cone but should still be kept) - if ((abs(irel).le.mnmdav).and.(abs(jrel).le.mnmdav)) goto 47 - -c --- 050412: Check if the gridpoint is within cone of influence -c --- First check that within +/- halfang of wind direction -c --- Direction of (ki,kj) relative to (i,j) - beta=270.-atan2(float(jrel),float(irel))/degrad - beta=amod(beta,360.) - - if ((beta.lt.alphaa).or.(beta.gt.alphab)) goto 50 - -c --- Then check than not beyond maximum upwind distance (050412) - dist=irel**2+jrel**2 - if (dist.gt.eta2) goto 50 - -47 continue - -c DELA is the upwind measure of a cell's location, with (iu,ju) -c corresponding to dela = eta (i.e. ignoring integer truncation). - dela = (irel*etax + jrel*etay) * etai -c -c --- Zero wind speed (eta=0) gives dela=0. Reset to dela=r. - if(eta.eq.zero) then - xrel = float(irel) - yrel = float(jrel) - dela = sqrt(xrel*xrel + yrel*yrel) - endif -c -c --- Downwind cells currently penalized as if beyond causal frontier. - if(dela.lt.zero) dela = eta - dela -c -c --- Now consider all non-local, upwind cells. -c DELC is the crosswind measure of a cells location. - delc = abs(irel*etay - jrel*etax) * etai -c -c cross = 50.0 -c Assume dela > 0 always now. -c if(dela.gt.zero) cross = delc / dela -c -c --- Note that the weight (wt) favors an upwind-facing cone region. -c The factor, one/(one + 2.0*cross**2) is a Gaussian-like, -c crosswind penalty function. -c wt = one / ( (one + dela) * (one + 2.0*cross**2) ) -c -c --- Note that the following weight (wt) is equivalent to 1/r. -c wt = one / ( dela*sqrt(one + cross**2) ) -c or wt = one / sqrt(dela**2 + delc**2) -c -c --- Note that the following weight (wt) is equivalent to 1/r**2. -c wt = one / (dela**2 + delc**2) -c -c --- Note that the following weight (wt) is like a displaced 1/r**2. - wt = one / (dela**2 + (one + abs(delc))**2) -c - 45 sumwt = sumwt + wt - zibar = zibar + wt * zi(ki,kj) - zicbar = zicbar + wt * ziconv(ki,kj) -c -c $$$ include a weight array for test purposes 4/16/90. -c $$$ wtij(ki,kj) = wt -c - - - 50 continue -c - ziave(i,j) = zibar / sumwt - zicave(i,j) = zicbar / sumwt - -c -c $$$ include a weight array for test purposes 4/16/90. -c $$$ write(6,1001) i,j,etax,etay,sumwt,wtij -c1001 format(' Weight array: i,j,etax,etay,sumwt=',2i5,3f10.3,/, -c f 10(/,10f7.2)) -c - 100 continue -c -c - -c --- Loop over grid cells a second time to load the zi array. - do 200 i=1,nx - do 200 j=1,ny -c - zi(i,j) = ziave(i,j) - ziconv(i,j) = zicave(i,j) -c - 200 continue -c - return - end -c----------------------------------------------------------------------- - subroutine avetmp(nx,ny,mnmdav,hafang,dgrid,u,v,ztemp) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050412 AVETMP -c --- M. Fernau, ETCO/SRC after AVEMIX by R. Yamartino, SRC -c -c --- PURPOSE: Calculate the average temperature (K) at each grid -c point based on an average over TEMP values at the -c grid point and grid points upwind. -c -c --- UPDATES: -c Level 940930 to V5.6b Level 050412 (F.Robe) -c (1) Add check to ensure upwind averaging of mixing heights -c is done over gridpoints within cone of influence and -c mnmdav square around (i,j) only -c -c --- INPUTS: -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c MNMDAV - integer - Max. grid cell search radius -c (outside of HAFANG cone region) -c for mixing depth averaging. -c HAFANG - real - Half-angle (degrees) of upwind -c looking cone for averaging. -c DGRID - real - Grid size (m) -c U(mxnx,mxny) - real array - U component of wind (m/s) -c V(mxnx,mxny) - real array - V component of wind (m/s) -c ZTEMP(mxnx,mxny) - real array - Temperature (K) from TEMP3D -c -c Parameters: mxnx, mxny, io6 -c -c --- OUTPUT: -c ZTEMP(mxnx,mxny) - real array - Temperature (K) -- average of -c local and upwind temperatures. -c -c --- AVETMP called by: TEMP3D -c --- AVETMP calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real u(mxnx,mxny),v(mxnx,mxny) - real ztemp(mxnx,mxny) - real ztave(mxnx,mxny) -c $$$ include a weight array for test purposes 4/16/90. -c $$$ real wtij(mxnx,mxny) -c - data dtime/3600./,one/1.0/,zero/0.0/,degrad/0.01745329/ -c -c --- Define dtdx for Courant number purposes. - dtdx = dtime / dgrid -c -c --- Define the tangent of the half-angle. - tanang= tan(degrad * hafang) -c -c --- Loop over grid cells - do 100 i=1,nx - ip1 = i + mnmdav - im1 = i - mnmdav -c - do 100 j=1,ny - jp1 = j + mnmdav - jm1 = j - mnmdav -c -c - etax = u(i,j) * dtdx - etay = v(i,j) * dtdx - eta2 = etax*etax + etay*etay -c - if(eta2.gt.zero) then - eta = sqrt(eta2) - etai = one / eta -c eta2i = one / eta2 - else - eta = zero - etai = zero -c eta2i = zero - endif -c - ietax = int(etax) - ietay = int(etay) - icwx = int(etay * tanang) - icwy = int(etax * tanang) -c -c --- Note that (iu,ju) is the location of the most upwind cell that -c could have contributed during the time step dt. The cells -c (ia,ja) and (ib,jb) are at the same upwind distance but are at -c a crosswind distance equal in magnitude to the upwind distance -c times the tangent of the half-angle (HAFANG). -c Thus, (i,j), (ia,ja), and (ib,jb) form the vertices of a -c triangle having a 2*HAFANG (degree) opening angle at (i,j). -c - iu = i - ietax - ju = j - ietay -c - ia = iu + icwx - ib = iu - icwx -c - ja = ju - icwy - jb = ju + icwy -c -c --- Wind direction +/- halfang (050412) - if (i.ne.ia) then - alphaa=270.-atan2(float(j-ja),float(i-ia))/degrad - alphaa=amod(alphaa,360.) - else - if(j.ge.ja) alphaa=180. - if(j.lt.ja) alphaa=0. - endif - if (i.ne.ib) then - alphab=270.-atan2(float(j-jb),float(i-ib))/degrad - alphab=amod(alphab,360.) - else - if(j.ge.jb) alphab=180. - if(j.lt.jb) alphab=0. - endif - -c --- Now set the search window: ki from kilow to kihgh -c kj from kjlow to kjhgh - kilow = min0(ia,ib,im1) - kilow = max0(kilow,1) -c - kihgh = max0(ia,ib,ip1) - kihgh = min0(kihgh,nx) -c - kjlow = min0(ja,jb,jm1) - kjlow = max0(kjlow,1) -c - kjhgh = max0(ja,jb,jp1) - kjhgh = min0(kjhgh,ny) -c -c --- Loop over the nearby neighbor cells, K. - sumwt = zero - ztbar = zero -c -c $$$ include a weight array for test purposes 4/16/90. -c $$$ do 10 ki=1,nx -c $$$ do 10 kj=1,ny -c $10 wtij(ki,kj) = zero -c - do 50 ki=kilow,kihgh - irel = i - ki -c - do 50 kj=kjlow,kjhgh - jrel = j - kj -c - wt = one -c --- The local cell always gets a weight of one - if(irel.eq.0 .and. jrel.eq.0) go to 45 -c -c --- 050412 - Check if the gridpoint is within mnmdav of (i,j) -c --- (square) -If so, skip the check on the upwind cone (as might -c --- be outside of the cone but should still be kept) - if ((abs(irel).le.mnmdav).and.(abs(jrel).le.mnmdav)) goto 47 - -c --- 050412: Check if the gridpoint is within cone of influence -c --- First check that within +/- halfang of wind direction -c --- Direction of (ki,kj) relative to (i,j) - beta=270.-atan2(float(jrel),float(irel))/degrad - beta=amod(beta,360.) - - if ((beta.lt.alphaa).or.(beta.gt.alphab)) goto 50 - -c --- Then check than not beyond maximum upwind distance (050412) - dist=irel**2+jrel**2 - if (dist.gt.eta2)goto 50 - -47 continue - -c DELA is the upwind measure of a cell's location, with (iu,ju) -c corresponding to dela = eta (i.e. ignoring integer truncation). - dela = (irel*etax + jrel*etay) * etai -c -c --- Zero wind speed (eta=0) gives dela=0. Reset to dela=r. - if(eta.eq.zero) then - xrel = float(irel) - yrel = float(jrel) - dela = sqrt(xrel*xrel + yrel*yrel) - endif -c -c --- Downwind cells currently penalized as if beyond causal frontier. - if(dela.lt.zero) dela = eta - dela -c -c --- Now consider all non-local, upwind cells. -c DELC is the crosswind measure of a cells location. - delc = abs(irel*etay - jrel*etax) * etai -c -c cross = 50.0 -c Assume dela > 0 always now. -c if(dela.gt.zero) cross = delc / dela -c -c --- Note that the weight (wt) favors an upwind-facing cone region. -c The factor, one/(one + 2.0*cross**2) is a Gaussian-like, -c crosswind penalty function. -c wt = one / ( (one + dela) * (one + 2.0*cross**2) ) -c -c --- Note that the following weight (wt) is equivalent to 1/r. -c wt = one / ( dela*sqrt(one + cross**2) ) -c or wt = one / sqrt(dela**2 + delc**2) -c -c --- Note that the following weight (wt) is equivalent to 1/r**2. -c wt = one / (dela**2 + delc**2) -c -c --- Note that the following weight (wt) is like a displaced 1/r**2. - wt = one / (dela**2 + (one + abs(delc))**2) -c - 45 sumwt = sumwt + wt - ztbar = ztbar + wt * ztemp(ki,kj) -c -c $$$ include a weight array for test purposes 4/16/90. -c $$$ wtij(ki,kj) = wt -c - 50 continue -c - ztave(i,j) = ztbar / sumwt -c -c $$$ include a weight array for test purposes 4/16/90. -c $$$ write(6,1001) i,j,etax,etay,sumwt,wtij -c1001 format(' Weight array: i,j,etax,etay,sumwt=',2i5,3f10.3,/, -c f 10(/,10f7.2)) -c - 100 continue -c -c --- Loop over grid cells a second time to load the ztemp array. - do 200 i=1,nx - do 200 j=1,ny - ztemp(i,j) = ztave(i,j) - 200 continue - return - end -c----------------------------------------------------------------------- - subroutine barier(x,y,xs,ys,ok) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 BARIER -c -c -c --- PURPOSE: CALCULATE WHAT SIDE OF A BARRIER A POINT IS ON -C BARRIERS ARE FINITE LENGTH LINE SEGMENTS -c -c ---UPDATES: -c --- Level 970825 to Version 5.548a Level 050101 (F.Robe) -c (1) Replaced common /d3/ by include d3.met and changed variable names from -c bas(4,mxbar) to barxy(4,mxbar), and from numbas to nbar -c -c -c --- MEF SRC 6/16/94 corrected the way that a vertical (N-S) barrier -c is handled. Fix modified 11/96 by J. Scire to work on PC. -c -C -C --- INPUTS: -C X (R) - X-COORDINATE OF POINT OF INTEREST -C Y (R) - Y-COORDINATE OF POINT OF INTEREST -C XS (R) - X-COORDINATE OF REFERENCE POINT -C YS (R) - Y-COORDINATE OF REFERENCE POINT -c -c Via common d3.met: -c BARXY(4,mxb) (R) - COORDINATE OF BARRIER END POINTS -c (in km relative to domain origin) -C NBAR (I) - NUMBER OF BARRIERS (UP TO MXBAR) -C IFIN (I) - IF 0 SET UP PT SLOPE LINES -c -c Via common params.met: MXBAR -C -C --- OUTPUTS: -C OK (R) - FLAG IF POS (X-Y) IS ON SAME SIDE AS -c (XS-YS) -c Via common d3.met -c SLPIN(1,mxbar) (R) - SLOPE OF LINE -C SLPIN(2,mxbar) (R) - INTERCEPT OF LINE -c ------------------------------------------------------------------------------- -c --- include parameters - include 'params.met' -c - DIMENSION A(3), B(3), C(3) -c --- explicit common replaced by include d3.met -c requires to change numbas to nbar and bas to barxy - include 'd3.met' -c COMMON /D3/ IFIN,NUMBAS,BAS(4,mxbar),SLPIN(2,mxbar) -C -C - OK = 1.0 - IF (NBAR .LE. 0) GO TO 140 - IF (IFIN .GT. 0) GO TO 110 -C -C SETUP SLOPE INTERCEPT FORM OF A LINE FOR BARRIER -C - DO 100 I = 1,NBAR - DY = BARXY(2,I)-BARXY(4,I) - DX = BARXY(1,I)-BARXY(3,I) -c -c...Logic to handle North-South vertical barrier with infinite slope. -c - if (dx.eq.0.0) then - slpin(1,i) = 9.9E9 - else - SLPIN(1,I) = DY/DX - endif - SLPIN(2,I) = BARXY(2,I)-SLPIN(1,I)*BARXY(1,I) - 100 CONTINUE - IFIN = 1 -C - 110 CONTINUE -c -c...C = vector from station to grid cell -c - C(1) = XS-X - C(2) = YS-Y - A(3) = 0. - B(3) = 0. - C(3) = 0. - DO 120 I = 1,NBAR -c -c...D1 and D2 are distances of vertical lines from station and grid -c...point, respectively, with plane of the barrier. -c - D1 = YS-SLPIN(1,I)*XS-SLPIN(2,I) - D2 = Y-SLPIN(1,I)*X-SLPIN(2,I) -c -c...Same sign for D1 and D2 means same side of the barrier. -c - IF (D1*D2.GE.0.) GO TO 120 -c -c...A = vector from grid cell to beginning of barrier. -c - A(1) = BARXY(1,I)-X - A(2) = BARXY(2,I)-Y -c -c...B = vector from grid cell to end of barrier. -c - B(1) = BARXY(3,I)-X - B(2) = BARXY(4,I)-Y - COSAB = UNIDOT(A,B) - COSAC = UNIDOT(A,C) - COSBC = UNIDOT(B,C) - IF (COSAC .LT. COSAB .OR. COSBC .LT. COSAB) GO TO 120 -c -c...True = clear of barrier, false = blocked by barrier. -c - OK = -1.0 - GO TO 130 - 120 CONTINUE - 130 CONTINUE -C - 140 CONTINUE - RETURN - END -c---------------------------------------------------------------------- - subroutine r2interpi(i,j,x,y,zarray,k,zi) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060106 R2INTERPI -c F.Robe (Earth Tech) -c after subroutine r2interp -c -c --- PURPOSE: Interpolate the IGF-CALMET data to the CALMET grid point -c using inverse distance squared weighting of four nearest -c points. -c -c --- INPUTS: -c I, J - integers - Row and column of the CALMET grid -c being processed -c X, Y - reals - Real-space (LCC or UTM) X, Y coordinates -c (km) of CALMET grid point (I,J) -c ZARRAY(mxnxi,mxnyi,mxnz)- Array of MM4 grid point values to -c be used in the interpolation to the -c CALMET grid point -c K - integer - CALMET layer being processed (NOTE: the -c IGF-CALMET data in ZARRAY is horizontally in -c the IGF-CALMET grid system, but vertically in -c the CALMET system at this point. -c -c Common block /IGF/: -c XIGF(mxnxi,mxnyi),YIGF(mxnxi,mxnyi), -c IGRABi(mxnx,mxny,4),JGRABi(mxnx,mxny,4) -c Parameters: -c MXNXi,MXNYi,MXNX,MXNY,MXNZ -c -c --- OUTPUT: -c ZI - real - Interpolated value returned for CALMET -c grid point (I,J,K) -c -c --- R2INTERPI called by: RDCALMET -c --- R2INTERPI calls: none -c---------------------------------------------------------------------- -c - include 'params.met' -c -c --- Include common block - include 'igf.met' -c - real zarray(mxnxi,mxnyi,mxnz) - - sum = 0. - sum1 = 0. -c - do m = 1,4 - pdist = ((xigf(igrabi(i,j,m),jgrabi(i,j,m)) - x) ** 2 + - & (yigf(igrabi(i,j,m),jgrabi(i,j,m)) - y) ** 2 ) -c -c --- Minimum distance to avoid computational problems - if (pdist .lt. 0.001) pdist = 0.001 -c -c --- Convert distance**2 to inverse distance**2 - pdist = 1. / pdist - sum = sum + zarray(igrabi(i,j,m),jgrabi(i,j,m),k) * pdist - sum1 = sum1 + pdist - enddo - zi = sum / sum1 -c - return - end -c---------------------------------------------------------------------- - subroutine r2interp(i,j,x,y,zarray,k,zi) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 990228 R2INTERP -c M. Fernau, Earth Tech -c -c -c --- PURPOSE: Interpolate the MM4 data to the CALMET grid point using -c inverse distance squared weighting of four nearest -c points. -c -c --- INPUTS: -c I, J - integers - Row and column of the CALMET grid -c being processed -c X, Y - reals - Real-space (LCC or UTM) X, Y coordinates -c (km) of CALMET grid point (I,J) -c ZARRAY(mxnxp,mxnyp,mxnz)- Array of MM4 grid point values to -c be used in the interpolation to the -c CALMET grid point -c K - integer - CALMET layer being processed (NOTE: the -c MM4 data in ZARRAY is horizontally in -c the MM4 grid system, but vertically in -c the CALMET system at this point. -c -c Common block /MM4HDO/: -c XLCMM4(mxnxp,mxnyp),YLCMM4(mxnxp,mxnyp), -c IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4) -c Parameters: -c MXNXP,MXNYP,MXNX,MXNY,MXNZ -c -c --- OUTPUT: -c ZI - real - Interpolated value returned for CALMET -c grid point (I,J,K) -c -c --- R2INTERP called by: RDMM4 -c --- R2INTERP calls: none -c---------------------------------------------------------------------- -c - include 'params.met' -c -c --- Include common block - include 'mm4hdo.met' -c - real zarray(mxnxp,mxnyp,mxnz) - - sum = 0. - sum1 = 0. -c - do m = 1,4 - pdist = ((xlcmm4(igrab(i,j,m),jgrab(i,j,m)) - x) ** 2 + - & (ylcmm4(igrab(i,j,m),jgrab(i,j,m)) - y) ** 2 ) -c -c --- Minimum distance to avoid computational problems - if (pdist .lt. 0.001) pdist = 0.001 -c -c --- Convert distance**2 to inverse distance**2 - pdist = 1. / pdist - sum = sum + zarray(igrab(i,j,m),jgrab(i,j,m),k) * pdist - sum1 = sum1 + pdist - enddo - zi = sum / sum1 -c - return - end -c---------------------------------------------------------------------- - subroutine r2interp2(i,j,x,y,zarray,zi) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 030119 R2INTERP2 -c F.Robe, Earth Tech -c After r2interp (M.Fernau) -c -c --- PURPOSE: Interpolate the MM4 data to the CALMET grid point using -c inverse distance squared weighting of four nearest -c points (2D arrays) -c -c --- INPUTS: -c I, J - integers - Row and column of the CALMET grid -c being processed -c X, Y - reals - Real-space (LCC or UTM) X, Y coordinates -c (km) of CALMET grid point (I,J) -c ZARRAY(mxnxp,mxnyp) - Array of MM4 grid point values to -c be used in the interpolation to the -c CALMET grid point -c -c Common block /MM4HDO/: -c XLCMM4(mxnxp,mxnyp),YLCMM4(mxnxp,mxnyp), -c IGRAB(mxnx,mxny,4) ,JGRAB(mxnx,mxny,4) -c Parameters: -c MXNXP,MXNYP,MXNX,MXNY -c -c --- OUTPUT: -c ZI - real - Interpolated value returned for CALMET -c grid point (I,J) -c -c --- R2INTERP2 called by: RDMM5 -c --- R2INTERP2 calls: none -c---------------------------------------------------------------------- -c - include 'params.met' -c -c --- Include common block - include 'mm4hdo.met' -c - real zarray(mxnxp,mxnyp) - - sum = 0. - sum1 = 0. -c - do m = 1,4 - pdist = ((xlcmm4(igrab(i,j,m),jgrab(i,j,m)) - x) ** 2 + - & (ylcmm4(igrab(i,j,m),jgrab(i,j,m)) - y) ** 2 ) -c -c --- Minimum distance to avoid computational problems - if (pdist .lt. 0.001) pdist = 0.001 -c -c --- Convert distance**2 to inverse distance**2 - pdist = 1. / pdist - sum = sum + zarray(igrab(i,j,m),jgrab(i,j,m)) * pdist - sum1 = sum1 + pdist - enddo - zi = sum / sum1 -c - return - end -c---------------------------------------------------------------------- - subroutine cinterp(i,j,x,y,zarray,zi) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070202 CINTERP -c F.Robe, TRC -c After R2INTERP2 subroutine -c -c -c --- PURPOSE: Interpolate the MM5 ceiling height to the CALMET grid -c using inverse distance squared weighting of four nearest -c points but giving no weight to zero values (no cloud) -c -c --- UPDATES: -c --- Level 030119 to V6.223 Level 070702 (F.Robe): -c - modify subroutine to account for the fact that the ceiling -c height arrays are 2 D not 3D i.e. model after R2INTERP2 not -c R2INTERP -c -c -c --- INPUTS: -c I, J - integers - Row and column of the CALMET grid -c being processed -c X, Y - reals - Real-space (LCC or UTM) X, Y coordinates -c (km) of CALMET grid point (I,J) -c ZARRAY(mxnxp,mxnyp)- Array of MM4 grid point values to -c be used in the interpolation to the -c CALMET grid point -c -c Common block /MM4HDO/: -c XLCMM4(mxnxp,mxnyp),YLCMM4(mxnxp,mxnyp), -c IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4) -c Parameters: -c MXNXP,MXNYP,MXNX,MXNY,MXNZ -c -c --- OUTPUT: -c ZI - real - Interpolated value returned for CALMET -c grid point (I,J,K) -c -c --- CINTERP called by: RDMM5 -c --- CINTERP calls: none -c---------------------------------------------------------------------- -c - include 'params.met' -c -c --- Include common block - include 'mm4hdo.met' -c - real zarray(mxnxp,mxnyp) - - sum = 0. - sum1 = 0. -c - do 1 m = 1,4 - pdist = ((xlcmm4(igrab(i,j,m),jgrab(i,j,m)) - x) ** 2 + - & (ylcmm4(igrab(i,j,m),jgrab(i,j,m)) - y) ** 2 ) -c -c --- Minimum distance to avoid computational problems - if (pdist .lt. 0.001) pdist = 0.001 -c -c --- Convert distance**2 to inverse distance**2 - pdist = 1. / pdist - a = zarray(igrab(i,j,m),jgrab(i,j,m)) -c --- don't take zero values into account (zero ceiling height=no clouds) -c --- allow for round-off errors - if (a .lt. 1.e-6) go to 1 - sum = sum + zarray(igrab(i,j,m),jgrab(i,j,m)) * pdist - sum1 = sum1 + pdist -1 continue - if (sum1.gt.1.e-9) then - zi = sum / sum1 - else - zi = 0. - endif -c - return - end -c---------------------------------------------------------------------- - subroutine box(ibx,xg,yg,ok) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 940616 BOX -c R. Mentzer, SRC -c --- MEF SRC 6/16/94 changed to include outer row and column of box -c in the box (better for boxes that abut edge of domain) -C -C THIS ROUTINE CALCULATES WHETHER A POINT IS WITHIN A DEFINED BOX -C -C INPUTS: ibx - Box number -C Xg (R) - X-COORDINATE OF POINT OF INTEREST -C Yg (R) - Y-COORDINATE OF POINT OF INTEREST -C -C Common BREEZ: -C XG1 (R) - X-grid line defining a box -C XG2 (R) - X-grid line defining a box -C YG1 (R) - Y-grid line defining a box -C YG2 (R) - Y-grid line defining a box -C Parameters: MXBAR -C -C OUTPUTS: -C OK (R) - FLAG IF Point is within the box -c -c CALLED BY: LLBREEZ -c CALLS : UNIDOT -c -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'breez.met' - - integer ibx -c - ok=-1.0 - if (amin1(xg1(ibx),xg2(ibx)) .eq. xg1(ibx)) then - if (xg .ge. xg1(ibx) .and. xg .le. xg2(ibx)) then - if (amin1(yg1(ibx),yg2(ibx)) .eq. yg1(ibx)) then - if (yg .ge. yg1(ibx) .and. yg .le. yg2(ibx)) OK=1.0 - else - if (yg .le. yg1(ibx) .and. yg .ge. yg2(ibx)) OK=1.0 - endif - endif - else - if (xg .le. xg1(ibx) .and. xg .ge. xg2(ibx)) then - if (amin1(yg1(ibx),yg2(ibx)) .eq. yg1(ibx)) then - if (yg .ge. yg1(ibx) .and. yg .le. yg2(ibx)) OK=1.0 - else - if (yg .le. yg1(ibx) .and. yg .ge. yg2(ibx)) OK=1.0 - endif - endif - endif -c - RETURN - END -c---------------------------------------------------------------------- - subroutine cgamma(nyrze,njulze,nhrze,nsece,iupt,zupt,ziconv, - & gamma) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 090511 CGAMMA -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the average temperature lapse rate in a layer -c up to the height "ZUPT" at upper station IU -c -c --- UPDATES: -c --- V6.32 Level 080205 to v6.327 LEvel 090511 (FRR) -c - Remove format statements 1089 and 1090 which are not -c used -c --- V6.218 Level 070113 to V6.32 Level 080205(FRR) -c - Use explicit end times instead of beginning times -c - Do not interpolate in time if time-average sounding -c (i.e. AA=BB arrays) -c --- v6.215 Level 061020 to V6.218 Level 070113 (FRR) -c - Add comment warning that IUPT in this subroutine is an -c internal parameter indicating the upper air station number -c where the lapse rate is computed, which ca be different from the -c user-selected flag "IUPT" (which can be <0) -c --- V5.1 Level 991104 to v6.215 Level 061020 (DGS) -c - Use explicit beginning times with seconds -c - JUSDT is now seconds, not hours -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c -c --- INPUTS: -c -c NYRZE - integer - Year of current hour (UTC) -c (explicit ending time) -c NJULZE - integer - Day of current hour (UTC) -c (explicit ending time) -c NHRZE - integer - Current hour UTC time (0-23) -c (explicit ending time) -C NSECB - integer - Current ending second -c IUPT - integer - Station number of the upper air -c sounding where lapse rate is computed -c !!! IUPT in this subroutine is an -c actual station number and not the "IUPT" -c flag in the calmet.inp file (which can -c be -1 if all the upper air stations are used -c ZUPT - real - Height (m) up to which temp. -c lapse rate is computed -c ZICONV - real - Convective mixing ht. (m) for -c the grid cell containing upper -c air station no. "IUPT" -c Parameters: MXUS, MXLEV, IO6 -C -c UPMET.MET: ISNAP(MXUS),JUSTA(MXUS),JUSTD(MXUS), NTZAA(MXUS),NTZBB(MXUS), -C JAASEC(MXUS),JBBSEC(MXUS) -c -c --- OUTPUT: -c GAMMA - real - Average temperature lapse rate -c (deg. K/m) in the layer up to -c height "ZUPT" at upper air station -c Number iupt - -c -c --- CGAMMA called by: PREPDI -c --- CGAMMA calls: INTP, DEDAT, DELTSEC -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - include 'upmet.met' -c - - data nconvdat/-9999/,xmiss/999.9/ - -c --- Current timestamp (ending UTC time) - nowtze = nyrze*100000 + njulze*100 + nhrze - - if(ziconv.ge.zupt)then -c -c --- layer within convective mixing height -c --- assume dry adiabatic lapse rate - gamma=-0.0098 -c --- save time -- last convective per of day is used in time interp - nconvdat=nowtze - nconvsec=nsece - return - endif - -C --- Skip time interpolation if time-averaged sounding (080205) -c --- Requires: ISNAP=0: averaged soundings in UP.DAT (v2.2) (AA=BB arrays) -c ---- JUSTA=+1 (BB time later than AA time) - -c --- If BB sooner than AA (justa=-1), then current time is between -c --- 2 averaged-soundings and time interpolation must be done - if (isnap(iupt).eq.0.and.justa(iupt).eq.+1) then - xmissm=xmiss-0.01 - ts=tzbb(iupt,1) -c --- Extract temp. at z = ZUPT via interpolation in height - call INTP(tzbb,zlbb,nlbb(iupt),iupt,zupt,xmissm,tt) - gamma=(tt-ts)/zupt - return - endif - - -c *** rjy additions of 1/26/90 for arbitrary soundings. *********** - jorder = justa(iupt) - jdelta = jusdt(iupt) - ntzaas = ntzaa(iupt) - call DEDAT(ntzaas,jaayr,jaaday,jaahr) - ntzbbs = ntzbb(iupt) - call DEDAT(ntzbbs,jbbyr,jbbday,jbbhr) - ibbsec=jbbsec(iupt) - iaasec=jaasec(iupt) - - if(jorder.gt.0) then -c call deltt(nyrz,njulz,nhrz,jbbyr,jbbday,jbbhr,jtogo) -c call deltt(jaayr,jaaday,jaahr,nyrz,njulz,nhrz,jpast) - call DELTSEC(nowtze,nsece,ntzbbs,ibbsec,jtogo) - call DELTSEC(ntzaas,iaasec,nowtze,nsece,jpast) - else -c call deltt(nyrz,njulz,nhrz,jaayr,jaaday,jaahr,jtogo) -c call deltt(jbbyr,jbbday,jbbhr,nyrz,njulz,nhrz,jpast) - call DELTSEC(nowtze,nsece,ntzaas,iaasec,jtogo) - call DELTSEC(ntzbbs,ibbsec,nowtze,nsece,jpast) - endif - -c --- Interpolate in time to current ending time. Note that xfact starts -c out at 1.0 and works down to 0 as jtogo gets smaller. - xfact = float(jtogo) / float(jdelta) - -c ******************************************************************** -c -c --- Reduce the missing value indicator by a small amount to allow -c --- for machine roundoff - xmissm=xmiss-0.01 -c -c --- Extract the two bounding values of surface temp. - tsbb=tzbb(iupt,1) - tsaa=tzaa(iupt,1) - if(tsbb.ge.xmissm.or.tsaa.ge.xmissm)then - write(io6,*)'ERROR in subr. CGAMMA -- bottom of sounding is ', - 1 'missing -- TSAA = ',tsaa,' TSBB = ',tsbb,' Date of AA ', - 2 'sounding (YYYYDDDHH) = ',ntzaas,' Date of BB sounding ', - 3 '(YYYYDDDHH) = ',ntzbbs - stop - endif -c -c --- Interpolate linearly to obtain the surface temp.,ts, at end time - if(jorder.lt.0) then - ts=tsaa-(tsaa-tsbb)*xfact - else - ts=tsbb-(tsbb-tsaa)*xfact - endif -c -c --- Reduce missing value indicator by a slight amount to allow for -c --- machine roundoff - xmissm=xmiss-0.01 -c -c --- Extract the two bounding values of temp. at z = ZUPT -c via interpolation in height of the two soundings. - call INTP(tzaa,zlaa,nlaa(iupt),iupt,zupt,xmissm,ttaa) - call INTP(tzbb,zlbb,nlbb(iupt),iupt,zupt,xmissm,ttbb) -c --- Interpolate linearly to obtain the temp at z=ZUPT at begin time - if(jorder.lt.0) then - tt=ttaa-(ttaa-ttbb)*xfact - else - tt=ttbb-(ttbb-ttaa)*xfact - endif -c -c --- Compute ave. lapse rate (deg. K/m) - gamma = (tt-ts) / zupt -c - -c --- We would normally be finished here, but we want to make use of -c adiabatic nature of the boundary layer during convective hours. -c --- First skip cases where NCONVDAT undefined. - if(nconvdat.LT.-9998) return -c --- Also, this additional information is only useful if NCONVDAT -c lies between the two current soundings. - if(jorder.gt.0) then - call DELTSEC(nconvdat,nconvsec,ntzbbs,ibbsec,jtogoc) - call DELTSEC(ntzaas,iaasec,nconvdat,nconvsec,jpastc) - else - call DELTSEC(nconvdat,nconvsec,ntzaas,iaasec,jtogoc) - call DELTSEC(ntzbbs,ibbsec,nconvdat,nconvsec,jpastc) - endif -c --- Check that last convective time lies between soundings. For this -c to be true, the sum JTOGOC+JPASTC will equal the duration JDELTA. -c --- If outside the interval, quit with the previous gamma definition. - if((jpastc+jtogoc).ne.jdelta) return -c --- Add a second test just to make sure the convective hour preceeds -c the current hour. However, this should be automatic. - if(jtogoc.le.jtogo) return -c --- Add a third test just to make sure that if the last convective -c hour is also a sounding hour, the sounding is preferentially used. - if(jtogoc.ge.jdelta) return -c - xfactc = float(jtogoc) / float(jdelta) -c --- Interpolate linearly to obtain the surface temp. computed elevated -c temperature at last convective hour. -c Assume sounding remains adiabatic up to and including last hour -c with convective mixing height > ZUPT. - if(jorder.lt.0) then - ttc = tsaa-(tsaa-tsbb)*xfactc - 0.0098*zupt - else - ttc = tsbb-(tsbb-tsaa)*xfactc - 0.0098*zupt - endif -c -c --- Now linearly interpolate from this last convective time to the -c next sounding to obtain the temp. at z=ZUPT at NOWTZE,NSECE. - xfact = float(jtogo) / float(jtogoc) -c Note that XFACT has been redefined to deal with the shorter period -c --- Interpolate linearly to obtain the temp at z=ZUPT at NOWTZE,NSECE. - if(jorder.lt.0) then - tt=ttaa-(ttaa-ttc)*xfact - else - tt=ttbb-(ttbb-ttc)*xfact - endif -c -c --- Compute ave. lapse rate (deg. K/m) - gamma = (tt-ts) / zupt -c - return - end -c---------------------------------------------------------------------- - subroutine cgamma2(tprog,ziconv,gamma) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070113 CGAMMA2 -c --- J. Scire, SRC -c -c --- PURPOSE: Compute a 2-D array of temperature lapse rate in a layer -c up to the height "ZUPT" using prognostic data -c Compute a domain representative temperature TINF -c based on prognostic surface temperatures -c -c --- UPDATES: -c --- (99/01-941101) to V6.218 Level 070113 (F.Robe) -c - Only compute domain representative surface temperature -c Tinf if isurft=-2 (if ISURFT=-1,spatially varying surface -c temperature is used instead of Tinf) -c - Replace single lapse rate gamma by 2-D array. Spatially -c variable gamma if iupt=-1 (default); domain average value -c otherwise (iupt=-2). -c - Remove itprog from calling list -c -c --- INPUTS: -c -c TPROG - real array - MM4 temperature array on CALMET -c grid -c ZICONV - real array - Convective mixing ht. (m) -c ZUPT - real - Height (m) up to which temp. -c lapse rate is computed -c (from common block WPARM) -c CELLZC - real array - Midpoints of CALMET levels -c (from common block D1) -c NX,NY,NZ - integer - CALMET grid dimensions -c (from common block D5) -c --- Via common wparm.met: -c -c IUPT - integer - Flag for the computation of lapse-rate -c IUPT=-1 : spatially variable lapse rate -c IUPT=-2: domain average lapse rate -c (IUPT>0: only with upper air soundings) -c ZUPT - real - height up to which lapse rate is computed -c ISURFT - integer - Flag for the surface temperature -c used in terrain-induced computations -c - ISURFT=-1: 2-D variable Sf temp. -c - ISURFT=-2:constant Sf temp.(averaged over all -c prognostic temp -c - ISURFT>0: surface station number to used -c (constant Tinf throughout domain) - Not relevant -c in this subroutine (only for progn.temp.) -c -c Parameters: MXNX,MXNY,MXNZ, IO6 -c -c --- OUTPUT: -c GAMMA - real array - Temperature lapse rate (deg. K/m) -c in the layer up to height "ZUPT". -c Spatially variable if IUPT=-1 (default); -c Domain average if IUPT=-2 (not recommended) -c via common wparm.met -c TINF - real - Average surface temperature -c -c --- CGAMMA2 called by: DIAGNO -c --- CGAMMA2 calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'd1.met' - include 'grid.met' - include 'wparm.met' - - real tprog(mxnx,mxny,mxnz),ziconv(mxnx,mxny) - real gamma(mxnx,mxny) -c - avgamma = 0. - -c --- initialize tinf - if (isurft.eq.-2) tinf=0 - -c --- Find ratio (ZHIGH - ZUPT)/(ZHIGH - ZLOW) for use in interpolation - do 10 k = 1,nz - if (cellzc(k) .ge. zupt) then - nbp = k - go to 20 - endif -10 continue -c -c --- Sounding does not go high enough - write(io6,15) zupt,nz,cellzc(nz) -15 format(//1x,'ERROR IN SUBR. CGAMMA2 -- interp. height is ', - 1 'above top model level'//5x,'Height = ',f10.1,5x, - 2 'No. model levels = ',i5,5x,'Top model height = ',f10.1) - stop -20 continue - if (nbp .eq. 1) then - write(io6,*) ' ZUPT is smaller than lowest layer midpoint' - stop - else - nbpm1 = nbp - 1 - end if - rat = (cellzc(nbp) - zupt) / - & (cellzc(nbp) - cellzc(nbpm1)) - - - do i = 1,nx - do j = 1,ny - if (ziconv(i,j) .ge. zupt) then -c -c --- layer within convective mixing height -c --- assume dry adiabatic lapse rate - avgamma= avgamma - 0.0098 - gamma(i,j)=-0.0098 - - else - ts = tprog(i,j,1) -c -c --- find temperature at ZUPT by interpolation -c - tu = tprog(i,j,nbp) - (tprog(i,j,nbp) - - & tprog(i,j,nbpm1)) * rat -c -c --- Compute ave. lapse rate (K/m) - tgamma = (tu - ts) / (zupt - cellzc(1)) - avgamma = avgamma + tgamma - gamma(i,j)=tgamma - end if - -c frr (09/01) -c --- Compute domain representative surface temperature TINF - if (isurft.eq.-2) tinf=tinf+tprog(i,j,1) - end do - end do - -c --- If users-selected, fill in gamma array with domain average lapse rate -c --- (not recommended but allowed for consistency purposes with older versions) - if (iupt.eq.-2) then - do i=1,nx - do j=1,ny - gamma(i,j) = avgamma / (nx * ny) - end do - end do - endif - - if (isurft.eq.-2) tinf = tinf/(nx * ny) - - return - end -c---------------------------------------------------------------------- - subroutine chksum(x,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 WRTI2D -c --- J. Scire, SRC -c -c --- PURPOSE: Sum all values of an array -- QA checking purposes -c -c---------------------------------------------------------------------- -c - real x(mxnx,mxny,mxnz) - character*80 cmesag -c -c --- sum all values of an array -- QA checking purposes - sum=0.0 - do 100 i=1,nx - do 100 j=1,ny - do 100 k=1,nz - sum=sum+x(i,j,k) -100 continue -c - write(io6,102)cmesag -102 format(1x,a80) - write(io6,*)'CHECK SUM = ',sum -c - return - end -c---------------------------------------------------------------------- - subroutine cmpd2(xref,yref,x,y,nsta,dist2) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 CMPD2 -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the (distance)**2 from each station to the -c reference coordinates (XREF, YREF) -c -c --- INPUTS: -c XREF - real - X coordinate of reference point -c YREF - real - Y coordinate of reference point -c X(nsta) - real - Array of X coordinates of stations -c Y(nsta) - real - Array of Y coordinates of stations -c NSTA - integer - Number of stations -c -c --- OUTPUT: -c DIST2(nsta) - real - Distance**2 from each station to the -c reference point (XREF, YREF) -c -c --- CMPD2 called by: MISSFC -c --- CMPD2 calls: none -c---------------------------------------------------------------------- -c - real x(nsta),y(nsta),dist2(nsta) -c -c --- Compute the (distance)**2 from (XREF, YREF) to each -c --- station - do 10 i=1,nsta - dist2(i)=(x(i)-xref)**2+(y(i)-yref)**2 -10 continue -c - return - end -c---------------------------------------------------------------------- - subroutine comp -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 121203 COMP -c --- J. Scire, R. Yamartino, SRC -c --- Modified by M. Fernau, X. Zhang, J. Scire -c -c --- PURPOSE: CALMET Computational Routine -- contains main time -c loop and calls routines performing hourly computations -c -c --- UPDATES: -c -c --- v6.330 (101006) to v6.4.0 (121203) -c - Add AUXOUT -c -c --- v6.327 (090511) to v6.330 (101006) (CEC) -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c -c --- v6.321 (080325) to v6.327 (090511) (FRR) -c - Revised write Formats 75,1311,1312 to add more information -c at stop -c --- V6.32 (080205) (FRR) to v6.321 (080325) -c - Remove nsecdt from calling list to rdupn2 -c -c --- 6.3 (070717) to V6.32 (080205) (FRR) -c - Compare end time of calmet timestep with end time -c of upper air soundings (instead of beginning times) -c - Allow new UP.DAT format (dataveru=2.2) in which -c beginning = end times indicate an instantaneous sounding -c begining < end times indicate a time-averaged sounding -c - Initialize Snapshot vs. time-averaged sounding flag: -c ISNAP(mxus): time-averaged=0 / snapshot=1 -c - Ensure that data frequency is no higher than CALMet sampling -c frequency -c -c --- V6.222 (070404) to v6.3 (070717) -c - Add IPSIFCN to ELUSTR argument list -c - Add ISFCMET option for 2D surface temperatures and density -c - Add IUPT to calling list to MIXHT -c - compute ending GMT time and pass it on to DIAGNO, WATER and WATERP -c rather than the beginning time (for use in COARE) -c -c --- V6.221 (070327)to V6.222 (070404)(FRR) -c - Pass on observed ceiling height iceil(mxss) and icloud -c to RADFLX (icloud=1) -c - Fill in gridded cloud array with observations sooner -c in the code (icloud=1) -c - Decode beginning date of precipitation record in 2.1 format -c for proper debug writing (debug mode only) -c -c --- V6.218 (070113) to V6.221 (070327)(FRR) -c - Save ldbhr in OUTPT.MET and do not declare it here anylonger -c - initialize idathrb, idathre,ipdathrb, ipdathre (B. Brashers) -c and isecb,isece,ipsecb,ipsece -c - Print out requested variables in list file on hourly basis -c (i.e. use nsecb for test instead of isecb) -c -c --- v6.215 (061020) to V6.218 (070113) (FRR) -c - Remove beta2 from PREPDI and DIAGNO calling lists -c - Make former scalar gamma a 2-D array -c - Remove nz,nssta,nusta,noobs from PREPDI calling list -c - Remove iupt from MIXHT calling list -c -c --- v6.208 (060329) to v6.215 (061020) (DGS) -c - Modified calling args for RDUP, RDUPN -c - Fix diagnostic write statements that use old hour-ending -c variable names -c - Activate hour-ending times for MESOPAC output option -c and restrict output to NSECDT=3600 -c -c --- v6.205 (060309) to v6.208 (060329) (DGS) -c - Fix date matching test on precip.dat file dates for old -c file format (MOD5) -c -c --- v6.202 to v6.205 (060309)(F.Robe) -c - Correct matching test on calmet/surf.dat dates for old surf.dat -c file format -c - No longer compute nowtz as nhr,njul,nyr are no longer updated -c (can crash call to indecr) -c - Replace nhr by nhrb at end of day loop -c -c --- v6.2 (060215)to v6.202 (F.Robe) -c - Correct linear interpolation of solar angle between 1800 and -c 3600sec -c -c --- v5.611 (051113)to v6.2 (060215) (F.Robe) -c - Use explicit beginning/ending times instead of hour-ending -c convention -c - Loop over sub-hourly timesteps and flag last one -c - Call to RDS/RDSN,RDP/RDPN,RDUP/RDUPN depending on data version -c number (explicit or hour-ending times) -c -c --- V5.6 (050328) to v5.611 (051113) (F.Robe) -c - Allow option to use prognostic offshore data (3D.DAT) instead -c of SEA.DAT with itwprog=2 (call to WATERP or WATER) -c - Add itwprog to DIAGNO calling list -c -c --- V5.55 (041030) to V5.6 (050328) (F.Robe) -c - remove nssta from calling list to airden -c - pass on value of imixh to water in order to compute the -c convective mixing height according to the user-selected -c method -c -c --- V5.547 to V5.55 (041030) (F.Robe) -c - Rationalize computation and use of 2D surface variables -c (change in calling lists, split of surfvar into -c surftemp and surfvar (rh,ipcode, cloud) -c - Change order of call to various subroutines to ensure -c that necessary variables are available for calls to COARE -c - Add itimstep variable to track timestep -c timestep stored in GEN.MET for use in COARE and -c passed to SOLAR -c - Compute Downward Long Wave radiative flux -c -c --- V5.5 (030402) to V5.547 (041010) (FRR) -c - Remove nears from calling list to MIXHT and NOOBS from -c list to WATER -c -c --- V5.4 (991104) to V5.5 (030402) (DGS) -c - Add list-file unit to GRDAY, INDECR calls -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- INPUTS: -c Common blocks: -c /GEN/, /GRID/, /OUTPT/, /MET1/, /MET2/, /MET3/, /UPMET/, -c /METGRD/, /GEO/, /HFLUX/, /OVRWAT/, /WPARM/, /D1/, /FLAGS/, -c /METPAC/, /ZIPARM/, /TMP/ -c Parameters: mxnx, mxny, mxnz, mxss, mxus, mxps, mxbar, -c mxows, mxlev, mxlu, io6 -c mxwnd, mxnzp1, mxxy -c -c --- OUTPUT: none -c -c --- COMP called by: MAIN -c --- COMP calls: VERTAV, SOLAR, PREPDI, DIAGNO, WATER, PGTSTB, -c HEATFX, AIRDEN, ELUSTR, MIXHT, WSTARR, GRIDE, -c RDUP, RDS, RDP, RDOW, DIAG2, INDECR, -c DELTT, OUT, OUTHR, GRDAY, TEMP3D, FACET, DEDAT, -c MISSFC, AVEMIX, OUTPC, PACAVE, AVETMP, OUTCLD, -c RDCLD, WATERP -c AIRDEN_NS, TEMP3D_back, SURFVAR_back -c --- v6.4.0, Level 121203 -c --- AUXOUT -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real ziconv(mxnx,mxny) - real rho(mxnx,mxny),qsw(mxnx,mxny) - real uaveaa(mxnz,mxus),uavebb(mxnz,mxus) - real vaveaa(mxnz,mxus),vavebb(mxnz,mxus) - real tzgraa(mxnzp1,mxus),tzgrbb(mxnzp1,mxus) -c real otempk(mxss) : otempk saved in met2.met (050328) - real tprog(mxnx,mxny,mxnz),vptprog(mxnx,mxny,mxnz) - real ccgrid(mxnx,mxny) - character*70 messag - character*4 namst - real temp2d (mxnx,mxny) -c --- Add 2D temperature array for nearest surface station/prognostic -c --- temperatures (ISFCMET=1 option) - real tsfnsp(mxnx,mxny) - integer irh2d(mxnx,mxny),ipcode2d(mxnx,mxny) - integer iceilg(mxnx,mxny) -c frr 050328 (long wave rad. flx) - real qlw(mxnx,mxny) - -c --- 2-D lapse rate (070113) - real gamma(mxnx,mxny) -c - logical ldate,lprthr -c - include 'd1.met' - include 'flags.met' - include 'gen.met' - include 'geo.met' - include 'grid.met' - include 'hflux.met' - include 'met1.met' - include 'met2.met' - include 'met3.met' - include 'metgrd.met' - include 'metpac.met' - include 'outpt.met' - include 'ovrwat.met' - include 'upmet.met' - include 'wparm.met' - include 'ziparm.met' - include 'tmp.met' - common /salp/ ihr2gmt,sinalp2(mxnx,mxny) -c - data nh/0/,ldate/.true./,iconvrt/1/,ziconv/mxxy*0.0/ - data maxsep/14/ -c sub-hourly timestep counter(replaces hourly counter nh) - data nsubh/0/ - -c initialize dataset time variables: - data idathrb, idathre /0,0/ ! BAB bug fix (un-initialized variables) - data ipdathrb,ipdathre/0,0/ ! BAB bug fix (un-initialized variables) - data isecb, isece /0,0/ ! - data ipsecb,ipsece/0,0/ ! - -c --- Initialize upper air sounding flags (080205) - do k=1,nusta - isnap(k)=1 - end do - - if(lmesg)then - write(iomesg,*)'ENTERING COMPUTATIONAL PHASE' - write(iomesg,*) - endif -c -c --- QA check on ISFCMET value - if(isfcmet.NE.0 .AND. isfcmet.NE.1) then - write(io6,*)'ERROR in COMP: invalid ISFCMET provided' - write(io6,*)' Expected isfcmet = 0 or1' - write(io6,*)' Found isfcmet = ',isfcmet - stop 'ERROR in COMP -- see list file' - endif -c - -c --- v6.4.0, Level 121203 -c --- Set flag for processing AUX output arrays (full max dims) - ifull=0 - if(mxnx.EQ.nx .AND. mxny.EQ.ny) ifull=1 - -c --- determine loop range & initialize date/time variables -c --- ("idays" sized at length plus TWO days to account for case -c --- when starting hour is not hour 0, e.g., so that a 24-hour -c --- run can span two days) - idays=(irlg-1)/24+2 - if(mod(ibyrn,4).eq.0)then - mxdays=366 - else - mxdays=365 - endif - -c --- Initialize MOD6 explicit beginning time -c --- nyrb=ibyr --- bug fix 101206 - nyrb=ibyrn - njulb=ibjuln-1 - nhrb=ibhrn-1 - nsecb=ibsecn-nsecdt -c -c --- Determine the sub-hourly update frequency (#timesteps in 1 hour) -c --- (nsecdt is a fraction of 3600 - This is ensured in READCF) - nsubst=3600/nsecdt -c -c --- Begin DAY loop - do 1000 idy=1,idays -c -c --- increment date/time -c --- beginning time of the current timestep - njulb=njulb+1 - if(njulb.gt.mxdays)then - nyrb=nyrb+1 - njulb=1 - if(mod(nyrb,4).eq.0)then - mxdays=366 - else - mxdays=365 - endif - endif - call grday(io6,nyrb,njulb,nmob,ndayb) - -c --- ending time of the current timestep -c --- (everything except seconds are the same as beginning time because -c --- (the ending seconds isece are allowed to be =3600) - njule=njulb - nyre=nyrb - nmoe=nmob - ndaye=ndayb - -c --- compute sin(solar elevation angles) at all gridpoints -c --- MOD6: compute 26 hourly values (between 23:30 previous day and 0:30 next day) -c --- Hourly alues are linearly interpolated to the half-time step and stored -c --- in SINALPC(mxnx,mxny) - - - call solar (njulb,ibtz,sinalp) -c - - -c --- Begin HOUR loop - do 900 ih=1,24 -c - -c --- increment hour variables - nh=nh+1 - -c --- current timestep (saved in GEN.MET - frr050328 - Used in COARE) - itimstep= nh - -c --- flag last hour of run - must be last timestep in MOD6 (060215) -c if (nh.eq.irlg) nendhr =1 - -c --- end of run no longer determined by last hour -c --- but by last sub-hourly step (060215) -c if(nh.gt.irlg)go to 1001 - - -c --- Increment hour of the day (beg/ending) - nhrb=nhrb+1 - if(nhrb.gt.23)then - nhrb=-1 - nh=nh-1 - go to 1000 - endif - nhre=nhrb - -c --- nhrind is hour variable ranging from 1-24 instead of 0-23 -c --- (used as array index for sinalp (i,j,1-24) so must be >0) - nhrind=nhrb+1 - -c --- compute MOD6 explicit beginning date/hour variable (YYYYJJJHH) - ndathrb=nyrb*100000+njulb*100+nhrb - -c --- MOD6 explicit ending date/hour variable (YYYYJJJHH)- (051116) - ndathre=ndathrb - -c --- MOD5 hour-ending date/hour variables (end of current hour) -c --- This assumes that current times always finish an hour with -c --- seconds=3600 - nyr=nyrb - njul=njulb - nmo=nmob - nday=ndayb - nhr=nhrb - call INCR(io6,nyr,njul,nhr,1) - ndathr=nyr*100000+njul*100+nhr - - -c frr 050328 - Compute GMT time whether noobs or not (needed in several -c places (upper air soundings and overwater coare method) - -c --- compute the current GMT (or Z) date/hr variable, NOWTZ (YYYYJJJHH) -c --- (MOD5 hour-ending) -c nhrz = nhr -c njulz = njul -c nyrz = nyr -c call indecr(io6,nyrz,njulz,nhrz,ibtz,0,23) -c nowtz = nyrz*100000 + njulz*100 + nhrz - -c --- compute the current GMT (or Z) beginning date/hr variable, NOWTZB (YYYYJJJHH) - nhrzb = nhrb - njulzb = njulb - nyrzb = nyrb -c *** Use the more general INDECR subroutine which allows -c *** negative values of IBTZ -c *** call incr(nyrz,njulz,nhrz,ibtz) - call indecr(io6,nyrzb,njulzb,nhrzb,ibtz,0,23) - nowtzb = nyrzb*100000 + njulzb*100 + nhrzb -c -c -c --- Begin SUB-HOUR loop - do 800 isub=1,nsubst - -c --- increment sub-hourly timestep counter - nsubh=nsubh+1 - -c --- flag last timestep of run (for use in rdmm5) 051128 - if (nsubh.eq.irsublg) nendhr = 1 - -c --- end run if arrives at final sub-hourly timestep - if(nsubh.gt.irsublg)go to 1001 - -c --- increment seconds - nsecb=nsecb+nsecdt - -c --- Current timestep beginning at (ndathrb,nsecb) - -c --- Go to next hour if exceed last sub-hourly step of that hour - if(nsecb.eq.3600) then - nsecb=-nsecdt - nsubh=nsubh-1 - go to 900 - endif - -c --- Update current timestep ending time -c --- (seconds up to 3600 so that do not update hour,day,etc) - nsece=nsecb+nsecdt -c -c --- update current timestep ending GMT time (070717) -c --- compute the current GMT (or Z) ending date/hr variable, NOWTZE (YYYYJJJHH) -c --- Note: INCRS subroutine will convert 3600sec into 1 hour - nhrze = nhrzb - njulze = njulzb - nyrze = nyrzb - nsecze=0 - call incrs(io6,nyrze,njulze,nhrze,nsecze,nsece) - nowtze = nyrze*100000 + njulze*100 + nhrze - -c --- Compute current sine of solar angle sinalpc stored in GEN.MET -c --- Interpolate from hourly values to mid-timestep -c --- Array index (k) has value for time (k-2) hours and 30 minutes -c --- For hourly timesteps, identical values as in MOD5 - Do j=1,ny - do i=1,nx - nsecm=nsecb+nsecdt/2 - dsec=abs( (float(nsecm)-1800.)/3600. ) - if (nsecm.eq.1800) then - sinalpc(i,j)=sinalp(i,j,nhrb+2) - else if (nsecm.gt.1800) then - sinalpc(i,j)=sinalp(i,j,nhrb+2)*(1.-dsec) - : + sinalp(i,j,nhrb+3)*dsec - else -c sinalpc(i,j)=sinalp(i,j,nhrb+1)*(1.-dsec) -c : + sinalp(i,j,nhrb+2)*dsec - sinalpc(i,j)=sinalp(i,j,nhrb+1)*dsec - : + sinalp(i,j,nhrb+2)*(1-dsec) - endif - end do - end do -c - -c --- write sine (solar elev. angle) if LDB switch is on - if(ldbhr)then - write(io6,95)nyrb,njulb,nhrb,sinalpc(1,1) -95 format(/2x,'Computed solar elevation angle data at point ', - 1 '1,1 -- Year: ',i4,2x,'Julian day: ',i3,3x,'Hour: ',i2// - 2 3x,'Sine (solar elev. angle)',2x,f7.5) - endif - - if(lmesg)print 788,nyrb,njulb,nhrb,nsecb,nyre,njule,nhre,nsece -788 format('+','Processing Year, Day, Hour, Sec from: ', - : i4,1x,i3,1x,i2,1x,i4,' to:', i4,1x,i3,1x,i2,1x,i4) - -c -c --- set print variables for this hour and sub-hourly step -c --- at this point only prints out on hourly basis max (051116) - if((lprint.and.mod(nh,iprinf).eq.0).and.(nsecb.eq.0)) then - lprthr=.true. - else - lprthr=.false. - endif -c - if(ldb.and.nh.ge.nn1.and.nh.le.nn2)then - ldbhr=.true. - else - ldbhr=.false. - endif -c - -c -c --- read surface meteorological data for current hour -c --- (idiopt(4) is 1 if using preprocessed surface data) -c FRR (09/2001) No surface obs option (noobs=2) -c if(idiopt(4).eq.1)go to 111 - if(idiopt(4).eq.1 .or. noobs .eq. 2)go to 111 - -c --- Surface records - -c --- Surface records - if (datavers.eq.'2.1') then -c --- explicit beg/ending time with seconds -c --- whether a new record is read or not is decided in rdsn not here - call rdsn(iforms,nssta,ispack,ios,0,ibuf, - 1 ndathrb,nsecb,idathrb,isecb,idathre,isece, - 1 ws,wd,iceil,icc,tempk,irh,pres,ipcode) - -c --- Ensure data frequency is no higher than CALMET frequency (080205) - call deltsec(idathrb,isecb,idathre,isece,ndatdt) - if(ndatdt.lt.nsecdt) then -c frequency too high - write(6,*)'STOP in subroutine COMP - see list file' - write(io6,*)'STOP in subroutine COMP' - write(io6,*)'Surface record frequency is too high' - write(io6,*)'Record ending at (YYYYJJJHH-SEC)',idathre, - : '-',isece - write(io6,*)'Time between sf records (sec): ',ndatdt - write(io6,*)'Should be less than CALMET timestep (sec): ', - : nsecdt - STOP - endif - - else if (nsecb.eq.0) then -c --- hour-ending time format - Update only every hour when nsecb=0 - - call rds(iforms,nssta,ispack,ios,0,ibuf,iyr,ijul,ihr,ws,wd, - 1 iceil,icc,tempk,irh,pres,ipcode) -c -c idathr=iyr*100000+ijul*100+ihr - idathre=iyr*100000+ijul*100+ihr - call incr(io6,iyr,ijul,ihr,-1) - idathrb=iyr*100000+ijul*100+ihr - -c - if(idathrb.ne.ndathrb)then - write(io6,102)ndathre,idathre -102 format(//1x,'ERROR IN SUBR. COMP', - 1 '-- Expected date/hour does ', - 1 'not match values read from SURFACE DATA file'/ - 2 5x,'Expected year, Julian day, hour = ',i9/ - 3 5x,'Values read from file = ',i9) - stop - endif - endif - - -c --- echo back surface met. data if "debug write" option is on -c --- (BEFORE missing data is replaced) - if(ldbhr)then - write(io6,108)idathrb,isecb,idathre,isece -108 format(/1x,'SURFACE MET. INPUT DATA -- YYYYJJJHH: ',i10,3x, - 1 'seconds: ',i5,' to -- YYYYJJJHH: ',i10,3x, - 1 'seconds: ',i5,/1x,'Station ID',6x, - 2 'WS',4x,' WD ',3x,'Ceil Ht',3x,'Cloud Cover',4x,'Temp', - 3 4x,'Rel Hum',4x,'Pres',3x,'Precip Code'/16x,'(m/s)',3x, - 4 '(deg)',3x,'(100s FT)',4x,'(tenths)',4x,'(deg K)',4x,'(%)', - 5 6x,'(mb)') - do 110 kk=1,nssta - write(io6,109)idssta(kk),ws(kk),wd(kk),iceil(kk),icc(kk), - 1 tempk(kk),irh(kk),pres(kk),ipcode(kk) -109 format(1x,i9,4x,f7.2,2x,f6.1,5x,i4,8x,i4,6x,f7.2,4x,i4,4x, - 1 f7.2,5x,i4) -110 continue - endif -c -c -c --- Replace missing surface data (ICEIL, ICC, IRH, and PRES) -c --- missing TEMPK replaced in TEMPK array, but original data is -c --- saved in the OTEMPK array -c --- 050328 - otempk stored in MET2.MET -c call missfc(iyr,ijul,ihr,otempk) - call missfc(iyr,ijul,ihr) -c -111 continue -c -c --- Read gridded CLOUD data for current hour (hourly records) -ccec101006 if(icloud.eq.2 .and. nsecb.eq.0)then -c if(mcloud.eq.2 .and. nsecb.eq.0)then -c call rdcld(iformc,nx,ny,ndathrb,ccgrid) -c endif -c --- Read gridded CLOUD data for at each timestep -c --- with beginning and ending times - if(mcloud.eq.2)then - call rdcldn(iformc,nx,ny,ndathrb,nsecb,ndathre,nsece,ccgrid) - endif - -c --- Fill in gridded cloud array with observations -c --- Must be done sooner in the code (i.e. here) to avoid -c --- un-initialized variables at first time step, and one -c --- timestep lagging for subsequent timesteps(070404) -c --- And must be done for icloud=0 (eq. mcloud=1) as well -c --- otherwise no gridded cloud data when observations -c --- Compute and output gridded cloud data -ccec101006 if(icloud.le.1)call outcld(ndathrb,nx,ny,nssta,icc,nears, -ccec101006 1 iformc,icloud,ccgrid) -c --- Write out cloud records with beginning and ending times (101206) -c if(icldout.eq.1.and.mcloud.eq.1)call outcld(ndathrb,nx,ny, -c 1 nssta,icc,nears,iformc,icldout,mcloud,ccgrid) - if(icldout.eq.1.and.mcloud.eq.1) - : call outcld(ndathrb,nsecb,ndathre,nsece,nx,ny, - : nssta,icc,nears,iformc,icldout,mcloud,ccgrid) -c - -c --- Echo back gridded cloud data (if debug option is on) - if(ldbhr)then - messag='Gridded input cloud fraction field' - call out(ccgrid,idum,1,5,ldate,messag,nx,ny) - endif -c - -c --- read precipitation data for current timestep - - if(npsta.gt.0)then - if (dataverp.eq.'2.1')then -c --- 2.1 time format with explicit beg/ending times with seconds - call rdpn(iformp,npsta,ippack,iop,0,ndathrb,nsecb, - 1 ipdathrb,ipsecb,ipdathre,ipsece,xprecp) - -c --- Ensure data frequency is no higher than CALMET frequency (080205) - call deltsec(ipdathrb,ipsecb,ipdathre,ipsece,ndatdt) - if(ndatdt.lt.nsecdt) then -c frequency too high - write(6,*)'STOP in subroutine COMP - see list file' - write(io6,*)'STOP in subroutine COMP' - write(io6,*)'Precipitaion record frequency is too high' - write(io6,*)'Record ending at (YYYYJJJHH-SEC)',ipdathre, - : '-',ipsece - write(io6,*)'Time between prec. records (sec): ',ndatdt - write(io6,*)'Should be less than CALMET timestep (sec): ', - : nsecdt - STOP - endif - - else if (nsecb.eq.0) then -c --- hour-ending time format - Update only every hour when nsecb=0 - call rdp(iformp,npsta,ippack,iop,0,iyr,ijul,ihr,xprecp) -c idathr=iyr*100000+ijul*100+ihr - ipdathre=iyr*100000+ijul*100+ihr - call incr(io6,iyr,ijul,ihr,-1) - ipdathrb=iyr*100000+ijul*100+ihr - -c DGS if(ipdathrb.ne.ndathr)then -c DGS write(io6,1022)ndathr,ipdathre - if(ipdathrb.ne.ndathrb)then - write(io6,1022)ndathrb,ipdathre -1022 format(//1x,'ERROR IN SUBR. COMP', - 1 '-- Expected date/hour does ', - 1 'not match values read from PRECIPITATION DATA file'/ - 2 5x,'Expected year, Julian day, hour = ',i9/ - 3 5x,'Values read from file = ',i9) - stop - endif - endif -c - -c -c --- echo back precip. input data if "debug write" option is on - if(ldbhr)then - if(dataverp.eq.'2.1')call dedat(ipdathrb,iyr,ijul,ihr) - write(io6,118)iyr,ijul,ihr -118 format(/1x,'PRECIPITATION INPUT DATA -- Year: ',i4,3x, - 1 'Julian day: ',i3,3x,'Starting Hour: ',i2/1x,'Station ID', - 2 5x,'Precip. rate'/18x,'(mm/hr)') - do 120 kk=1,npsta - write(io6,119)idpsta(kk),xprecp(kk) -119 format(2x,i8,5x,f9.3) -120 continue - endif - endif -c - -c --- read overwater data - if(nowsta.gt.0)then - call rdow(ndathrb) - if(ldbhr)then - write(io6,128)nyrb,njulb,nhrb,nsecb -128 format(/1x,'OVERWATER INPUT DATA -- Year: ',i4,3x, - 1 'Julian day: ',i3,3x,'Hour: ',i2,3x,'SECOND: ',i4/1x, - 2 'Station No',3x,'Rel. X',4x,'Rel. Y',6x,'Z',4x,'Beg. Time', - 3 3x,'End. Time',3x,'Delta T',3x,'Air T',3x,'Rel Hum',3x, - 4 'Mix Ht'/16x,'(m)',6x,'(m)',7x,'(m)',1x,'(YYYYJJJHH)',1x, - 5 '(YYYYJJJHH)',3x,'(Deg K)',2x,'(Deg K)',4x,'(%)',7x,'(m)') - do 130 kk=1,nowsta - write(io6,129)kk,xowsta(kk),yowsta(kk),zowsta(kk), - 1 iowbeg(kk),iowend(kk),dtow(kk),tairow(kk),rhow(kk),ziow(kk) -129 format(4x,i4,5x,f9.1,1x,f9.1,1x,f5.1,4x,i9,5x,i9,5x,f6.2, - 1 3x,f6.2,3x,f5.1,4x,f7.1) -130 continue - endif -c --- Fill in wind module common with OW values - call diag2(nssta,nowsta,chowsta,xowsta,yowsta) - endif -c - -c --- read upper air data -c -c *** rjy modified the following section on 1/24/90 ****************** -c --- (idiopt(5) is 1 if using preprocessed upper air data) -c FRR (09/2001) additional option for noobs -c if(idiopt(5).eq.1 .or. noobs.eq.1)go to 145 - if(idiopt(5).eq.1 .or. noobs.ge.1)go to 145 -c - -c --- begin loop over upper air station data. - io=iou-1 - do 140 iu=1,nusta - io=io+1 -c -c --- check if both current soundings straddle the current hour - 131 ntzaas = ntzaa(iu) -c check first if some data in place. - if(ntzaas.eq.0) go to 138 -c - ntzbbs = ntzbb(iu) - - if(ntzbbs.eq.0) go to 132 -c - justas = justa(iu) - - -c --- justas indicates the direction of time interpolation -c relative to the aa and bb arrays. -c justas=+1 implies ntzbbs > ntzaas so that bb arrays are freshest -c justas=-1 implies ntzbbs < ntzaas so that aa arrays are freshest -c Now insert logic to ensure the soundings either straddle current -c time, or one (or both) of these arrays are updated. -c -c ----Must check on seconds as well for sub-hourly timesteps (051116) -cc if(justas.eq.+1 .and. nowtz.lt.ntzaas) stop -- have read too far -c if(justas.eq.+1 .and. nowtz.ge.ntzbbs) go to 138 -cc if(justas.eq.-1 .and. nowtz.lt.ntzbbs) stop -- have read too far -c if(justas.eq.-1 .and. nowtz.ge.ntzaas) go to 132 - -c --- Ensure that time between soundings is longer than CALMET timestep -c --- (080205) - call deltsec(ntzbbs,jbbsec(iu),ntzaas,jaasec(iu),iupsec) - if(abs(iupsec).lt.nsecdt.and.iupsec.ne.0) then -c sounding frequency too high -c --- Convert to Gregorian Day for output purposes - ntzlow = min0(ntzaas,ntzbbs) - ntzhgh = max0(ntzaas,ntzbbs) - call dedat(ntzlow,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzhgh,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(6,*)'STOP in subroutine COMP - see list file' - write(io6,*)'STOP in subroutine COMP' - write(io6,*)'Soundings frequency is too high for station:',iu - write(io6,*)'Time between soundings (sec): ',abs(iupsec) - write(io6,*)'Should be less than CALMET timestep (sec): ', - : nsecdt - - write(io6,75)ioutya,ioutja,ioutma,ioutda,ioutha,jaasec(iu), - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,jbbsec(iu) -75 format(/,2x,'Consecutive UP.DAT records are at: ',/ - 1 2x,'Year Julian Day Month Day Hour Seconds (GMT-UTC)',/ -c xxxx xxx xx xx xx xxxx - 2 i6.4,i9.3,i9.2,i6.2,i5.2,i8.4,' ',/ - 3 i6.4,i9.3,i9.2,i6.2,i5.2,i8.4,' '/) - - STOP - endif - -c --- Compare ending times (080205) -c call deltsec(ntzbbs,jbbsec(iu),nowtzb,nsecb,nowdtb) - call deltsec(ntzbbs,jbbsec(iu),nowtze,nsecze,nowdtb) - - if (isnap(iu).eq.0) then -c time-averaged soundings - do not read further if nowdtb=0 (080205) - if(justas.eq.+1 .and. nowdtb.gt.0) go to 138 - else - if(justas.eq.+1 .and. nowdtb.ge.0) go to 138 - endif - -c --- Compare ending times (080205) -c call deltsec(ntzaas,jaasec(iu),nowtzb,nsecb,nowdta) - call deltsec(ntzaas,jaasec(iu),nowtze,nsecze,nowdta) - if(justas.eq.-1 .and. nowdta.ge.0)go to 132 -c -c --- if the above tests are satisfied, we don't need any new data, but -c do additional tests and terminate on unacceptable situations, -c such as, having read too far (due to missing or incorrect data). -c - -c if(((ntzaas-nowtz)*(ntzbbs-nowtz)) .gt. 0) then - if((nowdta*nowdtb) .gt. 0) then -c the two upper air times do not straddle the current time - ntzlow = min0(ntzaas,ntzbbs) - ntzhgh = max0(ntzaas,ntzbbs) -c --- Convert to Gregorian Day for output purposes - call dedat(nowtzb,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzlow,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzhgh,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - write(io6,1311)iu, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz, - : ioutya,ioutja,ioutma,ioutda,ioutha,jaasec(iu), - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,jbbsec(iu) -1311 format(//1x,'ERROR IN SUBR. COMP -- Required dates/hours'/ - 1 5x,'do not match values read from UPPER AIR STATION no.',i3/ - 2 32x,'Year Julian Day Month Day Hour Seconds (UTC-GMT) '/ -c xxxx xxx xx xx xx xxxx - 3 5x,'Current Model date/time : ', - 3 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/ - 4 5x,'Date/time in UP.DAT file : ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/ - 5 5x,'Next Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - - stop - endif -c -c --- Test for excessive time separation of the soundings. -c *** rjy modified the following on 1/30/90 ****************** - jdelta = jusdt(iu) - - -c if(jdelta.gt.maxsep) then - if(jdelta.gt.maxsep*3600) then -c --- The two upper air times are more than "maxsep*3600" seconds apart. - gap=jdelta/3600. - ntzlow = min0(ntzaas,ntzbbs) - ntzhgh = max0(ntzaas,ntzbbs) -c --- Convert to Gregorian Day for output purposes - call dedat(ntzlow,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzhgh,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1312)maxsep,iu,gap, - : ioutya,ioutja,ioutma,ioutda,ioutha,jaasec(iu), - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,jbbsec(iu) - -1312 format(//1x,'ERROR IN SUBR. COMP -- Missing upper air data', - 1 ' or record gap > ',i2,' hours', - 2 /23x,' for UPPER AIR STATION no.',i3, - 2 //,'Time Interval between records is: ',f9.3,' hours',// - 2 31x,'Year Julian Day Month Day Hour Seconds (UTC-GMT) '/ -c xxxx xxx xx xx xx xxxx - 4 ,'Date/time in UP.DAT file :', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/ - 5 ,'Next Date/time in UP.DAT file:', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - - stop - - endif -c ************************************************************ -c -c --- Current upper air soundings acceptable; thus, proceed. - go to 140 -c - 132 continue - if(dataveru.eq.'2.2') then -c --- explicit beginning/ending times with seconds -c --- where identical beg.end times mean instantaneous soundings -c --- and different beg. /end times mean time-average soundings -c call rdupn2(iu,io,1,iconvrt,nsecdt,jbbsec(iu),jbbhr, - call rdupn2(iu,io,1,iconvrt,jbbsec(iu),jbbhr, - & jbbday,jbbyr) - else if(dataveru.eq.'2.1') then -c --- explicit beginning/ending times with seconds - call rdupn(iu,io,1,iconvrt,jbbsec(iu),jbbhr, - & jbbday,jbbyr) - else -c --- single hour-ending times (older format compatible MOD5) -c call rdup(iu,io,1,iconvrt,nsecdt,jbbsec(iu),jbbhr, -c & jbbday,jbbyr) -c --- USe ending times (no seconds and no timesteps) - call rdup(iu,io,1,iconvrt,jbbhr,jbbday,jbbyr) - jbbsec(iu)=0 - endif - - ntzbbs = jbbyr*100000 + jbbday*100 + jbbhr - ntzbb(iu) = ntzbbs - justa(iu) = +1 -c -c --- Compute the time separation in seconds of the two upper air soundings. -c *** rjy addition of the following on 1/30/90 *************** - ntzaas = ntzaa(iu) - if(ntzaas.gt.0) then -c *** call dedat(ntzaas,jaayr,yaaday,jaahr) -c call dedat(ntzaas,jaayr,jaaday,jaahr) -c --- include seconds as well -c call deltt(jaayr,jaaday,jaahr,jbbyr,jbbday,jbbhr,jdelta) - call deltsec(ntzaas,jaasec(iu),ntzbbs,jbbsec(iu),jdelta) -c --- jdelta is now in seconds (051116) - jdelta = iabs(jdelta) - jusdt(iu) = jdelta - endif -c ************************************************************ -c -c --- perform vertical averaging through depth of each cell - call vertav(iu,ubb,vbb,zlbb,nlbb(iu),nz,zface,uavebb(1,iu), - 1vavebb(1,iu)) -c -c --- Calculate the vertical grid face temperatures -c using sounding data only. If LCALGRD only! 1/31/90. - if(LCALGRD)then - call facet(iu,tzbb,zlbb,nlbb,nzp1,zface,tzgrbb(1,iu)) - endif -c -c --- echo back upper air input data if "debug write" switch is on - if(ldbhr)then - write(io6,133)jbbyr,jbbday,jbbhr -133 format(/2x,'UPPER AIR DATA -- Year:',i4,2x,'Julian Day:', - 1 i3,2x,'Hour:',i2,' (GMT)') - write(io6,134) -134 format(/2x,'STA',2x,'PRES',3x,'HEIGHT',4x,'TEMP',6x,'U', - 1 7x,'V'/7x,'(mb)',3x,'(m LGL)',3x,'(K)',5x,'(m/s)',3x, - 2 '(m/s)') - write(io6,135)(iu,pbb(iu,jp),zlbb(iu,jp),tzbb(iu,jp), - 1 ubb(iu,jp),vbb(iu,jp),jp=1,nlbb(iu)) -135 format(1x,i3,2x,f6.1,2x,f7.1,2x,f6.2,2x,f6.2,2x,f6.2) -c -c --- write vertically averaged winds - write(io6,136)'U -- cell averaged',(uavebb(n,iu),n=1,nz) - write(io6,136)'V -- cell averaged',(vavebb(n,iu),n=1,nz) - if(LCALGRD)then - write(io6,136)'T -- cell face ',(tzgrbb(n,iu),n=1,nzp1) - endif -136 format(1x,a20,' = ',10f10.3,10(/24x,10f10.3)) - endif -c - go to 131 -c - 138 continue - if(dataveru.eq.'2.2') then -c --- explicit beginning/ending times with seconds -c --- where identical beg.ending times mean instantaneous sounding -c --- and different beg. /ending times mean time-average sounding - call rdupn2(iu,io,-1,iconvrt,jaasec(iu),jaahr, - & jaaday,jaayr) - else if(dataveru.eq.'2.1') then -c --- explicit beginning/ending times with seconds - call rdupn(iu,io,-1,iconvrt,jaasec(iu),jaahr, - & jaaday,jaayr) - else -c --- single hour-ending times records -c call rdup(iu,io,-1,iconvrt,nsecdt,jaasec(iu),jaahr, -c & jaaday,jaayr) -c --- USe ending times (no seconds and no timestep)(080205) - jaasec(iu)=0 - call rdup(iu,io,-1,iconvrt,jaahr,jaaday,jaayr) - endif - - ntzaas = jaayr*100000 + jaaday*100 + jaahr - ntzaa(iu) = ntzaas - justa(iu) = -1 -c -c --- Compute the time separation in seconds of the two upper air soundings. -c *** rjy addition of the following on 1/30/90 *************** - ntzbbs = ntzbb(iu) - if(ntzbbs.gt.0) then -c call dedat(ntzbbs,jbbyr,jbbday,jbbhr) -c call deltt(jaayr,jaaday,jaahr,jbbyr,jbbday,jbbhr,jdelta) - call deltsec(ntzaas,jaasec(iu),ntzbbs,jbbsec(iu),jdelta) -c --- jdelta is now in seconds (051116) - jdelta = iabs(jdelta) - jusdt(iu) = jdelta - endif -c - - -c --- perform vertical averaging through depth of each cell - - call vertav(iu,uaa,vaa,zlaa,nlaa(iu),nz,zface,uaveaa(1,iu), - 1vaveaa(1,iu)) -c - -c --- Calculate the vertical grid face temperatures -c using sounding data only. If LCALGRD only! 1/31/90. - if(LCALGRD)then - call facet(iu,tzaa,zlaa,nlaa,nzp1,zface,tzgraa(1,iu)) - endif - -c -c --- echo back upper air input data if "debug write" switch is on - if(ldbhr)then - write(io6,133)jaayr,jaaday,jaahr - write(io6,134) - write(io6,135)(iu,paa(iu,jp),zlaa(iu,jp),tzaa(iu,jp), - 1 uaa(iu,jp),vaa(iu,jp),jp=1,nlaa(iu)) -c -c --- write vertically averaged winds - write(io6,136)'U -- cell averaged',(uaveaa(n,iu),n=1,nz) - write(io6,136)'V -- cell averaged',(vaveaa(n,iu),n=1,nz) - if(LCALGRD)then - write(io6,136)'T -- cell face ',(tzgraa(n,iu),n=1,nzp1) - endif - endif -c - go to 131 -c - 140 continue -c - 145 continue - -c ******************************************************************** -c -c --- read and setup for diagnostic wind field module -c frr (09/01) no call if no upper and no surface stations -c --- 060215: pass on explicit beg. time to prepdi -c --- 080205: pass on explicit end time to prepdi - if (noobs.ne.2)then -c --- beta2 is defined but never used (remove from calling list 070113) - call prepdi(ws,wd,tempk,uaveaa,uavebb,vaveaa,vavebb, - 1 nhre,nyrze,njulze,nhrze,nsecze,ziconv, - 2 gamma,um,vm,wt,us,vs,nowsta,wsow,wdow) -c - -c --- Use explicit end times (consistent with MOD5) - if(ldbhr)then - if (noobs .eq. 0) then - write(io6,152)nyre,njule,nhre,nsece,gamma(1,1),tinf,um,vm -152 format(/2x,'Diagnostic wind field data -- Year: ',i4,3x, - 1 'Julian day: ',i3,3x,'Hour: ',i2,3x,'Second: ',i4/ - 1 2x,'Domain-scale temp. lapse rate at point (1,1)', - 1 '(GAMMA) = ',f10.5, - 1 ' (deg. K/m)'/ - 2 2x,'Domain scale surf. temperature (TINF) = ',f10.2, - 2 ' (deg. K)'/ - 3 2x,'Domain-scale U-component of wind (UM) = ',f10.3, - 3 ' (m/s)'/ - 4 2x,'Domain-scale V-component of wind (VM) = ',f10.3, - 4 ' (m/s)') - else - write(io6,153)nyre,njule,nhre,nsece,tinf -153 format(/2x,'Diagnostic wind field data -- Year: ',i4,3x, - 1 'Julian day: ',i3,3x,'Hour: ',i2,3x,'Second: ',i4/ - 2 2x,'Domain scale surf. temperature (TINF) = ',f10.2, - 2 ' (deg. K)'/ - 1 2x,'Domain-scale temp. lapse rate (GAMMA) is not yet ', - 1 ' defined'/ - 3 2x,'Domain-scale U-component of wind (UM) is not yet ', - 3 ' defined'/ - 4 2x,'Domain-scale V-component of wind (VM) is not yet ', - 4 ' defined') - end if - - write(io6,154)nyre,njule,nhre,nsece -154 format(/2x,'Surface station data for wind field module -- ', - 1 'Year: ',i4,3x,'Julian day: ',i3,3x,'Hour: ',i2,3x, - 2 'Second: ',i4/5x,'Station',2x,'Station',4x,'U-CMPT',4x, - 3 'V-CMPT'/6x,'Name',5x,'Number',5x,'(m/s)',5x,'(m/s)') - write(io6,156)(namst(n),n,us(1,n),vs(1,n),n=1,nssta+nowsta) -156 format(6x,a4,5x,i4,5x,f7.2,3x,f7.2) - -c - if (noobs .eq. 0) then - do 162 nups = 1,nusta - ii = nssta + nowsta + nups - write(io6,158)namst(ii),nups,nyre,njule,nhre,nsece -158 format(/2x,'Upper air station: ',a4,3x,'Number: ',i4,3x, - 1 'Year: ',i4,3x,'Julian day: ',i3,3x,'Hour: ',i2,3x, - 2 'Second: ',i4/8x,'Level',3x,'U-CMPT',3x,'V-CMPT'/17x, - 3 '(m/s)',4x,'(m/s)') - write(io6,159)(n,us(n,ii),vs(n,ii),n=1,nz) -159 format(7x,i4,4x,f7.2,2x,f7.2) -162 continue - else - write(io6,*)' upper air data not yet defined...' - end if - endif -c -c frr (09/01) noobs - else - if(ldbhr)then - write(io6,*)' No observation mode' - write(io6,*)' upper air data not yet defined...' - write(io6,*)' surface data not yet defined...' - endif - endif -c - -c --- load elevation angle common block for use in wind extrapolation -c frr (09/01) sinalp computed at all gridpoints - do j=1,ny - do i=1,nx -c sinalp2(i,j) = sinalp(i,j,nhrind) - sinalp2(i,j) = sinalpc(i,j) - end do - end do - -c --- current timestep GMT hour (stored in internal common salp) - ihr2gmt=nhrzb - - -c --- compute diagnostic winds -c --- also return the array of surface temperatures using nearest -c --- surface station or prognostic data for later use (ISFCMET) -c --- remove beta2 from calling list (never used) (070113) -c --- Pass on ending GMT time (070717) - call diagno(nhrze,nhrind,gamma,um,vm,nowsta,zowsta, - & itwprog,zlogwsta,ziconv,tsfnsp,tprog,vptprog, - & ccgrid,iceilg,rho) - -c - -c --- print wind field for levels and time periods requested - if(lprthr)then - do 142 kk=1,nz - if(iuvout(kk).eq.1)then - messag='U-component (m/s) -- Level: ' - write(messag(29:31),'(i3)')kk - call out(u(1,1,kk),idum,1,5,ldate,messag,nx,ny) - messag(1:1)='V' - call out(v(1,1,kk),idum,1,5,ldate,messag,nx,ny) - endif -c -c --- print W component (at TOP of cell face, i.e., kk+1) - if(iwout(kk).eq.1)then - messag='W-component (m/s) -- Level: ' - write(messag(29:31),'(i3)')kk - call out(w(1,1,kk+1),idum,1,5,ldate,messag,nx,ny) - endif -142 continue - endif -c -c --- if computing only wind field AND using preprocessed dT/dz data -c --- (i.e., not computing dT/dz from upper air data), skip met. model - if(irtype.eq.0.and.idiopt(2).eq.1)go to 799 - -c --- grid precipitation data using nearest station technique -c --- *** ALL CELLS -- LAND & WATER *** -c --- frr 050328 precipitation rates computed before call to WATER as rain is a required -c --- input to the COARE method (passed to water via common block metgrd.met) - - if(npsta.GT.0)then - call gride(npsta,xprecp,xpsta,ypsta,nearp,dgrid,nx,ny,rmm, - 1 nflagp,sigmap,cutp) -c frr (09/01) -c else if( npsta.eq.-1) then -c Use prognostic rain data (computed in rdmm5) - endif - - if(lprthr.and.imtout(6).eq.1)then - messag='Precipitation rate (mm/hr)' - call out(rmm,idum,1,5,ldate,messag,nx,ny) - endif - -c frr 050328 -c --- Compute surface temperature, RH and precip code -c --- Was done later in previous codes but can be done now to -c --- rationalize computations in heatfx and radfx (temp2d needed in heatfx) -c --- 050328: add flag to compute all sf. variables - -c --- Add ISFCMET control for SURFVAR call - if(isfcmet.EQ.0) then - call surfvar(u(1,1,1),v(1,1,1),tprog,temp2d,irh2d,ipcode2d,1) - endif - -c --- frr 050328: Call heatfx before subroutine WATER because the short -c wave flux is a required input for the overwater COARE method -c -c --- compute surface sensible heat flux *** LAND CELLS *** -c --- (NOTE: nighttime conditions (negative heat flux) flagged with -c --- qh = -0.1 W/m**2 -- actual nighttime value computed in -c --- subr. ELUSTR) -c --- also computes short-wave radiation (W/m**2) at ALL gridpoints - -c --- Pass either the nearest surface station/prognostic surface -c --- temperatures, or the full 2D temperatures - if(isfcmet.EQ.0) then -c --- Use full 2D surface temperature array - call heatfx(sinalpc,nears,temp2d,icc,ilandu,iwat1, -ccec101006 1 iwat2,nx,ny,icloud,ccgrid,qh,qsw) - 1 iwat2,nx,ny,mcloud,ccgrid,qh,qsw) - elseif(isfcmet.EQ.1) then - call heatfx(sinalpc,nears,tsfnsp,icc,ilandu,iwat1, -ccec101006 1 iwat2,nx,ny,icloud,ccgrid,qh,qsw) - 1 iwat2,nx,ny,mcloud,ccgrid,qh,qsw) - endif - -c --- compute met. fields for WATER CELLS (except precip. rate) -c --- Compute downward long wave radiation at the surface - if(isfcmet.EQ.0) then -c --- Use full 2D surface temperature and RH arrays -ccec101006 call radflx(icloud,iceil,ccgrid,iceilg,temp2d,irh2d,qlw) - call radflx(mcloud,iceil,ccgrid,iceilg,temp2d,irh2d,qlw) - elseif(isfcmet.EQ.1) then -c --- Use 2D temperature array of either nearest station temperature -c --- or prognostic temperature, but values in irh2d are not correct! -c --- RADFLX output is only for COARE option, which should not be -c --- allowed with ISFCMET=1 - if(icoare.NE.0) then - write(io6,*)'ERROR in COMP: invalid ISFCMET/ICOARE' - write(io6,*)' Expected icoare = 0 with isfcmet = 1' - write(io6,*)' Found isfcmet = ',isfcmet - write(io6,*)' Found icoare = ',icoare - stop 'ERROR in COMP -- see list file' - endif - endif - -c --- frr050328 (additional parameters passed on to water for COARE method) -c --- 051113 2 options : use SEA.DAT or 3D.DAT -c --- pass on ending GMT time rather than beginning GMT time (COARE) - if (itwprog.eq.2) then - call waterp(u,v,imixh,qsw,qlw,dcoast,zmid(1),ilandu,iwat1, - & iwat2,nx,ny,dgrid,fcori,nhrze,z0) - else - call water(u,v,imixh,qsw,qlw,dcoast,zmid(1),ilandu,iwat1,iwat2, - & nx,ny,dgrid,fcori,nhrze,z0) - endif -c - -c --- compute PGT stability class *** LAND CELLS *** -c call pgtstb(u,v,nears,icc,iceil,sinalp(1,1,nhrind),ilandu, - call pgtstb(u,v,nears,icc,iceil,sinalpc,ilandu, -ccec101006 1 iwat1,iwat2,nx,ny,icloud,ccgrid,iceilg,ipgt) - 1 iwat1,iwat2,nx,ny,mcloud,ccgrid,iceilg,ipgt) -c - if(lprthr.and.imtout(1).eq.1)then - messag='PGT stability class' - call out(xdum,ipgt,2,2,ldate,messag,nx,ny) - endif - -c --- compute air density at surface met. stations -c if 3D temp mode, 2D air density is computed in RDMM5 (called by diagno) -c if (noobs .eq. 0) then - if (itprog.lt.2) then - if(isfcmet.EQ.0) then -c --- Use 2D temperature field - call airden(pres,temp2d,rho) - elseif(isfcmet.EQ.1) then -c --- Use surface stations - call airden_ns(pres,tempk,nssta,rho) - endif - endif -c - if(ldbhr)then - write(io6,172)nyrb,njulb,nhrb,nsecb,rho(1,1),qsw(1,1) -172 format(/2x,'Computed surface parameters -- Year: ',i4,3x, - 1 'Julian day: ',i3,3x,'Hour: ',i2,3x,'Second: ',i4,3x, - 2 'At point (1,1):',/7x,'Air Density',12x,f6.3,4x,'(kg/m**3)', - 3 /7x,'Short-Wave Radiation',3x,f7.2,4x,'(W/m**2)') - endif -c -c --- compute friction velocity, Monin-Obukhov length, and nighttime -c --- surface sensible heat flux *** LAND CELLS *** -c -c --- Compute u-star, L, and for stable hours, Qh - if(isfcmet.EQ.0) then -c --- Use 2D temperature field - call elustr(z0,u,v,zmid(1),nears,rho,temp2d,icc,ilandu, -ccec101006 1 iwat1,iwat2,nx,ny,icloud,ccgrid,ipsifcn,qh,ustar,el) - 1 iwat1,iwat2,nx,ny,mcloud,ccgrid,ipsifcn,qh,ustar,el) - elseif(isfcmet.EQ.1) then -c --- Use surface stations - call elustr(z0,u,v,zmid(1),nears,rho,tsfnsp,icc,ilandu, -ccec101006 1 iwat1,iwat2,nx,ny,icloud,ccgrid,ipsifcn,qh,ustar,el) - 1 iwat1,iwat2,nx,ny,mcloud,ccgrid,ipsifcn,qh,ustar,el) - endif -c - - if(lprthr)then - if(imtout(7).eq.1)then - messag='Surface sensible heat flux (W/m**2)' - call out(qh,idum,1,5,ldate,messag,nx,ny) - endif - if(imtout(2).eq.1)then - messag='Friction velocity (m/s)' - call out(ustar,idum,1,5,ldate,messag,nx,ny) - endif - if(imtout(3).eq.1)then - messag='Monin-Obukhov length (m)' - call out(el,idum,1,5,ldate,messag,nx,ny) - endif - endif -c -c --- compute mixing heights *** LAND CELLS *** -c --- (ihrgmt is GMT time for current hour -- can be >= 24) -c ihrgmt=nhr+ibtz - if (itprog .eq. 0) then - call mixht(el,ustar,qh,nx,ny,rho,nhrzb,nearu,iupt, - 1 ilandu,iwat1,iwat2,ldbhr,imixh,zi,ziconv) - else -c -c --- Separate subroutine if using MM5 temperature - call mixht2(el,ustar,qh,nx,ny,rho,nhrzb, - 1 ilandu,iwat1,iwat2,ldbhr,imixh,zi,ziconv) - end if - -c - if(ldbhr)then - if(imtout(4).eq.1)then - messag='Mixing height (m) -- Before averaging ' - call out(zi,idum,1,5,ldate,messag,nx,ny) - endif - if(imtout(8).eq.1)then - messag='Convective mixing height (m) -- Before averaging' - call out(ziconv,idum,1,5,ldate,messag,nx,ny) - endif - endif -c -c --- Spatially average mixing heights: zi and ziconv - if(iavezi.eq.1)then - call avemix(nx,ny,mnmdav,hafang,dgrid,u(1,1,ilevzi), - 1 v(1,1,ilevzi),zi,ziconv) - endif - -c - if(lprthr)then - if(imtout(4).eq.1)then - if(iavezi.eq.1)then - messag='Mixing height (m) -- After averaging ' - else - messag='Mixing height (m) -- No averaging ' - endif - call out(zi,idum,1,5,ldate,messag,nx,ny) - endif - if(imtout(8).eq.1)then - if(iavezi.eq.1)then - messag='Convective mixing height (m) -- After averaging' - else - messag='Convective mixing height (m) -- No averaging' - endif - call out(ziconv,idum,1,5,ldate,messag,nx,ny) - endif - endif -c - -c --- compute convective velocity scale *** LAND CELLS *** -c --- 050328 - use temp2d rather than tempk,tprog,iprog - if(isfcmet.EQ.0) then -c --- Use 2D temperature field - call wstarr(ziconv,qh,temp2d,rho,ilandu,iwat1,iwat2,nx,ny, - 1 wstar) - elseif(isfcmet.EQ.1) then -c --- Use surface stations - call wstarr(ziconv,qh,tsfnsp,rho,ilandu,iwat1,iwat2,nx,ny, - 1 wstar) - endif -c - if(lprthr.and.imtout(5).eq.1)then - messag='Convective velocity scale (m/s)' - call out(wstar,idum,1,5,ldate,messag,nx,ny) - endif -c -c - -c --- Compute 3-D temperature field if requested - if( LCALGRD .or. itprog.ge.1 )then -c --- Add ISFCMET branch to different versions of TEMP3D - if(isfcmet.EQ.0) then -c --- frr 050328 temp2d (surface temp) computed earlier on -c --- frr 060215 Use explicit beginning time -c --- frr 080205 Use explicit end times - call temp3d(nyrze,njulze,nhrze,nsecze,temp2d,ziconv, - & tzgraa,tzgrbb,ztemp,zi,tprog) - elseif(isfcmet.EQ.1) then - call temp3d_back(nyrze,njulze,nhrze,nsecze,otempk, - & ziconv,tzgraa,tzgrbb,ztemp,zi,tprog, - & mnmdav,hafang,u(1,1,1),v(1,1,1)) - endif -c -c --- print temp. for levels and time periods requested - if(lprthr)then - do 782 kk=1,nz - if(itout(kk).eq.1)then - messag='Temperature (K) -- Level: ' - write(messag(27:29),'(i3)')kk - call out(ztemp(1,1,kk),idum,1,5,ldate,messag,nx,ny) - endif -782 continue - endif - endif -c - -c --- output results to disk -799 continue - - if(lsave)then - if(iformo.eq.1)then - -c --- Align code with previous version for ISFCMET=1 - if(isfcmet.EQ.1) then - call surfvar_back(tprog,temp2d,irh2d,ipcode2d) -c MCB-C (070501) Ensure Temp2D is the same as ZTEMP(k=1) -c when LCALGRID=T or itprog.ge.1 - if( LCALGRD .or. itprog.ge.1 )then - do j=1,ny - do i=1,nx - temp2d(i,j)=ztemp(i,j,1) - end do - end do - endif - endif - -c -c --- CALMET output format (non hourly timesteps - 060215) - call outhr(ndathrb,nsecb,ndathre,nsece, - 1 nx,ny,nz,npsta,irtype,rho,qsw, - 1 iomet,lcalgrd,temp2d,irh2d,ipcode2d) -c --- v6.4.0, Level 121203 - if(iauxlwc.EQ.1) call AUXOUT(ndathrb,nsecb,ndathre,nsece, - & nx,ny,nz,ifull,ioaux) - -c --- Restrict MESOPAC to hourly runs - else if(iformo.eq.2 .AND. nsecdt.EQ.3600)then -c -c --- MESOPAC II output format -c -c --- Vertically average winds into MESOPAC II layers - ztop=3000. - zincr=300. - call pacave(u,v,zi,zface,nx,ny,nz,ztop,zincr,ul,vl,uup,vup) -c -c --- MESOPAC II units of radiations are W/m**2 (same as CALMET) -c frr (09/01) QSW at all gridpoints-pick nearest i,j to the station - do l=1,nssta - iss=ist(l) - jss=jst(l) - iss = max0(1,iss) - iss = min0(iss,nx) - jss = max0(1,jss) - jss = min0(jss,ny) -c srad(i)=qsw(i) - srad(l)=qsw(iss,jss) - enddo -c -c --- Compute average air density (in kg/m**3) - avrho=0.0 -c frr (09/01): rho at all gridpoints -c do i=1,nssta -c avrho=avrho+rho(i) -c enddo -c avrho=avrho/float(nssta) - do j=1,ny - do i=1,nx - avrho=avrho+rho(i,j) - enddo - enddo -c avrho=avrho/float(nssta) - avrho=avrho/float(nx*ny) -c -c --- Write the data for this hour in MESOPAC II format - call outpc(ldbhr,nyr,njul,nhr,ul,vl,uup,vup,zi,ustar, - 1 wstar,el,ipgt,rmm,avrho,tempk,srad,irh,ipcode, - 2 nx,ny,nssta) - endif - endif -c - -c --- Compute and output gridded cloud data -c --- Must be done earlier in the code (070404) -ccec101006 - Allow to output gridded cloud data here for -c input gridded clouds: mcloud=3 or 4 -c no data are output if CLOUD.DAT is read -c if observations from surf.dat - output data -c are written earlier -c if(icloud.eq.1)call outcld(ndathrb,nx,ny,nssta,icc,nears, -c 1 iformc,ccgrid) -c --- Write out cloud records with beginning and ending times (101206) - if(icldout.eq.1) then - if(mcloud.ge.3) - : call outcld(ndathrb,nsecb,ndathre,nsece,nx,ny,nssta, - 1 icc,nears,iformc,icldout,mcloud,ccgrid) - endif - -c --- end of sub-hourly loop -800 continue - - -c --- set sub-hourly step for next pass through hour loop - nsecb=-nsecdt - -c --- end of hour loop -900 continue -c -c --- set hour for next pass through day loop -c nhr=-1 - nhrb=-1 - -c --- end of day loop -1000 continue -c -c --- end of run -1001 continue - return - end -c---------------------------------------------------------------------- - subroutine diag2(nssta,nowsta,chowsta,xowsta,yowsta) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 941018 DIAG2 -c --- M. Fernau, based on DIAGI by J. Scire, SRC -c -c --- PURPOSE: fill wind field common blocks for overwater sites -c -c --- INPUTS: -c NSSTA - integer - No. surface wind stations -c NOWSTA - integer - No. water wind stations -c XOWSTA(MXOWS) - real array - Water station relative X -c coordinate (m) (relative to grid -c origin) -c YOWSTA(MXOWS) - real array - Water station relative Y -c coordinate (m) (relative to grid -c origin) -c CHOWSTA(MXOWS) - char array - Water station name (character*4) -c Common block variables: -c /WPARM/ variables -c IWFCOD -c /D5/ variables -c DX,DY -c Parameters: MXWND, MXOWS -c -c --- OUTPUT: -c Common block variables: -c /D1/ variables -c /WPARM/ variables -c -c --- DIAG2 called by: COMP -c --- DIAG2 calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real xowsta(mxows),yowsta(mxows) - character*4 chowsta(mxows),namst -c - include 'wparm.met' - include 'd1.met' - include 'grid.met' -c -c --- IWFCOD = wind field code (0=objective analysis, 1=diagnostic -c model, 2=single station wind model) -c -- ERROR checks for analysis......... - if(iwfcod.eq.2)return -c -c --- transfer surface station names and coordinates to wind module -c --- arrays (convert relative station coordinates to km) - nstat = nssta + nowsta - do 35 i=nssta+1,nstat - namst(i)=chowsta(i - nssta) - utmxst(i)=0.001 * xowsta(i - nssta) - utmyst(i)=0.001 * yowsta(i - nssta) - ist(i)=xowsta(i - nssta) / dx + 1 - jst(i)=yowsta(i - nssta) / dy + 1 -35 continue - return - end -c---------------------------------------------------------------------- - subroutine diagi(elev,z0,nowsta) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070113 DIAGI -c --- J. Scire, SRC -c -- Modified by M. Fernau to add separate overwater winds -c -- (some of overwater assignments done in DIAG2) -c -c --- PURPOSE: Set default variables for diagnostic wind field model -c fill wind field common blocks -c -c --- UPDATES: -c --- V5.6 Level 050328 to v6.218 (070113)(F.Robe) -c - Compute nearest (i,j) to all upper air stations and store in -c IIUP(mxus) and JJUP(mxus) in MET1.MET -c -c --- V5.548a (050101) to V5.6 Level 050328 (F.Robe) -c - Compute adjustment coefficients at each surface station -c to ensure that observed surface winds are scaled down from -c the anemometer height to the first gridpoint level (usually 10m) -c Neutral log profile with Zo at gridpoint where station is located -c -c - Include MET1.MET in subroutine and change calling list -c accordingly. -c -c --- Level 000602c to V5.548a (050101) (F.Robe) -c - No need to redefine/scale barriers variables as they are now -c in d3.met with the correct units (km) (no longer in wparm.met) -c -c -c --- INPUTS: -c ELEV(MXNX,MXNY) - real array - Terrain elevations (m) -c Z0(MXNX,MXNY) - real array - Gridded roughness length (m) -c NOWSTA - integer - No. water wind stations -c Via Common grid.met -c XORIGR - real - Grid origin - X coordinate (m) -c YORIGR - real - Grid origin - Y coordinate (m) -c Via Common met1.met -c NSSTA - integer - No. surface wind stations -c NUSTA - integer - No. upper air wind stations -c XSSTA(MXSS) - real array - Surface station relative X -c coordinate (m) (relative to grid -c origin) -c YSSTA(MXSS) - real array - Surface station relative Y -c coordinate (m) (relative to grid -c origin) -c CSNAM(MXSS) - char array - Surface station name (character*4) -c XUSTA(MXUS) - real array - Upper air station relative X -c coordinate (m) (relative to grid -c origin) -c YUSTA(MXUS) - real array - Upper air station relative Y -c coordinate (m) (relative to grid -c origin) -c CUNAM(MXUS) - char array - Upper air station name (character*4) -c NOOBS - integer - Flag for use of prognostic data only -c -c Common block variables: -c /WPARM/ variables -c Parameters: MXNX, MXNY, MXNZ, MXNZP1, MXWND, MXBAR, -c MXSS, MXUS, MXOWS -c /GRID/ variables used in this subroutine -c NX2 - integer - No. X grid cells -c NY2 - integer - No. Y grid cells -c NZ2 - integer - No. vertical layers -c DGRID - real - Horizontal grid size (m) -c ZFACE(MXNZP1) - real array - Vertical cell face heights (m) -c above ground -c ZMID(MXNZ) - real array - Vertical cell center heights (m) -c above ground -c -c --- OUTPUT: -c Common block variables: -c all /D4/ variables -c all /D5/ variables -c ird, iwr, ifile, irdp -- /D6/ common block -c cellzb, cellzc, nintrp -- /D1/ common block -c /WPARM/ variables -c -c To MET1.MET: zlogsta(mxss) - log factor to scale surface wind -c observations to first CALMET level -c IIUP(MXUS),JJUP(mxus): nearest gridpoint (i,j) to -c upper air stations (used if iupt=-1) -c -c -c --- DIAGI called by: SETUP -c --- DIAGI calls: TERSET -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real elev(mxnx,mxny),z0(mxnx,mxny) - character*4 namst -c - include 'wparm.met' - include 'd1.met' - include 'd3.met' - include 'd4.met' - include 'grid.met' - include 'd6.met' - include 'met1.met' - -c -c --- IWFCOD = wind field code (0=objective analysis, 1=diagnostic -c model, 2=single station wind model) -c -- ERROR checks for analysis......... - if(iwfcod.eq.2)return -c - -c**** below is checked in READCF so it is redundant... -c -c if(iwfcod.eq.1.and.iprog.eq.1)then -c write (*,*)' ERROR -- RUN STOPPED IN SUB DIAGI' -c write (*,*)'Only objective analysis can be selected if' -c write (*,*)'prognostic model inputs are used as STEP 1 inputs' -c stop -c endif -c -c --- duplicate model parameters in both model and wind field module -c --- common blocks - i3dctw=iwfcod - dx=dgrid - dy=dgrid - nzprnt = nzprn2 -c --- grid origin -- change to km for wind module - utmxor=0.001*xorigr - utmyor=0.001*yorigr -c -c --- I/O unit number for prognostic wind field data (irdp) -c --- and preprocessed met. inputs (ird) - irdp=io20 - ird=io2 -c -c --- if using upper air data to compute diagnostic wind parameters, -c --- determine closest grid point to reference upper air stations - if(idiopt(2).eq.0 .and. noobs.eq.0)then - - do i=1,nusta - iiup(i)=xusta(i)/dgrid+1.5 - jjup(i)=yusta(i)/dgrid+1.5 - - if(iiup(i).lt.1)iiup(i)=1 - if(iiup(i).gt.nx)iiup(i)=nx - if(jjup(i).lt.1)jjup(i)=1 - if(jjup(i).gt.ny)jjup(i)=ny - - end do - -c --- If single upper air station is selected (iupt>0) store -c --- value in IiUPt,jjupt - if (iupt.ge.1) then - iiupt=iiup(iupt) - jjupt=jjup(iupt) - endif - - endif -c -c --- transfer surface station names and coordinates to wind module -c --- arrays (convert relative station coordinates to km) -c --- over water sites will be done in DIAG2 -c frr(09/01) noobs option - if (noobs.lt.2) then - nstat = nssta + nowsta - do 35 i=1,nssta - namst(i)=csnam(i) - utmxst(i)=0.001 * xssta(i) - utmyst(i)=0.001 * yssta(i) - ist(i)=xssta(i) / dx + 1 - jst(i)=yssta(i) / dy + 1 -35 continue - endif -c --- transfer upper air station names and coordinates to wind module -c --- arrays (convert relative station coordinates to km) - if (noobs .eq. 0) then - ii = nstat - do 37 i=1,nusta - ii=ii+1 - namst(ii)=cunam(i) - utmxst(ii)=0.001*xusta(i) - utmyst(ii)=0.001*yusta(i) - ist(ii)=xusta(i)/dx+1 - jst(ii)=yusta(i)/dy+1 -37 continue - end if -c - nzp1=nz+1 - do 5 i=1,nz - dz(i)=zface(i+1)-zface(i) - cellzc(i)=zmid(i) - cellzb(i)=zface(i) - nintrp(i)=nintr2(i) -c --- Add assignment of user-defined wind extrapolation factors -c --- (JSS 1/12/01) - fextrp(i)=fextr2(i) -5 continue - cellzb(nzp1)=zface(nzp1) - -c -c --- Compute scaling factors to extrapolate surface wind observations -c --- to first CALMET level (logarithmic profile) -c --- frr 050328 - do n=1,nssta -c --- z0: roughness length of gridpoint where station is located -c --- if station outside of domain use z0 at gridpoint closest to station -c --- Note: eventually will want to use z0 at station itself - isc=ist(n) - jsc=jst(n) - if(isc.gt.nx)isc=nx - if(isc.lt.1)isc=1 - if(jsc.gt.ny)jsc=ny - if(jsc.lt.1)jsc=1 - - xlnzo=alog(z0(isc,jsc)) -c --- z1: first CALMET level - xlnz1=alog(cellzc(1)) -c --- z2: anemometer height - xlnz2=alog(zanem(n)) -c --- Logarithmic profile scaling factor -c u(k=1)=zlogsta*u(zanem) - zlogsta(n)=(xlnz1-xlnzo)/(xlnz2-xlnzo) - end do - -c --- set missing data flags - edit=999. - editl=900. - iedit=999 - ieditl=900 -c -c --- set no. surf., upper, and total wind stations - nsurf = nssta + nowsta - nupper = nusta - nwind = nssta + nowsta + nusta - if (nwind .gt. mxwnd) then - write(io6,101)nssta,mxss,nowsta,mxows,nusta,mxus,nwind,mxwnd -101 format(//2x,'ERROR in SUBR. DIAGI -- too many wind stations ', - 1 ' for array dimensions'/2x,'nssta = ',i5,3x,'mxss = ',i5 - 2 /2x,'nowsta = ',i5,3x,'mxows = ',i5 - 2 /2x,'nusta = ',i5,3x,'mxus = ',i5 - 3 /2x,'nwind = ',i5,3x,'mxwnd = ',i5) - stop - endif -c -c --- No longer need to change variable names as all barriers parameters -c (nbar, barxy...) are now stored in d3.met (not in wparm.met) -c and are in km already (050101) -c --- set no. barriers and barrier coordinates -c numbar=nbar -c do 110 j=1,numbar -c --- convert to km for wind module -c barxy(1,j)=0.001*xybar(1,j) -c barxy(2,j)=0.001*xybar(2,j) -c barxy(3,j)=0.001*xybar(3,j) -c barxy(4,j)=0.001*xybar(4,j) -c110 continue -c -c --- set internal wind model control variable - icalc=1 -c -c --- copy terrain heights into wind module common block - do 30 i=1,nx - do 30 j=1,ny - htopo(i,j)=elev(i,j) -30 continue -c -c --- determine maximum terrain height within a given radius for -c --- each grid point - if(i3dctw.eq.1)call terset(htopo,hmax,terrad) -c -c --- determine which wind field output files are needed - i21=ipr0+ipr1+ipr2+ipr3+ipr4+ipr5+ipr6+ipr7+ipr8 - i22=ipr8+ioutd - i23=ipr5+ioutd - i24=ipr6+ioutd - i25=ipr7+ioutd -c -c --- initialize and then copy test file unit numbers into internal -c --- wind module variables - iwr=0 - ifile=0 - ifilek=0 - ifilef=0 - ifiles=0 - if(i21.ge.1)iwr=io21 - if(i22.eq.2)ifile=io22 - if(i23.eq.2)ifilek=io23 - if(i24.eq.2)ifilef=io24 - if(i25.eq.2)ifiles=io25 -c - return - end -c---------------------------------------------------------------------- - subroutine diagno(nhrz,nh,gamma,um,vm,nowsta,zowsta, - & itwprog,zlogwsta,ziconv,tsfnsp,tprog,vptprog,ccgrid, - & iceilg,rho) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 080205 DIAGNO -c --- R. KESSLER, S. DOUGLAS, SAI -c --- Modified by M. Fernau, J. Scire, F.Robe, EARTH TECH -C -C DIAGNO IS A DIAGNOSTIC WIND MODULE WHICH GENERATES A THREE- -C DIMENSIONAL, NON-DIVERGENT WIND FIELD IN TERRAIN FOLLOWING -C COORDINATES. BEGINNING WITH A DOMAIN-SCALE MEAN WIND, THE -C VERTICAL VELOCITY DUE TO TOPOGRAPHIC EFFECTS IS CALCULATED. -C THE HORIZONTAL VELOCITY FIELD IS THEN ADJUSTED TO MINIMIZE -C THE DIVERGENCE SUBJECT TO THE CONSTRAINT THAT THE VERTICAL -C VELOCITY IS HELD CONSTANT. THERMALLY-INDUCED SLOPE FLOWS -C ARE GENERATED AND ADDED TO THE WIND FIELD. A FROUDE NUMBER -C ADJUSTMENT PROCEDURE IS USED TO DIVERT THE FLOW AROUND -C TERRAIN OBSTACLES. THE COMPUTED FIRST-GUESS FIELD IS THEN -C COMBINED WITH OBSERVATIONAL DATA TO PRODUCE A GRIDDED WIND -C FIELD. FINALLY A NEW VERTICAL VELOCITY IS CAL- -C CULATED USING THE CONTINUITY EQUATION AND IS ADJUSTED SO THAT -C THE VERTICAL VELOCITY AT THE TOP OF THE MODEL IS ZERO. THE -C DIVERGENCE IS MINIMIZED SUBJECT TO THE CONSTRAINT THAT THE -C VERTICAL VELOCITY IS UNCHANGED. -C -C THE DIAGNOSTIC WIND MODULE IS AN ENHANCED VERSION OF THE CIT -C WIND MODEL (GOODIN,MCRAE AND SEINFELD, 1980). THE FROUDE -C NUMBER MODIFICATION SCHEME IS ADAPTED FROM THE MELSAR MODEL -C (ALLWINE AND WHITEMAN, 1985). THE KINEMATIC AND SLOPE FLOW -C PARAMETERIZATIONS ARE DERIVED FORM THE COMPLEX-TERRAIN WIND -C MODEL (YOCKE, 1979). -C -c UPDATES: -c ******** -c --- V6.3 Level 070717 to V6.32 080205 -c - Remove progn record LST time (mhr,mjul,mhr) from calling -c list to RDMM4/RDMM5 (never used) -c -c --- V6.223 Level 070702 to V6.3 Level 070717 -c - Add IPSIFCN to ELUSTR argument list -c - Add IPSIFCN to STHEOR argument list -c - Add ISFCMET option (pass TSFNSP array back in arg list) -c -c --- V6.222 Level 070404 to V6.223 Level 070702 (FRR) -c - initialize Temp2d, irh2d, rho2d early on so defined -c for obj. analysis (iwfcod=0) -c - make sure vertical extrapolation is not done for iextrp=1 -c -c --- V6.218 Level 070113 to V6.222 Level 070404(FRR) -c - Pass on observed ceiling height iceil(mxss) and icloud -c to RADFLX -c --- V6.216 Level 061230 to V6.218 Level 070113(F.Robe) -c - Make an earlier call to sURFVAR to get first estimate of -c 2-D surface temperature (TEMP2D) prior to computing -c terrain-stability induced effects. -c - Bit of clean up (delete comments related to very old versions) -c - Make former scalar gamma a 2-D array -c - Remove beta2 from calling list (never used) -c - Remove iupt from STHEOR calling list and itprog from CGAMMA2 -c calling list -c -c --- V 6.2 level 060215 to V6.216 Level 061230 (F.RobE) -c - pass on ending seconds to PROGRD instead of beg. seconds -c -c --- V5.711 Level 060106 to v6.2 Level 060215(F.Robe) -c - Use explicit times with seconds (sub-hourly timesteps) -c - Replace sinalp(i,j,nhrind) by sinalpc(i,j) -c -c --- V5.611 Level 051113 to V5.711 Level 060106 (F.Robe) -c - Add option to use coarse CALMET winds as IGF -c -c --- Version 5.6 Level 050328 to v5.611 Level 051113 -c - itwprog in calling list and passed on to rdmm5 and stheor -c -c --- Version 5.55 Level 050217 V5.6 Level 050328 -c - Remove nssta from calling list to airden -c - Pass on value of imixh (method to compute the convective mixing height) -c to stheor (wind extrapolation at the stations) -c - Bug fix: water cell not defined by htopo=0 but by ilandu/SEA.DAT -c - Adjust winds from anemometer height to first CALMET level -c using user-selected extrapolation method (iextrp) or neutral -c log profile if iextrp=1 -c -c --- Version 5.548a Level 050101 to Version 5.55 Level 050217 -c - Remove nbar from calling list to inter2 and interp -c (passed via common d3.met) -c -c --- Version 5.547 Level 041016 to Version 5.548a Level 050101 -c - Replace common /d3/ by include d3.met (and accordingly replaced -c numbar by nbar) -c -c --- Version 5.546a Level 041001 to Version 5.547 Level 041016 -c - Bug fix: water cell not defined by htopo=0 but by ilandu/SEA.DAT (F.Robe) -c -c --- Modified : Frr (09/01) -c - Allow no-observation mode -c --- Modified : FRR (12/96) -c - Calls to subroutines HEATFX,AIRDEN,ELUSTR to -c compute a first estimate of the sensible heat flux -c - Include common blocks: MET1, MET2, GRID, GEO, METGRD -c and GEN - Needed for calls to subroutines -c HEATFX,AIRDEN,ELUSTR -c -c --- include parameters - include 'params.met' - include 'breez.met' - include 'wparm.met' - include 'd3.met' -c -c NEW - FRR - 12/19/96 - -c --- Include the common blocks needed to compute a first estimate -c of the sensible heat flux. This estimate is used to compute -c the slope flows- -c Variables used in common blocks: -c geo.met : ilandu,iwat1,iwat2 -c - MEF - -c met1.met : nssta,icloud,zanem,noobs -c met2.met : tempk,icc -c metgrd.met: qh,zi -c - MEF - -c grid.met : nears,nx,ny,zmid,dx,dy -c gen.met : sinalpc,nhrind,nsecb -c - include 'geo.met' - include 'grid.met' - include 'met1.met' - include 'met2.met' - include 'metgrd.met' - include 'gen.met' - include 'mm4hdo.met' -c - real rho(mxnx,mxny),ccgrid(mxnx,mxny),qsw(mxnx,mxny) -c frr 050328 - 2D surface arrays - real temp2d(mxnx,mxny),qlw(mxnx,mxny) - -c --- Add 2D array of surface temperatures from nearest stations or -c --- prognostic data - real tsfnsp(mxnx,mxny) - logical ltsf - - integer irh2d(mxnx,mxny),ipcode2d(mxnx,mxny) -c -frr(12/96)-- real zanem(mxss),zowsta(mxows) - real zowsta(mxows),zlogwsta(mxows) - real uprog(mxnx,mxny,mxnz),vprog(mxnx,mxny,mxnz), - & tprog(mxnx,mxny,mxnz),vptprog(mxnx,mxny,mxnz) - real work3(mxwk3),work4(mxnx,mxny,2) - real udat(mxnxp,mxnyp,mxnz),vdat(mxnxp,mxnyp,mxnz) - real ziconv(mxnx,mxny) - integer iceilg(mxnx,mxny) - -c --- IGF-CALMET wind fields (on CALMET Grid) - real uigf(mxnx,mxny,mxnz),vigf(mxnx,mxny,mxnz) - -c --- 2-D lapse rate (070113) - real gamma(mxnx,mxny) - - CHARACTER*4 namst -c *** character*80 cmesag -C -c frr 050328 - common via include statement -c COMMON /D1/ U(mxnx,mxny,mxnz),V(mxnx,mxny,mxnz), -c 1 W(mxnx,mxny,mxnzp1), UB(mxny,2,mxnz), VB(mxnx,2,mxnz), -c 1 USLOPE(mxnx,mxny,mxnz), VSLOPE(mxnx,mxny,mxnz), -c 1 UG(mxnx,mxny,mxnz), VG(mxnx,mxny,mxnz), -c 1 HTOPO(mxnx,mxny), HMAX(mxnx,mxny), -c 1 UTMXST(mxwnd), UTMYST(mxwnd), WT(mxwnd), -c 1 RS(mxwnd), IS(mxwnd), IST(mxwnd), JST(mxwnd), -c 1 US(mxnz,mxwnd), VS(mxnz,mxwnd), -c 1 CELLZB(mxnzp1), CELLZC(mxnz), -c 1 PEXP(7), FEXTRP(mxnz), DIV(mxnx,mxny,mxnz), -c 1 NINTRP(mxnz) -c frr 050328 - common via include statement - include 'd1.met' - - COMMON /D2/ WORK(mxxy), WORK2(3) -c COMMON /D3/ IFIN, NUMBAR, BARXY(4,MXBAR), SLPIN(2,MXBAR) -c COMMON /D4/ EDIT, EDITL, IEDIT, IEDITL -c COMMON /D6/ IRD, IWR, IFILE, irdp -C -c frr 050328 - replace explicit common by include statements - include 'd4.met' - include 'd6.met' - - - DATA ZERO /0./ -c -c --- Parameters used: -c MXNX, MXNY, MXNZ, MXSS, MXUS, MXBAR, MXNZP1, -c MXWND, MXXY, MXWK3 -C -C INITIALIZE SOME PARAMETERS -C - IFIN = 0 - NZP1=NZ+1 - dxk=0.001*dx - dyk=0.001*dy - TIME = (nh-1) * 100 - - ltsf=.FALSE. -c -c --- 070702- Must initialize temp2d,irh,rho so that defined when obj.analysis only - n=mxnx*mxny*mxnz - call xmit(-n,zero,ug) - call xmit(-n,zero,vg) - call surfvar(ug(1,1,1),vg(1,1,1),tprog,temp2d,irh2d,ipcode2d,2) - if (itprog.lt.2) call airden(pres,temp2d,rho) - -C -C --- BEGIN SIMULATION -C - IF (I3DCTW .NE. 1) GO TO 292 -C -C ----- SET UP FIRST GUESS FIELD -C -c -c --- initialize arrays if using prognostic results as input to -c --- diagnostic model - n=mxnx*mxny*mxnz - np=mxnxp*mxnyp*mxnz - call xmit(-np,zero,udat) - call xmit(-np,zero,vdat) - call xmit(-n,zero,uprog) - call xmit(-n,zero,vprog) - - if(iprog.eq.2)then - call progrd(uprog,vprog,cellzc,utmxor,utmyor,time,nsece) - - elseif(iprog.eq.4)then -c --- remove time from calling list (never used -080205) -c call rdmm4(cellzc,udat,vdat,uprog,vprog, -c 1 mhr,mjul,myr,tprog,vptprog, -c 2 icloud,ccgrid,iceilg,rho,npsta) - call rdmm4(cellzc,udat,vdat,uprog,vprog, - 1 tprog,vptprog, -ccec101006 2 icloud,ccgrid,iceilg,rho,npsta) - 2 mcloud,ccgrid,iceilg,rho,npsta) - -c --- Must define GAMMA if using prognostic T - if (itprog.ge.1) then - call cgamma2(tprog,ziconv,gamma) - -c --- Store the sign of GAMMA in BETA2 -c --- never used so do not compute (070113) -c IF (GAMMA .LT. 0.) BETA2 = 1. -c IF (GAMMA .EQ. 0.) BETA2 = 0. -c IF (GAMMA .GT. 0.) BETA2 = -1. - - end if - - elseif(iprog.eq.14)then -c --- remove time from calling list (never used -080205) -c call rdmm5(cellzc,udat,vdat,uprog,vprog,mhr,mjul,myr, -c 1 tprog,vptprog,icloud,ccgrid,iceilg,rho,npsta, -c 2 itwprog) - call rdmm5(cellzc,udat,vdat,uprog,vprog, -ccec101006 1 tprog,vptprog,icloud,ccgrid,iceilg,rho,npsta, - 1 tprog,vptprog,mcloud,ccgrid,iceilg,rho,npsta, - 2 itwprog) - -c --- Must define GAMMA if using prog T - if (itprog .ge. 1) then - call cgamma2(tprog,ziconv,gamma) - -c --- Store the sign of GAMMA in BETA2 -c --- never used so do not compute (070113) -c IF (GAMMA .LT. 0.) BETA2 = 1. -c IF (GAMMA .EQ. 0.) BETA2 = 0. -c IF (GAMMA .GT. 0.) BETA2 = -1. - - end if - - end if -c - -c DO 400 K = 1,NZ -c DO 400 J = 1,mxny -c DO 400 I = 1,mxnx -c if (iprog.eq.2 .or. iprog.eq.4)then -c UG(I,J,K) = uprog(i,j,k) -c VG(I,J,K) = vprog(i,j,k) -c else -c UG(I,J,K) = um -c VG(I,J,K) = vm -c endif -c 400 CONTINUE -c -c *** JC modifications of 8/23/93 for non-uniform first-guess field. *** -c - -c --- initialize arrays if using coarse CALMET results as input to -c --- diagnostic model -c --- n=mxnx*mxny*mxnz (defined above) - call xmit(-n,zero,uigf) - call xmit(-n,zero,vigf) - if (igfmet.eq.1) call rdcalmet(cellzc,uigf,vigf) - - if (iprog.eq.2 .or. iprog.eq.4 .or. iprog.eq.14) then -c Use prognostic wind field as the first-guess field - DO 400 K = 1,NZ - DO 400 J = 1,mxny - DO 400 I = 1,mxnx - UG(I,J,K) = uprog(i,j,k) - VG(I,J,K) = vprog(i,j,k) - 400 CONTINUE - - else if (igfmet.eq.1)then -c --- USE coarse CALMET wind fields (060106) - DO 401 K = 1,NZ - DO 401 J = 1,mxny - DO 401 I = 1,mxnx - UG(I,J,K) = uigf(i,j,k) - VG(I,J,K) = vigf(i,j,k) - 401 CONTINUE - else -c Otherwise... - if (idiopt(3).eq.1) then -c Use preprocessed values from the DIAG.DAT file as the uniform -c first-guess field - DO 410 K = 1,NZ - DO 410 J = 1,mxny - DO 410 I = 1,mxnx - UG(I,J,K) = um - VG(I,J,K) = vm - 410 CONTINUE - else -c Otherwise... - if (iupwnd.gt.0) then -c Use single upper air station to compute uniform first-guess field. - DO 420 K = 1,NZ - DO 420 J = 1,mxny - DO 420 I = 1,mxnx - UG(I,J,K) = um - VG(I,J,K) = vm - 420 CONTINUE - else -c Otherwise, compute spatially-varying first-guess field - call WIND1 - end if - end if - endif -C - -C ---- SET BOUNDARY CONDITIONS ** insert 10/13/87 ** -C - DO 152 K=1,NZ - CALL WINDBC(UG,VG,UB,VB,K) - 152 CONTINUE - -C - -c --- Fill in 2D arrays of surface Temperature TEMP2D (frr 070113) -c --- so (first estimate of )temp2d available for terrain-stability -c --- induced effects (if domain representative Tinf is not used) - - - if (isurft.lt.0) - : call surfvar(ug(1,1,1),vg(1,1,1),tprog,temp2d,irh2d,ipcode2d,0) - - -C ---- INITIALIZE THE VERTICAL VELOCITY -C - N = mxnx*mxny*mxnzp1 - CALL XMIT(-N,ZERO,W) - -C -C ---- CALCULATE THE VERTICAL VELOCITY DUE TO TOPOGRAPHIC EFFECTS -C - IF (IKINE .EQ. 1) CALL TOPOF2(UG,VG,W,HTOPO, - 1 CELLZB,GAMMA,ISURFT,TINF,TEMP2D,ALPHA) - -C -C ---- GENERATE A NEW HORIZONTAL VELOCITY FIELD USING THE -C DIVERGENCE MINIMIZATION PROCEDURE -C - IF (IKINE .EQ. 1) CALL MINIM(UG,VG,W,UB,VB,DIV, - 1 NITER,DIVLIM) -C -C ---- OUTPUT KINEMATIC EFFECTS -C - IF (IPR5 .LE. 0) GO TO 286 - WRITE(IWR,2904) - WRITE(IWR,2905) - CALL WINDPR(UG,VG,W) - IF (IOUTD .GT. 0) CALL OUTFIL(IFILEK,TIME,UG,VG,W) - 286 CONTINUE - -C -C ---- APPLY THE MELSAR FROUDE NUMBER ADJUSTMENT -C - IF (IFRADJ .EQ. 1) CALL FRADJ(UG,VG,HTOPO,GAMMA,ISURFT,TINF, - 1 TEMP2D,CRITFN,CELLZB,HMAX) -C -C------- OUTPUT FROUDE NUMBER EFFECTS -C - IF (IPR6 .LE. 0) GO TO 287 - WRITE(IWR,2906) - WRITE(IWR,2907) - CALL WNDPR2(UG,VG) - IF (IOUTD .GT. 0) CALL OUTFIL(IFILEF,TIME,UG,VG,W) - 287 CONTINUE - -c -c --- Set 2D array of surface temperatures using either nearest surface -c --- station or prognostic data (for ISFCMET=1 option) - call T2D_NSP(nears,nx,ny,itprog,tprog,tsfnsp) - ltsf=.TRUE. -c - -c --- Update 2D arrays of surface Temperature (frr 050328) -c --- so temp2d available for heatfx -Note not final U,V field yet so -c --- upwind temperature averaging is not final (surfvar called again later) -c --- 050328: no need to compute rh and ipcode at this point so skip - -c --- Add ISFCMET control for SURFVAR call - if(isfcmet.EQ.0) then - call surfvar(ug(1,1,1),vg(1,1,1),tprog,temp2d,irh2d,ipcode2d,0) - endif - -c NEW: frr (12/96) --- SENSIBLE HEAT FLUX ---------------------------- -c --- Compute a first estimate of the heat fluxes in order to -c compute the slope flows based on local sensible heat flux - -c --- First daytime fluxes (over land) - -c --- calling list has changed (frr 050328 as temp2d is available) - -c --- Add branch for surface temperature option: -c --- Pass either the nearest surface station/prognostic surface -c --- temperatures, or the full 2D temperatures - if(isfcmet.EQ.0) then -c --- Use full 2D surface temperature array -c --- First daytime fluxes (over land) - -c --- calling list has changed (frr 050328 as temp2d is available) - call heatfx(sinalpc,nears,temp2d,icc,ilandu,iwat1, -ccec101006 1 iwat2,nx,ny,icloud,ccgrid,qh,qsw) - 1 iwat2,nx,ny,mcloud,ccgrid,qh,qsw) -c --- Then nightime fluxes (over land) -c RHO based on sf data if itprog<2 and on MM5 data if itprog=2 -c call airden(pres,tempk,nssta,rho) - if (itprog.lt.2) call airden(pres,temp2d,rho) - call elustr(z0,ug,vg,zmid(1),nears, - 1 rho,temp2d,icc,ilandu,iwat1,iwat2, -ccec101006 2 nx,ny,icloud,ccgrid,ipsifcn,qh,ustar,el) - 2 nx,ny,mcloud,ccgrid,ipsifcn,qh,ustar,el) - elseif(isfcmet.EQ.1) then -c --- Use 2D temperature array of either nearest station temperature -c --- or prognostic temperature -c --- First daytime fluxes (over land) - -c --- calling list has changed (frr 050328 as temp2d is available) - call heatfx(sinalpc,nears,tsfnsp,icc,ilandu,iwat1, -ccec101006 1 iwat2,nx,ny,icloud,ccgrid,qh,qsw) - 1 iwat2,nx,ny,mcloud,ccgrid,qh,qsw) -c --- Then nightime fluxes (over land) -c RHO based on sf data if itprog<2 and on MM5 data if itprog=2 - if (itprog.lt.2) call airden_ns(pres,tempk,nssta,rho) - call elustr(z0,ug,vg,zmid(1),nears, - 1 rho,tsfnsp,icc,ilandu,iwat1,iwat2, -ccec101006 2 nx,ny,icloud,ccgrid,ipsifcn,qh,ustar,el) - 2 nx,ny,mcloud,ccgrid,ipsifcn,qh,ustar,el) - else - write(io6,*)'ERROR in DIAGNO: invalid ISFCMET provided' - write(io6,*)' Expected isfcmet = 0 or1' - write(io6,*)' Found isfcmet = ',isfcmet - stop 'ERROR in DIAGNO -- see list file' - endif - -c NEW END -------------------------------------------------------------- - -C CALCULATE THE SLOPE FLOW - if (ISLOPE.EQ.1)CALL SLOPE(USLOPE,VSLOPE,HTOPO,ISURFT,TINF,TEMP2D, - : HMAX) -C -C ADD THE SLOPE FLOW COMPONENT TO THE HORIZONTAL WIND FIELD -C - DO 300 K=1,NZ - DO 300 J=1,NY - DO 300 I=1,NX - UG(I,J,K)=UG(I,J,K)+USLOPE(I,J,K) - VG(I,J,K)=VG(I,J,K)+VSLOPE(I,J,K) - 300 CONTINUE - -C -C OUTPUT SLOPE FLOW EFFECTS -C - IF (IPR7 .LE. 0) GO TO 288 - WRITE(IWR,2908) - WRITE(IWR,2909) - CALL WNDPR2(UG,VG) - IF (IOUTD .GT. 0) CALL OUTFIL(IFILES,TIME,UG,VG,W) - 288 CONTINUE -C - -C SET BOUNDARY CONDITIONS -C - DO 290 K=1,NZ - CALL WINDBC(UG,VG,UB,VB,K) - 290 CONTINUE -C -C IN THE CASE OF NO OBSERVATIONS, PROCEED DIRECTLY TO THE -C SMOOTHING STEP -c (true only for IWFCOD=1, otherwise the code has already stepped to 292) -C - IF (NWIND .EQ. 0) THEN - DO 291 K = 1,NZ - DO 291 J = 1,NY - DO 291 I = 1,NX - U(I,J,K) = UG(I,J,K) - V(I,J,K) = VG(I,J,K) - 291 CONTINUE - ENDIF - IF (NWIND .EQ. 0) GO TO 285 - -c This is where one lands if i3dctw=0 (objective analysis only) -292 continue - -c frr(09/01)note: icalc is hardcoded to 1 in subroutine diagi so what's the point??? - 52 IF(ICALC.LT.0) GO TO 850 -C -C EXTRAPOLATE SURFACE WINDS -C EXTRAPOLATION OPTIONS: -C 1) IF IABS(IEXTRP)=1, THEN DO NOT EXTRAPOLATE FROM SURFACE DATA -c Except from anemometer height to first CALMET level (050328) -C 2) IF IABS(IEXTRP)=2, THEN USE POWER LAW -C 3) IF IABS(IEXTRP)=3, THEN USE FEXTRP MULTIPLIER -C 4) IF IEXTRP=4, THEN USE SIMILARITY THEORY -C 5) IF IEXTRP<=0, THEN DO NOT USE LEVEL 1 DATA FROM UA WINDS -C -c --- if iextrp=1, must extrapolate from anemometer to first CALMET level -c IF(IABS(IEXTRP).EQ.1) GO TO 91 -c --- NSOL is the number of overland surface stations - nsol=nsurf-nowsta -c --- NSOW is the local counter for of the overwater stations - nsow=0 - - if(.NOT.ltsf .AND. nsurf.GT.0) then -c --- Diagnostic module was skipped. -c --- Set 2D array of surface temperatures using nearest surface -c --- station data (for ISFCMET=1 option) for use if surface data -c --- are profiled using similarity - itprog_sfc=1 - call T2D_NSP(nears,nx,ny,itprog_sfc,tprog,tsfnsp) - endif - - - DO 70 L=1,NSURF -c -c --- keep track of overwater station number (NSURF=nssta+nowsta) - if(L.gt.nsol)nsow=nsow+1 -c -c --- Skip upper air check if no stations -c --- (Should also be skipped if using similarity theory, i.e., let -c --- RMIN2 < 0) - IF(NUPPER.EQ.0) GO TO 63 -C -C CHECK FOR CLOSE UPPER AIR STATION WITH VALID WIND DATA -C SKIP EXTRAPOLATION IF CLOSE UPPER AIR DATA EXISTS -C - N = NSURF + 1 - CALL XMIT(-NUPPER,EDIT,RS(N)) -C -C CHECK IF UPPER AIR STATION HAS SOME VALID DATA -C - DO 64 I = 1,NUPPER - lup=nsurf+i - DO 61 K = 1,NZ - IF(US(K,Lup).LT.EDITL.OR.VS(K,Lup).LT.EDITL) GO TO 62 - 61 CONTINUE - GO TO 64 -C -C COMPUTE DISTANCES BETWEEN SURFACE STATION AND UPPER STATIONS -C - 62 J = NSURF + I - RSX = (UTMXST(J) - UTMXST(L))/DXK - RSY = (UTMYST(J) - UTMYST(L))/DYK - RS(I) = RSX**2 + RSY**2 - RS(I) = SQRT(RS(I)) - 64 CONTINUE - CALL FMINF(RS,NUPPER,FMIN,NMIN) - IF(FMIN.LT.RMIN2) GO TO 70 - -c --- Anemometer height and neutral log adjustment coefficient - if(L.le.NSOL)then -c --- Station is an overland surface station - zwsref=zanem(L) - zlog=zlogsta(l) - else -c --- Station is an overwater station - zlog=zlogwsta(nsow) - zwsref=zowsta(nsow) -c --- Use 10 m overwater anemometer height if not specified - if(zwsref.ge.9998.)zwsref=10. - endif - - IF (IABS(IEXTRP) .EQ. 1) THEN -c --- Adjust from Anenometer height to first CALMET level only -c --- using neutral log profile (050328 - Frr) if non missing - IF(US(1,L).GT.EDITL .OR. VS(1,L).GT.EDITL) GOTO 70 - us(1,l)=us(1,l)*zlog - vs(1,l)=vs(1,l)*zlog - ENDIF - - 63 IF (IABS(IEXTRP) .EQ. 2) THEN -C -C EXTRAPOLATE WITH POWER LAW PROFILE -C - IG = IST(L) - JG = JST(L) -c --- Pick nearest grid cell if station is off grid - ig = max0(1,ig) - ig = min0(ig,nx) - jg = max0(1,jg) - jg = min0(jg,ny) - DO 67 K=2,NZ - - KM1=K-1 - - IF(US(KM1,L).GT.EDITL .OR. VS(KM1,L).GT.EDITL) GOTO 70 - pexp2 = 0.143 -c --- 041010: Bug fix (F.Robe). Overwater cell not defined by htopo=0 -c --- but either by OW station or LU=water tagged for OW treatment -c IF (HTOPO(IG,JG) .EQ. 0.) pexp2 = 0.286 - if( ( (l.gt.nssta).and.(l.le.nsurf) ) .OR. - : ( (ilandu(ig,jg).ge.iwat1).and.(ilandu(ig,jg).le.iwat2))) - : pexp2=0.286 - - IF (K .EQ. 2) THEN - PADJ = (CELLZC(K)/zwsref)**pexp2 - ELSE - PADJ = ( CELLZC(K)/CELLZC(KM1) )**pexp2 - END IF - US(K,L) = US(KM1,L)*PADJ - VS(K,L) = VS(KM1,L)*PADJ - 67 CONTINUE -c --- Also adjust winds from anenometer height to first calmet level -c --- 050328 (frr) - PADJ = (zwsref/CELLZC(1))**pexp2 - US(1,L) = US(1,L)/PADJ - VS(1,L) = VS(1,L)/PADJ - - ELSE IF (IABS(IEXTRP) .EQ. 3) THEN -C -C EXTRAPOLATE WITH USER'S EXTRAPOLATION MULTIPLIERS - -c --- Bug fix (050328- Frr) extrapolate only if not missing - IF(US(1,L).GT.EDITL .OR. VS(1,L).GT.EDITL) GOTO 70 - -c --- 050328-frr: NZ values of fextrp => use the first value -c --- to scale from anenometer height to 1st CALMET level - -C DO 69 K=2,NZ - DO 69 K=NZ,1,-1 - US(K,L) = US(1,L)*FEXTRP(K) - VS(K,L) = VS(1,L)*FEXTRP(K) - 69 CONTINUE -c ELSE : must specify 4 otherwise also redone if iextrp=1 - ELSE IF (IABS(IEXTRP) .EQ. 4) THEN -C -C EXTRAPOLATE WITH SIMILARITY THEORY -C - IG = IST(L) - JG = JST(L) -c --- Pick nearest grid cell if station is off grid - ig = max0(1,ig) - ig = min0(ig,nx) - jg = max0(1,jg) - jg = min0(jg,ny) - -c --- frr 021105: allow vertical extrapolation if noobs=1 -c CALL STHEOR(ZI,ZICONV,US,VS,L,IG,JG,NSURF,IUPT,icloud,ccgrid) -c --- frr 050328: pass short and long wave fluxes (Qsw-QLW) to stheor -c for COARE computations in WATER2 subroutine -c --- compute long wave radiation (needed in water2 called by stheor) -c --- Note : qsw and qlw are not quite the final values yet as temp2d -c at this point is not quite final (u,v because umv were not final -c when temp2d computed) - At this point rmm is filled with current -c values only if npsta=-1 (prognostic rainfall rates passed via METGRD) -c - if(isfcmet.EQ.0) then -c --- Use full 2D surface temperature and RH arrays -ccec101006 call radflx(icloud,iceil,ccgrid,iceilg,temp2d,irh2d,qlw) - call radflx(mcloud,iceil,ccgrid,iceilg,temp2d,irh2d,qlw) - elseif(isfcmet.EQ.1) then -c --- Use 2D temperature array of either nearest station temperature -c --- or prognostic temperature, but values in irh2d are not correct! -c --- RADFLX output is only for COARE option, which should not be -c --- allowed with ISFCMET=1 --- do nothing here - endif - - if(isfcmet.EQ.0) then -c --- pass interpolated surface temperatures (temp2d) rather than tprog - CALL STHEOR(NHRZ,ZI,ZICONV,US,VS,L,IG,JG,NSURF,iupt,itwprog, -ccec101006 : icloud,ccgrid,rho,temp2d,rmm,qsw,qlw, - : mcloud,ccgrid,rho,temp2d,rmm,qsw,qlw, - & ipsifcn,isfcmet) - elseif(isfcmet.EQ.1) then -c --- pass surface temperature field as tsfnsp rather than tprog - CALL STHEOR(NHRZ,ZI,ZICONV,US,VS,L,IG,JG,NSURF,iupt,itwprog, -ccec101006 : icloud,ccgrid,rho,tsfnsp,rmm,qsw,qlw, - : mcloud,ccgrid,rho,tsfnsp,rmm,qsw,qlw, - & ipsifcn,isfcmet) - endif -c --- Note: after call to STHEOR, the "surface observations" are no longer -c --- at anemometer height but at zmid(1) (first CALMET level) - 050328 - - END IF - 70 CONTINUE - 91 CONTINUE -c -c --- initialize arrays if using prognostic results as input to -c --- diagnostic model - if(iprog.eq.1.and.i3dctw.ne.1)then - n=mxnx*mxny*mxnz - call xmit(-n,zero,uprog) - call xmit(-n,zero,vprog) - call progrd(uprog,vprog,cellzc,utmxor,utmyor,time,nsece) - elseif(iprog.eq.3 .AND. i3dctw.ne.1)then - n=mxnx*mxny*mxnz - np=mxnxp*mxnyp*mxnz - call xmit(-np,zero,udat) - call xmit(-np,zero,vdat) - call xmit(-n,zero,uprog) - call xmit(-n,zero,vprog) -c --- remove time from calling list (never used -080205) -c call rdmm4(cellzc,udat,vdat,uprog,vprog, -c 1 mhr,mjul,myr,tprog,vptprog, -c 2 icloud,ccgrid,iceilg,rho,npsta) - call rdmm4(cellzc,udat,vdat,uprog,vprog,tprog,vptprog, -ccec101006 1 icloud,ccgrid,iceilg,rho,npsta) - 1 mcloud,ccgrid,iceilg,rho,npsta) - elseif(iprog.eq.13 .AND. i3dctw.ne.1)then - n=mxnx*mxny*mxnz - np=mxnxp*mxnyp*mxnz - call xmit(-np,zero,udat) - call xmit(-np,zero,vdat) - call xmit(-n,zero,uprog) - call xmit(-n,zero,vprog) -c --- remove time from calling list (never used -080205) -c call rdmm5(cellzc,udat,vdat,uprog,vprog,mhr,mjul,myr, -c 1 tprog,vptprog,icloud,ccgrid,iceilg,rho,npsta -c 2 ,itwprog) - call rdmm5(cellzc,udat,vdat,uprog,vprog, -ccec101006 1 tprog,vptprog,icloud,ccgrid,iceilg,rho,npsta - 1 tprog,vptprog,mcloud,ccgrid,iceilg,rho,npsta - 2 ,itwprog) - endif -c -c --- Initialize arrays if using prognostic data as observations -c frr (09/01) BUG- MM4 data should be read independently of i3dctw -c if(iprog.EQ.5 .and. i3dctw .ne. 1)then - if(iprog.EQ.5)then - np=mxnxp*mxnyp*mxnz - call xmit(-np,zero,udat) - call xmit(-np,zero,vdat) -c --- remove time from calling list (never used -080205) -c call rdmm4(cellzc,udat,vdat,uprog,vprog, -c 1 mhr,mjul,myr,tprog,vptprog, -c 2 icloud,ccgrid,iceilg,rho,npsta) - call rdmm4(cellzc,udat,vdat,uprog,vprog,tprog,vptprog, -ccec101006 1 icloud,ccgrid,iceilg,rho,npsta) - 1 mcloud,ccgrid,iceilg,rho,npsta) - -c frr (09/01) BUG- MM5 data should be read independently of i3dctw -c else if(iprog.EQ.15 .and. i3dctw .ne. 1)then - else if(iprog.EQ.15)then - np=mxnxp*mxnyp*mxnz - call xmit(-np,zero,udat) - call xmit(-np,zero,vdat) -c --- remove time from calling list (never used -080205) -c call rdmm5(cellzc,udat,vdat,uprog,vprog,mhr,mjul,myr, -c 1 tprog,vptprog,icloud,ccgrid,iceilg,rho,npsta -c 2 ,itwprog) - call rdmm5(cellzc,udat,vdat,uprog,vprog, -ccec101006 1 tprog,vptprog,icloud,ccgrid,iceilg,rho,npsta - 1 tprog,vptprog,mcloud,ccgrid,iceilg,rho,npsta - 2 ,itwprog) - endif -C - - if(.NOT.ltsf) then -c --- Diagnostic module was skipped. -c --- Set 2D array of surface temperatures using nearest surface -c --- station or prognostic data (for ISFCMET=1 option) - call T2D_NSP(nears,nx,ny,itprog,tprog,tsfnsp) - ltsf=.TRUE. - endif - - -C INITIALIZE GLOBAL ARRAYS . -C - N = mxnx*mxny*mxnz - CALL XMIT(-N,ZERO,U) - CALL XMIT(-N,ZERO,V) - CALL XMIT(-N,ZERO,DIV) - N = mxnx*mxny*mxnzp1 - CALL XMIT(-N,ZERO,W) -C -C INTERPOLATE WIND FIELD IN EACH VERTICAL LAYER - -C - IF (I3DCTW .EQ. 1) THEN -c --- i3dctw=iwfcod=1: diagnostic wind model - - CALL INTER2(US,NWIND,UTMXST,UTMYST, - 1 NINTRP,RS,IS,work3,U,UG,ILANDU, - 2 iwat1,iwat2,udat,noobs) - - CALL INTER2(VS,NWIND,UTMXST,UTMYST, - 1 NINTRP,RS,IS,work3,V,VG,ILANDU, - 2 iwat1,iwat2,vdat,noobs) - - ELSE -c --- i3dctw=iwfcod=0: objective analysis - - CALL INTERP(US,NWIND,UTMXST,UTMYST,RMIN,RMAX1,LVARY,NINTRP, - 1 RS,IS,work3,U,iprog,rprog,uprog, - 2 udat,noobs) - CALL INTERP(VS,NWIND,UTMXST,UTMYST,RMIN,RMAX1,LVARY,NINTRP, - 1 RS,IS,work3,V,iprog,rprog,vprog, - 2 vdat,noobs) - ENDIF - - -C -C Lake breeze region calculations.... ----- CALL LLBREEZ -C - if (llbreze) then - call llbreez - endif -C -C OUTPUT INTERPOLATED WIND FIELD -C - IF(IPR0.LE.0) GO TO 250 - WRITE(IWR,2900) - WRITE(IWR,2901) - CALL WNDPR2(U,V) - 250 CONTINUE -C -C ADJUST SURFACE LAYER WIND FOR TERRAIN EFFECTS -C - IF(HTFAC.LE.0.) GO TO 285 - IF (I3DCTW .NE. 1) CALL ADJUST(U,V,W,HTOPO,CELLZB(NZP1), - 1 UB,VB) -C -C -C SET BOUNDARY CONDITIONS -C - DO 1810 K = 1,NZ - CALL WINDBC(U,V,UB,VB,K) - 1810 CONTINUE -C -C OUTPUT ADJUSTED WIND FIELD . -C - IF(IPR1.LE.0) GO TO 285 - WRITE(IWR,2902) - WRITE(IWR,2903) - CALL WNDPR2(U,V) - 285 CONTINUE -C -c********************************************************************** -c *** cmesag='CHECK SUM -- U FIELD -- after 285' -c *** call chksum(u,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c *** cmesag='CHECK SUM -- V FIELD -- after 285' -c *** call chksum(v,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c********************************************************************** -C SMOOTH HORIZONTAL FIELDS -C - CALL SMOOTH(U,V,UB,VB,NSMTH) -C -C REINITIALIZE VERTICAL VELOCITY -C - N=mxnx*mxny*mxnzp1 - CALL XMIT(-N,ZERO,W) -C -C COMPUTE DIVERGENCE FIELDS AND VERTICAL VELOCITIES -C - DIVMAX=-1.0E+09 - DO 330 K=1,NZ - CALL DIVCEL(U,V,W,DIV,UB,VB,DIVMAX,K) - 330 CONTINUE -c********************************************************************** -c *** cmesag='CHECK SUM -- U FIELD -- after 330' -c *** call chksum(u,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c *** cmesag='CHECK SUM -- V FIELD -- after 330' -c *** call chksum(v,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c********************************************************************** -C - DO 345 K=1,NZ - DO 340 J=1,NY - DO 340 I=1,NX - W(I,J,K+1)=-DZ(K)*DIV(I,J,K)+W(I,J,K) - 340 CONTINUE -C -C SET BOUNDARY CONDITIONS -C - CALL WINDBC(U,V,UB,VB,K) - 345 CONTINUE -C -C ADJUST VERTICAL VELOCITY AS SUGGESTED BY OBRIEN (1970) -C (JAM, V.9, NO.2), WITH ERROR IN W PROPORTIONAL TO HEIGHT -C - IF (IOBR .EQ. 1) THEN - DO 350 K=1,NZ - DO 350 J=1,NY - DO 350 I=1,NX - W(I,J,K+1)=W(I,J,K+1)-CELLZB(K+1)/CELLZB(NZP1)*W(I,J,NZP1) - 350 CONTINUE - ENDIF -C -C OUTPUT INITIAL WIND AND DIVERGENCE FIELDS -C - IF (IPR2 .LE. 0) GO TO 360 - WRITE(IWR,2400) - WRITE(IWR,2402) - CALL WINDPR(U,V,W) - WRITE(IWR,2401) DIVMAX - CALL DIVPR(DIV) - 360 CONTINUE -c********************************************************************** -c *** cmesag='CHECK SUM -- U FIELD -- after 360' -c *** call chksum(u,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c *** cmesag='CHECK SUM -- V FIELD -- after 360' -c *** call chksum(v,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c********************************************************************** -C -C ITERATE TO MINIMIZE DIVERGENCE -C -c *** CALL MINIM(U,V,W,UB,VB,DIV,NITER,DIVLIM) - IF (IOBR .EQ. 1) CALL MINIM(U,V,W,UB,VB,DIV,NITER,DIVLIM) -C -C OUTPUT FINAL WIND FIELDS -C - if(ipr8.gt.0)then - WRITE(IWR,2800) TIME,NH - WRITE(IWR,2801) - CALL WINDPR(U,V,W) - endif -c********************************************************************** -c *** cmesag='CHECK SUM -- U FIELD' -c *** call chksum(u,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c *** cmesag='CHECK SUM -- V FIELD' -c *** call chksum(v,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c *** cmesag='CHECK SUM -- W FIELD' -c *** call chksum(w,mxnx,mxny,mxnz,nx,ny,nz,cmesag,io6) -c********************************************************************** -C -C OUTPUT FINAL DIVERGENCE FIELDS -C - IF(IPR4.LE.0) GO TO 560 - WRITE(IWR,2803) - CALL DIVPR(DIV) -C -C OUTPUT FINAL WIND SPEED AND DIRECTION FIELDS -C - 560 IF(IPR3.LE.0) GO TO 800 - WRITE(IWR,2820) TIME,NH - WRITE(IWR,2821) - CALL RTHETA(U,V,work4) - 800 CONTINUE -C - - -C OUTPUT FINAL WIND FIELD -C - if(ipr8.gt.0.and.ioutd.gt.0)CALL OUTFIL(IFILE,TIME,U,V,W) -850 continue - 900 CONTINUE - return -C -C FORMAT SPECIFICATIONS -C - 2400 FORMAT(/,10X,'SMOOTHED WIND AND INITIAL DIVERGENCE FIELDS') - 2401 FORMAT(//,20X,'MAXIMUM DIVERGENCE = ',E12.4) - 2402 FORMAT(10X,43('-')) - 2800 FORMAT(10X,'FINAL WIND FIELD AT TIME = ',F7.0, - 1 5X,'(SIMULATION HOUR NO.',I3,' )') - 2801 FORMAT(10X,63(1H-)) - 2803 FORMAT(/,10X,'FINAL DIVERGENCE FIELD AT TIME = ' ,F7.0, - 1 5X,'(SIMULATION HOUR NO.',I3,' )',/,10X,66('-')) - 2820 FORMAT(/,10X,'FINAL WIND SPEED AND DIRECTION AT TIME = ',F7.0, - 1 '(SIMULATION HOUR NO. ,I3)') - 2821 FORMAT(10X,72('-')) - 2900 FORMAT(' ',10X,'INTERPOLATED WIND FIELD') - 2901 FORMAT(11X,23('-')) - 2902 FORMAT(/,10X,'TERRAIN ADJUSTED SURFACE WINDS') - 2903 FORMAT(10X,30('-')) - 2904 FORMAT(/,10X,'KINEMATIC EFFECTS') - 2905 FORMAT(10X,17('-')) - 2906 FORMAT(/,10X,'FROUDE NUMBER EFFECTS') - 2907 FORMAT(10X,21('-')) - 2908 FORMAT(/,10X,'SLOPE EFFECTS') - 2909 FORMAT(10X,13('-')) - END -c---------------------------------------------------------------------- - subroutine divcel(u,v,w,div,ub,vb,divmax,k) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 940304 DIVCEL -c -c --- include parameters - include 'params.met' -c NEW -frr (12/96) - D5 replaced by grid.met -c COMMON /D5/ NX,NY,NZ,DX,DY,dz(mxnz),NZPRNT - include 'grid.met' - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*) - DIMENSION W(mxnx,mxny,*),DIV(mxnx,mxny,*) - DIMENSION UB(mxny,2,*),VB(mxnx,2,*) -C -C COMPUTES THE 3-D DIVERGENCE IN EACH GRID CELL -C -C INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C W (R ARRAY) - GRIDDED VERTICAL WIND COMPONENTS -C UB (R ARRAY) - U-COMPONENT BOUNDARY VALUES -C VB (R ARRAY) - V-COMPONENT BOUNDARY VALUES -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C OUTPUTS: DIV (R ARRAY) - GRIDDED 3-D DIVERGENCE -C - HTOP=1.0 - DXI=1.0/(2.0*DX) - DYI=1.0/(2.0*DY) - DZI=1.0/DZ(K) - DO 100 J=1,NY - DO 100 I=1,NX - DIV(I,J,K)=0. - WPH=W(I,J,K+1) - WMH=W(I,J,K) - UPH=UB(J,2,K) - IF(I.LT.NX) UPH=U(I+1,J,K) - VPH=VB(I,2,K) - IF(J.LT.NY) VPH=V(I,J+1,K) - UMH=UB(J,1,K) - IF(I.GT.1) UMH=U(I-1,J,K) - VMH=VB(I,1,K) - IF(J.GT.1) VMH=V(I,J-1,K) -C -C DIVERGENCE IS EVALUATED USING CENTRAL DIFFERENCES -C - DUDX=(UPH-UMH)*DXI - DVDY=(VPH-VMH)*DYI - DWDZ=(WPH-WMH)*DZI - DIV(I,J,K)=HTOP*(DUDX+DVDY)+DWDZ - DIVABS=ABS(DIV(I,J,K)) - DIVMAX=AMAX1(DIVABS,DIVMAX) - 100 CONTINUE -C -C SCALE DIVERGENCE FOR TERRAIN-CONFORMAL SYSTEM -C - DIVMAX=DIVMAX/HTOP - RETURN - END -c---------------------------------------------------------------------- - subroutine divpr(div) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 DIVPR -c -c --- include parameters - include 'params.met' - include 'd6.met' - include 'grid.met' -c --- frr 050328 - explicit common D6 replaced by include d6.met -c COMMON /D6/ IRD,IWR,IFILE,irdp - DIMENSION DIV(mxnx,mxny,*) -C -C DIVPR PRINTS OUT DIVERGENCE FIELD AT EACH LAYER . -C -C INPUTS: DIV (R ARRAY) - GRIDDED 3-D DIVERGENCE -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C - DO 100 K=1,NZPRNT - if(iwr.gt.0)WRITE(IWR,40) K - 40 FORMAT(//,5X,'DIVERGENCE AT LEVEL = ',I4) - if(iwr.gt.0)WRITE(IWR,41) - 41 FORMAT(5X,24('-')) - CALL WNDLPT(DIV(1,1,K)) - 100 CONTINUE - RETURN - END -c---------------------------------------------------------------------- - subroutine elustr(z0,u1,v1,zm,nears,rho,temp2d,icc,ilandu, -ccec101006 1 iwat1,iwat2,nx,ny,icloud,ccgrid,ipsifcn,qh,ustar,el) - 1 iwat1,iwat2,nx,ny,mcloud,ccgrid,ipsifcn,qh,ustar,el) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101006 ELUSTR -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the friction velocity (m/s) and Monin-Obukhov -c length (m) for land cells using the methods of -c Holtslag & van Ulden (1983) (daytime) or -c Venkatram (1980) and Weil & Brower (1983) (nighttime) -c -c --- UPDATES: -c --- V6.3 (070717) to V6.330 (101006) -c - Change ICLOUD into MCLOUD and ICLDOUT -c --- v6.217 (061231) to V6.3 (070717) -c - add new control variable IPSIFCN to select call to PSIU -c functions -cc - v5.612 (051214) to v6.217 (061231)(FRR) -c - allow new icloud=4 option -c - V5.6 (050328) to v5.612 (051214) (DGS-FRR) -c - use double precision argument for psiud -c - (09/01) to V5.6 050328 (Frr) -c - Use consistent similarity relations -c (COARE stability function PSIU with Dyers fit ) -c - Use already computed 2-D field of surface temperature (Temp2d) -c rather than tprog/tempk based on itprog (calling list change) -c -c - F.Robe(09/01) 2D array of air density, NOOBS mode okay -c -c - FRR (1/97) Minimum wind speed (0.5 m/s=sigmav minimum -c in CALPUFF) for the computation of U*, theta* and HQ -c during stable conditions -c -c -c --- INPUTS: -c Z0(mxnx,mxny) - real array - surface roughness lengths (m) -c U1(mxnx,mxny) - real array - U component of the wind (m/s) -c in the lowest layer (i.e.,10 m) -c V1(mxnx,mxny) - real array - V component of the wind (m/s) -c in the lowest layer (i.e.,10 m) -c ZM - real - Height (m) of the cell center -c in the lowest layer -c NEARS(mxnx,mxny) - integer array - Station number of surface -c station closest to each grid pt -c RHO(mxnx,mxny)) - real array - Air density (kg/m**3) -c TEMP2D(mxnx,mxny) - real array - Surface Air temperature (deg. K) -c ICC(mxss) - integer array - Cloud cover (tenths) -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c MCLOUD - integer - Flag indicating if gridded -c cloud data are available -c (2,3,4 = yes, otherwise, no) -c CCGRID(mxnx,mxny) - real array - Gridded cloud fraction -c (Used only if MCLOUD=2,3,4) -c IPSIFCN - integer - Flag controlling choice of PSI -c stability correction for wind -c profile -c (IPSIFCN=0 use CALMET v5.6; -c IPSIFCN=1 use CALMET v5.53) -c QH(mxnx,mxny) - real array - Sensible heat flux (W/m**2) -c (only positive values are valid -c -- nightime hours are flagged -c with QH = -0.1) -c Parameters: MXNX, MXNY, MXSS -c -c --- OUTPUT: -c QH(mxnx,mxny) - real array - Sensible heat flux (W/m**2) -- -c (only nightime (negative) -c values are updated) -c USTAR(mxnx,mxny) - real array - Friction velocity (m/s) -c EL(mxnx,mxny) - real array - Monin-Obukhov length (m) -c -c --- ELUSTR called by: DIAGNO,COMP -c --- ELUSTR calls: function PSIUD, PSIUC -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real qh(mxnx,mxny),ustar(mxnx,mxny),el(mxnx,mxny) - real u1(mxnx,mxny),v1(mxnx,mxny),z0(mxnx,mxny) - real temp2d(mxnx,mxny),rho(mxnx,mxny) - real ccgrid(mxnx,mxny) - - real*8 psiud,r8 -c - integer nears(mxnx,mxny),ilandu(mxnx,mxny) - integer icc(mxss) -c -c --- NOTE: a value of vk = 0.4 has been assumed in some of the -c --- other constants - data vk/0.4/,xcrit/0.05/,wsmin/0.001/ -c -c --- loop over grid cells - do 200 i=1,nx - do 200 j=1,ny -c -c --- skip over water grid cells (OCD method is used over water) - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2)go to 200 -c -c --- frr (09/01) Surface temperature from surface obs. or from MM5 -c --- 050328: temp2d is the surface temperature in all cases - tsf=temp2d(i,j) -c - ws=sqrt(u1(i,j)**2+v1(i,j)**2) -c --- prevent numerical problems - ws=amax1(ws,wsmin) - xlnzz0=alog(zm/z0(i,j)) -c -c --- daytime method -- use Holtslag and van Ulden (1983) - if(qh(i,j).lt.0.0)go to 100 -c -c --- first guess -- assume neutral conditions - xl=-9.9e9 - xustar=vk*ws/xlnzz0 -c --- prevent numerical problems - assume reasonable lower bound - xustar=amax1(xustar,0.05) -c --- actual conditions are neutral if heat flux is zero - if(qh(i,j).eq.0.0)go to 181 -c -c --- iterate to refine estimate of u* and L - maxit=5 - xlold=xl - do 180 niter=1,maxit -c -c --- new estimate of L -c --- constant 253.8226 = cp/(vk*g) with cp=996 m**2/(s**2 deg.), -c --- vk=0.4, g=9.81 m/s**2 -c - xl=-253.8226*rho(i,j)*tsf*xustar**3/qh(i,j) -c -c --- new estimate of ustar -c -c --- stability correction factors (psim(z/L), psim(z0/L)) -- unstable -c --- conditions -c --- 050328 (frr) use consistent PSI functions (same as COARE) - if(ipsifcn.EQ.0) then - r8=zm/xl - psizl = PSIUD(r8) - r8=z0(i,j)/xl - psiz0l = PSIUD(r8) - elseif(ipsifcn.EQ.1) then - psizl = PSIUC(zm,xl,15) - psiz0l = PSIUC(z0(i,j),xl,15) - else - write(io6,*)'ERROR in ELUSTR: invalid IPSIFCN' - write(io6,*)' Expected IPSIFCN = 0 or 1' - write(io6,*)' Found IPSIFCN = ',ipsifcn - stop 'ERROR in ELUSTR -- see list file' - endif - - xustar=vk*ws/(xlnzz0-psizl+psiz0l) -c --- prevent numerical problems - assume reasonable lower bound - xustar=amax1(xustar,0.05) -c -c --- check for convergence (5% criterion) - if(abs((xl-xlold)/xl).lt.0.005)go to 181 - xlold=xl -180 continue -181 continue -c -c --- insert final values into arrays - ustar(i,j)=xustar - el(i,j)=xl - go to 200 -c -c --- stable conditions -- use Venkatram(1980), Weil & Brower(1983) -100 continue -c -c NEW (frr: 1/21/97) : Minimum wind speed for the computation of -c Ustar, ThetaStar and HQ (stable conditions) - ws=max(ws,0.5) -c --- Determine cloud cover (tenths) for this grid cell -ccec101006 if(icloud.gt.1)then - if(mcloud.gt.1)then -c --- Use gridded cloud data - convert from fraction to tenths - jcc=10.*ccgrid(i,j)+0.5 - else -c --- Use NWS cloud data (in tenths) -c jcc=icc(nsta) - jcc=icc(nears(i,j)) - endif -c -c --- constant 5.e-3 is 0.5 * (0.1)**2 -- factor of 0.1 converts -c --- cloud cover from tenths to a fraction - theta1=0.09*(1.-5.e-3*jcc**2) -c -c --- constant 184.428 = 4*gamma*g with gamma=4.7, g=9.81 m/s**2 - cdn=vk/xlnzz0 - - theta2=tsf*cdn*ws**2/(184.428*zm) - - thetas=amin1(theta1,theta2) -c --- prevent numerical problems - thetas=amax1(thetas,1.e-9) -c -c --- compute ustar -c --- constant 46.107 = gamma*g, with gamma=4.7, g=9.81 m/s**2 - u02=46.107*zm*thetas/tsf - - cu2=amax1(0.0,ws*ws-4.*u02/cdn) - ustar(i,j)=0.5*cdn*(ws+sqrt(cu2)) -c --- prevent numerical problems - assume a reasonable lower bound - ustar(i,j)=amax1(ustar(i,j),0.05) -c -c --- product of (u*)(theta*) is not allowed to exceed XCRIT (=0.05) - if(ustar(i,j)*thetas.gt.xcrit)then - maxit=3 -c --- tolerance set at 5% above xcrit - toler=1.05*xcrit - do 190 k=1,maxit - thetas=xcrit/ustar(i,j) - - u02=46.107*zm*thetas/tsf - - cu2=amax1(0.0,ws*ws-4.*u02/cdn) - ustar(i,j)=0.5*cdn*(ws+sqrt(cu2)) - if(ustar(i,j)*thetas.le.toler)go to 191 -190 continue -191 continue - endif -c -c --- replace arbitrary nighttime heat flux indicator (-0.1 W/m**2) -c --- with actual value -c --- constant 996 m**2/(s**2 deg K) = cp -c frr (09/01 2d array of rho -c qh(i,j)=-996.*rho(nsta)*ustar(i,j)*thetas - qh(i,j)=-996.*rho(i,j)*ustar(i,j)*thetas -c -c --- compute Monin-Obukhov length -c --- constant 253.8226 = cp/(vk*g) with cp=996 m**2/(s**2 deg.), -c --- vk=0.4, g=9.81 m/s**2 - el(i,j)=-253.8226*rho(i,j)*tsf*ustar(i,j)**3/qh(i,j) -c -200 continue -c - return - end -c---------------------------------------------------------------------- - subroutine elustr2(ziconv,us,vs,ns,zzanem,is,js, -ccec101006 & icc,iupt,icloud,itprog,ccgrid,zi,temp,rho,ipsifcn) - & icc,iupt,mcloud,itprog,ccgrid,zi,temp,rho,ipsifcn) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101006 ELUSTR2 -c --- M. Fernau, Earth Tech after ELUSTR by J. Scire, SRC -c Modified by f.Robe, Earth Tech -c -c --- PURPOSE: Compute the friction velocity (m/s), Monin-Obukhov -c length (m), and mixing height (m) for land cells using -c the methods of Holtslag & van Ulden (1983) (daytime) or -c Venkatram (1980) and Weil & Brower (1983) (nighttime) -c so that similarity theory extrapolation can be done -c -c --- UPDATES: -c --- V6.3 (070717) to V6.330 (101006) CEC -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c --- V6.221 (070327)to V6.3 (070717) -c - add new control variable IPSIFCN to select call to PSIU -c functions -c - Add IUPT to calling list (to pass to MIXHTST) -c -c --- V6.218 (070113) to v6.221 (070327)(F.Robe) -c - Remove ldbhr from calling list to MIXHTST and MIXHST2 -c (was not defined) -c -c --- v6.217 (061231) to V6.218 (070113)(FRR) -c - Remove iupt from calling list and from MIXHT calling list -c -c - v5.612 (051214) to v6.217 (061231)(FRR) -c - allow new icloud=4 option -c - fix bug that ignore icloud=3 option (cloud fraction -c therefore assumed to be zero in stable conditions -c with icloud=3 -c --- V5.6 (040830) to V5.612 (051214) (DGS) -c - Use double precision argument for PSIUD -c --- V5.55 021105 to V5.6 040830 (F.Robe) -c - Use actual anemometer height zanem for extrapolation -c - Use already computed interpolated surface temperature -c and density (do not recompute here) -c - Use new PSIUD function -c -c --- INPUTS: -c ZICONV(mxnx,mxny) - real array - Convective mixing heights (m) -c of previous hour -c ZI(mxnx,mxny) - real array - Previous hour mixing height (m) -c US(MXNZ,MXWND) - real array - U component of observed winds -c VS(MXNZ,MXWND) - real array - V component of observed winds -c NS - integer - Location of station in surface -c array -c ZZANEM - real - Anemometer height at surface station -c IS,JS - integer - Coordinates of grid cell in -c which station is located -c ICC(mxss) - integer array - Cloud cover (tenths) -c IUPT - integer - Upper air station to use for -c computing the domain-scale -c lapse rate -c MCLOUD - integer - Flag indicating if gridded -c cloud data are available -c (2,3,4=yes, otherwise, no) -c ITPROG - integer - Temperature flag for use -c of prognostic data and/or observations -c CCGRID(mxnx,mxny) - real array - Gridded cloud fraction -c (Used only if MCLOUD=2,3,4) -c NOOBS - integer - Flag for noobs mode -c TEMP - real - Surface temperature at station (or -c at gridpoint where station is located -c RHO - real - Surface density at station (or -c at gridpoint where station is located -c at gridpoint where station is located -c IPSIFCN - integer - Flag controlling choice of PSI -c stability correction for wind -c profile -c (IPSIFCN=0 use CALMET v5.6; -c IPSIFCN=1 use CALMET v5.53) -c -c Common block /HFLUX/ variables: -c qf(mxnx,mxny),hcg(mxnx,mxny), -c albedo(mxnx,mxny),bowen(mxnx,mxny), -c ha1,ha2,hb1,hb2,hc1,hc2,hc3,hc3p1 -c Common block /ZIPARM/ variables: -c zimax,zimin,constn,dzzi,dptmin,twodte,onedte,cmech -c Common block /GRID/ variables: -c nears,nearu,zmid -c Common block /UPMET/ -c justa, nlaa, nlbb, zlaa, tzaa, zlbb, tzbb -c Parameters: MXNZ, MXWND, MXNX, MXNY, MXSS -c -c --- OUTPUT: -c US(MXNZ,MXWND) - real array - U component of observed winds -c VS(MXNZ,MXWND) - real array - V component of observed winds -c (extrapolated aloft) -c -c --- ELUSTR2 called by: STHEOR -c --- ELUSTR2 calls: SIMILT, PSIUD, PSIUC -c---------------------------------------------------------------------- -c - include 'params.met' - include 'hflux.met' - include 'ziparm.met' - include 'grid.met' - include 'upmet.met' - include 'geo.met' - - common /salp/ ihr2gmt,sinalp2(mxnx,mxny) - common /tjump/ dptt(mxnx,mxny) - real us(mxnz,mxwnd),vs(mxnz,mxwnd), - & ziconv(mxnx,mxny),zi(mxnx,mxny) - real ccgrid(mxnx,mxny) - integer icc(mxss) - real*8 psiud,r8 -c -c --- NOTE: a value of vk = 0.4 has been assumed in some of the -c --- other constants - data vk/0.4/, xcrit/0.05/, xmissm/990./ - data wsmin/0.001/ -c - -c --- If surface wind components missing, don't bother to extrapolate - if (us(1,ns) .gt. xmissm .or. vs(1,ns) .gt. xmissm) return -c - ws = sqrt(us(1,ns) **2 + vs(1,ns) **2) -c --- Do not extrapolate calm winds - if (ws .lt. wsmin) return - xlnzz0 = alog(zmid(1) / z0(is,js)) -c -c -c --- Calculate heat flux at the station: -c --- Compute short-wave radiation (W/m**2) -c -c --- Determine cloud cover (tenths) for this grid cell -ccec101006 if(icloud.gt.1)then - if(mcloud.gt.1)then -c --- Use gridded fractional cloud data - ccfrac=ccgrid(is,js) - else -c --- Use NWS cloud data (in tenths) - convert to fraction - ccfrac = 0.1 * icc(ns) - endif -c - -c frr (09/01) 2d-sinalp -c qsw = (ha1 * sinalp2(ns) + ha2) * (1. + hb1 * ccfrac ** hb2) - qsw = (ha1 * sinalp2(is,js) + ha2) * (1. + hb1 * ccfrac ** hb2) - qsw = amax1(qsw,0.0) -c -c --- Flag nighttime periods with negative sensible heat flux -c frr (09/01) 2D sinalp -c if (sinalp2(ns) .le. 0.0) then - if (sinalp2(is,js) .le. 0.0) then - qqh = -0.1 - else -c -c --- Compute net radiation (W/m**2), QSTAR using the method of -c --- Holtslag and van Ulden (1983) -c --- constant 5.67e-8 W/m**2/deg. K**4 is the Stefan-Boltzmann constant - - qstar = ((1. - albedo(is,js)) * qsw + hc1 * temp**6 - & - 5.67e-8 * temp** 4 + hc2 * ccfrac) / hc3p1 -c -c --- Compute sensible heat flux (w/m**2), QH -c --- qf is the anthropogenic heat flux (W/m**2) - qqh = bowen(is,js) * (qstar * (1. - hcg(is,js)) - & + qf(is,js)) / (1. + bowen(is,js)) -c - end if - -c -c -c --- Daytime method -- use Holtslag and van Ulden (1983) - if(qqh .lt. 0.0) goto 100 -c -c --- First guess -- assume neutral conditions - xl = -9.9e9 - xustar = vk * ws / xlnzz0 -c --- Prevent numerical problems - assume reasonable lower bound - xustar = amax1(xustar,0.05) -c --- Actual conditions are neutral if heat flux is zero - if (qqh .eq. 0.0) goto 181 -c -c --- Iterate to refine estimate of u* and L - maxit = 5 - xlold = xl - do 180 niter = 1,maxit -c -c --- New estimate of L -c --- Constant 253.8226 = cp/(vk*g) with cp=996 m**2/(s**2 deg.), -c --- vk=0.4, g=9.81 m/s**2 - xl = -253.8226 * rho * temp * xustar ** 3 / qqh -c -c --- New estimate of ustar -c -c --- Stability correction factors (psim(z/L), psim(z0/L)) -- unstable -c --- Conditions -c --- 050328 (frr) use consistent PSI function (same as COARE) -c --- 050328: Winds (ws) in this subroutine are at zanem (not zmid) - if(ipsifcn.EQ.0) then - r8=zzanem/xl - psizl = PSIUD(r8) - r8=z0(is,js)/xl - psiz0l = PSIUD(r8) - elseif(ipsifcn.EQ.1) then -c --- Use explicit code from old subroutine - psizl = PSIUC(zzanem,xl,15) - psiz0l = PSIUC(z0(is,js),xl,15) - else - write(io6,*)'ERROR in ELUSTR: invalid IPSIFCN' - write(io6,*)' Expected IPSIFCN = 0 or 1' - write(io6,*)' Found IPSIFCN = ',ipsifcn - stop 'ERROR in ELUSTR -- see list file' - endif - - xustar = vk * ws / (xlnzz0 - psizl + psiz0l) -c --- Prevent numerical problems - assume reasonable lower bound - xustar = amax1(xustar,0.05) -c -c --- Check for convergence (5% criterion) - if (abs((xl - xlold) / xl) .lt. 0.005) go to 181 - xlold = xl -180 continue -181 continue -c -c --- Assign final values - ustar = xustar - el = xl - - go to 200 -c -c --- stable conditions -- use Venkatram(1980), Weil & Brower(1983) -100 continue -c -c --- Determine cloud cover (tenths) for this grid cell -c if(icloud.eq.2)then -c (061230: bug fix (should already have had icloud=3); add option icloud=4 (061231) -ccec101006 if(icloud.gt.1)then - if(mcloud.gt.1)then -c --- Use gridded cloud data - convert from fraction to tenths - jcc=10.*ccgrid(is,js)+0.5 - else -c --- Use NWS cloud data (in tenths) - jcc=icc(ns) - endif -c -c --- Constant 5.e-3 is 0.5 * (0.1)**2 -- factor of 0.1 converts -c --- Cloud cover from tenths to a fraction - theta1 = 0.09 * (1. -5.e-3 * jcc ** 2) -c -c --- Constant 184.428 = 4*gamma*g with gamma=4.7, g=9.81 m/s**2 - cdn = vk / xlnzz0 - theta2 = temp * cdn * ws ** 2 / (184.428 * zmid(1)) - thetas = amin1(theta1,theta2) -c --- Prevent numerical problems - thetas = amax1(thetas,1.e-9) -c -c --- Compute ustar -c --- Constant 46.107 = gamma*g, with gamma=4.7, g=9.81 m/s**2 - u02 = 46.107 * zmid(1) * thetas / temp - cu2 = amax1(0.0,ws * ws - 4. * u02 / cdn) - ustar = 0.5 * cdn *(ws + sqrt(cu2)) -c --- Prevent numerical problems - assume a reasonable lower bound - ustar = amax1(ustar,0.05) -c -c --- Product of (u*)(theta*) is not allowed to exceed XCRIT (=0.05) - if (ustar * thetas .gt. xcrit) then - maxit = 3 -c --- Tolerance set at 5% above xcrit - toler = 1.05 * xcrit - do 190 k = 1,maxit - thetas = xcrit / ustar - u02 = 46.107 * zmid(1) * thetas / temp - cu2 = amax1(0.0,ws * ws - 4. * u02 / cdn) - ustar = 0.5 * cdn * (ws + sqrt(cu2)) - if (ustar * thetas .le. toler) go to 191 -190 continue -191 continue - endif -c -c --- Replace arbitrary nighttime heat flux indicator (-0.1 W/m**2) -c --- With actual value -c --- Constant 996 m**2/(s**2 deg K) = cp - qqh = -996. * rho * ustar * thetas -c -c --- Compute Monin-Obukhov length -c --- Constant 253.8226 = cp/(vk*g) with cp=996 m**2/(s**2 deg.), -c --- vk=0.4, g=9.81 m/s**2 - el = -253.8226 * rho * temp * ustar ** 3 / qqh -c - - - -200 continue - -c Calculate mixing heights - -c frr 021105 previous timestep mixing heights: - zii=zi(is,js) - ziconvi=ziconv(is,js) - -c frr 021105 - if (itprog.eq.0)then - call mixhtST(el,ustar,qqh,rho,ihr2gmt,is,js,nearu(is,js), - : iupt,ilandu(is,js),iwat1,iwat2,imixh,zii,ziconvi) - else - call mixht2ST(el,ustar,qqh,rho,ihr2gmt,is,js, - : ilandu(is,js),iwat1,iwat2,imixh,zii, - : ziconvi) - endif -c - -c -c --- Call extrapolation routine -c --- 050328 - Frr- Use Actual anemometer height not arbitrary one -c zzanem = 10. - call similt(zzanem,el,z0(is,js),zii,ns,ipsifcn,us,vs,zimin) - return - end -c---------------------------------------------------------------------- - function esat(tdegc) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 ESAT -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the saturation water vapor pressure (mb) using -c the method of Lowe (1977) (JAM, 16, pp 100-103). -c -c --- INPUT: -c TDEGC - real - Air temperature (deg. C) -c -c --- OUTPUT: -c ESAT - real - Saturation water vapor -c pressure (mb) -c -c --- ESAT called by: WATER -c --- ESAT calls: none -c---------------------------------------------------------------------- - data a0/6.107799961/,a1/4.436518521e-1/,a2/1.428945805e-2/ - data a3/2.650648471e-4/,a4/3.031240396e-6/,a5/2.034080948e-8/ - data a6/6.136820929e-11/ -c -c --- compute saturation water vapor pressure (mb) -c --- NOTE: temperature is in deg. C - esat=a0+tdegc*(a1+tdegc*(a2+tdegc*(a3+tdegc*(a4+tdegc* - 1 (a5+tdegc*a6))))) -c - return - end -c---------------------------------------------------------------------- - subroutine facet(iu,tt,zz,nlev,nzp1,zface,tface) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 920831 FACET -c --- R. Yamartino, SRC -c --- Modified by J. Scire to allow missing data -c -c --- PURPOSE: Calculate the vertical grid face temperatures -c using sounding data only. -c -c --- INPUTS: -c IU - integer - Upper air station number -c (1, 2, ..., nusta) -c TT(mxus,mxlev) - real array - Temperatures (deg K) -c ZZ(mxus,mxlev) - real array - Height (m) of TT (above LGL) -c NLEV(mxus) - int. array - Number of sounding levels -c NZP1 - integer - Number of vertical grid faces -c ZFACE(mxnzp1) - real array - Height (m) of cell face -c -c Parameters: MXUS, MXLEV, MXNZP1 -c -c --- OUTPUT: -c TFACE(mxnzp1) - real array - Layer averaged Temperatures -c (deg K) -c -c --- FACET called by: COMP -c --- FACET calls: INTP -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real tt(mxus,mxlev),zz(mxus,mxlev) - integer nlev(mxus) - real zface(mxnzp1) - real tface(mxnzp1) -c - data xmiss/999.9/ -c -c --- Reduce missing value indicator by a slight amount to allow for -c --- machine roundoff - xmissm=xmiss-0.01 -c -c --- Interpolate temperatures to cell face heights (zface) for all -c --- nzp1 values - do 15 k=1,nzp1 - znow = zface(k) - call intp(tt,zz,nlev(iu),iu,znow,xmissm,ttzz) - tface(k) = ttzz -15 continue -c - return - end -c---------------------------------------------------------------------- - subroutine fillgeo(iogeo,iopt,ilucat,nlu,varlu,ilandu,nx,ny,var) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 FILLGEO -c --- J. Scire, SRC -c -c --- PURPOSE: Fill geophysical parameter arrays with data computed -c from land use category or read gridded values from -c the control file -c Parameters include: surface roughness (z0), -c albedo (ALBEDO), Bowen ratio (BOWEN), soil heat flux -c parameter (HCG), anthropogenic heat flux (QF), -c leaf area index (XLAI) -c -c --- INPUTS: -c IOGEO - integer - Fortran unit number of -c geophysical data file (GEO.DAT) -c IOPT - integer - Option flag: -c 0=compute parameter from land -c use using default table -c 1=read new values for each -c land use catgeory -c 2=read gridded field of values -c ILUCAT(NLU) - integer array - Array of allowable values of -c land use -c NLU - integer - Number of land use categories -c VARLU(NLU) - real array - Value of geophysical parameter -c for each land use category -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c Parameters: MXNX, MXNY -c -c --- OUTPUT: -c VAR(mxnx,mxny) - real array - Gridded geophysical parameter -c computed from land use data or -c read from control file -c -c --- FILLGEO called by: READGE -c --- FILLGEO calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real varlu(nlu),var(mxnx,mxny) - integer ilucat(nlu),ilandu(mxnx,mxny) -c - if(iopt.eq.0)then -c -c --- compute parameter value from land use data -- use default -c --- values - do 110 i=1,nx - do 110 j=1,ny - ilu=ilandu(i,j) -c - do 105 k=1,nlu - if(ilu.eq.ilucat(k))then - var(i,j)=varlu(k) - go to 107 - endif -105 continue -c -c --- land use category not found in table - write(io6,106)i,j,ilu,nlu,(ilucat(n),n=1,nlu) -106 format(//2x,'ERROR IN SUBR. FILLGEO -- Land use category ', - 1 'not found in table'/2x,'I = ',i5,2x,'J = ',i5,2x,'ILU = ', - 2 i5,2x,'NLU = ',i5/2x,'Values in table (ILUCAT) = ',20i5/ - 3 10(28x,20i5/)) - stop -107 continue -110 continue - else if(iopt.eq.1)then -c -c --- read new table relating geophysical parameter to land use - do 120 i=1,nlu - read(iogeo,*)ilu,varlu(i) -c - if(ilu.ne.ilucat(i))then - write(io6,118)i,ilu,nlu,ilucat(i) -118 format(//2x,'ERROR IN SUBR. FILLGEO -- land use catgeory ', - 1 'does not match expected value'/2x,'i = ',i5,'ILU = ',i5, - 2 2x,'NLU = ',i5,2x,'ILUCAT(i) = ',i5) - stop - endif -120 continue -c -c --- compute geophysical parameter from USER-INPUT table - do 130 i=1,nx - do 130 j=1,ny - ilu=ilandu(i,j) -c - do 125 k=1,nlu - if(ilu.eq.ilucat(k))then - var(i,j)=varlu(k) - go to 127 - endif -125 continue - write(io6,106)i,j,ilu,nlu,(ilucat(n),n=1,nlu) - stop -127 continue -130 continue - else if(iopt.eq.2)then -c -c --- read gridded field of geophysical parameters - do 150 j=ny,1,-1 - read(iogeo,*)(var(n,j),n=1,nx) -150 continue - else -c -c --- invalid value of flag -- IOPT must be 0, 1, or 2 - write(io6,165)iopt -165 format(//2x,'ERROR IN SUBR. FILLGEO -- Invalid value of ', - 1 'IOPT -- IOPT = ',i5) - stop - endif -c - return - end -c---------------------------------------------------------------------- - subroutine fin(itest) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 090511 FIN -c --- J. Scire -c -c --- PURPOSE: Run termination routine -- compute runtime, -c write last day processed -c -c --- UPDATES: -c --- V6.208 (060329) to V6.327 (090511) (DGS) -c - Reformat date reported at end of run -c -c --- V6.2 (060215) to V6.208 (060329) (DGS) -c - Revise text for last period time -c -c --- V5.5 (030402) to V6.2 (060215) (F.Robe) -c - Change date format to beg/ending times -c -c --- V5.4 (991104) to V5.5 (030402) (DGS) -c - Add list-file unit to JULDAY, GRDAY, INDECR calls -c - rdate, rdate2 changed to include YYYY format for -c year (MM-DD-YYYY) -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- INPUTS: -c ITEST - integer - Flag indicating if execution is to -c include COMPUTATIONAL phase -c (ITEST = 1 to STOP program after -c SETUP phase, -c ITEST = 2 to CONTINUE execution to -c include computations) -c -c Common block /GEN/ -c nyr, nmo, nday, njul, nhr -c Common block /QA/ -c rdate, rtime -c Common block /FLAGS/ -c lmesg, iomesg -c Parameters: IO6 -c -c --- OUTPUT: none -c -c --- FIN called by: MAIN -c --- FIN calls: DATETM, GRDAY, JULDAY, DELTT, INDECR, YR4C, -c FMT_DATE -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - character*8 rtime2 - character*10 rdate2 - character*12 rdate12 -c - include 'gen.met' - include 'qa.met' - include 'flags.met' -c - if(lmesg)write(iomesg,*)'ENTERING TERMINATION PHASE' -c - if(itest.eq.2)then -c --- write last day/hour processed - - if(nsecb.lt.0)then - nsecb=3600+nsecb - nhrb=nhrb-1 - if(nhrb.EQ.-1)then - nhrb=0 - call indecr(io6,nyrb,njulb,nhrb,-1,0,23) - call grday(io6,nyrb,njulb,nmob,ndayb) - endif - endif - -c DGS Switch from (HH-1) 3600 to HH 000 for end of run - nsece0=nsece -c --- Reset ending hour if nsece=3600 (as hour is incremented -c --- before the check is done for the last step ) - if (nsece.eq.3600.)then - nsece0=0 -c DGS call indecr(io6,nyre,njule,nhre,-1,0,23) -c DGS call grday(io6,nyre,njule,nmoe,ndaye) - endif - - write(io6,5)nyre,nmoe,ndaye,njule,nhre,nsece0 -5 format(//2x,'LAST PERIOD PROCESSED ENDS AT:'/5x, - 1 ' Year: ',i4,2x,'Month: ',i2,3x,'Day: ',i2,3x, - 2 'Julian day: ',i3,3x,'Hour: ',i2,3x,'Second: ',i4) - else -c -c --- TEST mode -- COMPUTATIONAL phase skipped - write(io6,12) -12 format(/1x,13('----------')//1x, - 1 'Completion of CALMET test mode run -- run terminating ', - 2 'normally'//1x,13('----------')) - endif - -c -c --- get system date & time at end of run - call datetm(rdate2,rtime2,rcpu) -c -c --- compute runtime - read(rtime(1:2),10)ihr1 - read(rtime(4:5),10)imin1 - read(rtime(7:8),10)isec1 -10 format(i2) - t1=ihr1*3600.+imin1*60.+isec1 - - read(rtime2(1:2),10)ihr2 - read(rtime2(4:5),10)imin2 - read(rtime2(7:8),10)isec2 - t2=ihr2*3600.+imin2*60.+isec2 - - if(rdate.eq.rdate2)then - delt=t2-t1 - else - read(rdate(1:2),10)imo1 - read(rdate(4:5),10)iday1 - read(rdate(7:10),'(i4)')iyr1 - call julday(io6,iyr1,imo1,iday1,ijul1) - - read(rdate2(1:2),10)imo2 - read(rdate2(4:5),10)iday2 - read(rdate2(7:10),'(i4)')iyr2 - call julday(io6,iyr2,imo2,iday2,ijul2) - -c --- compute no. hours from beg. of first hour of run to -c --- ending hour of ending day of the run - call deltt(iyr1,ijul1,ihr1,iyr2,ijul2,ihr2,idelhr) - -c --- adjust for minutes and seconds - delt=idelhr*3600.-imin1*60.-isec1+imin2*60.+isec2 - endif - -c --- On the PC, the runtime and CPU time are the same -c --- (DATETM provides RCPU = 0.0 on the PC) - if(rcpu.eq.0.0)rcpu=delt - -c --- Report current date - rdate12=rdate2(1:10)//' ' - call FMT_DATE(io6,'MM-DD-YYYY','DD-MMM-YYYY',rdate12) - write(io6,1402)rtime2,rdate12,delt,rcpu -1402 format(//2x,'End of run -- Clock time: ',a8/ - 1 2x,' Date: ',a12// - 2 2x,' Elapsed clock time: ',f10.1,' (seconds)'// - 3 2x,' CPU time: ',f10.1,' (seconds)') - - return - end -c---------------------------------------------------------------------- - subroutine fminf(f,nf,fmin,nmin) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 FMINF -C - DIMENSION F(NF) -C -C FMINF LOCATES THE MINIMUM VALUE AMONG NF CONSECUTIVE -C MEMBERS OF THE F ARRAY AND RETURNS BOTH THE VALUE FMIN -C AND ITS ARRAY INDEX NMIN -C -C INPUTS: F (R ARRAY) - DISTANCES FROM STATION TO GRID POINT -C NF (I) - NUMBER OF STATIONS -C -C OUTPUTS: FMIN (R ARRAY) - MINIMUM STATION DISTANCE -C NMIN (I) -INDEX OF CLOSEST STATION -C -C - N = 1 - A = F(N) - IF(NF.LT.2) GO TO 120 - DO 100 N=2,NF - A = AMIN1(F(N),A) - 100 CONTINUE - DO 110 N=1,NF - IF(A-F(N)) 110,120,120 - 110 CONTINUE - N = NF - 120 NMIN = N - FMIN = A - RETURN - END -c---------------------------------------------------------------------- - subroutine fradj(u,v,htopo,gamma,isurft,tinf,temp2d,critfn, - 1 cellzb,hmax) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070717 FRADJ -c S.DOUGLAS, SAI -c Modified by J. Scire, F.Robe -c -c --- PURPOSE: THIS SUBROUTINE IS ADAPTED FROM THE MELSAR MODEL. -C THE LOCAL FROUDE NUMBER FOR EACH GRID POINT IS CALCULATED -C IF THIS EXCEEDS A CRITICAL VALUE AND IF THE WIND IS BLOWING -C TOWARD THE OBSTACLE, THE U AND V WIND COMPONENTS ARE -C ADJUSTED. -c -c -c --- UPDATES: -c --- V6.218 (070113) to V6.3 (070717)(F. Robe) -c (1) Use average surface temperature for ISURFT=-2 -c -c --- V5.6 (970825) to V6.218 (070113) (F. Robe) -c (1) Reformat header -c (2) Add option to use spatially varying temp2D instead of domain -c repreentative Tinf -c (3) Make former scalar gamma a 2D array -C -C --- INPUTS: -c U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C HTOPO (R ARRAY) - GRIDDED TERRAIN HEIGHTS -C GAMMA (R ARRAY) - TEMPERATURE LAPSE RATES -c ISURFT (I) - Surface station number where domain -c representative temperature is used from -c or trigger for using 2-D surface temp -c (ISURFT=-1; default) -C TINF (R) - DOMAIN REPRESENTATIVE TEMPERATURE -C CRITFN (R) - CRITICAL FROUDE NUMBER -C HMAX (R ARRAY) - MAXIMUM TERRAIN HEIGHTS WITHIN A -C GIVEN RADIUS -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C --- OUTPUTS: -c U (R ARRAY) - ADJUSTED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - ADJUSTED Y-DIRECTION WIND COMPONENTS -C -c --- FRADJ called by: DIAGNO -c --- FRADJ calls: none -c ------------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'grid.met' - include 'd6.met' -c - DIMENSION U(mxnx,mxny,*), V(mxnx,mxny,*), - 1 HTOPO(mxnx,*), HMAX(mxnx,*), CELLZB(mxnzp1), - 2 temp2D(mxnx,mxny), gamma (mxnx,mxny) -C - -C COMPUTE THE STABILITY PARAMETER -C - TAU=-0.01 -C -C MELSAR FROUDE NUMBER ADJUSTMENT -C - RPD=0.017453 - DPR=57.296 - DO 100 J=1,NY - DO 100 I=1,NX -C - GAMMA2=GAMMA(i,j) - TAU - -C CALCULATE THE TOPOGRAPHIC GRADIENTS -C - DXI=0.5/DX - DYI=0.5/DY - HTOIM1=HTOPO(I,J) - HTOJM1=HTOPO(I,J) - IF (I .GT. 1) HTOIM1=HTOPO(I-1,J) - IF (J .GT. 1) HTOJM1=HTOPO(I,J-1) - HTOIP1=HTOPO(I,J) - HTOJP1=HTOPO(I,J) - IF (I .LT. NX) HTOIP1=HTOPO(I+1,J) - IF (J .LT. NY) HTOJP1=HTOPO(I,J+1) - DELHI=(HTOIP1-HTOIM1)*DXI - DELHJ=(HTOJP1-HTOJM1)*DYI - IF (ABS(DELHI) .LT. 0.00015 .AND. ABS(DELHJ) .LT. 0.00015) THEN - DELHI = 0. - DELHJ = 0. - ENDIF -C -c --- Use spatially varying temperature unless specifically requested -c --- 070717 -c if (isurft.gt.0) then -c temp=tinf -c else -c temp=temp2d(i,j) -c endif - if (isurft.eq.-1) then - temp=temp2d(i,j) - else - temp=tinf - endif - - DO 100 K=1,NZ -C -C CALCULATE THE LOCAL FROUDE NUMBER -C - SPEED=(U(I,J,K)**2+V(I,J,K)**2)**0.5 - if(speed.le.0.)go to 100 - OBSHGT=HMAX(I,J)-(HTOPO(I,J)+CELLZB(K)+DZ(K)/2.) - IF (OBSHGT .LE. 0.) GO TO 100 - IF (GAMMA2 .LE. 0.) GO TO 100 - FROUDE=SPEED/(((9.8*GAMMA2/temp)**0.5)*OBSHGT) - IF (FROUDE .GT. CRITFN) GO TO 100 -C -C SET UP DRAINAGE VECTOR DIRECTIONS -C - IF (DELHI .EQ. 0.) THEN - IF (DELHJ .EQ. 0.) GO TO 100 - IF (DELHJ .LT .0.) THET=270. - IF (DELHJ .GT. 0.) THET=90. - ELSE - THETP=ATAN(DELHJ/DELHI)*DPR - ENDIF - IF (DELHI .LT. 0.) THET=THETP+180. - IF (DELHI .GT. 0.) THEN - IF (DELHJ .GT. 0.) THEN - THET=THETP - ELSE - THET=THETP+360. - ENDIF - ENDIF - IF (THET .GE. 0. .AND. THET .LE. 90) THETD=90.-THET - IF (THET .GT. 90. .AND. THET .LE. 360) THETD=450.-THET -C -C RESOLVE DRAINAGE VECTOR INTO COMPONENTS -C - ANG=(270.-THETD)*RPD - DRX=-COS(ANG) - DRY=-SIN(ANG) -C -C ADJUST WINDS -C FIRST NORMALIZE WIND VECTOR -C - UN=U(I,J,K)/SPEED - VN=V(I,J,K)/SPEED -C -C DETERMINE IF WIND IS BLOWING TOWARD OBSTACLE (AA>0) -C - AA=DRX*UN+DRY*VN - IF (AA .LE. 0) GO TO 100 -C -C DETERMINE TANGENT WIND VECTOR -C - TT=-DRY*UN+DRX*VN - IF (TT .GT. 0.) THEN - TAX=-DRY - TAY=DRX - ELSE - TAX=DRY - TAY=-DRX - ENDIF - U(I,J,K)=TAX*SPEED - V(I,J,K)=TAY*SPEED - 100 CONTINUE -C - RETURN - END -c---------------------------------------------------------------------- - subroutine gride(npsta,xprecp,xpsta,ypsta,nearp,dgrid,nx,ny,rmm, - 1 nflag,usersig,usercut) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 941215 GRIDE -c --- Xiaoming (John) Zhang, SRC -c Joseph Scire, SRC -c -c --- PURPOSE: Assign precipitation rates (mm/hr) to each grid point -c using objective mapping technique -c *** ALL CELLS -- LAND & WATER *** -c -c --- INPUTS: -c NPSTA - integer - Number of precipitation -c stations -c XPRECP(mxps) - real array - Precipitation rate (mm/hr) at -c each station (9999. used to -c indicate a missing value) -c XPSTA(mxps) - real array - Relative X-coordinates (m) of -c precipitation stations -c YPSTA(mxps) - real array - Relative Y-coordinates (m) of -c precipitation stations -c NEARP(mxnx,mxny) - integer array - Station number of precip. -c station closest to each grid pt -c DGRID - real - Horizontal grid size (m) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c NFLAG - integer - =1, for 1/R interpolation -c =2, for 1/R**2 interpolation -c =3, for exp(-R**2/sigma**2)/R**2 -c interpolation -c where R = radius -c USERSIG - real - User specified radius of -c influence or weighting (sigma) -c factor (km) -c If NFLAG=1,2 -- radius of -c influence (km) -c If NFLAG=3 -- sigma weighting -c factor (km) -- if 0.0, -c USERSIG will be computed -c internally as 1/2 dist. -c between nearest stations -c w/ and w/o precipitation -c USERCUT - real - User specified cutoff value -c for computed precipitation rate -c (mm/hr) -- (values < USERCUT -c are set equal to 0.0 mm/hr) -c Common block /gen/ -c nyr, nmo, nday, nhr, njul -c Parameters: mxnx, mxny, mxps, io6 -c -c --- OUTPUT: -c RMM(mxnx,mxny) - real array - Precipitation rate (mm/hr) at -c each grid point -c -c --- GRIDE called by: COMP -c --- GRIDE calls: CMPD2 -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' -c - real xprecp(mxps),xpsta(mxps),ypsta(mxps) - real x(mxps),y(mxps),p(mxps),dis2(mxps) - real rmm(mxnx,mxny) - integer nearp(mxnx,mxny) -c - include 'gen.met' -c - data dismin/0.01/,xmax/1.e37/ -c -c --- Compute the number of precip stations with good values and their -c locations -c - np=0 - do 300 i=1,npsta - if(XPRECP(i).lt.9998.) then - np=np+1 - x(np)=xpsta(i) - y(np)=ypsta(i) - p(np)=xprecp(i) - endif -300 continue -c -c --- If all precip. data is missing for this hour, assume -c --- precip. rate = 0.0, and write warning message - if(np.eq.0)then - do 55 ii=1,nx - do 55 jj=1,ny - rmm(ii,jj)=0.0 -55 continue - write(io6,15)nyr,nmo,nday,nhr,njul -15 format(//1x,'WARNING -- All precip. data missing on ', - 1 'YEAR, MONTH, DAY, HOUR = ',4i4,3x,'Julian day = ',i3/ - 2 1x,'Precip. rate assumed to be zero for this hour') - goto 999 - endif -c -c --- If user-defined radius not used, then find radius of influence -c --- which is defined as half of the minimum distance between any -c --- nonzero precip. stations and any zero precip. stations. -c - if (nflag.eq.3.and.usersig .eq. 0.0) then - sigma2=xmax - do 60 k1=1,np - do 70 k2=1,np - test1=p(k1)*p(k2) - test2=p(k1)+p(k2) - if((test1.eq.0.0).and.(test2.gt.0.0)) then - d2=(x(k1)-x(k2))**2+(y(k1)-y(k2))**2 - if(d2.lt.sigma2) sigma2=d2 - endif -70 continue -60 continue - sigma = sqrt(sigma2) - sigma = 0.5 * sigma - else -c -c --- SIGMA is in meters (USERSIG is in km) - sigma = 1000.*usersig - sigma2= sigma*sigma - end if -c -c --- Compute precipitation rate at each grid point - if(nflag.eq.1)then -c -c --- 1/R INTERPOLATION METHOD - do 110 i=1,nx - xgm=(float(i)-0.5)*dgrid - do 105 j=1,ny - ygm=(float(j)-0.5)*dgrid -c - top=0.0 - bot=0.0 -c -c --- Compute distance**2 of each precip. station with -c VALID (non-missing) data to grid point - call cmpd2(xgm,ygm,x,y,np,dis2) -c -c --- Compute weighting functions for 1/R method - do 103 k=1,np - if(dis2(k).le.sigma2)then -c -c --- Station is within radius of influence - dis=sqrt(dis2(k)) -c --- Minimum value of distance to avoid numerical problems - dis=amax1(dis,dismin) -c - top=top+p(k)/dis - bot=bot+1.0/dis - endif -103 continue -c -c --- If there are NO stations within region of influence, -c use value at nearest station with valid data - if(bot.eq.0.0)then -c -c --- NOTE: NEARP array contains index of XPRECP, not P - ista=nearp(i,j) - if(xprecp(ista).lt.9998.)then - rmm(i,j)=xprecp(ista) - go to 105 - else -c -c --- Precip. at nearest station is missing -- find -c nearest station with VALID data -c (note: all stations in P array have valid data) - dmin2=xmax - do 101 k=1,np - if(dis2(k).lt.dmin2)then - dmin2=dis2(k) - ksta=k - endif -101 continue - rmm(i,j)=p(ksta) - go to 105 - endif - else -c -c --- Compute precipitation rate with 1/R method - rmm(i,j)=top/bot - if(rmm(i,j).lt.usercut)rmm(i,j)=0.0 - endif -105 continue -110 continue - else if(nflag.eq.2)then -c -c --- 1/R**2 INTERPOLATION METHOD - do 210 i=1,nx - xgm=(float(i)-0.5)*dgrid - do 205 j=1,ny - ygm=(float(j)-0.5)*dgrid -c - top=0.0 - bot=0.0 -c -c --- Compute distance**2 of each precip. station with -c VALID (non-missing) data to grid point - call cmpd2(xgm,ygm,x,y,np,dis2) -c -c --- Compute weighting functions for 1/R**2 method - do 203 k=1,np - if(dis2(k).le.sigma2)then -c -c --- Station is within radius of influence -c --- Minimum value of dist**2 to avoid numerical problems - dis2saf=amax1(dis2(k),dismin) -c - top=top+p(k)/dis2saf - bot=bot+1.0/dis2saf - endif -203 continue -c -c --- If there are NO stations within region of influence, -c use value at nearest station with valid data - if(bot.eq.0.0)then -c -c --- NOTE: NEARP array contains index of XPRECP, not P - ista=nearp(i,j) - if(xprecp(ista).lt.9998.)then - rmm(i,j)=xprecp(ista) - go to 205 - else -c -c --- Precip. at nearest station is missing -- find -c nearest station with VALID data -c (note: all stations in P array have valid data) - dmin2=xmax - do 201 k=1,np - if(dis2(k).lt.dmin2)then - dmin2=dis2(k) - ksta=k - endif -201 continue - rmm(i,j)=p(ksta) - go to 205 - endif - else -c -c --- Compute precipitation rate with 1/R**2 method - rmm(i,j)=top/bot - if(rmm(i,j).lt.usercut)rmm(i,j)=0.0 - endif -205 continue -210 continue - else if(nflag.eq.3)then -c -c --- Exponential interpolation method - do 310 i=1,nx - xgm=(float(i)-0.5)*dgrid - do 305 j=1,ny - ygm=(float(j)-0.5)*dgrid - bot=0.0 - top=0.0 -c -c --- Compute distance**2 of each precip. station with -c VALID (non-missing) data to grid point - call cmpd2(xgm,ygm,x,y,np,dis2) -c - do 301 k=1,np - expo=dis2(k)/sigma2 - if(expo.gt.60.0) then - bbb=0.0 - else - bbb=exp(-expo) - endif -c --- Minimum value of dist**2 to avoid numerical problems - dis2saf=amax1(dis2(k),dismin) - bot=bot+bbb/dis2saf - top=top+p(k)*bbb/dis2saf -301 continue -c - if(top.lt.1.0e-30) then - rmm(i,j)=0.0 - else - rmm(i,j)=top/bot - if(rmm(i,j).lt.usercut) rmm(i,j)=0.0 - endif -305 continue -310 continue - else - write(io6,*)'ERROR in Subr. GRIDE -- Invalid value ', - 1 'of NFLAG -- NFLAG = ',nflag - stop - endif -c -999 continue - return - end -c---------------------------------------------------------------------- - subroutine INTERPQR(qrprog,rmm) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 INTERPQR -c --- F.Robe Earth Tech -c after subroutine GRIDE -c -c --- PURPOSE: Assign precipitation rates (mm/hr) to each grid point -c using objective mapping technique of MM5 rainfall rates -c Use the 4 closest MM5 gridpoints -c *** ALL CELLS -- LAND & WATER *** -c -c --- UPDATES: -c -c - V5.546 (040924) to V5.55 (050328) frr -c - no need to declare x(mxnx,xmny) and y(mxnx,mxny) any longer -c - 030830 to V5.546 (040924) frr -c - Locations of MM5 gridpoints relative to CALMET grid origin -c are computed in RDHD5 & stored as X04,Y04 in MM4HD0 -c (units changed from km to meters- bug fix) -c - Do not initialize rmm each time -c -c - 030830(FRR)- Bug fix- Use consistent coordinate systems -c for MM5 and CALMET grdipoints. -c -c -c --- INPUTS: -c -c QRPROG(mxnxp,mxnyp) - real array - Precipitation rate (mm/hr) at -c each MM5 gridpoint -c Via common MET1.MET: -c -c NFLAGP - integer - =1, for 1/R interpolation -c =2, for 1/R**2 interpolation -c =3, for exp(-R**2/sigma**2)/R**2 -c interpolation -c where R = radius -c SIGMAP - real - User specified radius of -c influence or weighting (sigma) -c factor (km) -c If NFLAGP=1,2 -- radius of -c influence (km) -c If NFLAGP=3 -- sigma weighting -c factor (km) -- if 0.0, -c SIGMAP will be computed -c internally as 1/2 dist. -c between nearest stations -c w/ and w/o precipitation -c CUTP - real - User specified cutoff value -c for computed precipitation rate -c (mm/hr) -- (values < CUTP -c are set equal to 0.0 mm/hr) -c Via MM4HDO.MET -c XLCMM4 -c YLCMM4 -c IGRAB -c JGRAB -c -c --- OUTPUT: -c RMM(mxnx,mxny) - real array - Precipitation rate (mm/hr) at -c each grid point -c -c --- INTERPQR called by: RDMM5 -c --- INTERPQR calls: CMPD2 -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' -c - real qrprog(mxnxp,mxnyp) - real p(mxnxp*mxnyp) - real dis2(mxnxp*mxnyp) - real rmm(mxnx,mxny) -c - include 'met1.met' - include 'grid.met' - include 'mm4hdo.met' -c - data dismin/0.01/,xmax/1.e37/ -c -c --- 040924 (frr) no need to initialize rmm each time. -c --- Initialise precip rate -c do 55 i=1,nx -c do 55 j=1,ny -c rmm(i,j)=0.0 -c55 continue -c -c --- 040924 (frr) Locations of MM5 gridpoints is computed in RDHD5 -c --- (and units are in meters -bug fix) -c -c --- Compute the number of MM5 gridpoints and fill in progn. precip. - np=0 - do 300 ip=1,nxp - do 300 jp=1,nyp - np=np+1 - p(np)=qrprog(ip,jp) -300 continue - - -c --- If user-defined radius not used, then find radius of influence -c --- which is defined as half of the minimum distance between any -c --- nonzero precip. stations and any zero precip. stations. -c -c - if (nflagp.eq.3.and.sigmap .eq. 0.0) then - sigma2=xmax - do 60 k1=1,np - do 70 k2=1,np - test1=p(k1)*p(k2) - test2=p(k1)+p(k2) - if((test1.eq.0.0).and.(test2.gt.0.0)) then - d2=(x04(k1)-x04(k2))**2+(y04(k1)-y04(k2))**2 - if(d2.lt.sigma2) sigma2=d2 - endif -70 continue -60 continue - sigma1 = sqrt(sigma2) - sigma1 = 0.5 * sigma1 - else -c -c --- sigma1 is in meters (sigmap is in km) - sigma1 = 1000.*sigmap - sigma2= sigma1*sigma1 - end if -c -c --- Compute precipitation rate at each grid point - if(NFLAGP.eq.1)then -c -c --- 1/R INTERPOLATION METHOD - do 110 i=1,nx - xgm=(float(i)-0.5)*dgrid - do 105 j=1,ny - ygm=(float(j)-0.5)*dgrid -c - top=0.0 - bot=0.0 -c -c --- Compute distance**2 of each precip. station with -c VALID (non-missing) data to grid point - call cmpd2(xgm,ygm,x04,y04,np,dis2) -c -c --- Compute weighting functions for 1/R method - do 103 k=1,np - if(dis2(k).le.sigma2)then -c -c --- Station is within radius of influence - dis=sqrt(dis2(k)) -c --- Minimum value of distance to avoid numerical problems - dis=amax1(dis,dismin) -c - top=top+p(k)/dis - bot=bot+1.0/dis - endif -103 continue -c -c --- If there are NO gridpoint within region of influence, -c use value at nearest MM5 gridpoint - if(bot.eq.0.0)then - rmm(i,j)=qrprog(igrab(i,j,1),jgrab(i,j,1)) - else -c --- Compute precipitation rate with 1/R method - rmm(i,j)=top/bot - if(rmm(i,j).lt.CUTP)rmm(i,j)=0.0 - endif -105 continue -110 continue - - else if(NFLAGP.eq.2)then -c -c --- 1/R**2 INTERPOLATION METHOD - do 210 i=1,nx - xgm=(float(i)-0.5)*dgrid - do 205 j=1,ny - ygm=(float(j)-0.5)*dgrid -c - top=0.0 - bot=0.0 -c -c --- Compute distance**2 of each precip. station with -c VALID (non-missing) data to grid point - call cmpd2(xgm,ygm,x04,y04,np,dis2) -c -c --- Compute weighting functions for 1/R**2 method - do 203 k=1,np - if(dis2(k).le.sigma2)then -c -c --- Station is within radius of influence -c --- Minimum value of dist**2 to avoid numerical problems - dis2saf=amax1(dis2(k),dismin) -c - top=top+p(k)/dis2saf - bot=bot+1.0/dis2saf - endif -203 continue -c -c --- If there are NO gridpoint within region of influence, -c use value at nearest gridpoint - if(bot.eq.0.0)then - rmm(i,j)=qrprog(igrab(i,j,1),jgrab(i,j,1)) - else -c --- Compute precipitation rate with 1/R**2 method - rmm(i,j)=top/bot - if(rmm(i,j).lt.CUTP)rmm(i,j)=0.0 - endif -205 continue -210 continue - - else if(NFLAGP.eq.3)then -c -c --- Exponential interpolation method - do 310 i=1,nx - xgm=(float(i)-0.5)*dgrid - do 305 j=1,ny - ygm=(float(j)-0.5)*dgrid - bot=0.0 - top=0.0 -c -c --- Compute distance**2 of each precip. station with -c VALID (non-missing) data to grid point - call cmpd2(xgm,ygm,x04,y04,np,dis2) -c - do 301 k=1,np - expo=dis2(k)/sigma2 - if(expo.gt.60.0) then - bbb=0.0 - else - bbb=exp(-expo) - endif -c --- Minimum value of dist**2 to avoid numerical problems - dis2saf=amax1(dis2(k),dismin) - bot=bot+bbb/dis2saf - top=top+p(k)*bbb/dis2saf -301 continue -c - if(top.lt.1.0e-30) then - rmm(i,j)=0.0 - else - rmm(i,j)=top/bot - if(rmm(i,j).lt.CUTP) rmm(i,j)=0.0 - endif -305 continue -310 continue - else - write(io6,*)'ERROR in Subr. GRIDE -- Invalid value ', - 1 'of NFLAGP -- NFLAGP = ',NFLAGP - stop - endif -c -999 continue - return - end -c---------------------------------------------------------------------- - subroutine heatfx(sinalp,nears,temp2d,icc,ilandu,iwat1,iwat2, -ccec101006 1 nx,ny,icloud,ccgrid,qh,qsw) - 1 nx,ny,mcloud,ccgrid,qh,qsw) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101006 HEATFX -c --- J. Scire, SRC -c Modified by F.Robe,Earth Tech Inc.(09/01) -c -c --- PURPOSE: Compute the sensible heat flux (W/m**2) at each -c non-water grid point using the energy budget method -c Compute also the solar radiation at ALL gridpoints -c -c --- CHANGES: -c -c --- V6.217 level 061231 to V6.330 Level 101006 (CEC) -c - Change Cloud option from ICLOUD to ICLDOUT and MCLOUD -c -c --- 951021 (MOD5) to V6.217 Level 061231 -c - Allow icloud=4 option -c -c --- 951021 to MOd5 -c - Short wave radiation computed at all gridpoints -c -c --- INPUTS: -c SINALP(mxnx,mxny) - real array - Sine of the solar elevation -c angle at each grid point -c NEARS(mxnx,mxny) - integer array - Station number of surface -c station closest to each grid pt -c TEMP2D(mxnx,mxny) - real array - Surface Air temperature (deg. K) -c ICC(mxss) - integer array - Cloud cover (tenths) -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c NSSTA - integer - Number of surface stations -c MCLOUD - integer - Flag indicating if gridded -c cloud data are available -c (2,3 = yes, otherwise, no) -c CCGRID(mxnx,mxny) - real array - Gridded cloud fraction -c (Used only if MCLOUD=2,3,4) -c -c Common block /HFLUX/ variables: -c qf(mxnx,mxny),hcg(mxnx,mxny), -c albedo(mxnx,mxny),bowen(mxnx,mxny), -c ha1,ha2,hb1,hb2,hc1,hc2,hc3,hc3p1 -c Parameters: MXNX, MXNY, MXSS -c -c --- OUTPUT: -c QH(mxnx,mxny) - real array - Sensible heat flux (W/m**2) at -c each grid point -c QSW(mxnx,mxny) - real array - Short-wave radiation (W/m**2) -c at each grid point -c -c --- HEATFX called by: DIAGNO, COMP -c --- HEATFX calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real qh(mxnx,mxny) - real sinalp(mxnx,mxny),temp2d(mxnx,mxny),qsw(mxnx,mxny) - real ccgrid(mxnx,mxny) -c - integer nears(mxnx,mxny),ilandu(mxnx,mxny) - integer icc(mxss) -c - include 'hflux.met' -c -c --- compute short-wave radiation (W/m**2) at all gridpoints, QSW - -c --- loop over grid cells - do 200 i=1,nx - do 200 j=1,ny -c -c --- Station number of the nearest surface met. station to -c --- the current grid point (i,j)-NSTA - -c Compute short-wave radiation QSW -ccec101006 if(icloud.gt.1)then - if(mcloud.gt.1)then -c --- use gridded cloud data (2:from cloud.dat - 3,4: from MM5) - ccfrac = ccgrid(i,j) - else -c --- use cloud fraction at surface stations -c --- convert cloud cover (tenths) to fractional value - ccfrac = 0.1*icc(nears(i,j)) - endif - qsw(i,j)=(ha1*sinalp(i,j)+ha2)*(1.+hb1*ccfrac**hb2) - qsw(i,j)=amax1(qsw(i,j),0.0) -c --- skip water grid cells -- (DT method used to compute heat flux -c --- over water) - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2)go to 200 -c -c -c --- flag nighttime periods with negative sensible heat flux -c if(sinalp(nsta).le.0.0)then - if(sinalp(i,j).le.0.0)then - qh(i,j)=-0.1 - go to 200 - endif -cc -c --- compute net radiation (W/m**2), QSTAR using the method of -c --- Holtslag and van Ulden (1983) -c --- constant 5.67e-8 W/m**2/deg. K**4 is the Stefan-Boltzmann constant - qstar=((1.-albedo(i,j))*qsw(i,j)+hc1*temp2d(i,j)**6 - : -5.67e-8*temp2d(i,j)**4+hc2*ccfrac)/hc3p1 -c - -c --- compute sensible heat flux (w/m**2), QH -c --- qf is the anthropogenic heat flux (W/m**2) - qh(i,j)=bowen(i,j)*(qstar*(1.-hcg(i,j))+qf(i,j))/(1.+bowen(i,j)) -c -200 continue - -676 format(4(1x,i2),2x,3f10.5) -c - return - end -c---------------------------------------------------------------------- - subroutine inter2(stdat1,nst,xst,yst, - 1 nintrp,rs,is,work,field1,fgfld,ilandu, - 2 iwat1,iwat2,pdat,noobs) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050217 INTER2 -c Earth Tech -c based on DWM subroutine by S.DOUGLAS, SAI -c Modified by Earth Tech -c -c --- UPDATES: -c --- V5.548a (050101) to V5.551 Level 050217(FRR) -c - Iflag removed from calling list (=nbar, which is passed via -c common d3.met) -c - call barier only if nbar>0 (for prog. data) - -c --- V5.5 (030402) to V5.548a (050101) (FRR) -c - Implemented level dependent barriers (up to KBAR) -c - Rearrange comments/declations to fit convention -c (purpose, update, input, output, declarations) -c -c --- V5.4 (990228) to V5.5 (030402) (DGS) -c - Change documentation: coordinates may be other than -c UTM or LLC -c -c --- PREVIOUS UPDATES: -c --- Modifed by F.Robe to pass arguemtns bia wparm.met (021105) -c --- Modified to use sigma weighting in interpolation, EMI 920923 -c --- Modified to allow gridded MM4 prognostic winds to be treated as -c observations EMI 920925 -c -c --- Modified by Ed Chang; 3/8/94; SRC -c - Initialize JS array in 121-loop -c - Changed loop index of 135- & 185- loop from N to N44. -c -c --- Modified by E. Insley & J. Scire; 940331; SRC -c - When using the LVARY option, change the variables dealing with -c the closest station to a grid cell into arrays over levels -c (i.e., RS2(mxnz) & NRS2(mxnz)) and only use a station as the -c closest station if it has valid (non-missing) data. -c --- Modified to use RMAX3 over water cells in 160 loop. -c -c --- Modified by M. Fernau, 941101; ETCO -c --- Can handle MM4 only; no upper air NWS data -c -c --- Modified by M. Fernau (2/99) to handle arbitrary coordinates correctly -c -C -C --- INPUTS: -c STDAT1 (R ARRAY) - WIND COMPONENT STATION DATA -C NST (I) - NUMBER OF STATIONS -C XST (R ARRAY) - LOCAL X-COORDINATES OF STATIONS -C YST (R ARRAY) - LOCAL Y-COORDINATES OF STATIONS -C RMIN (R) - MINIMUM RADIUS OF INFLUENCE -C RMAX1 (R) - MAXIMUM RADIUS OF INFLUENCE OVER -C LAND IN THE SURFACE LAYER -C RMAX2 (R) - MAXIMUM RADIUS OF INFLUENCE OVER -C LAND IN UPPER LAYERS -C RMAX3 (R) - MAXIMUM RADIUS OF INFLUENCE OVER -C WATER -C R1 (R) - WEIGHTING PARAMETER FOR SURFACE -C LAYER -C R2 (R) - WEIGHTING PARAMETER FOR UPPER -C LAYERS -C FGFLD (R ARRAY) - DIAGNOSTIC WIND FIELD -C ilandu (I ARRAY) - GRIDDED SURFACE TYPE INDICATORS -C UTMXOR (R) - DIAGNOSTIC WIND MODEL X COORD OF ORIGIN (KM) -C UTMYOR (R) - DIAGNOSTIC WIND MODEL Y COORD OF ORIGIN (KM) -C IPROG (I) - FLAG FOR USING PROGNOSTIC WIND FIELDS -C PDAT (R ARRAY) - GRIDDED PROGNOSTIC MODEL WINDS ON -C HORIZONTAL PROGNOSTIC GRID -C XMAP0,YMAP0 - REAL SPACE COORDINATES OF GRID ORIGIN (KM) -C (FROM GRID.MET) -C -c Parameters: MXNX, MXNY, MXNZ, MXNZP1, MXSS, MXUS, MXWND, IO6 -C -C --- OUTPUTS: -c FIELD1 (R ARRAY) - INTERPOLATED WIND COMPONENT -C ARRAY -C -c --- INTER2 called by: DIAGNO -c --- INTER2 calls : XMIT,BARIER,FMINF -c -c ---------------------------------------------------------------------- - -c --- include parameters - - include 'params.met' -c --- Relative weighting between obs and MM4 (wo(i,j,k)): - include 'wtgrd.met' - include 'wparm.met' - - logical lland - - include 'grid.met' - include 'mm4hdo.met' -c need kbar and pass nbar through common (050101) - include 'd3.met' - include 'd4.met' - include 'd6.met' - - - DIMENSION STDAT1(mxnz,*), XST(*), YST(*), RS(*), - 1 IS(*), WORK(*), FIELD1(mxnx,mxny,*), JS(mxwnd), - 2 FGFLD(mxnx,mxny,*), FIELD2(mxnx,mxny,mxnz),NINTRP(*), - 3 ilandu(mxnx,mxny), - 4 FIELD3(mxnx,mxny,mxnz), FIELD4(mxnx,mxny,mxnz), - 5 PDAT(mxnxp,mxnyp,mxnz),RSQM(4), - 6 IJOUT(4,mxnz) -c --- IJOUT: level dependent as barriers are level dependent (050101) - -c --- level and station dependent barrier flag (050101) - real okk(mxnz,mxwnd) -c -c --- Declare closest station arrays - real rs2(mxnz) - integer nrs2(mxnz) -c --- - DOUBLE PRECISION WT - double precision wt2,wt3 -C - DATA ZERO/0./ - DATA one/1./ - DATA npts/4/ -C - -C INITIALIZE FIELD2 ARRAY -C - N = mxnx * mxny * mxnz - CALL XMIT(-N,ZERO,FIELD2) -C - if(iprog.EQ.5 .or. iprog.eq.15)then -c --- Initialize field3 & field4 arrays (sum arrays for prognostic -c --- data as observations) - call xmit(-N,ZERO,FIELD3) - call xmit(-N,ZERO,FIELD4) - endif -c -C CONVERT GRID SPACING TO KM -C - DXK=DX*0.001 - DYK=DY*0.001 - rminsq = rmin * rmin -C -C DETERMINE RMAX -C - RMAX = AMAX1(RMAX1,RMAX2) - RMAX = AMAX1(RMAX,RMAX3) -C - DO 200 J=1,NY - DO 200 I=1,NX -c -c *** Initialize closest station arrays -c --- (if using variable radius of influence option) - if(LVARY)then - do 210 k=1,nz - rs2(k) = 9.9e9 - nrs2(k)= 0 -210 continue - endif -c *** -c --- set LLAND = .true. if land use category is not water - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2)then - lland=.false. - else - lland=.true. - endif -c -c (x,y) = CALMET grid point relative to CALMET origin - X = (float(I)-0.5)*DXK - Y = (float(J)-0.5)*DYK - CALL XMIT(-NST,EDIT,RS) - -c --- initialize level and station dependent barrier flags: - ok=1 - call xmit(-mxnz*mxwnd,1.,okk) - - DO 120 L=1,NST - IF(NBAR.LE.0) GO TO 90 -C -C CHECK FOR BARRIERS TO INTERPOLATION -C - CALL BARIER(X,Y,XST(L),YST(L),OK) - -c --- vertical extent of barriers (050101) - IF(OK.LE.0. ) then - do k=1,kbar - okk(k,l)=-1. - end do - if (kbar.eq.nz) GO TO 115 - endif - -C SKIP STATION IF NO DATA AT ANY ELEVATION -C - 90 DO 100 K=1,NZ - IF(STDAT1(K,L).LT.EDITL) GO TO 110 - 100 CONTINUE - GO TO 115 -C -C COMPUTE DISTANCE TO STATIONS LESS THAN RMAX AWAY -C - 110 RSX = X - XST(L) - RSY = Y - YST(L) - RS(L) = RSX**2 + RSY**2 - RS(L) = SQRT(RS(L)) -c -c *** Loop over levels to find closest station with valid data -c *** (done independently for EACH layer) -c --- add check for barriers (050101) - - if(LVARY)then - do 111 k=1,nz - if (ok.gt.0 .or. k.gt.kbar) then - if(stdat1(k,L).LT.editl)then - if(rs(L).lt.rs2(k))then - rs2(k)=rs(L) - nrs2(k)=L - endif - endif - endif -111 continue - endif -c *** - IF(RS(L).LT.RMIN) RS(L)=RMIN - IF(RS(L) .LE. RMAX) GO TO 115 - RS(L) = EDIT - 115 CONTINUE - 120 CONTINUE -c -c *** Check to make sure there is valid data from at least one station, -c *** when using LVARY option -- if not write message and stop -c *** program - if(LVARY)then - do 121 k=1,nz - if(nrs2(k).EQ.0)then - if (k .eq. 1 .or. noobs .eq. 0) then -c -c --- It's OK if there are no upper air observations if MM4 data are -c --- being used... -c Note that if noobs=2 (no sf or upper air data, the program skips -c this subroutine) i.e. noobs mode here means noobs=1 - write(io6,2063) i,j,k - stop - end if - endif -121 continue - endif -c *** -c -C ORDER STATIONS -C -c... First initialize arrays IS and JS - DO 122 NN = 1,NST - IS(NN) = IEDIT - js(nn) = iedit - 122 CONTINUE -c - CALL XMIT(NST,RS,WORK) - N = 0 - DO 130 L = 1,NST - CALL FMINF(WORK,NST,FMIN,NMIN) - WORK(NMIN) = EDIT + L - IS(L) = NMIN - IF(FMIN.GT.EDITL) GO TO 150 - N = N + 1 - 130 CONTINUE - 150 CONTINUE - - if(iprog.EQ.5 .or. iprog.eq.15) then -c -c --- Initialize ijout array (flag for using the prognostic grid -c --- data at that point in the interpolation; 0=do not use,1=use) - call xmit(-npts,one,ijout) -c -c --- Initialize rm array (distances from prognostic grid point to -c --- diagnostic grid point) - call xmit(-npts,zero,rsqm) -c -c *** New code -c -c --- Get absolute x/y of CALMET point -c *** xcm = x + utmxor -c *** ycm = y + utmyor -c --- Compute CALMET grid coordinates in real space coordinates - xcm = x + xmap0 - ycm = y + ymap0 -c - do 135 n44 = 1,npts -c -c --- Get MM4 coordinates relative to CALMET origin -c --- (XLCMM4,YLCMM4 are in real space coordinates) -c *** xpc = xlcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - utmxor -c *** ypc = ylcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - utmyor - xpc = xlcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - xmap0 - ypc = ylcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - ymap0 -c -c --- Check for barriers to interpolation -c --- Check for barriers to interpolation of MM4/5 data - ok=1. - if (nbar.le.0) goto 91 - - call barier(x,y,xpc,ypc,ok) - if(ok.LE.0.0) then - do k=1,kbar - ijout(n44,k) = 0 - end do -c --- skip only if barriers up to the top (050101) - if(kbar.eq.nz) go to 135 - endif -c -91 continue -c -c --- Calculate distance from MM4 grid point to diagnostic grid point - rsqm(n44) = (xlcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - xcm) - & ** 2. + - & (ylcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - ycm) ** 2. - rsqm(n44) = AMAX1(rsqm(n44),rminsq) -135 continue - endif -c - DO 190 K=1,NZ -c -c...skip observations from NWS if only using MM4 data -c frr(020511): ok to use vertically extrapolated surface winds if noobs=1 -c FRR (09/2001) additional option for noobs -c if (k .gt. 1 .and. noobs .eq. 1) goto 181 -c if (k .gt. 1 .and. noobs .ge. 1) goto 181 - if (k .gt. 1 .and. noobs .ge. 1 .and. abs(iextrp).eq.1) goto 181 -C -C FIND STATIONS WITH DATA FOR THIS LEVEL -C - IF (K .EQ. 1 ) THEN - R = R1 - ELSE - R = R2 - ENDIF - wt2 = (1-wo(i,j,k))/R**2 -c -c --- Determine the closest NINTRP stations which are within radius -c --- of influence, are not blocked by barriers and which have valid data - NK = 0 - if(n.eq.0)go to 161 - DO 160 M=1,N - L=IS(M) -c --- skip station if no valid data at that level - IF(STDAT1(K,L).GT.EDITL) GO TO 160 -c --- skip station if blocked by barrier at that level - if(okk(k,l).lt.0.) go to 160 - - if(lland)then -c -c --- Land cells - if(k.eq.1)then -c -c --- Surface layer over land - if(rs(L).gt.rmax1)go to 160 - else -c -c --- Layers aloft over land - if(rs(L).gt.rmax2)go to 160 - endif - else -c -c --- Water cells - if(rs(L).gt.rmax3)go to 160 - endif - NK = NK + 1 - JS(NK) = IS(M) - IF(NK.EQ.NINTRP(K)) GO TO 165 -160 CONTINUE -161 continue - - IF (NK .GT. 0) GO TO 165 -c -c --- If using LVARY option, and no stations with valid data are within -c --- RMAX, use closest station - if (LVARY) then - nk = 1 - js(nk)=nrs2(k) - L=nrs2(k) - rs(L)=rs2(k) - if(rs(L).lt.rmin)rs(L)=rmin - goto 165 - endif -c -c FRR (12/16/96): next section commented - No special treatment of water -c if (lland) go to 165 -c if(iwr.gt.0)WRITE(IWR,2065) I,J,K -c WRITE(io6,2065) I,J,K -c STOP - - 165 CONTINUE - -C -C FIND THE INTERPOLATION WEIGHTING FACTOR FOR EACH VALID STATION -C - if(nk.EQ.0) go to 181 - DO 180 M = 1,NK - L=JS(M) - IF(STDAT1(K,L) .GT. EDITL) GO TO 180 -c --- Compute weighting factors ( wt is for sfc obs, wt3 is for Step 1 field -c** WT = 1./(RS(L)**2) - wt = wo(i,j,k)/(RS(L)**2) -c -C -C APPLY WEIGHTING FACTOR -C - FIELD1(I,J,K) = FIELD1(I,J,K) + STDAT1(K,L)*WT - FIELD2(I,J,K) = FIELD2(I,J,K) + WT - - - 180 CONTINUE -181 continue -c - if(iprog.EQ.5 .or. iprog.eq.15) then -c --- Compute weighting factor for prognostic data used as observations -c --- Compute weighted sums - do 185 n44=1,npts - if(ijout(n44,k).EQ.1) then - wt2 = (1-wo(i,j,k))/rsqm(n44) - field3(i,j,k) = field3(i,j,k) + - & pdat(igrab(i,j,n44),jgrab(i,j,n44),k)*wt2 -c *** - field4(i,j,k) = field4(i,j,k) * wt2 - endif -185 continue - endif -c -c *** IF (LNDWTR(I,J) .EQ. 1) THEN -c** IF (lland) THEN -c** FIELD1(I,J,K) = (FIELD1(I,J,K) + FGFLD(I,J,K)/R**2)/ -c** 1 (FIELD2(I,J,K) + 1./R**2) -c** FIELD1(I,J,K) = (FIELD1(I,J,K) + FGFLD(I,J,K)*wt2)/ -c** 1 (FIELD2(I,J,K) + wt2) -c** ELSE -c** if(field2(i,j,k).eq.0.)then -c** write(io6,*)'ERROR in SUBR. INTER2 -- WATER CELL -- ', -c** 1 ' FIELD2 = 0.0 -- I,J,K = ',i,j,k -c** stop -c** endif -c** FIELD1(I,J,K) = FIELD1(I,J,K)/FIELD2(I,J,K) -c** ENDIF -c -c --- Compute weighting factor (wt3 is for Step 1 field) - wt3 = 1./(R**2) -c - if(iprog.EQ.0) then -c FRR (12/16/96): No distinction between water and land -c if(lland) then - field1(i,j,k) = (field1(i,j,k) + fgfld(i,j,k) * wt3)/ - 1 (field2(i,j,k) + wt3) -c else -c if(field2(i,j,k).eq.0.)then -c write(io6,*)'ERROR in SUBR. INTER2 -- WATER CELL -- ', -c 1 ' FIELD2 = 0.0 -- I,J,K = ',i,j,k -c stop -c endif -c field1(i,j,k) = field1(i,j,k)/field2(i,j,k) -c endif - else if(iprog.EQ.2 .OR. iprog.EQ.4 .OR. iprog.eq.14) then -c --- If using noobs, then levels 2 to nz will just be the MM4-based -c step 1 field (field 1 and field 2 = 0) - - field1(i,j,k) = (field1(i,j,k) + fgfld(i,j,k) * wt3)/ - 1 (field2(i,j,k) + wt3) - - - else if(iprog.EQ.5 .OR. iprog.eq.15) then - if(lland) then -c --- If using noobs, at levels 2 to nz field 1 and field 2 = 0; -c first-guess field will be specified in DIAG.DAT - field1(i,j,k) = (field1(i,j,k) + field3(i,j,k) + - 1 fgfld(i,j,k) * wt3)/ - 2 (field2(i,j,k) + field4(i,j,k) + wt3) - else -c --- If using noobs, then levels 2 to nz will just be the MM4 "obs" -c (field 1 and field 2 = 0) - field1(i,j,k) = (field1(i,j,k) + field3(i,j,k))/ - 1 (field2(i,j,k) + field4(i,j,k)) - endif - else - write(io6,*) 'ERROR in Subr. INTER2 - Invalid value of IPROG; ' - 1 ,' IPROG = ',iprog - stop - endif - 190 CONTINUE - 200 CONTINUE - RETURN -2063 format(' JOB ABORTED--THERE ARE NO STATIONS WITH VALID DATA FOR ', - 1 'I = ',i4,' J = ',i4,' K = ',i4,' IN SUBR. INTER2') -2065 FORMAT(' JOB ABORTED -- THERE ARE NO CLOSE STATIONS FOR', - 1 ' I = ',I4,' J = ',I4,' K = ',I4,' IN SUBR. INTER2') - END -c---------------------------------------------------------------------- - subroutine interb(sdat,gdat,dp,nlbs,dg,gridsign,statsign) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 950531 INTERb -c R. MENTZER, SRC -c --- Modified by M. Fernau -c -c PURPOSE: To interpolate the obs. data in the lake breeze region -c to the CALMET grid -c -C INPUTS: SDAT (R ARRAY) - station obs data -c DP (R ARRAY) - distance from stations to the shore -c DG (R) - distance from grid point to the shore -c nlbs - number of stations in the region -c gridsign (R) - vertical distance from grid cell to shore -c statsign (R array) -c - vertical distance from stations to shore -C -c OUTPUTS: GDAT -- Gridded station data -c -c INTERb CALLED BY: LLBREEZ -c -c INTER CALLS: NONE -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' - DIMENSION SDAT(mxwnd),dp(mxwnd),statsign(mxwnd) - double precision dpr,wt(mxwnd),bot - bot = 0.000000 - top = 0.000000 - do 170 l = 1,nlbs -c get the weighting factor for each station - if (statsign(l) * gridsign .ge. 0.) then -c...same side of shore - dpr = dp(l) - dg - else -c...opposite sides of shore - dpr = dp(l) + dg - end if - dpr = dmax1(dabs(dpr),1.d-10) - wt(l) = 1. / (dpr**2) -170 continue -C -C APPLY WEIGHTING FACTOR -c - gdat = 999. - ngood = 0 - do 180 l = 1,nlbs -c...omit missing data - if (sdat(l) .lt. 990.) then - top=top + (sdat(l) * wt(l)) - bot=bot + wt(l) - ngood = ngood + 1 - end if -180 CONTINUE - if (ngood .gt. 0) gdat = top / bot - RETURN - END -c---------------------------------------------------------------------- - subroutine interp(stdat1,nst,xst,yst,rmin,rmax,lvary, - 1 nintrp,rs,is,work,field1,iprog,rprog,prog, - 2 pdat,noobs) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 INTERP -c S.DOUGLAS, SAI -c -c -c --- PURPOSE: COMPUTES 3-D WIND FIELD FROM STATION DATA -C BY THE ERT INTERPOLATION SCHEME -c -c --- UPDATES: -c --- V5.55(050217) to V5.6 (050328) (FRR) -c - Explicit D4/D6 common replaced by include -c -c --- V5.548a (050101) to V5.55 (FRR) -c - IFlag removed from calling list (=nbar, which is passed via -c common d3.met) -c - call barier only if nbar>0 -c -c --- V5.5 (030402) to V5.548a (050101) (FRR) -c - Implemented vertical limitation (KBAR) to barriers -c - shift initial comments and declarations to fit conventions -c (purposes, updates, inputs, output, declarations, include) -c --- V5.4 (990228) to V5.5 (030402) (DGS) -c - Change documentation: coordinates may be other than -c UTM or LLC -c -c --- Modified to allow gridded MM4 prognostic winds to be treated as -c observations EMI 920925 -c -c --- Modified by Ed Chang & Liz Insley; 940309; SRC -c - Add comment at various places to explain the code -c - Initialize JS array with constant IEDIT (=999) in 121-loop -c - Changed from 'NST=1' to 'N=1' in logical 'LVARY'-block after -c statement-140 -c - Changed upper limit of 160-loop from NST TO N. -c - Changed loop index of 135- and 185- loop from N to N44. -c - Re-activate the IF-check after 160-loop -c -c --- Modified by E. Insley & J. Scire; 940331; SRC -c - When using the LVARY option, change the variables dealing with -c the closest station to a grid cell into arrays over levels -c (i.e., RS2(mxnz) & NRS2(mxnz)) and only use a station as the -c closest station if it has valid (non-missing) data. -c -c --- Modified by M. Fernau, 941101; ETCO -c - Can handle MM4 only; no upper air NWS data -c -c -- Modified by M. Fernau (2/99) to handle arbitrary coordinates correctly -c -C -C -C --- INPUTS: -c STDAT1 (R ARRAY) - WIND COMPONENT STATION DATA -C NST (I) - NUMBER OF STATIONS -C XST (R ARRAY) - LOCAL X-COORDINATES OF STATIONS -C YST (R ARRAY) - LOCAL Y-COORDINATES OF STATIONS -C RMIN (R) - MINIMUM RADIUS OF INFLUENCE -C RMAX (R) - MAXIMUM RADIUS OF INFLUENCE -C NINTRP(I) - NO. OF STATIONS USED IN THE -C INTERPOLATION TO A GRID POINT -C IPROG (I) - FLAG FOR USING PROGNOSTIC WIND FIELDS -C RPROG (R) - WEIGHTING PARAMETER FOR PROGNOSTIC -C WIND FIELDS -C PROG (R ARRAY) - GRIDDED PROGNOSTIC MODEL WINDS -c INTERPOLATED TO DIAGNOSTIC GRID -C UTMXOR (R) - DIAGNOSTIC WIND MODEL X COORD OF ORIGIN (KM) -C UTMYOR (R) - DIAGNOSTIC WIND MODEL Y COORD OF ORIGIN (KM) -C PDAT (R ARRAY) - GRIDDED PROGNOSTIC MODEL WINDS ON -C HORIZONTAL PROGNOSTIC GRID -c INTERPOLATED TO DIAGNOSTIC MODEL LEVELS -c NOOBS - FLAG FOR MM5 REPLACING OBSERVATIONS -c = 1: use sf obs and MM5 aloft -c = 2: use MM5 at the sf and aloft -c -C XMAP0,YMAP0 - REAL SPACE COORDINATES OF GRID ORIGIN (KM) -C (FROM GRID.MET) -c Parameters: MXNX, MXNY, MXNZ, MXNZP1, MXSS, MXUS, MXWND, IO6 -C -C OUTPUTS: -c FIELD1 (R ARRAY) - INTERPOLATED WIND COMPONENT ARRAY -c -c --- INTERP called by: DIAGNO -c --- INTERP calls: XMIT,BARRIER,FMINF -c ---------------------------------------------------------------------- - -c --- include parameters - include 'params.met' - include 'wtgrd.met' -c - include 'grid.met' - include 'mm4hdo.met' - include 'd3.met' - - COMMON /D4/ EDIT,EDITL,IEDIT,IEDITL - COMMON /D6/ IRD,IWR,IFILE,IRDP - - DIMENSION STDAT1(mxnz,*), XST(*), YST(*), RS(*), - 1 IS(*), WORK(*), FIELD1(mxnx,mxny,*), JS(mxwnd), NINTRP(*), - 2 PROG(mxnx,mxny,*), FIELD2(mxnx,mxny,mxnz), - 3 FIELD3(mxnx,mxny,mxnz), FIELD4(mxnx,mxny,mxnz), - 4 PDAT(mxnxp,mxnyp,mxnz),RSQM(4), - 5 IJOUT(4,mxnz) -c -c --- Level and station dependent barrier flags - real okk(mxnz,mxwnd) - -c *** Declare closest station arrays - real rs2(mxnz) - integer nrs2(mxnz) -c *** - DOUBLE PRECISION WT - double precision wt2,wt3 -c - LOGICAL LVARY -C - DATA ZERO/0./ - DATA npts/4/ -C -C INITIALIZE FIELD2 ARRAY -C - N = mxnx * mxny * mxnz - CALL XMIT(-N,ZERO,FIELD2) -c - if(iprog.EQ.5 .OR. iprog.eq.15)then -c --- Initialize field3 & field4 arrays (sum arrays for prognostic -c --- data as observations) - call xmit(-N,ZERO,FIELD3) - call xmit(-N,ZERO,FIELD4) - endif -C -C CONVERT GRID SPACING TO KM -C - DXK=DX*0.001 - DYK=DY*0.001 - rminsq = rmin * rmin -C - DO 200 J=1,NY - DO 200 I=1,NX -c -c *** Initialize closest station arrays -c --- (if using variable radius of influence option) - if(LVARY)then - do 210 k=1,nz - rs2(k) = 9.9e9 - nrs2(k)= 0 -210 continue - endif -c *** -c (x,y) = CALMET grid point relative to CALMET origin - X = (float(I)-0.5)*DXK - Y = (float(J)-0.5)*DYK - CALL XMIT(-NST,EDIT,RS) - DO 120 L=1,NST -c IF(NBAR.LE.0) GO TO 90 -C -C CHECK FOR BARRIERS TO INTERPOLATION - -c --- initialize level and station dependent barrier flags: - call xmit(-mxnz*mxwnd,1.,okk) - ok=1. - - if (nbar.le.0) goto 90 - -C - CALL BARIER(X,Y,XST(L),YST(L),OK) - - -c --- vertical extent of barriers (050101) -c IF(OK.LE.0.) GO TO 115 - IF(OK.LE.0. ) then - do k=1,kbar - okk(k,l)=-1 - end do - if (kbar.eq.nz) GO TO 115 - endif -C -C -C SKIP STATION IF NO DATA AT ANY ELEVATION -C - 90 DO 100 K=1,NZ - IF(STDAT1(K,L).LT.EDITL) GO TO 110 - 100 CONTINUE - GO TO 115 -c -c --- COMPUTE DISTANCE TO STATIONS LESS THAN RMAX AWAY -c --- RS2(mxnz): Distance of closest station with valid data to -c present grid cell (whose coordinate is (X,Y)) -c --- NRS2(mxnz): Station number of the closest station. - 110 RSX = X - XST(L) - RSY = Y - YST(L) - RS(L) = RSX**2 + RSY**2 - RS(L) = SQRT(RS(L)) -c -c *** Loop over levels to find closest station with valid data -c *** (done independently for EACH layer) -c --- add check for barriers (050101) - if(LVARY)then - do 111 k=1,nz - if (ok.gt.0 .or. k.gt.kbar) then - if(stdat1(k,L).LT.editl)then - if(rs(L).lt.rs2(k))then - rs2(k)=rs(L) - nrs2(k)=L - endif - endif - endif -111 continue - endif -c *** -c - IF(RS(L).LT.RMIN) RS(L)=RMIN - IF(RS(L) .LE. RMAX) GO TO 115 - RS(L) = EDIT - 115 CONTINUE - 120 CONTINUE -c -c *** Check to make sure there is valid data from at least one station, -c *** when using LVARY option -- if not write message and stop -c *** program - if(LVARY)then - do 121 k=1,nz - if(nrs2(k).EQ.0)then - -c frr (09/01)if ( k .eq. 1 .or. noobs .eq. 0) then - if ( (k .eq. 1 .and. noobs.ne.2) .or. noobs .eq. 0) then -c --- It's OK if there are no observations if MM5 are used (NOOBS=1,2) - write(io6,2063) i,j,k - stop - end if - endif -121 continue - endif -c *** -C -C ORDER STATIONS -C -c... First initialize arrays IS and JS - DO 122 NN = 1,NST - IS(NN)=IEDIT - js(nn)=iedit - 122 CONTINUE -c - CALL XMIT(NST,RS,WORK) -c -c... Loop-130 is to put station sequence in near-to-far order. Once -c... a station is chosen, its distance value to the present grid cell -c... in the WORK array is added to 999.0 so that you will not pick up -c... that same station next round! - N = 0 - DO 130 L = 1,NST - CALL FMINF(WORK,NST,FMIN,NMIN) - WORK(NMIN) = EDIT + L - IS(L) = NMIN - IF(FMIN.GT.EDITL) GO TO 140 - N = N + 1 - 130 CONTINUE -c - 140 IF (N .GT. 0 .OR. IPROG .GE. 1) GO TO 150 -c -c... LVARY =.true. means use a variable radius of influence so that if no -c... stations were found within the radius of influence, N=0, the closest -c... station to the grid point will be used (even though it is outside the -c... radius of influence). - if (LVARY)go to 150 -c -c... Fail the model only when no stations are within RMAX, -c... LVARY=.false., and IPROG = 0 - 145 if(iwr.gt.0)WRITE(IWR,2064) I,J - WRITE(io6,2064) I,J - STOP -c - 150 CONTINUE -c - if(iprog.EQ.5 .OR. iprog.eq.15) then -c -c --- Initialize ijout array (flag for using the prognostic grid -c --- data at that point in the interpolation; 0=do not use,1=use) -c do 125 m=1,npts -c ijout(m) = 1 -c125 continue - call xmit (-npts*mxnz,1,ijout) -c -c --- Initialize rm array (distances from prognostic grid point to -c --- diagnostic grid point) - call xmit(-npts,zero,rsqm) -c -c *** New code -c -c --- Get absolute x/y of CALMET point -c *** xcm = x + utmxor -c *** ycm = y + utmyor -c --- Compute CALMET grid coordinates in real space coordinates - xcm = x + xmap0 - ycm = y + ymap0 -c - do 135 n44 = 1,npts -c -c --- Get MM4 coordinates relative to CALMET origin -c --- (XLCMM4,YLCMM4 are in real space coordinates) -c *** xpc = xlcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - utmxor -c *** ypc = ylcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - utmyor - xpc = xlcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - xmap0 - ypc = ylcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - ymap0 -c -c --- Check for barriers to interpolation of MM4/MM5/3D.DAT - ok=1. - if (nbar.le.0) goto 91 - - call barier(x,y,xpc,ypc,ok) - if(ok.LE.0.0) then - do k=1,kbar - ijout(n44,k) = 0 - end do -c --- skip only if barriers up to the top (050101) - if(kbar.eq.nz) go to 135 - endif -c -91 continue - -c --- Calculate distance from MM4 grid point to diagnostic grid point - rsqm(n44) = (xlcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - xcm) - & ** 2. + - & (ylcmm4(igrab(i,j,n44),jgrab(i,j,n44)) - ycm) ** 2. - rsqm(n44) = AMAX1(rsqm(n44),rminsq) - 135 continue - endif - -c --- END OF IPROG=5,15 computations - -C - DO 190 K=1,NZ -c -c...skip observations from NWS if only using MM4 data -c frr (09/01) noobs=1,2 -c if (k .gt. 1 .and. noobs .eq. 1) goto 181 - if ( (noobs.eq.2) .or. ( k.gt.1 .and. noobs.eq.1) ) goto 181 -C -C... Identify closest NINTRP stations which are within RMAX and which -c... have valid data - NK = 0 - if(n.eq.0)go to 161 - do 160 M=1,n - L=IS(M) - IF(STDAT1(K,L).GT.EDITL) GO TO 160 - IF (RS(L) .GT. RMAX) GO TO 160 - NK = NK + 1 - JS(NK) = IS(M) - IF (NK .EQ. NINTRP(K)) GO TO 165 -160 CONTINUE -161 continue -c - IF(NK .GT. 0 .OR. IPROG .GE. 1) GO TO 165 -c -c --- If using LVARY option, and no stations with valid data are within -c --- RMAX, use closest station - if (LVARY) then - nk = 1 - js(nk)=nrs2(k) - L=nrs2(k) - rs(L)=rs2(k) - if(rs(L).lt.rmin)rs(L)=rmin - goto 165 - endif - if(iwr.gt.0)WRITE(IWR,2065) I,J,K - WRITE(io6,2065) I,J,K - STOP - 165 CONTINUE -C -C FIND THE INTERPOLATION WEIGHTING FACTOR FOR EACH VALID STATION -C - if(nk.EQ.0)go to 181 - DO 180 M = 1,NK - L=JS(M) - IF(STDAT1(K,L) .GT. EDITL) GO TO 180 -c --- Compute weighting factor ( wt is for sfc obs, wt3 is for prognostic -c --- data as Step 1 Field) -c ** WT = 1./RS(L)**2 -c - wt = wo(i,j,k)/RS(L)**2 -C -C APPLY WEIGHTING FACTOR -C - FIELD1(I,J,K) = FIELD1(I,J,K) + STDAT1(K,L)*WT - FIELD2(I,J,K) = FIELD2(I,J,K) + WT - 180 CONTINUE -181 continue -c - if(iprog.EQ.5 .OR. iprog.eq.15) then -c --- Compute weighting factor for prognostic data used as observations -c --- Compute weighted sums - do 185 n44=1,npts - if(ijout(n44,k).EQ.1) then - wt2 = (1.0-wo(i,j,k))/rsqm(n44) - field3(i,j,k) = field3(i,j,k) + - & pdat(igrab(i,j,n44),jgrab(i,j,n44),k)*wt2 -c *** - field4(i,j,k) = field4(i,j,k) + wt2 - endif -185 continue - endif -c -c ** IF (IPROG .GE. 1) THEN -c ** FIELD1(I,J,K) = (FIELD1(I,J,K) + PROG(I,J,K)/RPROG**2)/ -c ** 1 (FIELD2(I,J,K) + 1./RPROG**2) -c ** ELSE -c ** FIELD1(I,J,K) = FIELD1(I,J,K)/FIELD2(I,J,K) -c ** ENDIF - if(iprog.EQ.0) then - if(field2(i,j,k).eq.0.)then - write(io6,*)'ERROR in SUBR. INTERP -- ', - 1 ' FIELD2 = 0.0 -- I,J,K = ',i,j,k - stop - endif - field1(i,j,k) = field1(i,j,k)/field2(i,j,k) - else if(iprog.EQ.1 .OR. iprog.EQ.3 .OR. iprog.eq.13) then -c --- Compute weighting factor (wt3 is for prognostic data as Step 1 Field) - wt3 = (1-wo(i,j,k))/rprog**2 -c --- If using noobs=1(2), then levels 2(1) to nz will just be the step 1 field -c (field 1 and field 2 = 0) - field1(i,j,k) = (field1(i,j,k) + prog(i,j,k) * wt3)/ - 1 (field2(i,j,k) + wt3) - else if(iprog.EQ.5 .OR. iprog.eq.15) then -c --- If using noobs=1(2), then levels 2(1) to nz will just be the MM4 "obs" -c (field 1 and field 2 = 0) - field1(i,j,k) = (field1(i,j,k) + field3(i,j,k))/ - 1 (field2(i,j,k) + field4(i,j,k)) - else - write(io6,*) 'ERROR in Subr. INTERP - Invalid value of IPROG; ' - 1 ,' IPROG = ',iprog - stop - endif - 190 CONTINUE - 200 CONTINUE - 2063 format('JOB ABORTED--THERE ARE NO STATIONS WITH VALID DATA FOR ', - 1 'I = ',i4,' J = ',i4,' K = ',i4,' IN SUBR. INTERP') - 2064 FORMAT('JOB ABORTED--THERE ARE NO CLOSE STATIONS FOR I = ', - 1 I4,' J = ',I4,' IN SUBR. INTERP') - 2065 FORMAT('JOB ABORTED--THERE ARE NO CLOSE STATIONS FOR I = ', - 1 I4,' J = ',I4,' K = ',I4,' IN SUBR. INTERP') - RETURN - END -c---------------------------------------------------------------------- - subroutine intp(xparm,zl,nl,ius,z,xmissm,xint) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 970825 INTP -c --- J. Scire, SRC -c Modified to check for sounding layers at same height & -c verify lower height is below Z (J. Scire, 8/97) -c -c --- PURPOSE: Interpolate an upper air parameter to height "z" -c -c --- INPUTS: -c -c XPARM(mxus,mxlev) - real array - Upper air parameter to interpolate -c ZL(mxus,mxlev) - real array - Height (m) of observations -c NL - integer - Number of levels -c IUS - integer - Station number of the upper air -c sounding to interpolate -c Z - real - Height (m) to interpolate -c XMISSM - real - Missing value indicator for the -c upper air parameter -c Parameters: MXUS, MXLEV, IO6 -c -c --- OUTPUT: -c XINT - real - Interpolated value of XPARM at -c height Z -c -c --- INTP called by: CGAMMA, FACET -c --- INTP calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real xparm(mxus,mxlev),zl(mxus,mxlev) -c -c --- Find the first level at or just above Z with valid data - do 10 j=2,nl - if(zl(ius,j).ge.z.and.xparm(ius,j).lt.xmissm)then - nbp=j - go to 20 - endif -10 continue -c -c --- Sounding does not go high enough - write(io6,15)z,nl,zl(ius,nl) -15 format(//1x,'ERROR IN SUBR. INTP -- interpolation height is ', - 1 'above top sounding level'//5x,'Height = ',f10.1,5x, - 2 'No. sounding levels = ',i5,5x,'Top sounding height = ',f10.1) - stop -c -c --- Find the next lowest layer with valid data -20 continue - nbpm1=nbp-1 - do 22 j=nbpm1,1,-1 - if(xparm(ius,j).lt.xmissm)then - nbm=j - go to 28 - endif -22 continue -c -c --- Bottom of sounding is missing - write(io6,27)nl,zl(ius,1),xparm(ius,1) -27 format(//1x,'ERROR IN SUBR. INTP -- bottom level of sounding ', - 1 'is missing'//5x,'No. sounding levels = ',i5,5x, - 2 'Bottom sounding height = ',f10.1,'Value = ',f10.2) - stop -c -28 continue -c --- Check that layer "NBM" is at or below height "Z" - if(zl(ius,nbm).gt.z)then - write(io6,29) -29 format(//1x,'ERROR IN SUBR. INTP -- Sounding below height Z ', - 1 'is missing') - write(io6,*)'NL = ',nl,' IUS = ',ius,' Z = ',z - write(io6,*)'ZL = ',(zl(ius,n),n=1,nl) - write(io6,*)'XPARM = ',(xparm(ius,n),n=1,nl) - endif -c -c --- Compute delta Z of layer containing height "Z" - dz=zl(ius,nbp)-zl(ius,nbm) -c -c --- Check for possible identical layer heights - if(abs(dz).lt.1.e-5)then -c --- Identical layer heights -- average two values - xint=0.5*(xparm(ius,nbp)+xparm(ius,nbm)) - else -c --- Interpolate parameter to height Z - rat=(zl(ius,nbp)-z)/dz - xint=xparm(ius,nbp)-(xparm(ius,nbp)-xparm(ius,nbm))*rat - endif -c - return - end -c---------------------------------------------------------------------- - subroutine ireplac(dist2,nsta,iarr,imiss,ideflt,ivalue) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 IREPLAC -c --- J. Scire, SRC -c -c --- PURPOSE: Replace the missing value of an INTEGER variable with -c the value from the closest station with valid data -- -c If all values are missing, set variable equal to the -c default value (IDEFLT) -c -c --- INPUTS: -c DIST2(nsta) - real - Distance**2 from each station to the -c current station with missing data -c NSTA - integer - Number of stations -c IARR(nsta) - integer - Array of values at each station -c IMISS - integer - Missing value indicator -c IDEFLT - integer - Default value to be returned if all values -c are missing -c -c --- OUTPUT: -c IVALUE - integer - Value of the variable to be used in -c replacement of the missing value -c NOTE: if all values are missing, -c IVALUE is set equal to IDEFLT -c -c --- IREPLAC called by: MISSFC -c --- IREPLAC calls: none -c---------------------------------------------------------------------- -c - real dist2(nsta) - integer iarr(nsta) -c - data xmax/1.e38/ -c - dmin2=xmax - ista=0 -c -c --- Loop over stations - do 10 i=1,nsta -c -c --- Find the closest non-missing value - if(iarr(i).lt.imiss)then -c - if(dist2(i).lt.dmin2)then - dmin2=dist2(i) - ista=i - endif - endif -10 continue -c -c --- Return the appropriate value - if(ista.ge.1)then -c -c --- At least one station with non-missing data - ivalue=iarr(ista) - else -c -c --- All values missing -- use default value - ivalue=ideflt - endif -c - return - end -c---------------------------------------------------------------------- - subroutine llbreez -c---------------------------------------------------------------------- -c --- CALMET Version: 6.5.0 Level: 940930 LLBREEZ -c R. Mentzer, SRC -c Modified by M. Fernau -c -c This routine will set up for the lake breeze region of -c influence -c -c --- NOTE: If an upper air station is co-located with a surface -c station and the IDs are the same, then the surface -c station will be used. If IDs are different, then -c both will be used. -c -c INPUTS XBCST,YBCST The first point defining the coastline -c XECST,YECST The last point defining the coastline -c NLB The number of surface stations within the -c box -c IBOXID Array of surf.sta. id's that are in the box -c -c OUTPUTS Updated U avd V values -c -c CALLS : COORD, INTERB, BOX -c -c CALLED BY: DIAGNO -c -c********************************************************************* - include 'params.met' - include 'grid.met' - include 'met1.met' - include 'breez.met' - include 'd1.met' - include 'ovrwat.met' - real ubsta(mxwnd),vbsta(mxwnd) - real dp(mxwnd) - real ug1,ug2,xbsta(mxwnd),ybsta(mxwnd) - real xsta(mxwnd),ysta(mxwnd),ista(mxwnd) - real dg,gridsign,statsign(mxwnd) -c -c...Loop over the regions to be used -c - do 500 ibx = 1,nbox -c -c...calculate the line equation of the coast -c - xcd = xbcst(ibx) - xecst(ibx) - ycd = ybcst(ibx) - yecst(ibx) - if (xcd .eq. 0) then - cslope = 9.9E19 - else - cslope = ycd / xcd - end if - yinter = ybcst(ibx) - cslope * xbcst(ibx) -c -c...get proper met stations; load location and data -c - nsta = nssta + nowsta + nusta - nstat = nssta + nowsta - do 95 k = 1,nstat - if (k .le. nssta) then - ista(k) = idssta(k) - xsta(k) = xssta(k) - ysta(k) = yssta(k) - else - ista(k) = idowsta(k - nssta) - xsta(k) = xowsta(k - nssta) - ysta(k) = yowsta(k - nssta) - end if - 95 continue - if (nusta .gt. 0) then - do 98 k=1,nusta - ista(nstat+k) = idusta(k) - xsta(nstat+k) = xusta(k) - ysta(nstat+k) = yusta(k) - 98 continue - end if - do 100 j = 1,nlb(ibx) - do 105 k = 1,nsta - if(iboxid(ibx,j) .eq. ista(k)) then - ubsta(j) = us(1,k) - vbsta(j) = vs(1,k) - xbsta(j) = xsta(k) - ybsta(j) = ysta(k) - goto 100 - endif -105 continue -100 continue -c -c find the distance from the station to the shore -c - do 107 kk = 1,nlb(ibx) - if (xcd .eq. 0.) then -c -c...vertical coast -c - dp(kk) = abs(xbsta(kk) - xecst(ibx)) - else if (ycd .eq. 0) then -c -c...horizontal coast -c - dp(kk) = abs(ybsta(kk) - yecst(ibx)) - else -c -c...slanted coast line; create a right triangle between the station -c...and the coast line or its extension. -c - yc1 = xbsta(kk) * cslope + yinter - xc2 = (ybsta(kk) - yinter) / cslope -c -c...calculate the length of the three sides of the right triangle -c - a = abs(yc1 - ybsta(kk)) - b = abs(xc2 - xbsta(kk)) - c = sqrt(a**2 + b**2) -c -c...drop a perpendicular from the station to the coast and calculate -c...its distance -c - if (c .gt. 0.) then - dp(kk) = a * b / c - else - dp(kk) = 0. - end if - end if -c -c...drop a vertical line from the station to the coast and calculate -c...its distance; it will be compared to a vertical line from the -c...grid cell to the coast; same sign means same side of coast; this -c...info is used in INTERB to get proper distance differential -c - statsign(kk) = ybsta(kk) - cslope * xbsta(kk) - yinter - 107 continue - do 110 i = 1,nx - do 115 j = 1,ny - call box(ibx,float(i),float(j),ok) - if (ok .le. 0.) goto 115 -c -c...grid point is inside lake breeze box -c -c...convert grid point to relative utm coordinates in meters -c - xgc = (float(i) - 0.5) * dgrid - ygc = (float(j) - 0.5) * dgrid -c -c find the distance from the grid cell to the shore.... -c - if (xcd .eq. 0.) then -c -c...vertical coast -c - dg = abs(xgc - xecst(ibx)) - else if (ycd .eq. 0) then -c -c...horizontal coast -c - dg = abs(ygc - yecst(ibx)) - else -c -c...slanted coast line; create a right triangle between the grid cell -c...and the coast line or its extension. -c - yc1 = xgc * cslope + yinter - xc2 = (ygc - yinter) / cslope -c -c...calculate the length of the three sides of the right triangle -c - a = abs(yc1 - ygc) - b = abs(xc2 - xgc) - c = sqrt(a**2 + b**2) -c -c...drop a perpendicular from the grid cell to the coast and calculate -c...its distance -c - if (c .gt. 0.) then - dg = a * b / c - else - dg = 0. - end if - end if -c...drop a vertical line from the grid cell to the coast and calculate -c...its distance; it will be compared to a vertical line from the -c...station to the coast; same sign means same side of coast; this -c...info is used in INTERB to get proper distance differential -c - gridsign = ygc - cslope * xgc - yinter -c -c...use weighted interpolation for the grid cell; weight is the -c...difference in the relative distances from coastline for station -c...and cell (does not consider directly the actual geographical -c...distance between grid cell and station) - call interb(ubsta,ug1,dp,nlb(ibx),dg,gridsign,statsign) - call interb(vbsta,ug2,dp,nlb(ibx),dg,gridsign,statsign) -c -c...if any observations were present, substitute new lake breeze -c...vector for the original CALMET vector -c - mefskip = 0 - if (ug1.gt.990. .or. ug2.gt.990.) then - write(33,*) ' no wind data in region, cell: ',i,j -c stop - mefskip = 1 - end if - if (mefskip.eq.0) then - u(i,j,1) = ug1 - v(i,j,1) = ug2 - end if -115 continue -110 continue -500 continue - return - end -c---------------------------------------------------------------------- - subroutine microi(nsecdt) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060218 MICROI -c --- J. Scire, SRC -c -c --- PURPOSE: Set-up computations for micrometeorological model -c including latitudes & longitudes of all gridpoints, -c and gridded Coriolis parameter -c -c --- UPDATES: -c -c --- V6.2 Level 060215 to v6.201 Level 060218 (F.Robe) -c (1) dgrid used instead of dx,dy in computation of xkm,ykm,lat,long -c because dx,xy not yet defined (done in diagi) -c -c --- V5.6 (050328) to V6.2 Level 060215 (F.Robe) -c (1) compute constants onedte and twodte using actual timestep -c (not necessarily one hour in MOD6) -c -c --- V5 Level 000602b to V5.6 (050328) - F.Robe -c -c (1) Compute mapping parameters from (X,Y)-CALMET to (Lat,Lon) -c (same datum) and store them in MAP.MET -c so they can be used for other similar transformations -c (e.g. in RDOW) -c -c (2) Compute gridded lat,lon and store them in grid.met -c -c (3) Compute gridded field of Coriolis parameter and -c make cmech an array (mxnx x mxny) -c -c --- 000602b - Modified to allows default values of ha1,ha2,hb1,hb2, -c hc1,hc2,hc3 to be set in block data and modified -c in control file inputs -c -c --- INPUT: -c Common block /ZIPARM/ variables -c constb,conste, -c Common block /HFLUX/ variables -c hc3 -c Common block /MAP/ variables -c utmhem,datum,pmap,xlat1,xlat2,rnlat0,relon0,feast,fnorth -c Common block /GRID/ variables -c xmap0,ymap0,xy,xy,nx,ny -c -c Parameters: MXNX, MXNY, MXOWS -c -c --- OUTPUT: -c Common block /HFLUX/ variables -c hc3p1 -c Common block /ZIPARM/ variables -c fcori(mxnx,mxny),cmech(mxnx,mxny), twodte, onedte -c -c Common block /GRID/ variables -c xlat(mxnx,mxny),xlon(mxnx,mxny) -c -c Common block /MAP/ variables -c cactionll, vectill,vectoll -c -c --- MICROI called by: SETUP -c --- MICROI calls: GLOBE1,GLOBE -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - include 'map.met' - include 'grid.met' - include 'hflux.met' - include 'ziparm.met' - - character*8 cmapi,cmapo - character*4 c4hem - -c -c --- COMPUTE MAPPING PARAMETERS from projection (x,y)km to N.lat/E.lon -c -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c --- Set translation vectors going from projection(x,y)km -c --- to N.lat/E.lon - iutmi=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmi=-iutmi - cmapi=pmap - if(cmapi.EQ.'TTM ') cmapi='TM ' - cmapo='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,iutmi,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & cmapo,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cactionll,vectill,vectoll) - -c --- Compute latitude/longitude of each gridpoint - twopi=2*3.141592 - - do j=1,ny - do i=1,nx -c --- Compute coordinates of gridpoint (in km) -c xkm= xmap0 +(float(i)-0.5)*dx*0.001 -c ykm= ymap0 +(float(j)-0.5)*dy*0.001 - xkm= xmap0 +(float(i)-0.5)*dgrid*0.001 - ykm= ymap0 +(float(j)-0.5)*dgrid*0.001 - -c --- Compute the N.lat/W.lon for (xkm,ykm) - call GLOBE(io6,cactionll,datum,vectill,datum,vectoll, - & xkm,ykm,xelon,xnlat,izone,c4hem) - xlat(i,j)=xnlat - xlon(i,j)=xelon - -c --- Compute the gridded field of Coriolis parameter values -c f=2 *omega *sin(lat) - unless f is given by the user - if (fcoriol.gt.998.) then - f= 2*(twopi/86400.)*sin(xlat(i,j)*twopi/360.) - else - f=fcoriol - endif -c --- Set a minimum value to avoid divisions by 0- Use Absolute value -c --- min corresponds to a latitude of about 10degrees - fcori(i,j)=max(abs(f),0.25e-4) - -c --- CMECH is constb/sqrt(f), where f is the absolute value of -c --- the Coriolis parameter - cmech(i,j)=constb/sqrt(fcori(i,j)) - - - enddo - enddo - - -c --- Energy budget variables -- Holtslag and van Ulden (1973) -c UNITS: HA1 (W/m**2), HA2 (W/m**2), -c HB1 (no units), HB2 (no units) -c HC1 (W/m**2/deg. K**6), HC2 (W/m**2), HC3 (no units) - - hc3p1=hc3+1.0 -c -c --- compute other mixing height variables in common -c Assume time step of one hour (3600. sec) -c twodte=7200.*conste -c onedte=3600.*(1.+conste) -c --- In MOD6, timestep can be sub-hourly -c twodte=7200.*conste -c onedte=3600.*(1.+conste) - twodte=2.*nsecdt*conste - onedte=nsecdt*(1.+conste) -c - return - end -c---------------------------------------------------------------------- - subroutine minim(u,v,w,ub,vb,div,niter,divlim) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 MINIM -c --- S.DOUGLAS, SAI -C -c -c --- UPDATES: -c --- V5.6 (050328)- explicit common replaced by include 'd6.met' -c -c --- include parameters - include 'params.met' -c - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*),W(mxnx,mxny,*), - 1 UB(mxny,2,*),VB(mxnx,2,*),DIV(mxnx,mxny,*) - - include 'grid.met' - - include 'd6.met' -c COMMON /D6/ IRD,IWR,IFILE,irdp -C -C ITERATIVE SCHEME TO MINIMIZE DIVERGENCE -C -C INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C W (R ARRAY) - GRIDDED VERTICAL WIND COMPONENTS -C UB (R ARRAY) - U-COMPONENT BOUNDARY VALUES -C VB (R ARRAY) - V-COMPONENT BOUNDARY VALUES -C DIV (R ARRAY) - 3-D DIVERGENCE -C NITER (I) - MAXIMUM NUMBER OF ITERATIONS -C DIVLIM (R) - MAXIMUM DIVERGENCE -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C -C OUTPUTS: U (R ARRAY) - NON-DIVERGENT X-DIRECTION WIND -C COMPONENT -C V (R ARRAY) - NON-DIVERGENT Y-DIRECTION WIND -C COMPONENT - if(iwr.gt.0)WRITE(IWR,2809) - DO 10 K=1,NZ - ITER=0 -C -C COMPUTE DIVERGENCE -C - DIVMAX=-1.0E+09 - CALL DIVCEL(U,V,W,DIV,UB,VB,DIVMAX,K) - IF (DIVMAX .LE. DIVLIM) GO TO 10 -C -C ADJUST HORIZONTAL WIND FIELDS -C - DO 20 ITER=1,NITER - DO 30 IDIR=1,4 - DO 40 JJ=1,NY - DO 40 II=1,NX - GO TO (50,60,70,80), IDIR - 50 I=II - J=JJ - GO TO 90 - 60 I=NX-II+1 - J=JJ - GO TO 90 - 70 I=II - J=NY-JJ+1 - GO TO 90 - 80 I=NX-II+1 - J=NY-JJ+1 - 90 CONTINUE - IF (DIV(I,J,K) .EQ. 0.) GO TO 40 - IP1=I+1 - IM1=I-1 - JP1=J+1 - JM1=J-1 - UIM1=UB(J,1,K) - IF (I .GT. 1) UIM1=U(IM1,J,K) - VJM1=VB(I,1,K) - IF (J .GT. 1) VJM1=V(I,JM1,K) - UIP1=UB(J,2,K) - IF (I .LT. NX) UIP1=U(IP1,J,K) - VJP1=VB(I,2,K) - IF (J .LT. NY) VJP1=V(I,JP1,K) - ALPHA1=0.5 - ALPHA2=0.5 - ALPHA3=0.5 - ALPHA4=0.5 - AL1234=ALPHA1+ALPHA2+ALPHA3+ALPHA4 - IF (AL1234 .LT. 1.E-6) GO TO 40 - UT=-2.*(DIV(I,J,K)*DX)/AL1234 - VT=-2.*(DIV(I,J,K)*DY)/AL1234 - UIP1=UIP1+ALPHA1*UT - UIM1=UIM1-ALPHA2*UT - VJP1=VJP1+ALPHA3*VT - VJM1=VJM1-ALPHA4*VT - IF (I .GT. 1) U(IM1,J,K)=UIM1 - IF (I .LT. NX) U(IP1,J,K)=UIP1 - IF (J .GT. 1) V(I,JM1,K)=VJM1 - IF (J .LT. NY) V(I,JP1,K)=VJP1 - 40 CONTINUE - DIVMAX=-1.0E+09 - CALL DIVCEL(U,V,W,DIV,UB,VB,DIVMAX,K) -C -C RESET BOUNDARY CONDITIONS -C - CALL WINDBC(U,V,UB,VB,K) - 30 CONTINUE -C -C CONVERGENCE TEST FOR DIVERGENCE MAGNITUDE -C - IF (DIVMAX .LE. DIVLIM) GO TO 10 - 20 CONTINUE - 10 if(iwr.gt.0)WRITE(IWR,2810) K,ITER,DIVMAX -C - 2809 FORMAT(//,5X,'SUMMARY OF DIVERGENCE MINIMIZATION' - 1,//,' LEVEL ITERATIONS MAXIMUM DIVERGENCE (/SEC)') - 2810 FORMAT(3X,I2,I11,12X,E10.3) - RETURN - END -c---------------------------------------------------------------------- - subroutine missfc(iyr,ijul,ihr) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101006 MISSFC -c --- J. Scire, SRC -c -c --- PURPOSE: Fill in missing values of certain surface met. -c variables using data from the nearest station with -c non-missing data -- Met. variables checked in this -c routine are: Ceiling height (ICEIL), cloud cover (ICC), -c air temperature (TEMPK), relative humidity (IRH), and -c surface pressure (PRES) -c -c NOTE: wind speed (WS), wind direction (WD), and -c precipitation code (IPCODE) are NOT checked because -c missing values are allowed for these variables. -c -c ALSO NOTE that the original temp. data (i.e., with -c missing values) is saved in OTEMPK. -c -c --- UPDATES: -c -c--- V6.217 Level 061231 to V6.330 Level 101006 (CEC) -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c -c--- V5.6 Level 050328 to V6.217 Level 061231 (Frr): -c - Allow icloud=4 option -c -c--- V5.1 Level 991104 to V5.6 Level 050328 (Frr): -c - Store OTEMPK in MET2.MET (no longer in calling list) -c -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- INPUTS: -c IYR - integer - Year -c IJUL - integer - Julian day -c IHR - integer - Hour (NOTE: date/hr used in printing of -c error messages) -c Common block /MET1/ variables: -c nssta,xssta(mxss),yssta(mxss),mcloud,icldout -c Common block /MET2/ variables: -c iceil(mxss),icc(mxss),tempk(mxss),irh(mxss),pres(mxss) -c Parameters: MXSS, MXUS, MXPS, IO6 -c -c --- OUTPUT: -c Common block /MET2/ variables: -c iceil(mxss),icc(mxss),tempk(mxss),irh(mxss),pres(mxss) -c OTEMPK(mxss):Original temperatures at surface stations -c (deg. K) BEFORE replacing missing values (in met2 since 050328) -c --- MISSFC called by: COMP -c --- MISSFC calls: CMPD2, IREPLAC, RREPLAC -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - real dist2(mxss) -c real otempk(mxss): otempk stored in met2.met (050328) - real opres(mxss) - integer jceil(mxss),jcc(mxss),jrh(mxss) - logical ldist -c -c --- Include common blocks - include 'met1.met' - include 'met2.met' -c - data imiss/9999/,xmiss/9999./ - data ierr/0/ -c -c --- Reduce real missing value indicator by a slight amount -c --- to allow for machine roundoff - xmissm=xmiss-0.01 -c -c --- Store original values in local arrays - do 10 i=1,nssta - jceil(i)=iceil(i) - jcc(i)=icc(i) - otempk(i)=tempk(i) - jrh(i)=irh(i) - opres(i)=pres(i) -10 continue -c -c ------------------------------ -c --- Loop over surface stations -c ------------------------------ - do 100 i=1,nssta -c -c --- LDIST tracks whether distance**2 from station "i" to every other -c --- surface station have been computed (i.e., LDIST=.true.) or not -c --- (i.e., LDIST=.false.) - ldist=.false. -c -c ------------------ -c --- Ceiling height -c ------------------ -c frr (021105): okay if all missing if cloud ceiling and cover from MM5 -ccec101006 if(iceil(i).ge.imiss. and. icloud.lt.3)then - if(iceil(i).ge.imiss. and. mcloud.lt.3)then -c -c --- Ceiling height is missing at station "i" - if(.not.ldist)then -c -c --- Distance**2 not yet computed -- therefore compute them now - ldist=.true. - call cmpd2(xssta(i),yssta(i),xssta,yssta,nssta,dist2) - endif -c -c --- Replace missing value with nearest non-missing station value - call ireplac(dist2,nssta,jceil,imiss,imiss,iceil(i)) -c -c --- If all data missing, write error message - if(iceil(i).ge.imiss)then - write(io6,9992)iyr,ijul,ihr -9992 format(/1x,'ERROR in SUBR. MISSFC -- IYR = ',i4,2x, - 1 'IJUL = ',i3,2x,'IHR = ',i2) - write(io6,*)'CEILING HEIGHT data at all stations ', - 1 'missing for this hour -- At least one station must ', - 2 'have non-missing data -- NSSTA = ',nssta, - 3 ' JCEIL = ',(jceil(n),n=1,nssta) - ierr=1 - endif - endif -c -c --------------- -c --- Cloud cover -c --------------- -c frr (021105): okay if all missing if cloud ceiling and cover from MM5 -ccec101006 if(icc(i).ge.imiss .and. icloud.lt.3)then - if(icc(i).ge.imiss .and. mcloud.lt.3)then -c -c --- Cloud cover is missing at station "i" - if(.not.ldist)then -c -c --- Distance**2 not yet computed -- therefore compute them now - ldist=.true. - call cmpd2(xssta(i),yssta(i),xssta,yssta,nssta,dist2) - endif -c -c --- Replace missing value with nearest non-missing station value - call ireplac(dist2,nssta,jcc,imiss,imiss,icc(i)) -c -c --- If all data missing, write error message - if(icc(i).ge.imiss)then - write(io6,9992)iyr,ijul,ihr - write(io6,*)'CLOUD COVER data at all stations ', - 1 'missing for this hour -- At least one station must ', - 2 'have non-missing data -- NSSTA = ',nssta, - 3 ' JCC = ',(jcc(n),n=1,nssta) - ierr=1 - endif - endif -c -c ------------------- -c --- Air Temperature -c ------------------- -c frr (021105): okay if all missing if sf temp from MM5 - if(tempk(i).ge.xmissm .and. itprog.ne.2)then -c -c --- Temperature is missing at station "i" - if(.not.ldist)then -c -c --- Distance**2 not yet computed -- therefore compute them now - ldist=.true. - call cmpd2(xssta(i),yssta(i),xssta,yssta,nssta,dist2) - endif -c -c --- Replace missing value with nearest non-missing station value - call rreplac(dist2,nssta,otempk,xmissm,xmiss,tempk(i)) -c -c --- If all data missing, write error message - if(tempk(i).ge.xmissm)then - write(io6,9992)iyr,ijul,ihr - write(io6,*)'AIR TEMPERATURE data at all stations ', - 1 'missing for this hour -- At least one station must ', - 2 'have non-missing data -- NSSTA = ',nssta, - 3 ' OTEMPK = ',(otempk(n),n=1,nssta) - ierr=1 - endif - endif -c -c --------------------- -c --- Relative humidity -c --------------------- - if(irh(i).ge.imiss)then -c -c --- Relative humidity is missing at station "i" - if(.not.ldist)then -c -c --- Distance**2 not yet computed -- therefore compute them now - ldist=.true. - call cmpd2(xssta(i),yssta(i),xssta,yssta,nssta,dist2) - endif -c -c --- Replace missing value with nearest non-missing station value - call ireplac(dist2,nssta,jrh,imiss,imiss,irh(i)) -c -c --- If all data missing, write error message - if(irh(i).ge.imiss)then - write(io6,9992)iyr,ijul,ihr - write(io6,*)'RELATIVE HUMIDITY data at all stations ', - 1 'missing for this hour -- At least one station must ', - 2 'have non-missing data -- NSSTA = ',nssta, - 3 ' JRH = ',(jrh(n),n=1,nssta) - ierr=1 - endif - endif -c -c -------------------- -c --- Surface pressure -c -------------------- - if(pres(i).ge.xmissm)then -c -c --- Pressure is missing at station "i" - if(.not.ldist)then -c -c --- Distance**2 not yet computed -- therefore compute them now - ldist=.true. - call cmpd2(xssta(i),yssta(i),xssta,yssta,nssta,dist2) - endif -c -c --- Replace missing value with nearest non-missing station value - call rreplac(dist2,nssta,opres,xmissm,xmiss,pres(i)) -c -c --- If all data missing, write error message - if(pres(i).ge.xmissm)then - write(io6,9992)iyr,ijul,ihr - write(io6,*)'SURFACE PRESSURE data at all stations ', - 1 'missing for this hour -- At least one station must ', - 2 'have non-missing data -- NSSTA = ',nssta, - 3 ' OPRES = ',(opres(n),n=1,nssta) - ierr=1 - endif - endif -c -c --- If all data missing for any variable, terminate execution - if(ierr.eq.1)stop -c -c --- End of loop over surface stations -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine mixdt(ihrgmt,i,j,ista,htold,nlev,zl,tz,dptmin,dzzi, - 1 tht,thtp,dtheta) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 950825 MIXDT -c --- J. Scire, SRC -c Modified 8/97 - J. Scire -c -c --- PURPOSE: Calculate the potential temperature lapse rate -c (deg. K/m) in a layer "DZZI" meters deep above the -c previous hour's convective mixing height -c -c --- INPUTS: -c IHRGMT - integer - Local time (GMT) (IHRGMT can -c be >= 24) -c I,J - integers - Grid cell indexes -c ISTA - integer - Number of nearest upper air -c station to grid cell (I,J) -c HTOLD - real - Height (m) of previous hour's -c convective mixing height -c NLEV - integer - Number of levels in current -c temperature sounding -c ZL(mxus,mxlev) - real array - Height (m) of each level in -c current sounding -c TZ(mxus,mxlev) - real array - Temperature (deg. K) at each -c height in current sounding -c DPTMIN - real - Minimum potential temperature -c lapse rate (deg. K/m) -c DZZI - real - Depth (m) of layer above -c mixing height through which -c potential temp. lapse rate is -c computed -c Common block /gen/ variables -c NYR, NJUL -c Parameters: MXUS, MXLEV, IO6 -c -c --- OUTPUT: -c THT - real - Temperature (deg. K) at height -c "HTOLD" meters -c THTP - real - Temperature (deg. K) at height -c "HTOLD + DZZI" meters -c DTHETA - real - Potential temperature lapse rate -c (deg. K) in "DZZI" meter layer -c above convective mixing height -c -c --- MIXDT called by: MIXHT -c --- MIXDT calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real zl(mxus,mxlev),tz(mxus,mxlev) -c - include 'gen.met' -c - data xmiss/999.9/ -c -c --- Reduce missing value indicator by a slight amount to allow for -c --- machine roundoff - xmissm=xmiss-0.01 -c -c ------------------------------------------------------------ -c --- Find highest level w/ valid data at or below HTOLD -- KL -c ------------------------------------------------------------ - kl=0 - do k=1,nlev -c -c --- At first height above HTOLD, skip out of loop - if(zl(ista,k).gt.htold)go to 12 -c -c --- If data is valid, keep store this level - if(tz(ista,k).lt.xmissm)kl=k - enddo -c -c --- If search unsuccessful, write error message -12 continue - if(kl.eq.0)then - write(io6,15) -15 format(//1x,'ERROR in subr. MIXDT -- no valid data below ', - 1 'HTOLD found in the sounding') - write(io6,*)'ISTA = ',ista,' NLEV= ',nlev - write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(ista,nl),' TZ: ', - 1 tz(ista,nl) - enddo - stop - endif -c -c ------------------------------------------------------ -c --- Find lowest level w/ valid data above HTOLD -- KLP -c ------------------------------------------------------ - klp=0 - klp1=kl+1 - do k=klp1,nlev -c -c --- Level must be above HTOLD & data valid - if(zl(ista,k).gt.htold.and.tz(ista,k).lt.xmissm)then - klp=k - go to 27 - endif - enddo -c -c --- If search unsuccessful, write error message - if(klp.eq.0)then - write(io6,25) -25 format(//1x,'ERROR in subr. MIXDT -- no valid data above ', - 1 'HTOLD found in the sounding') - write(io6,*)'ISTA = ',ista,' NLEV= ',nlev - write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(ista,nl),' TZ: ', - 1 tz(ista,nl) - enddo - stop - endif -27 continue -c -c ----------------------------------------------------------------- -c --- Find highest level w/ valid data at or below HTOLD+DZZI -- KU -c ----------------------------------------------------------------- - htpdz=htold+dzzi - ku=0 - do k=kl,nlev -c -c --- At first height above HTOLD+DZZI, skip out of loop - if(zl(ista,k).gt.htpdz)go to 32 -c -c --- If data is valid, keep store this level - if(tz(ista,k).lt.xmissm)ku=k - enddo -32 continue -c -c --- If search unsuccessful, write error message - if(ku.eq.0)then - write(io6,35) -35 format(//1x,'ERROR in subr. MIXDT -- no valid data below ', - 1 'HTOLD+DZZI found in the sounding') - write(io6,*)'ISTA = ',ista,' NLEV= ',nlev - write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi,' HTPDZ = ',htpdz - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(ista,nl),' TZ: ', - 1 tz(ista,nl) - enddo - stop - endif -c -c ----------------------------------------------------------- -c --- Find lowest level w/ valid data above HTOLD+DZZI -- KUP -c ----------------------------------------------------------- - kup=0 - kup1=ku+1 - do k=kup1,nlev -c -c --- Level must be above HTOLD+DZZI & data valid - if(zl(ista,k).gt.htpdz.and.tz(ista,k).lt.xmissm)then - kup=k - go to 47 - endif - enddo -c -c --- If search unsuccessful, write error message - if(kup.eq.0)then - write(io6,45) -45 format(//1x,'ERROR in subr. MIXDT -- no valid data above ', - 1 'HTOLD+DZZI found in the sounding') - write(io6,*)'ISTA = ',ista,' NLEV= ',nlev - write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi,' HTPDZ = ',htpdz - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(ista,nl),' TZ: ', - 1 tz(ista,nl) - enddo - stop - endif -47 continue -c -c --- Compute temperature at HTOLD by interpolation - tht=tz(ista,klp)-(tz(ista,klp)-tz(ista,kl))* - 1 (zl(ista,klp)-htold)/(zl(ista,klp)-zl(ista,kl)) -c -c --- Compute temperature at HTOLD+DZZI by interpolation - thtp=tz(ista,kup)-(tz(ista,kup)-tz(ista,ku))* - 1 (zl(ista,kup)-htpdz)/(zl(ista,kup)-zl(ista,ku)) -c -c --- Compute potential temperature lapse rate (deg. K/m) - dtheta=(thtp-tht)/dzzi+0.0098 -c -c --- dptmin is minimum stable pot. temp. lapse rate - dtheta=amax1(dtheta,dptmin) -c - return - end -c---------------------------------------------------------------------- - subroutine mixdt2(ihrgmt,i,j,htold,dptmin,dzzi,tsf,tht,thtp, - : dtheta) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 MIXDT2 -c --- F.Robe based on MIXDT (J. Scire, SRC) -c -c -c --- PURPOSE: Calculate the potential temperature lapse rate -c (deg. K/m) in a layer "DZZI" meters deep above the -c previous hour's convective mixing height -c Based on prognostic input only (no upper air obs.) -c MIXDT2 uses the latest actual MM5 sounding -c (i.e. no time interpolation) -c -c --- UPGRADES: -c --- Level 020211 to V5.6 Level 050328 -c - Add surface temperature to calling list -c -c -c --- INPUTS: -c IHRGMT - integer - Local time (GMT) (IHRGMT can -c be >= 24)- Beginning time -c I,J - integers - Grid cell indexes -c HTOLD - real - Height (m) of previous hour's -c convective mixing height -c DPTMIN - real - Minimum potential temperature -c lapse rate (deg. K/m) -c DZZI - real - Depth (m) of layer above -c mixing height through which -c potential temp. lapse rate is -c computed -c INPUT via COMMON /MM5TEMP/ -c ZL - real array - Heights (m) of MM5 levels at MM5 gridpoint -c closest to CALMET gridpoint -c TZ - real array - MM5 Temperature (deg. K) at MM5 levels of -c MM5 gridpoint closest to CALMET gridpoint -c NLEV- integer - Number of vertical levels in MM5 + 1(sf) -c -c Common block /gen/ variables -c NYR, NJUL -c Parameters: MXUS, MXLEV, IO6 -c -c --- OUTPUT: -c TSF - real - Surface Air Temperature (deg. K) -c THT - real - Temperature (deg. K) at height -c "HTOLD" meters -c THTP - real - Temperature (deg. K) at height -c "HTOLD + DZZI" meters -c DTHETA - real - Potential temperature lapse rate -c (deg. K) in "DZZI" meter layer -c above convective mixing height -c -c --- MIXDT2 called by: MIXHBG, MIXHMC -c --- MIXDT2 calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c --- do not need mm4hdo.met and gen.met(050328) -c include 'mm4hdo.met' -c include 'gen.met' - -c Prognostic temperature soundings at each gridpoint (read in rdmm5) - common /mm5temp/nlev,zl(mxnx,mxny,mxnzp+1), - : tz(mxnx,mxny,mxnzp+1) -c - data xmiss/999.9/ -c -c --- Reduce missing value indicator by a slight amount to allow for -c --- machine roundoff - xmissm=xmiss-0.01 - -c --- Surface Air temperature at MM5 gridpoint nearest to CALMET (i,j) - tsf=tz(i,j,1) - -c ------------------------------------------------------------ -c --- Find highest level w/ valid data at or below HTOLD -- KL -c ------------------------------------------------------------ - kl=0 - do k=1,nlev -c -c --- At first height above HTOLD, skip out of loop - if(zl(i,j,k).gt.htold)go to 12 -c -c --- If data is valid, keep store this level - if(tz(i,j,k).lt.xmissm)kl=k - enddo -c -c --- If search unsuccessful, write error message -12 continue - if(kl.eq.0)then - write(io6,15) -15 format(//1x,'ERROR in subr. MIXDT2 -- no valid data below ', - 1 'HTOLD found in the prognostic data') - write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(i,j,nl),' TZ: ', - 1 tz(i,j,nl) - enddo - stop - endif -c -c ------------------------------------------------------ -c --- Find lowest level w/ valid data above HTOLD -- KLP -c ------------------------------------------------------ - klp=0 - klp1=kl+1 - do k=klp1,nlev -c -c --- Level must be above HTOLD & data valid - if(zl(i,j,k).gt.htold.and.tz(i,j,k).lt.xmissm)then - klp=k - go to 27 - endif - enddo -c -c --- If search unsuccessful, write error message - if(klp.eq.0)then - write(io6,25) -25 format(//1x,'ERROR in subr. MIXDT2 -- no valid data above ', - 1 'HTOLD found in the sounding') - write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(i,j,nl),' TZ: ', - 1 tz(i,j,nl) - enddo - stop - endif -27 continue -c -c ----------------------------------------------------------------- -c --- Find highest level w/ valid data at or below HTOLD+DZZI -- KU -c ----------------------------------------------------------------- - htpdz=htold+dzzi - ku=0 - do k=kl,nlev -c -c --- At first height above HTOLD+DZZI, skip out of loop - if(zl(i,j,k).gt.htpdz)go to 32 -c -c --- If data is valid, keep store this level - if(tz(i,j,k).lt.xmissm)ku=k - enddo -32 continue -c -c --- If search unsuccessful, write error message - if(ku.eq.0)then - write(io6,35) -35 format(//1x,'ERROR in subr. MIXDT2 -- no valid data below ', - 1 'HTOLD+DZZI found in the sounding') -2 write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi,' HTPDZ = ',htpdz - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(i,j,nl),' TZ: ', - 1 tz(i,j,nl) - enddo - stop - endif -c -c ----------------------------------------------------------- -c --- Find lowest level w/ valid data above HTOLD+DZZI -- KUP -c ----------------------------------------------------------- - kup=0 - kup1=ku+1 - do k=kup1,nlev -c -c --- Level must be above HTOLD+DZZI & data valid - if(zl(i,j,k).gt.htpdz.and.tz(i,j,k).lt.xmissm)then - kup=k - go to 47 - endif - enddo -c -c --- If search unsuccessful, write error message - if(kup.eq.0)then - write(io6,45) -45 format(//1x,'ERROR in subr. MIXDT2 -- no valid data above ', - 1 'HTOLD+DZZI found in the sounding') - write(io6,*)'IHRGMT = ',ihrgmt,' I = ',I,' J = ',j - write(io6,*)'HTOLD = ',htold,' DZZI = ',dzzi,' HTPDZ = ',htpdz - do nl=1,nlev - write(io6,*)'NL: ',nl,' ZL: ',zl(i,j,nl),' TZ: ', - 1 tz(i,j,nl) - enddo - stop - endif -47 continue -c -c --- Compute temperature at HTOLD by interpolation - tht=tz(i,j,klp)-(tz(i,j,klp)-tz(i,j,kl))* - 1 (zl(i,j,klp)-htold)/(zl(i,j,klp)-zl(i,j,kl)) -c -c --- Compute temperature at HTOLD+DZZI by interpolation - thtp=tz(i,j,kup)-(tz(i,j,kup)-tz(i,j,ku))* - 1 (zl(i,j,kup)-htpdz)/(zl(i,j,kup)-zl(i,j,ku)) -c -c --- Compute potential temperature lapse rate (deg. K/m) - dtheta=(thtp-tht)/dzzi+0.0098 -c -c --- dptmin is minimum stable pot. temp. lapse rate - dtheta=amax1(dtheta,dptmin) -c - return - end -c---------------------------------------------------------------------- - subroutine mixht(el,ustar,qh,nx,ny,rho,ihrgmt,nearu,iupt, - 1 ilandu,iwat1,iwat2,ldbhr,imixh,zi,ziconv) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 110421 MIXHT -c --- J. Scire, SRC -c -c --- PURPOSE: Calculate the convective and mechanical mixing -c height (m) at each grid cell over LAND -c -c --- Daytime mixing height are computed as the MAXIMUM of -c --- convective ((Maul, 1980, or Batchvarovan & Gryning, 1990,1994) -c --- and mechanical (Venkatram,1980b) values. -c --- Mixing heights during stable conditions -c --- are determine as the MINIMUM produced by two schemes -c --- (Venkatram, 1980a) and Zilitinkevich (1972). -c -c --- All mixing heights over land are subject to the -c --- MIN/MAX values specified by user inputs ZIMIN and -c --- ZIMAX. -c -c --- MIXHT is called when lapse rates above mixing heights -c --- are extracted from upper air soundings (UP.DAT). MIXHT2 is -c --- the equivalent subroutine called when lapse rates come -c --- from prognostic data (3D.DAT) -c -c -c --- UPDATES -c -c--- V6.3 (070707) to v6.334 (110421) (JSS) -c - Ensure that the station which is used to define older/newer -c sounding and that which is used to provide lapse rate at top -c of the convective mixing height and in MIXHBG are identical. -c -c--- V6.218 (070113) to V6.3 (070707) (FRR) -c - Use IUPT sounding if IUPT>0 for consistency with MOD5 and -c use nearest sounding otherwise (IUPT passed through calling -c list) -c -c --- v5.611 (051113) to V6.218 (070113)- (FRR) -c - Get sounding order at nearest upper air station rather than at -c iupt station (which is no longer always defined since iupt can be <0) -c - Remove iupt from calling list -c -c --- V5.6 (050328) to v5.611 (051113)- (FRR) -c - Remove zimin from calling list to MIXHMC -c -c --- V5.547 (041010) to v5.6 (050328)- (FRR) -c - Add new convective mixing height parameterization (Batchvarova -c and Gryning). -c - Add buoyancy flux threshold for convective growth (dissipation) -c -c --- V5.546 (950201) to V5.547 (041010) - (FRR) -c - Bug fix: RHO is 2D not 1D -c - NEARS no longer needed so removed from in calling list -c -c --- INPUTS: -c EL(mxnx,mxny) - real array - Monin-Obukhov Length (m) -c USTAR(mxnx,mxny) - real array - Friction velocity (m/s) -c QH(mxnx,mxny) - real array - Sensible heat flux (W/m**2) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c RHO(mxnx,mxny) - real array - Air density (kg/m**3) -c IHRGMT - integer - Local time (GMT) (IHRGMT can -c be >= 24)beginning time -c NEARU(mxnx,mxny) - integer array - Station number of upper air -c station closest to each grid pt -c IUPT - integer - Upper air station to use for -c computing the domain-scale -c lapse rate (if >0) -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c LDBHR - logical - Control variable determining -c the printing of intermediate -c results useful for debugging -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c Common block /ziparm/ -c constn,dptmin,dzzi,zimax,zimin,cmech,twodte,onedte,fcoriol,threshl -c Common block /upmet/ -c zlaa, tzaa, zlbb, tzbb -c Parameters: mxnx, mxny, mxss, mxus, mxlev, io6, mxxy -c -c --- OUTPUT: -c ZI(mxnx,mxny) - real array - Mixing height (m) -- max. of -c convective and mechanical hts. -c ZICONV(mxnx,mxny) - real array - Convective mixing height (m) -c -c --- MIXHT called by: COMP -c --- MIXHT calls: MIXDT, MIXHBG, MIXHMC, OUT -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - real ustar(mxnx,mxny),qh(mxnx,mxny),el(mxnx,mxny) - real zi(mxnx,mxny),ziconv(mxnx,mxny) - real rho(mxnx,mxny) - integer nearu(mxnx,mxny) - integer ilandu(mxnx,mxny) - character*70 messag - logical ldbhr,ldate -c - include 'ziparm.met' - include 'upmet.met' - common /tjump/ dptt(mxnx,mxny) -c - data cp/996./,g/9.81/,ldate/.true./ -c - -c --- Loop over grid cells -- Process only LAND cells - do 100 i=1,nx - do 100 j=1,ny -c -c --- Check if cell is land or water - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2) go to 100 -c -c --- Nearest upper air station to current grid cell - iusta=nearu(i,j) -c -c --- Check if heat flux is positive (daytime) or negative (nighttime) - if(qh(i,j).lt.0.0)go to 300 -c -c ----------------------------------------------------------------- -c --- Daytime -- calculate convective and mechanical mixing heights -c ----------------------------------------------------------------- -c -c --- Convert heat flux (W/m**2) to w'theta' (m * deg. K/s) - wt=qh(i,j)/(rho(i,j)*cp) - -c *** rjy modifications of 1/29/90 for arbitrary soundings. ******* -c --- for any hour, use the most recent past sounding to -c calculate pot. temp. gradient. -c JORDER = +1 implies that the contents of the aa arrays is older. -c JORDER = -1 implies that the contents of the bb arrays is older. -c (070717) - Use iupt if >0 for consistency with MOD5 -c 110421: ensure that whatever sounding is used for jorder (kusta) -c is also used in the call to mixdt to determinde lapse rate above Zic - if (iupt.gt.0) then - jorder = justa(iupt) -c --- 110421 - kusta=iupt - else - jorder = justa(iusta) -c --- 110421 - kusta=iusta - endif - if(jorder.gt.0) go to 200 -c ***************************************************************** -c -c --- Use 12z sounding to determine potential temperature lapse rate -c --- in 'dzzi'-meter layer above last timestep's convective mixing ht. - htold=ziconv(i,j) -c 110421: ensure that whatever sounding is used for jorder (kusta) -c is also used in the call to mixdt to determinde lapse rate above Zic -c nlev=nlbb(iusta) -c call mixdt(ihrgmt,i,j,iusta,htold,nlev,zlbb,tzbb,dptmin,dzzi, - nlev=nlbb(kusta) - call mixdt(ihrgmt,i,j,kusta,htold,nlev,zlbb,tzbb,dptmin,dzzi, - 1 tht,thtp,dtheta) - - if(abs(imixh).eq.2) then -c --- Batchvarova-Gryning convective mixing height -c 110421 - kusta instead of iusta -c call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzbb(iusta,1),2,THRESHL, - call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzbb(kusta,1),2,THRESHL, - : ZIMAX,ZIMIN,USTAR(i,j),EL(i,j),HTOLD,ZICONV(I,J), - : THT,THTP) - - else if (abs(imixh).eq.1) then -c--- Carson convective mixing height - call MIXHMC(ihrgmt,i,j,wt,DTHETA,2,threshl,zimax, - : htold,ziconv(i,j),dptt(i,j),tht,thtp) - endif - -c --- Upper bound to conv. mixing height: - ziconv(i,j)=amin1(zimax,ziconv(i,j)) - -c -c --- Calculate daytime(neutral) mechanical mixing height - tave=(thtp+tht)/2. -c --- BVF is sqrt(Brunt-Vaisala frequency) = (N**2)**0.25 - bvf=(g*dtheta/tave)**0.25 -c -c --- CMECH is constb/sqrt(f), where f is the Coriolis parameter -c --- Default values -- constb=1.41, conste=0.15, constn=2400. - hmech=cmech(i,j)*ustar(i,j)/bvf - zi(i,j)=amax1(zimin,hmech,ziconv(i,j)) - zi(i,j)=amin1(zimax,zi(i,j)) - go to 100 -c -c --- For daytime hours after 00z (4 pm PST, 7 pm EST), use 00z -c --- sounding to determine lapse rate above mixing ht. -200 continue - - htold=ziconv(i,j) -c 110421: ensure that whatever sounding is used for jorder (kusta) -c is also used in the call to mixdt to determinde lapse rate above Zic -c nlev=nlaa(iusta) -c call mixdt(ihrgmt,i,j,iusta,htold,nlev,zlaa,tzaa,dptmin,dzzi, - nlev=nlaa(kusta) - call mixdt(ihrgmt,i,j,kusta,htold,nlev,zlaa,tzaa,dptmin,dzzi, - 1 tht,thtp,dtheta) - - if(abs(imixh).eq.2) then -c --- Batchvarova-Gryning convective mixing height -c 110421 - kusta instead of iusta -c call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzaa(iusta,1),2,THRESHL, - call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzaa(kusta,1),2,THRESHL, - : ZIMAX,ZIMIN,USTAR(i,j),EL(i,j),HTOLD,ZICONV(I,J), - : tht,thtp) - - else if (abs(imixh).eq.1) then -c--- Carson convective mixing height - call MIXHMC(ihrgmt,i,j,wt,DTHETA,2,threshl,zimax, - : htold,ziconv(i,j),dptt(i,j),tht,thtp) - endif - -c --- Upper bound to conv. mixing height: - ziconv(i,j)=amin1(zimax,ziconv(i,j)) - -c --- Calculate daytime (neutral) mechanical mixing height using 00z -c --- sounding - tave=0.5*(thtp+tht) - bvf=(g*dtheta/tave)**0.25 - hmech=cmech(i,j)*ustar(i,j)/bvf - zi(i,j)=amax1(zimin,hmech,ziconv(i,j)) - zi(i,j)=amin1(zimax,zi(i,j)) - - go to 100 -c -c ----------------------------------------------------------- -c --- Nighttime (stable) conditions -- mechanical mixing only -c ----------------------------------------------------------- -c --- Default value for constn is 2400. -300 continue -c -c --- Take the minimum of constn*ustar(i,j)**1.5 and -c --- 0.4*sqrt(ustar(i,j)*el(i,j)/abs(fcori(i,j))) -c -c --- Stable mixing ht. - Venkatram (1980a) - zi1=constn*ustar(i,j)**1.5 -c -c --- Stable mixing ht. - Zilitinkevich (1972) - zi2=0.4*sqrt(ustar(i,j)*el(i,j)/fcori(i,j)) -c -c --- Mixing height must be between user-specified MIN/MAX range - zi(i,j)=amin1(zi1,zi2,zimax) - zi(i,j)=amax1(zimin,zi(i,j)) -c - ziconv(i,j)=0.0 - dptt(i,j)=0.0 -c -100 continue - - - -c --- DEBUG write option - if(ldbhr)then - messag='Temperature jump at top of mixed layer (deg. K)' - call out(dptt,idum,1,5,ldate,messag,nx,ny) - endif -c - return - end -c---------------------------------------------------------------------- - subroutine mixhtST(el,ustar,qh,rho,ihrgmt,ist,jst,nearus, - 1 iupt,ilandu,iwat1,iwat2,imixh,zi,ziconv) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 110421 MIXHTST -c --- F. Robe after MIXHT (J. Scire, SRC) -c -c --- PURPOSE: Calculate the convective and mechanical mixing -c height (m) at one grid cell only (ist,jst) -c -c --- Daytime mixing height are computed as the MAXIMUM of -c --- convective (Maul, 1980) and mechanical (Venkatram, -c --- 1980b) values. Mixing heights during stable conditions -c --- are determine as the MINIMUM produced by two schemes -c --- (Venkatram, 1980a) and Zilitinkevich (1972). -c -c --- All mixing heights over land are subject to the -c --- MIN/MAX values specified by user inputs ZIMIN and -c --- ZIMAX. -c -c --- MIXHTST is called when lapse rates above mixing heights -c --- are extracted from upper air soundings (UP.DAT). MIXHT2ST is the -c --- the equivalent subroutine when lapse rates come from -c --- prognostic data (3D.DAT) -c -c --- UPGRADES: -c--- V6.3 (070707) to v6.334 (JSS) -c - Ensure that the station which is used to define older/newer -c sounding and that which is used to provide lapse rate at top -c of the convective mixing height and in MIXHBG are identical. -c -c--- V6.221 (070327) to V6.3 (070707) (FRR) -c - Use IUPT sounding if IUPT>0 for consistency with MOD5 and use -c nearest sounding otherwise (IUPT passed through calling list) -c -c --- V6.218 (070113)to V6.221 (070327)- (FRR) -c - Include 'grid.met' for debug option call to out and change variable -c name nearu to nearus to avoid conflict with common variable -c - Remove ldbhr from calling list (was not defined) and include -c outpt.met where ldbhr is now defined -c -c --- v5.611 (051113) to V6.218 (070113)- (FRR) -c - Get sounding order at nearest upper air station rather than at iupt station -c (which is no longer always defined since iupt can be <0) -c - Remove iupt from calling list -c V5.6 (050328) to v5.611 (051113)- (FRR) -c - Remove zimin from calling list to MIXHMC -c --- Level 021105 to v5.6 (050328) - (FRR) -c - Add new convective mixing height parameterization (Batchvarova -c and Gryning). -c - Add buoyancy flux threshold for convective growth (dissipation) - -c -c --- INPUTS: -c EL - real - Monin-Obukhov Length (m) at point (ist,jst) -c USTAR - real - Friction velocity (m/s) at point (ist,jst) -c QH - real - Sensible heat flux (W/m**2)at point (ist,jst) -c IST - integer - I of the gridpoint -c JST - integer - J of the gridpoint -c RHO - real - Air density (kg/m**3) at point (ist,jst) -c IHRGMT - integer - Local time (GMT) (IHRGMT can -c be >= 24) -c NEARUS - integer - Station number of surface -c station closest to point (ist,jst) -c ILANDU - integer - Land use category at point (ist,jst) -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c Common block /ziparm/ -c constn,dptmin,dzzi,zimax,zimin,cmech,fcoriol,threshl -c Common block /upmet/ -c zlaa, tzaa, zlbb, tzbb -c Parameters: mxnx, mxny, mxss, mxus, mxlev, io6, mxxy -c -c --- OUTPUT: -c ZI - real - Mixing height (m) at point (ist,jst)-- max. of -c convective and mechanical hts. -c ZICONV - real - Convective mixing height (m)at point (ist,jst) -c -c --- MIXHTST called by: ELUSTR2 -c --- MIXHTST calls: MIXDT, MIXHBG, MIXHMC, OUT -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - character*70 messag - logical ldate - - include 'outpt.met' - include 'grid.met' -c - include 'ziparm.met' - include 'upmet.met' - common /tjump/ dptt(mxnx,mxny) -c - data cp/996./,g/9.81/,ldate/.true./ -c -c --- Only one gridpoint - i=ist - j=jst - -c -c --- Check if cell is land or water - if(ilandu.ge.iwat1.and.ilandu.le.iwat2) go to 100 -c -c --- Nearest upper air station to current grid cell - iusta=nearus -c -c --- Check if heat flux is positive (daytime) or negative (nighttime) - if(qh.lt.0.0)go to 300 -c -c ----------------------------------------------------------------- -c --- Daytime -- calculate convective and mechanical mixing heights -c ----------------------------------------------------------------- -c -c --- Convert heat flux (W/m**2) to w'theta' (m * deg. K/s) - wt=qh/(rho *cp) - -c -c *** rjy modifications of 1/29/90 for arbitrary soundings. ******* -c --- for any hour, use the most recent past sounding to -c calculate pot. temp. gradient. -c JORDER = +1 implies that the contents of the aa arrays is older. -c JORDER = -1 implies that the contents of the bb arrays is older. -c Use IUPT if >), otherwise use nearest station (070717) -c 110421: ensure that whatever sounding is used for jorder (kusta) -c is also used in the call to mixdt to determinde lapse rate above Zic - if (iupt.gt.0) then - jorder = justa(iupt) - kusta=iupt - else - jorder = justa(iusta) - kusta=iusta - endif - if(jorder.gt.0) go to 200 -c ***************************************************************** -c -c --- Use 12z sounding to determine lapse rate in 'dzzi'-meter layer -c --- above last hour's convective mixing ht. - htold=ziconv -c 110421: ensure that whatever sounding is used for jorder (kusta) -c is also used in the call to mixdt to determinde lapse rate above Zic -c nlev=nlbb(iusta) -c call mixdt(ihrgmt,i,j,iusta,htold,nlev,zlbb,tzbb,dptmin,dzzi, - nlev=nlbb(kusta) - call mixdt(ihrgmt,i,j,kusta,htold,nlev,zlbb,tzbb,dptmin,dzzi, - 1 tht,thtp,dtheta) - - if(abs(imixh).eq.2) then -c --- Batchvarova-Gryning convective mixing height -c 110421 - kusta instead of iusta -c call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzbb(iusta,1),2,THRESHL, - call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzbb(kusta,1),2,THRESHL, - : ZIMAX,ZIMIN,USTAR,EL,HTOLD,ZICONV, - : THT,THTP) - - else if (abs(imixh).eq.1) then -c--- Carson convective mixing height - call MIXHMC(ihrgmt,i,j,wt,DTHETA,2,threshl,zimax,htold, - : ziconv,dptt(i,j),THT,THTP) - endif - -c --- Upper bound to conv. mixing height: - ziconv=amin1(zimax,ziconv) -c -c --- Calculate daytime(neutral) mechanical mixing height - tave=(thtp+tht)/2. -c --- BVF is sqrt(Brunt-Vaisala frequency) = (N**2)**0.25 - bvf=(g*dtheta/tave)**0.25 -c -c --- CMECH is constb/sqrt(f), where f is the Coriolis parameter -c --- Default values -- constb=1.41, conste=0.15, constn=2400. - hmech=cmech(i,j)*ustar/bvf - zi=amax1(zimin,hmech,ziconv) - zi=amin1(zimax,zi) - go to 100 -c -c --- For daytime hours after 00z (4 pm PST, 7 pm EST), use 00z -c --- sounding to determine lapse rate above mixing ht. -200 continue - htold=ziconv -c 110421: ensure that whatever sounding is used for jorder (kusta) -c is also used in the call to mixdt to determinde lapse rate above Zic -c nlev=nlaa(iusta) -c call mixdt(ihrgmt,i,j,iusta,htold,nlev,zlaa,tzaa,dptmin,dzzi, - nlev=nlaa(kusta) - call mixdt(ihrgmt,i,j,kusta,htold,nlev,zlaa,tzaa,dptmin,dzzi, - 1 tht,thtp,dtheta) -c - - if(abs(imixh).eq.2) then -c --- Batchvarova-Gryning convective mixing height -c 110421 - kusta instead of iusta -c call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzaa(iusta,1),2,THRESHL, - call MIXHBG (ihrgmt,I,J,WT,DTHETA,tzaa(kusta,1),2,THRESHL, - : ZIMAX,ZIMIN,USTAR,EL,HTOLD,ZICONV, THT,THTP) - - else if (abs(imixh).eq.1) then -c--- Carson convective mixing height - call MIXHMC(ihrgmt,i,j,wt,DTHETA,2,threshl,zimax, - : htold,ziconv,DPTT(i,j),THT,THTP) - endif - -c --- Upper bound to conv. mixing height: - ziconv=amin1(zimax,ziconv) -c -c --- Calculate daytime (neutral) mechanical mixing height using 00z -c --- sounding - tave=0.5*(thtp+tht) - bvf=(g*dtheta/tave)**0.25 - hmech=cmech(i,j)*ustar/bvf - zi=amax1(zimin,hmech,ziconv) - zi=amin1(zimax,zi) - go to 100 -c -c ----------------------------------------------------------- -c --- Nighttime (stable) conditions -- mechanical mixing only -c ----------------------------------------------------------- -c --- Default value for constn is 2400. -300 continue -c -c --- Take the minimum of constn*ustar**1.5 and -c --- 0.4*sqrt(ustar*el/abs(fcori)) -c -c --- Stable mixing ht. - Venkatram (1980a) - zi1=constn*ustar**1.5 -c -c --- Stable mixing ht. - Zilitinkevich (1972) - zi2=0.4*sqrt(ustar*el/fcori(i,j)) -c -c --- Mixing height must be between user-specified MIN/MAX range - zi=amin1(zi1,zi2,zimax) - zi=amax1(zimin,zi) -c - ziconv=0.0 - dptt(i,j)=0.0 -c -100 continue -c -c --- DEBUG write option - if(ldbhr)then - messag='Temperature jump at top of mixed layer (deg. K)' - call out(dptt,idum,1,5,ldate,messag,nx,ny) - endif -c - return - end -c---------------------------------------------------------------------- - subroutine mixht2(el,ustar,qh,nx,ny,rho,ihrgmt, - 1 ilandu,iwat1,iwat2,ldbhr,imixh,zi,ziconv) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 051113 MIXHT2 -c --- -c F.Robe (09/2001) -c Based on MIXHT (J. Scire, SRC) - -c --- PURPOSE: Calculate the convective and mechanical mixing -c height (m) at each grid cell over LAND in the NOOBS mode -c (i.e. based on prognostic input - no observations) -c -c --- Each mixing height is computed based on the MM5 temperature -c --- profile at the MM5 gridpoint closest to the CALMET gridpoint -c -c --- Daytime mixing height are computed as the MAXIMUM of -c --- convective (Maul, 1980) and mechanical (Venkatram, -c --- 1980b) values. Mixing heights during stable conditions -c --- are determine as the MINIMUM produced by two schemes -c --- (Venkatram, 1980a) and Zilitinkevich (1972). -c -c --- All mixing heights over land are subject to the -c --- MIN/MAX values specified by user inputs ZIMIN and -c --- ZIMAX. -c -c --- MIXHT2 is called when lapse rates above mixing heights -c --- are extracted from prognostic data (3D.DAT). MIXHT is the -c --- equivalent subroutine when lapse rates are extracted from -c --- upper air soundings (UP.DAT) -c -c -c --- UPDATES: -c --- v5.611 (051113) to V6.223 Level 070702- (FRR) -c - HTOLD uses last zi even if less than zimin -c -c V5.6 (050328) to v5.611 (051113)- (FRR) -c - Remove zimin from calling list to MIXHMC -c --- Level 020211 to v5.6 (050328) - (FRR) -c - Add new convective mixing height parameterization (Batchvarova -c and Gryning). -c - Add buoyancy flux threshold for convective growth (dissipation) -c - Move details of mix. hgt computation and call to mixdt2 to -c subroutines mixhbg and mixhmc -c -c --- INPUTS: -c EL(mxnx,mxny) - real array - Monin-Obukhov Length (m) -c USTAR(mxnx,mxny) - real array - Friction velocity (m/s) -c QH(mxnx,mxny) - real array - Sensible heat flux (W/m**2) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c IHRGMT - integer - Local time (GMT) (IHRGMT can -c be >= 24) -c RHO(mxnx,mxny) - real array - Air density -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c LDBHR - logical - Control variable determining -c the printing of intermediate -c results useful for debugging -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c Common block /ziparm/ -c constn,dptmin,dzzi,zimax,zimin,cmech,threshl -c Parameters: mxnx, mxny, mxss, mxus, mxlev, io6, mxxy -c -c --- OUTPUT: -c ZI(mxnx,mxny) - real array - Mixing height (m) -- max. of -c convective and mechanical hts. -c ZICONV(mxnx,mxny) - real array - Convective mixing height (m) -c -c --- MIXHT2 called by: COMP -c --- MIXHT2 calls: MIXHBG, MIXHMC, OUT -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - real ustar(mxnx,mxny),qh(mxnx,mxny),el(mxnx,mxny) - real zi(mxnx,mxny),ziconv(mxnx,mxny),rho(mxnx,mxny) - integer ilandu(mxnx,mxny) - character*70 messag - logical ldbhr,ldate -c - include 'ziparm.met' -c --- mm4hdo.met not needed (050328) -c include 'mm4hdo.met' - common /tjump/ dptt(mxnx,mxny) -c - data cp/996./,g/9.81/,ldate/.true./ -c - -c --- Loop over grid cells -- Process only LAND cells - do 100 i=1,nx - do 100 j=1,ny -c -c --- Check if cell is land or water - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2) go to 100 -c -c --- Check if heat flux is positive (daytime) or negative (nighttime) - if(qh(i,j).lt.0.0)go to 300 -c -c ----------------------------------------------------------------- -c --- Daytime -- calculate convective and mechanical mixing heights -c ----------------------------------------------------------------- -c -c --- Convert heat flux (W/m**2) to w'theta' (m * deg. K/s) - wt=qh(i,j)/(rho(i,j)*cp) - -c --- previous hour mixing height -c htold=max(ziconv(i,j),zimin) - 070702 - htold=ziconv(i,j) - -c --- MIXDT2 is now called in mixhbg/mixhmc (050328) -c call mixdt2(ihrgmt,i,j,htold,dptmin,dzzi,tsf,tht,thtp,dtheta) - - - if(abs(imixh).eq.2) then -c --- Batchvarova-Gryning convective mixing height - call MIXHBG (ihrgmt,I,J,WT,DTHETA,TSF,1,THRESHL, - : ZIMAX,ZIMIN,USTAR(i,j),EL(i,j),HTOLD,ZICONV(I,J), - : THT,THTP) - - - else if (abs(imixh).eq.1) then -c--- Carson convective mixing height - call MIXHMC(ihrgmt,i,j,wt,DTHETA,1,threshl,zimax, - : htold,ziconv(i,j),DPTT(i,j),THT,THTP) - - endif - -c --- Upper bound to conv. mixing height: - ziconv(i,j)=amin1(zimax,ziconv(i,j)) - -c -c --- Calculate daytime(neutral) mechanical mixing height -c --- average potential temperature in DZZI above previous hour mix. height - tave=(thtp+tht)/2. -c --- BVF is sqrt(Brunt-Vaisala frequency) = (N**2)**0.25 - bvf=(g*dtheta/tave)**0.25 -c -c --- CMECH is constb/sqrt(f), where f is the Coriolis parameter -c --- Default values -- constb=1.41, conste=0.15, constn=2400. - hmech=cmech(i,j)*ustar(i,j)/bvf - zi(i,j)=amax1(zimin,hmech,ziconv(i,j)) - zi(i,j)=amin1(zimax,zi(i,j)) - - go to 100 -c -c ----------------------------------------------------------- -c --- Nighttime (stable) conditions -- mechanical mixing only -c ----------------------------------------------------------- -c --- Default value for constn is 2400. -300 continue -c -c --- Take the minimum of constn*ustar(i,j)**1.5 and -c --- 0.4*sqrt(ustar(i,j)*el(i,j)/abs(fcori(i,j))) -c -c --- Stable mixing ht. - Venkatram (1980a) - zi1=constn*ustar(i,j)**1.5 -c -c --- Stable mixing ht. - Zilitinkevich (1972) - zi2=0.4*sqrt(ustar(i,j)*el(i,j)/fcori(i,j)) -c - -c --- Mixing height must be between user-specified MIN/MAX range - zi(i,j)=amin1(zi1,zi2,zimax) - zi(i,j)=amax1(zimin,zi(i,j)) -c - ziconv(i,j)=0.0 - dptt(i,j)=0.0 -c -100 continue -c - -c --- DEBUG write option - if(ldbhr)then - messag='Temperature jump at top of mixed layer (deg. K)' - call out(dptt,idum,1,5,ldate,messag,nx,ny) - endif -c - return - end -c---------------------------------------------------------------------- - subroutine mixht2ST(el,ustar,qh,rho,ihrgmt,is,js, - 1 ilandu,iwat1,iwat2,imixh,zi,ziconv) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070702 MIXHT2ST -c --- -c F.Robe (09/2001) -c Based on MIXHT (J. Scire, SRC) - -c --- PURPOSE: Calculate the convective and mechanical mixing -c height (m) at one gridpoint over LAND in the NOOBS mode -c quick version of MIXHT2 -c -c --- Each mixing height is computed based on the MM5 temperature -c --- profile at the MM5 gridpoint closest to the CALMET gridpoint -c -c --- Daytime mixing height are computed as the MAXIMUM of -c --- convective (Maul, 1980) and mechanical (Venkatram, -c --- 1980b) values. Mixing heights during stable conditions -c --- are determine as the MINIMUM produced by two schemes -c --- (Venkatram, 1980a) and Zilitinkevich (1972). -c -c --- All mixing heights over land are subject to the -c --- MIN/MAX values specified by user inputs ZIMIN and -c --- ZIMAX. -c -c --- MIXHT2ST is called when lapse rates above mixing heights -c --- are extracted from prognostic data (3D.DAT). MIXHTST is the -c --- equivalent subroutine when lapse rates are extracted from -c --- upper air soundings (UP.DAT) -c -c --- UPGRADES: -c --- V6.221 (070327) to V6.223 (070702)- (FRR) -c - HTOLD uses last zi even if less than zimin -c -c --- v5.6 (050328) to V6.221 (070327)- (FRR) -c - Include 'grid.met' for debug option call to out -c - Remove ldbhr from calling list (was not defined) and -c include outpt.met where ldbhr is now defined -c -c --- Level 021105 to v5.6 (050328) - (FRR) -c - Add new convective mixing height parameterization -c (Batchvarova and Gryning). -c - Add buoyancy flux threshold for convective growth -c (dissipation) -c - Detailed computation and call to mixdt2 are now done -c in subroutines MIXHBG or MIXHMC -c -c --- INPUTS: -c EL - real - Monin-Obukhov Length (m) -c USTAR - real - Friction velocity (m/s) -c QH - real - Sensible heat flux (W/m**2) -c IHRGMT - integer - Local time (GMT) (IHRGMT can -c be >= 24) -c RHO - real - Air density at gridpoint (is,js) -c IS,JS - integer - gridpoint I,J -c ILANDU - integer - Land use category -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c results useful for debugging -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c Common block /ziparm/ -c constn,dptmin,dzzi,zimax,zimin,cmech,threshl -c -c Parameters: mxnx, mxny, mxss, mxus, mxlev, io6, mxxy -c -c --- OUTPUT: -c ZI(mxnx,mxny) - real array - Mixing height (m) -- max. of -c convective and mechanical hts. -c ZICONV(mxnx,mxny) - real array - Convective mixing height (m) -c -c --- MIXHT2ST called by: COMP -c --- MIXHT2ST calls: MIXHBG, MIXHMC,OUT -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - character*70 messag - logical ldate -c - include 'outpt.met' - - include 'ziparm.met' - include 'grid.met' - -c --- mm4hdo.met not needed (050328) -c include 'mm4hdo.met' - common /tjump/ dptt(mxnx,mxny) -c - data cp/996./,g/9.81/,ldate/.true./ -c - -c --- Check if cell is land or water - if(ilandu.ge.iwat1.and.ilandu.le.iwat2) go to 100 -c -c --- Check if heat flux is positive (daytime) or negative (nighttime) - if(qh.lt.0.0)go to 300 -c -c ----------------------------------------------------------------- -c --- Daytime -- calculate convective and mechanical mixing heights -c ----------------------------------------------------------------- -c -c --- Convert heat flux (W/m**2) to w'theta' (m * deg. K/s) - wt=qh/(rho*cp) -c -c --- Previous timestep convective mixing height -c htold=max(ziconv,zimin) --- 070702 - htold=ziconv - -c mixdt2 is now called in mixhbg/mixhmc (050328) -c call mixdt2(ihrgmt,is,js,htold,dptmin,dzzi,tsf,tht,thtp,dtheta) - - if(abs(imixh).eq.2) then -c --- Batchvarova-Gryning convective mixing height - call MIXHBG (ihrgmt,IS,JS,WT,DTHETA,tsf,1,THRESHL,ZIMAX,ZIMIN, - : USTAR,EL,HTOLD,ZICONV,THT,THTP) - - else if (abs(imixh).eq.1) then -c--- Carson convective mixing height - call MIXHMC(ihrgmt,is,js,wt,DTHETA,1,threshl,zimax, - : htold,ziconv,dptt(is,js),tht,thtp) - endif - -c --- Upper bound to conv. mixing height: - ziconv=amin1(zimax,ziconv) -c -c --- Calculate daytime(neutral) mechanical mixing height - tave=(thtp+tht)/2. -c --- BVF is sqrt(Brunt-Vaisala frequency) = (N**2)**0.25 - bvf=(g*dtheta/tave)**0.25 -c -c --- CMECH is constb/sqrt(f), where f is the Coriolis parameter -c --- Default values -- constb=1.41, conste=0.15, constn=2400. - hmech=cmech(is,js)*ustar/bvf - zi=amax1(zimin,hmech,ziconv) - zi=amin1(zimax,zi) - go to 100 -c -c ----------------------------------------------------------- -c --- Nighttime (stable) conditions -- mechanical mixing only -c ----------------------------------------------------------- -c --- Default value for constn is 2400. -300 continue -c -c --- Take the minimum of constn*ustar**1.5 and -c --- 0.4*sqrt(ustar*el/abs(fcori(is,js))) -c -c --- Stable mixing ht. - Venkatram (1980a) - zi1=constn*ustar**1.5 -c -c --- Stable mixing ht. - Zilitinkevich (1972) - zi2=0.4*sqrt(ustar*el/fcori(is,js)) -c -c --- Mixing height must be between user-specified MIN/MAX range - zi=amin1(zi1,zi2,zimax) - zi=amax1(zimin,zi) -c - ziconv=0.0 - dptt(is,js)=0.0 -c -100 continue -c -c --- DEBUG write option - if(ldbhr)then - messag='Temperature jump at top of mixed layer (deg. K)' - call out(dptt,idum,1,5,ldate,messag,nx,ny) - endif -c - return - end -c -c ------------------------------------------------------------------------- - Subroutine MIXHBG (ihrgmt,IS,JS,WT,GAMMA,TK,ILAPSE,THRESH, - : ZIMX,ZIMN,USTAR,EL,ZICBGOLD,ZICBG,THT,THTP) -c ------------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 110212 MIXHBG -c --- F. Robe (Earth Tech Inc.) -c -c --- PURPOSE: Compute the convective mixing height (m) -c following Batchvarova and Gryning (1991,1994) -c -c -c --- UPDATES -c--- v6.329 (100719) to v6.332 (110212)(FRR) -c (1) Apply relaxation of convective mixing height to equilibrium -c value according to user-input flag IZICRLX -c (2) USe user-defined relaxation time TZICRLX rather than -c hardwired value of 800s -c (3) IZICRLX and TZICRLX are passed on via ZIPARM.MET -c (4) Make relaxation ZIcbg consistent with the threshold flux -c i.e. a function h0 (min of 100m) rather than zicbgold -c -c --- v6.206 Level 060322 to v6.329 (100719) (F.Robe) -c - Relax convective mixing heigt to equilibrium value based on THRESHW -c (or THRESHL) and turbulence timescale of 800s when the buoyancy flux -c is positive but lower than the threshold (rather than collapsing -c the convective mixing height to 0, causing w*=0 eventhough qh>0) -c This change can affect Zi and w* prior results for cases where -c THRESHW>0 and/or THRESHL>0 during weakly convective times -c -c --- v6.203 Level 060301 to v6.206 Level 060322 -c --- Modifications by F.Robe -c (1) Replace Tk by dummy variable tsf in call to mixdt2 -c otherwise mixdt2 overwrites Tk with MM5 surface temperature -c (not ok for all options e.g. overwater) (also in V5.718 Level 060305) -c (2) Add check for negative log arguments and replace zeta2 estimate -c by average value if necessary (also in V5.722 level 060322) -c -c --- V6.2 Level 060215 to V6.203 Level 060301 (F.Robe) -c (1) Replace numerical integration of the BG equations by an -c analytical integration method ("false images") to optimize -c accuracy/CPU time. -c -c --- V5.6 Level 050328 to V6.2 Level 060215 (F.Robe) -c - Get CALMET timestep in seconds from GEN.MET and -c estimate growth once per timestep -c -c --- INPUTS: -c IHRGMT - real - GMT hour -c (IS,JS) - integer - CALMET gridpoints -c WT - REAL - Surface Buoyancy flux in terms of -c (m * deg. K/s) -c GAMMA - REAL - potential temperature lapse rate above -c previous hourmixing height -c (input if ilapse=0 or 2 or if ilapse=1 -c and nstep=1 (hourly computational timestep)) -c TK - real - Surface air temperature (K) -c ILAPSE - INT - Lapse rate computational option -c 0: read from SEA.DAT file (TGRADA) and -c passed on as dtdz -c 1: computed from MM5.DAT (call to mixdt2) -c 2: extracted from UP.DAT and passed on -c as gamma -c THRESH - real - Threshold surface buoyancy (energy) flux per -c meter of boundary layer to get Mixing -c height growth (units: W/m2/m) -c = THRESHL overland -c = Threshw overwater -c ZIMX - REAL - Maximum mixing height (m) -c ZIMN - REAL - Minimum mixing height (m) -c USTAR - REAL - Ustar (m/s) -c EL - REAL - Monin-Obuknov length (m) -c ZICBGOLD - real - Previous hour convective mixing height (m) -c -c --- Via common block /ziparm/ -c DPTMIN: minimum potential temp. lapse rate -c DZZI: thickness of layer above Mix. Height where lapse rate is computed -c IZICRLX, TZICRLX -c -c --- Via common block /gen/ -c nsecdt: timestep (in seconds) -c -c --- OUTPUT: -c ZICBG - real - Convective mixing height -c GAMMA - real - Potential temperature lapse rate above -c previous hour mixing height -c (output if ilapse=1 and nstep>1) -c THT - real - Temperature (deg. K) at height -c "HTOLD" meters -c THTP - real - Temperature (deg. K) at height -c "HTOLD + DZZI" meters -c -c --- MIXHBG called by : WATER , MIXHT, MIXHT2, MIXHTST, MIXHT2ST -c -c --- MIXHBG calls : MIXDT2, function FBG -c -c---------------------------------------------------------------------- - include 'params.met' - include 'ziparm.met' -c --- need nsecdt (060215) - include 'gen.met' - - data g/9.81/,rho/1.2/,cp/1005./ - data vonk/0.4/,ca/0.2/,cb/2.5/,cc/8./ - -c --- Initial mixing height - h0=max(zicbgold,zimin) - -c --- Compute temperature lapse rate above current mixing height -c --- if using MM5 profile (non constant) - if (ilapse.eq.1 ) then - call MIXDT2(ihrgmt,is,js,h0,dptmin,dzzi,tsf,tht,thtp, - : gamma) - endif - -c --- Threshold buoyancy flux to sustain H0 meters of mixing height - wto=thresh*h0/(rho*cp) - -c --- Net buoyancy flux (surface flux - dissipation) - wptp=wt-wto - -c --- Opt for either total collapse (backward compatible with V5.8 and -c pre v6.329 codes) or relaxation, based upon user input (110212) - if (izicrlx.eq.0) then - -c --- No convective growth if positive Lmo or negative wptp - if(el.gt.0. .or. wptp.lt.0) then - zicbg=0. - return - endif -c --- If no net buoyancy flux, no further growth - if(wptp.eq.0) then - zicbg=zicbgold - return - endif - - else -c --- 100719 - Do not totally collapse Zic if 0>-2c (i.e. small abs|L| ) - h=SQRT(h0*h0+2.*d*a*t) - else -c --- for h<<-2c (large abs|L|) - h=(h0**3-6*a*c*t)**0.333 - endif - zeta1=d*h-2.*c - zetap1=e*h-c - f1=r4*fbg(zeta1,zetap1,r1,r2,r3)-time - h=(zeta1+2.*c)/d -c --- Check if first guess good enough (implied time f1 < 1s) - if(ABS(f1).LE.1.) goto 20 - -c --- Second value estimated from zeta1 and zeta0 (h0) - f0=-t - zeta2=(f1*zeta0-f0*zeta1)/(f1-f0) - zetap2=r5*(zeta2+2.*c)-c - if(zeta2.le.0.or.zetap2.le.0) then -c --- compute second guess as average z0,z1 instead (definite positive)(060322) - zeta2=0.5*(zeta0+zeta1) - zetap2=r5*(zeta2+2.*c)-c - endif - f2=r4*fbg(zeta2,zetap2,r1,r2,r3)-time - h=(zeta2+2.*c)/d -c --- Check if second guess good enough (implied time f2 < 1s) - if(ABS(f2).LE.1.) goto 20 - - -c --- Maximum 10 iterations - do n=1,10 -c --- Might have already converged (screen those to avoid dividing by 0) - if(abs(f1-f2).le.1e-10) goto 20 - zeta3=(f1*zeta2-f2*zeta1)/(f1-f2) - zetap3=r5*(zeta3+2.*c)-c -c --- only positive definite arguments to fbg (060322) - if(zeta3.le.0.or.zetap3.le.0) goto 19 - f3=r4*fbg(zeta3,zetap3,r1,r2,r3)-time - h=(zeta3+2.*c)/d - zeta1=zeta2 - zetap1=zetap2 - zeta2=zeta3 - zetap2=zetap3 - f1=f2 - f2=f3 -c --- Done if time difference is less than 1 second - if(ABS(f3).LE.1.) goto 20 - enddo -19 continue -c --- if solution has not converged in 10 iterations or if negative arguments -c --- average last 2 values (could be oscillating hence the average) - h=((zeta1+zeta2)/2. + 2.*c)/d -20 continue - -c --- Convective mixing height (within min-max values) - zicbg=min(h,zimx) - zicbg=max(h,zimn) - - return - - end -c -------------------------------------------------------------------- - function fbg(zeta,zetap,r1,r2,r3) -c ------------------------------------------------------------------- -c --- CALMET Version: 6.5.0 Level: 060301 FBG -C -C FBG is a function used by the solver in subroutine MIXHBG -C INPUT: Zeta, zetap,R1,R2,R3 - real -C OUTPUT: FBG - real -C - - fbg=zeta**2+r1*zeta+r2*LOG(zeta)+r3*LOG(zetap) - return - end -c --------------------------------------------------------------------- - subroutine mixhmc(ihrgmt,is,js,wt,gamma,ilapse,thresh,zimx, - : htold,zic,dptt,tht,thtp) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 110212 MIXHMC -c --- F. Robe -c after MIXHTST/MIXHTST2 (J. Scire, SRC) -c -c --- PURPOSE: Compute the convective mixing height (m) -c following the Maul-Carson method, upgraded to include -c a buoyancy threshold (minimum heat flux required to overcome -c dissipation and allow convective growth) -c -c --- UPDATES -c--- v6.329 (100719) to v6.332 (110212)(FRR) -c (1) Apply relaxation of convective mixing height to equilibrium -c value according to user-input flag IZICRLX -c (2) USe user-defined relaxation time TZICRLX rather than -c hardwired value of 800s -c (3) IZICRLX and TZICRLX are passed on via ZIPARM.MET -c -c--- V6.203 (060301) to v6.329 (100719)(FRR) -c - Relax convective mixing heigt to equilibrium value based on THRESHW -c (or THRESHL) and turbulence timescale of 800s when the buoyancy flux -c is positive but lower than the threshold (rather than collapsing -c the convective mixing height to 0, causing w*=0 eventhough qh>0) -c This change can affect Zi and w* prior results for cases where -c THRESHW>0 and/or THRESHL>0 during weakly convective times -c - Include GEN.MET to get nsecdt -c -c--- v6.202 (060219) to V6.203 (060301)(FRR) -c - Test whether convective growth based on net surface buoyancy flux -c (wt-wto) (i.e. consider threshold too). -c - Calculate values for Tht and THTP even when negative net flux (ilapse=1) -c as they are needed in mixht/mixht2 in that case too. -c -c --- V6.2 (060215) to v6.202 (060219) (FRR) -c - Comment out the (hourly) definitions of onedte and twodte (which -c are correctly done in microi and passed via common ziparm.met -c -c --- V5.7 (051230) to V6.2 (060215) (FRR) -c - Implement sub-hourly timestep for growth (this is done implicitly -c via constants onedte and twodte defined in microi as a multiple -c of the actual timestep (not necessarily 3600sec anylonger) -c -c --- V5.614 (051113) to V5.7 (051230)- J. Scire -c - Correct checks of mixing ht (ZIC) vs. maximum (ZIMX) -c - Update of some comments (units added + common block inputs) -c - Add checks on range of WT variable for testing purposes -c --- V5.6 (050328) to v5.611 (051113)- (FRR) -c - Remove zimin from calling list (not used) -c --- v5.6 Level 050328 to v5.611 Level 051113 (F.Robe) -c - Set non-zero minimum mixing height -c -c --- INPUTS: -c IHRGMT - real - GMT hour -c (IS,JS) - integer - CALMET gridpoints -c WT - REAL - Surface Buoyancy flux in terms of -c (m * deg. K/s) -c GAMMA - REAL - potential temperature lapse rate -c (deg. K/m) above previous hour's -c mixing height -c (input when ilapse=0 or 2) -c ILAPSE - INT - Lapse rate computational option -c 0: read from SEA.DAT file (TGRADA) and -c passed on as gamma -c 1: computed from MM5.DAT (call to mixdt2) -c 2: extracted from UP.DAT and passed on -c as gamma -c THRESH - real - Threshold surface buoyancy (energy) flux per -c meter of boundary layer to get mixing -c height growth (units: W/m2/m) -c = THRESHL overland -c = Threshw overwater -c HTOLD - REAL - Previous hour convective mixing height (m) -c DPTT - real - Pot. temp. jump (deg. K) at top of -c previous hour conv. mix. height -c (updated in this subroutine) -c ZIMX - REAL - Maximum mixing height (m) -c -c Common block /ziparm/ -c dptmin, conste, dzzi , onedte, twodte, izicrlx, tzicrlx -c -c Common block /gen/ -c nsecdt -c -c --- OUTPUT: -c ZIC - real - Convective mixing height (m) -c GAMMA - real - Lapse rate (deg. K/m) above previous -c hour's mixing height (output if ilapse=1) -c DPTT - real - Pot. temp. jump (deg. K) at top of new -c conv. mix. height -c THT - real - Temperature (deg. K) at height -c "HTOLD" meters -c THTP - real - Temperature (deg. K) at height -c "HTOLD + DZZI" meters -c -c -c --- MIXHMC called by: WATER, MIXHT, MIXHT2, MIXHTST, MIXHT2ST -c --- MIXHMC calls : MIXDT2 -c -c---------------------------------------------------------------------- - include 'params.met' - include 'ziparm.met' - include 'gen.met' - - data cp/996./,rho/1.2/ - - - -c --- Compute temperature lapse rate above current mixing height -c --- if using MM5 profile (non constant) - if (ilapse.eq.1) then - call MIXDT2(ihrgmt,is,js,htold,dptmin,dzzi,tsf,tht,thtp,gamma) - endif -c --- dptmin is minimum stable pot. temp. lapse rate - gamma=amax1(gamma,dptmin) - -c --- Threshold buoyancy flux - wto=thresh*htold/(rho*cp) - -c --- Opt for either total collapse (backward compatible with V5.8 and -c pre v6.329 codes) or relaxation, based upon user input (110212) - if (izicrlx.eq.0) then -c --- Compute convective growth Only if net positive buoyancy flux - if ((wt-wto).le.0) then - zic=0. - return - endif - else -c --- 100719 - Do not totally collapse Zic if 0 0) or if MM5 precipitation data exist(NPSTA=-1) -c -c --- UPDATES: -c Level 901130 to V6.2 (060215) (F. Robe) -c - Replace hour ending times with explicit beginning/ending -c times, including seconds (sub-hourly timesteps) - -c --- INPUTS: -c NDATHRB - integer - Beginning Date and hour (YYYYJJJHH) -c in LST (explicit) -c NSECB - integer - Beginning seconds in LST (explicit) -c NDATHRE - integer - Ending Date and hour (YYYYJJJHH) -c in LST (explicit) -c NSECE - integer - Ending seconds in LST (explicit) -c NX, NY - integers - No. X, Y grid cells -c NZ - integer - No. vertical layers -c NSSTA - integer - No. surface stations -c NPSTA - integer - No. precipitation stations -c IRTYPE - integer - Run type (0=only wind fields computed, -c 1=winds + other met. fields computed) -c RHO(mxnx,mxny)- real array - Air density (kg/m**3) at all gridpoints -c QSW(mxnx,mxny)- real array - Short-wave radiation (W/m**2) at all -c gridpoints -c IOMET - integer - Fortran unit no. of output file -c LCALGRD - logical - Logical flag controlling output of -c special data fields needed by CALGRID -c (3-D fields of W and temperature) -c (LCALGRD=T to output these fields) -c IRH2D(mxnx,mxny) - real array - surface relative humidity -c TEMP2D(mxnx,mxny)- real array - surface temperature -c IPCODE2D(mxnx,mxny)- real array - precipitation code -c -c Common block /METGRD/ -c IPGT(mxnx,mxny), USTAR(mxnx,mxny), ZI(mxnx,mxny), -c EL(mxnx,mxny), WSTAR(mxnx,mxny), RMM(mxnx,mxny) -c ZTEMP(mxnx,mxny,mxnz) -c frr (09/01) no need for common block MET2 as 2D values of T,RH,IPCODE -c Common block /MET2/ -c TEMPK(mxss), IRH(mxss), IPCODE(mxss) -c Common block /D1/ -c U(mxnx,mxny,mxnz), V(mxnx,mxny,mxnz), W(mxnx,mxny,mxnzp1) -c Parameters: MXSS, MXUS, MXNX, MXNY, MXNZ, MXWND, MXNZP1 -c -c --- OUTPUT: none -c -c --- OUTHR called by: COMP -c --- OUTHR calls: WRTI2D, WRTR2D -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real rho(mxnx,mxny),qsw(mxnx,mxny),xbuf(mxnx,mxny) - real temp2d(mxnx,mxny) - integer irh2d(mxnx,mxny),ipcode2d(mxnx,mxny) - - character*8 clabel - logical lcalgrd -c - include 'metgrd.met' - include 'd1.met' - -c -c --- write the wind components - do 10 i=1,nz -c - clabel='U-LEV' - write(clabel(6:8),'(i3)')i - call wrtr2d(iomet,u(1,1,i),xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel(1:1)='V' - call wrtr2d(iomet,v(1,1,i),xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - if(LCALGRD)then -c --- W velocities at TOP cell face are written (NZ fields in all) - clabel(1:5)='WFACE' - call wrtr2d(iomet,w(1,1,i+1),xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) - endif -10 continue -c -c --- write the 3-D temperature field (LCALGRD run only) - if(irtype.eq.0)return - if(LCALGRD)then - clabel='T-LEV' - do 20 i=1,nz - write(clabel(6:8),'(i3)')i - call wrtr2d(iomet,ztemp(1,1,i),xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -20 continue - endif -c -c --- write other 2-D meteorological fields -- PGT stability class, -c Friction velocity (m/s), Mixing height (m), Monin-Obukhov -c length (m), Convective velocity scale (m/s), Precip. -c rate (mm/hr) -c (if run type = 0, i.e., only winds computed, skip these writes) - if(irtype.eq.0)return - clabel='IPGT' - call wrti2d(iomet,ipgt,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='USTAR' - call wrtr2d(iomet,ustar,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='ZI' - call wrtr2d(iomet,zi,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='EL' - call wrtr2d(iomet,el,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='WSTAR' - call wrtr2d(iomet,wstar,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='RMM' - if(npsta.ne.0 ) - : call wrtr2d(iomet,rmm,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) - -c -c frr (09/01) SF TEMP, RHO, QSW, IRH, IPCODE: 2-D fields -c Air density (kg/m**3), Short-wave solar radiation (W/m**2), -c Relative humidity (percent), Precipitation code - - clabel='TEMPK' - call wrtr2d(iomet,temp2d,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='RHO' - call wrtr2d(iomet,rho,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='QSW' - call wrtr2d(iomet,qsw,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='IRH' - call wrti2d(iomet,irh2d,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) -c - clabel='IPCODE' - if(npsta.ne.0) - : call wrti2d(iomet,ipcode2d,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) - - return - end -c---------------------------------------------------------------------- - subroutine pack(nvals,xdata,nwords,xbuf) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 PACK -c --- J. Scire, SRC -c -c --- PURPOSE: Pack a packed array of data by eliminating zeroes -c (assumes all data values >= 0.0) -c -c --- INPUTS: -c XDATA(NVALS) - real array - Array of unpacked data -c NVALS - integer - No. of unpacked values stored in -c packed array -c -c --- OUTPUT: -c NWORDS - integer - Number of packed words -c XBUF(NWORDS) - real array - Array of packed data -c -c --- PACK called by: ****** -c --- PACK calls: none -c---------------------------------------------------------------------- - real xbuf(nvals),xdata(nvals) -c -c --- pack the data - nzero=0 - nwords=0 - do 100 i=1,nvals -c - if(xdata(i).eq.0.)then - nzero=nzero+1 - go to 100 - endif -c - if(nzero.gt.0)then - nwords=nwords+1 - xbuf(nwords)=-nzero - nzero=0 - endif -c - nwords=nwords+1 - xbuf(nwords)=xdata(i) -100 continue -c -c --- account for case when last value in unpacked array is a zero - if(nzero.gt.0)then - nwords=nwords+1 - xbuf(nwords)=-nzero - endif -c -c --- if all values are zero, set nwords = 0 - nzero=-xbuf(1)+0.001 - if(nzero.eq.nvals)nwords=0 -c - return - end -c---------------------------------------------------------------------- - subroutine pgtstb(u10,v10,nears,icc,iceil,sinalp,ilandu, -ccec101006 1 iwat1,iwat2,nx,ny,icloud,ccgrid,iceilg,ipgt) - 1 iwat1,iwat2,nx,ny,mcloud,ccgrid,iceilg,ipgt) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101006 PGTSTB -c --- J. Scire, SRC -c Modified by F.Robe, Earth Tech Inc. (09/01) -c -c --- PURPOSE: Calculate PGT stability class (1-6) at each non-water -c grid point -c -c --- UPDATES -c --- V6.217 (061231) to V6.330 (101006) -c - Change in ICLOUD into MCLOUD (and ICLDOUT) -c -c --- MOD5 (951021) to V6.217 (061231) (FRR) -c - Allow icloud=4 option -c -c --- INPUTS: -c U10(mxnx,mxny) - real array - Surface U component wind (m/s) -c at height of 10 m -c V10(mxnx,mxny) - real array - Surface V component wind (m/s) -c at height of 10 m -c NEARS(mxnx,mxny) - integer array - Station number of surface -c station closest to each grid pt -c ICC(mxss) - integer array - Cloud cover (tenths) -c ICEIL(mxss) - integer array - Ceiling height (hundreds of ft) -c SINALP(mxnx,mxny) - real array - Sine of the solar elevation -c angle at all grid points -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c MCLOUD - integer - Flag indicating if gridded -c cloud data are available -c (2 = yes, otherwise, no) -c CCGRID(mxnx,mxny) - real array - Gridded cloud fraction -c (Used only if MCLOUD=2,3,4) -c ICEILG(mxnx,mxny) - int array - Gridded ceiling height -c (Used only if MCLOUD=3 or 4) -c Parameter: MXNX, MXNY, MXSS -c -c --- OUTPUT: -c IPGT(mxnx,mxny) - integer array - PGT stability class (1-6) at -c each grid point -c -c --- PGTSTB called by: COMP -c --- PGTSTB calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real u10(mxnx,mxny),v10(mxnx,mxny) - real ccgrid(mxnx,mxny) -c frr (09/01) sinalp at all grid points -c real sinalp(mxss) - real sinalp(mxnx,mxny) - real scrit(3) -c frr (09/01) gridded ceiling height - integer iceilg(mxnx,mxny) -c - integer nears(mxnx,mxny),ilandu(mxnx,mxny),ipgt(mxnx,mxny) - integer icc(mxss),iceil(mxss) - integer jstab(12,7) -c - data scrit/0.258819,0.5735764,0.8660254/ - data jstab/6,6,6,6,6,6,5,5,5,5,4,4, - 1 6,6,6,5,5,5,4,4,4,4,4,4, - 2 4,4,4,4,4,4,4,4,4,4,4,4, - 3 3,3,3,4,4,4,4,4,4,4,4,4, - 4 2,2,2,3,3,3,3,3,3,4,4,4, - 5 1,2,2,2,2,2,2,3,3,3,3,4, - 6 1,1,1,1,1,2,2,2,2,3,3,3/ -c -c --- calculate PGT stability class -c - do 200 i=1,nx - do 200 j=1,ny -c -c --- check land use category -- water if ILANDU between IWAT1 & IWAT2 - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2)go to 200 -c -c --- over land -- use Turner method -c -c --- NSTA is the station number of the nearest surface met. station to -c --- the current grid point (i,j) - nsta=nears(i,j) -c -c frr (09/01) ceiling height -ccec101006 if (icloud.ge.3) then - if (mcloud.ge.3) then - jceil=iceilg(i,j) - else - jceil=iceil(nsta) - endif - -c --- calculate insolation category & pgt stability class -ccec101006 if( icloud.gt.1)then - if( mcloud.gt.1)then -c --- Use gridded cloud data - convert from fraction to tenths - jcc=10.*ccgrid(i,j)+0.5 - else -c --- Use NWS cloud data (in tenths) - jcc=icc(nsta) - endif -c jceil=iceil(nsta) - -c frr (09/01) -c if(sinalp(nsta).le.0.0)then - if(sinalp(i,j).le.0.0)then -c -c --- nightime stability -c --- for icc = 0-4, ic = -2 - ic=-2 - if(jcc.gt.4)then -c --- for icc = 4-9 or 10 (with iceil ge 7,000 ft), icc = -1 - ic=-1 -c --- for icc = 10 and iceil lt 7,000 ft, icc = 0 -c frr (09/01)jceil already computed -c if(jcc.eq.10.and.iceil(nsta).lt.70)ic=0 - if(jcc.eq.10.and.jceil.lt.70)ic=0 - endif - else -c -c --- daytime stability -c --- calculate radiation index, iri -c --- sinalp array contains sine of the elevation angle -c --- scrit(1)=sin(15. deg);scrit(2)=sin(35. deg); -c --- scrit(3)=sin(60. deg) -c frr sel=sinalp(nsta) - sel=sinalp(i,j) - do 55 n=1,3 - if(sel.le.scrit(n))then - iri=n - go to 56 - endif -55 continue - iri=4 -56 continue -c -c --- determine daytime insolation class, ic - ic=iri - if(jcc.gt.5)then -c frr (09/01)jceil already computed -c jceil=iceil(nsta) - if(jcc.eq.10)then -c -c --- icc = 10 -- ceiling ht. is in hundreds of ft. - if(jceil.lt.70)then -c --- icc=10; iceil lt 7,000 ft. - ic=0 - else if(jceil.lt.160)then -c -c --- icc=10; 7,000 ft le iceil lt 16,000 ft - ic=iri-2 - ic=max0(ic,1) - else -c -c --- icc=10; iceil ge 16,000 ft - ic=iri-1 - ic=max0(ic,1) - endif - else -c -c --- 5 lt icc lt 10 - if(jceil.lt.70)then -c -c --- 5 lt icc lt 10; iceil lt 7,000 ft - ic=iri-2 - ic=max0(ic,1) - else if(jceil.lt.160)then -c -c --- 5 lt icc lt 10; 7,000 ft le iceil lt 16,000 ft - ic=iri-1 - ic=max0(ic,1) - else -c -c --- 5 lt icc lt 10; iceil ge 16,000 ft - ic=iri - endif - endif - endif - endif -c -c --- convert insolation class (-2 to +4) to array index (1 to 7) - index=ic+3 -c -c --- convert wind speed from m/s to nearest knot(1.9438 knots=1 m/s) - iwsx=1.9438*sqrt(u10(i,j)**2+v10(i,j)**2)+0.5 - iwsx=max0(iwsx,1) - iwsx=min0(iwsx,12) -c - ipgt(i,j)=jstab(iwsx,index) -c -200 continue -c - return - end -c---------------------------------------------------------------------- - subroutine prepdi(ws,wd,tempk,uaveaa,uavebb,vaveaa,vavebb, - 1 nhre,nyrze,njulze,nhrze,nsece,ziconv,gamma, - 2 um,vm,wt,us,vs,nowsta,wsow,wdow) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 090511 PREPDI -c --- J. Scire, SRC -c --- Sections adapted from code written by S. Douglas, SAI -c --- Modified by M. Fernau -c -c --- PURPOSE: Fill wind observational data arrays for the wind -c field module -c - If input wind data are preprocessed into -c hourly U, V components, read directly from -c input file -c - If using twice-daily soundings and routinely -c available hourly surface data, perform time -c interpolation of upper air data and convert -c surface wind components to U, V components -c -c --- UPDATES: -c --- V6.32 Level 080205 to v6.327 Level 090511(FRR) -c - Add more explicit information to 1089-1090 error write -c statements -c -c --- V6.222 (070404) to V6.32 Level 080205(FRR) -c - Use explicit end times instead of beginning times -c -c --- V6.218 (070113)to V6.222 (070404) (F.Robe) -c - Initialize um,vm -c -c --- V6.215 (061020) to V6.218 (070113) (F.Robe) -c - Do not compute domain representative sf temp (Tinf) if -c ISURFT=-1 (2D spatially varying sf temp) -c - Remove Beta2 from calling list (not computed anylonger -c as never used) -c - Replace former scalar lapse rate gamma by 2-D array based on all -c upper air stations if IUPT=-1 and only one if IUPT>0 -c - Include met1.met and remove nssta,nusta,noobs nz from calling list -c - Include grid.met and remove nz from calling list -c -c --- V6.2 (060215) to V6.215 (061020) (DGS) -c - Update arguments for CGAMMA (include seconds) -c -c --- V5.6 (050328) to V6.2 (060215) (F.Robe) -c - Allow sub-hourly sounding frequency -c - Replace hour-ending times with explicit beginning times with seconds -c -c --- V5.6 (050328-FRR): explicit common replace by include d4/d6.met -c -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- INPUTS: -c WS(mxss) - real array - Surface land wind speed (m/s) -c WD(mxss) - real array - Surface land wind direction (degrees) -c WSOW(mxows) - real array - Over water wind speed (m/s) -c WDOW(mxows) - real array - Over water wind direction (degrees) -c TEMPK(mxss) - real array - Surface air temperature (deg. K) -c note:no missing value in TEMPK (replaced -c by nearest station value) -c UAVEaa(mxnz,mxus) - real array - U component of wind for each grid -c cell and upper air station at -c aa GMT for NWS stations or -c arbitrary time for other stations -c UAVEbb(mxnz,mxus) - real array - U component of wind for each grid -c cell and upper air station at -c bb GMT for NWS stations or -c arbitrary time for other stations -c VAVEaa(mxnz,mxus) - real array - V component of wind for each grid -c cell and upper air station at -c aa GMT for NWS stations or -c arbitrary time for other stations -c VAVEbb(mxnz,mxus) - real array - V component of wind for each grid -c cell and upper air station at -c bb GMT for NWS stations or -c arbitrary time for other stations -c NOWSTA - integer - Number of over water stations -c NHRE - integer - Hour (LST) in "IBTZ" time zone -c (explicit end time) -c NYRZE - integer - Year of current hour (GMT) -c (explicit end time) -c NJULZE - integer - Day of current hour (GMT) -c (explicit end time) -c NHRZE - integer - Current Hour (GMT) -c (explicit end time) -c NSECE - integer - Current End Second -c ZICONV(mxnx,mxny) - real array - Convective mixing heights (m) -c -c Common block /WPARM/ -c idiopt(5), isurft, iupt, zupt, iupwnd, zupwnd1, zupwnd2, -c iiupt, jjupt, iiupwn, jjupwn, iextrp -c Parameters: MXNX, MXNY, MXNZ, MXSS, MXUS, MXBAR, MXLEV, -c MXWND, MXWK3, IO6, MXOWS -c Common block /GRID/ -c nx,ny,nz,dgrid -c common block /MET1/ -c xusta(mxus),yusta(mxus),noobs,IIUP(mxus),JJUP(mxus) -c -c --- OUTPUT: -c ** GAMMA - real array - Temperature lapse -c rate (deg. K/m) -c ** UM - real - Domain-scale U wind component -c (m/s) -c ** VM - real - Domain-scale V wind component -c (m/s) -c WT(mxwnd) - real array - Weighting factor for observations -c US(mxnz,mxwnd) - real array - U wind components (surface & upper -c air stations) to be used in wind -c field module -c VS(mxnz,mxwnd) - real array - V wind components (surface & upper -c air stations) to be used in wind -c field module -c common block /WPARM/ -c **tinf, htfac -c -c ** => parameters used only if diagnostic wind field option -c is selected -c -c --- PREPDI called by: COMP -c --- PREPDI calls: CGAMMA, VERTAV, XMIT, DELTT -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real ws(mxss),wd(mxss),tempk(mxss),wsow(mxows),wdow(mxows) - real ziconv(mxnx,mxny) - real uaveaa(mxnz,mxus),uavebb(mxnz,mxus),uave(mxnz,mxus) - real vaveaa(mxnz,mxus),vavebb(mxnz,mxus),vave(mxnz,mxus) - real wt(mxwnd),us(mxnz,mxwnd),vs(mxnz,mxwnd) - real work2(3),work3(mxwk3) - - real gamma(mxnx,mxny),gamup(mxus),dis2(mxus) -c - CHARACTER*4 namst,LAST,IBLANK,NAM -c - include 'd4.met' - include 'd6.met' - include 'upmet.met' - include 'wparm.met' - include 'grid.met' - include 'met1.met' -c - DATA ZERO /0./, LAST /'LAST'/, IBLANK /' '/ - -c - htfac=1.0 - um=0. - vm=0. - -c --- Explicit end time (080205) - nowtze= nyrze*100000+njulze*100+nhrze -c -c --- TINF, GAMMA, UM, VM are needed only if using diagnostic model - if(iwfcod.ne.1)go to 8 -c -c --- set surface temperature (deg. K) for use in wind field module -c --- unless 2D spatially varying surface temp is used (isurft=-1)(070113) - - if (isurft.ne.-1) then - if(idiopt(1).eq.0)then -c -c --- use temperature from surface station "isurft" - tinf=tempk(isurft) - else -c -c --- read temp. (deg. K) from diagnostic data file - READ(IRD,1010)TINF -1010 FORMAT(10X,F6.2) - endif - endif -c -c --- Computer temperature lapse rate - if (noobs .eq. 0 ) then - if(idiopt(2).eq.0)then -c -c --- use lapse rate from upper air station "iupt" or 2-D variable -c --- lapse rate based on all upper air stations (070113) - - if(iupt.gt.0) then -c --- use single upper air station IUPT - call CGAMMA(nyrze,njulze,nhrze,nsece,iupt,zupt, - & ziconv(iiupt,jjupt),gamup(iupt)) -c --- Fill in 2D array (and convert to deg. K/m) (070113) - do i=1,nx - do j=1,ny - GAMMA(i,j) = GAMUP(iupt) - end do - end do - else -c --- 2-D varying lapse rate -c --- First compute lapse rate at each upper air station - do iu=1,nusta -c --- compute lapse rate at all upper air stations - call CGAMMA(nyrze,njulze,nhrze,nsece,iu,zupt, - & ziconv(iiup(iu),jjup(iu)),gamup(iu)) - end do -c --- Perform 1/R**2 INTERPOLATION - do 210 i=1,nx - xgm=(float(i)-0.5)*dgrid - do 205 j=1,ny - ygm=(float(j)-0.5)*dgrid - top=0.0 - bot=0.0 -c --- Compute distance**2 of each upper air station to grid point (in meters) - call cmpd2(xgm,ygm,xusta,yusta,nusta,dis2) -c -c --- Compute weighting functions for 1/R**2 method - do 203 k=1,nusta -c --- Minimum value of dist**2 to avoid numerical problems - dis2saf=amax1(dis2(k),0.01) - top=top+gamup(k)/dis2saf - bot=bot+1.0/dis2saf -203 continue -c --- Weighted lapse rate at each gridpoint - gamma(i,j)=top/bot - - -205 continue -210 continue - - - endif - - else -c -c --- read lapse rate (deg. K/km) from diagnostic data file - READ(IRD,1030)GAMDIA -1030 FORMAT(10X,8F5.1) -c -c --- Fill in 2D array (and convert to deg. K/m) (070113) - do i=1,nx - do j=1,ny - GAMMA(i,j) = GAMDIA/1000. - end do - end do - - endif -C - -C --- STORE THE SIGN OF GAMMA IN BETA2 ARRAY -c --- Beta2 is never used - Do not compute (070113) -c IF (GAMMA .LT. 0.) BETA2 = 1. -c IF (GAMMA .EQ. 0.) BETA2 = 0. -c IF (GAMMA .GT. 0.) BETA2 = -1. - - end if -c -c --- set domain-scale wind components -c *** JC modifications of 8/23/93 for non-uniform first-guess field. *** -c Added additional criterion of iupwnd.gt.0 -c - if (noobs .eq. 0) then - if(idiopt(3).eq.0)then - if(iupwnd.gt.0)then -c -c --- compute from upper air station "iupwnd" -c --- first calculate vertically averaged winds through layer -c --- from zupwnd(1) to zupwnd(2) at aa GMT and bb GMT - call vertav(iupwnd,uaa,vaa,zlaa,nlaa(iupwnd),1,zupwnd, - 1 umaa,vmaa) - call vertav(iupwnd,ubb,vbb,zlbb,nlbb(iupwnd),1,zupwnd, - 1 umbb,vmbb) -c -c *** rjy additions of 1/26/90 for arbitrary soundings. *********** - jorder = justa(iupwnd) - jdelta = jusdt(iupwnd) - ntzaas = ntzaa(iupwnd) - call dedat(ntzaas,jaayr,jaaday,jaahr) - ntzbbs = ntzbb(iupwnd) - call dedat(ntzbbs,jbbyr,jbbday,jbbhr) - -c --- For sub-hourly soundings(060215) - iaasec = jaasec(iupwnd) - ibbsec = jbbsec(iupwnd) - - -c**** Modified by EMI -- 4/26/94 - if(jorder.gt.0) then -c --- Compute time difference in seconds (060215) - call deltsec(nowtze ,nsece,ntzbbs,ibbsec,jtogo) - call deltsec(ntzaas,iaasec,nowtze,nsece,jpast) - else - call deltsec(nowtze ,nsece,ntzaas,iaasec,jtogo) - call deltsec(ntzbbs,ibbsec,nowtze,nsece,jpast) - endif -c check for negative values of jtogo or jpast - if(jtogo.LT.0 .OR. jpast.LT.0)then - -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1089)iupwnd, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - -1089 format(//1x,'ERROR IN SUBR. PREPDI -- Upper air ', - 1 'soundings do not straddle current hour'/ - 1 2x,'Station no.: ',i5/, - 2 38x,'Year Julian Day Month Day Hour Seconds '/, -c xxxx xxx xx xx xx xxxx - 4 ' Current model date/time (UTC-GMT): ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 1 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 2 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - - stop - endif -c double check for upper air data inconsistencies. - if((jpast+jtogo).ne.jdelta) then - -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1090)iupwnd, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - -1090 format(//1x,'ERROR IN SUBR. PREPDI -- Inconsistent ', - 1 'upper air times for station ',i3/ - 2 38x,'Year Julian Day Month Day Hour Seconds '/, -c xxxx xxx xx xx xx xxxx - 4 ' Current model date/time (UTC-GMT): ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 1 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 2 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - - stop - endif -c**** End of EMI Modification -- 4/26/94 -c ******************************************************************** -c -c *** rjy modifications of 1/26/90 for arbitrary soundings. ******* -c --- interpolate in time to current hour - xfact = float(jtogo) / float(jdelta) - if(jorder.lt.0) then - um=umaa-(umaa-umbb)*xfact - vm=vmaa-(vmaa-vmbb)*xfact - else - um=umbb-(umbb-umaa)*xfact - vm=vmbb-(vmbb-vmaa)*xfact - endif - endif -c ******************************************************************** - else -c -c --- read domain-scale wind components from diagnostic data file - READ(IRD,1030)UM - READ(IRD,1030)VM - endif - endif -c -c --- set-up arrays with missing value indicators -8 continue - NUS=mxnz*mxwnd - CALL XMIT(-NUS,EDIT,US) - CALL XMIT(-NUS,EDIT,VS) -c -c --- convert surface observations of WS, WD into U, V components, -c --- insert results into output arrays - if(idiopt(4).eq.1)go to 32 - nstat = nssta + nowsta - do 10 j = 1,nstat -c -c --- weighting factor is 1.0 - wt(j)=1.0 -c - if (j .le. nssta) then -c -c --- check for missing data on land -c - if (abs(wd(j)) .ge. edit) go to 10 - if (abs(ws(j)) .ge. edit) go to 10 -c - wdrad = 0.0174533 * wd(j) - speed = ws(j) - us(1,j) = -speed * sin(wdrad) - vs(1,j) = -speed * cos(wdrad) - else -c -c --- check for missing data over water -c - if (abs(wdow(j - nssta)) .ge. edit) go to 10 - if (abs(wsow(j - nssta)) .ge. edit) go to 10 -c - wdrad = 0.0174533 * wdow(j - nssta) - speed = wsow(j - nssta) - us(1,j) = -speed * sin(wdrad) - vs(1,j) = -speed * cos(wdrad) - end if -10 continue -c -c --- compute time-interpolated winds -11 continue -c FRR (09/2001) additional option for noobs -c if (noobs .eq. 1) goto 52 - if (noobs .ge. 1) goto 52 - if(idiopt(5).eq.1)go to 50 - do 20 j=1,nusta -c -c *** rjy additions of 1/26/90 for arbitrary soundings. *********** - jorder = justa(j) - jdelta = jusdt(j) - ntzaas = ntzaa(j) - call dedat(ntzaas,jaayr,jaaday,jaahr) - ntzbbs = ntzbb(j) - call dedat(ntzbbs,jbbyr,jbbday,jbbhr) - -c --- For sub-hourly soundings(060215) - iaasec = jaasec(j) - ibbsec = jbbsec(j) - - if(jorder.gt.0) then - call deltsec(nowtze ,nsece,ntzbbs,ibbsec,jtogo) - call deltsec(ntzaas,iaasec,nowtze,nsece,jpast) - else - call deltsec(nowtze ,nsece,ntzaas,iaasec,jtogo) - call deltsec(ntzbbs,ibbsec,nowtze,nsece,jpast) - endif -c check for negative values of jtogo or jpast - if(jtogo.LT.0 .OR. jpast.LT.0)then - - -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - -c --- use station number j not iupwnd (=-1) for 1089 error message - write(io6,1089)j, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - stop - endif -c double check for upper air data inconsistencies. - if((jpast+jtogo).ne.jdelta) then - -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1090)j, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - - stop - endif -c -c *** rjy modifications of 1/26/90 for arbitrary soundings. ******* -c --- interpolate in time to current hour. Note that xfact starts -c out at 1.0 and works down to 0 as jtogo gets smaller. - xfact = float(jtogo) / float(jdelta) - do 15 i=1,nz - if(jorder.lt.0) then - uave(i,j)=uaveaa(i,j)-(uaveaa(i,j)-uavebb(i,j))*xfact - vave(i,j)=vaveaa(i,j)-(vaveaa(i,j)-vavebb(i,j))*xfact - else - uave(i,j)=uavebb(i,j)-(uavebb(i,j)-uaveaa(i,j))*xfact - vave(i,j)=vavebb(i,j)-(vavebb(i,j)-vaveaa(i,j))*xfact - endif -15 continue -20 continue -c ******************************************************************** -c -c --- insert upper air results into output arrays - do 30 j = 1,nusta - jj = nstat + j -c -c --- weighting factor is 1.0 - wt(jj) = 1.0 -c -c --- if a surface station exists at the same point as an upper air -c --- station, do not use the upper air data in the lowest layer - i1 = 1 - nam = namst(jj) - do 28 kk = 1,nstat - if (nam .eq. namst(kk)) i1 = 2 -28 continue -c -c --- ignore upper air data in lowest layer if appropriate flag set - if (iextrp .le. 0) i1 = 2 -c - do 30 i = i1,nz - us(i,jj)=uave(i,j) - vs(i,jj)=vave(i,j) -30 continue - return -C -C READ HOURLY INPUT DATA -C -32 continue - time=nhre - if(iwr.gt.0)then - WRITE(IWR,2240) TIME, nhre - 2240 FORMAT(///,' INPUT DATA AT TIME = ',F6.0,' HOURS ',4X, - 1 ' (SIMULATION HOUR NO. ',I3,' )') - WRITE(IWR,2241) - 2241 FORMAT(3X,64('-')) - endif -C -C READ SURFACE WIND DATA -C - 35 IF(NSURF.EQ.0) GO TO 48 - NUS=mxnz*mxwnd - CALL XMIT(-NUS,EDIT,US) - CALL XMIT(-NUS,EDIT,VS) - 41 READ(IRD,1043) NAM, (WORK2(J),J=1,3) - 1043 FORMAT(15X,A4,1X,3F5.1) - IF(NAM.EQ.LAST) GO TO 47 - IF(NAM.EQ.IBLANK) GO TO 41 - DO 42 J=1,NSURF - IF(NAM.EQ.NAMST(J)) GO TO 43 - 42 CONTINUE - if(iwr.gt.0)WRITE(IWR,2069) TIME,NAM - WRITE(io6,2069) TIME,NAM - 2069 FORMAT(2X,'JOB ABORTED -- UNRECOGNIZED STATION NAME FOR SURFACE - 1 WIND DATA AT TIME = ',F6.0,1X,'NAME = ',A4) - stop - 43 WT(J) = WORK2(1) - US(1,J)=WORK2(2) - VS(1,J)=WORK2(3) - 45 CONTINUE - GO TO 41 - 47 CONTINUE -C -C PRINT INPUT SURFACE WIND DATA -C - if(iwr.gt.0)then - WRITE(IWR,2279) - 2279 FORMAT(//,12X,'SURFACE WIND DATA ',/,12X,17('-')) - WRITE(IWR,2280) - 2280 FORMAT(/,' STATION ','U-CMPT',5X,'V-CMPT',4X,'WEIGHTING', - 1 /,11X,'M/SEC',8X,'HM/SEC') -c - DO 40 I=1,NSURF - WRITE(IWR,2290) NAMST(I),US(1,I),VS(1,I),WT(I) - 2290 FORMAT(2X,A4,F9.1,3X,F9.1,4X,F8.2) - 40 CONTINUE - endif -48 continue - go to 11 -C -C INPUT UPPER AIR WIND DATA -C (WINDS ARE INPUT FOR THE CELL CENTER ELEVATION) -C - 50 IF(NUPPER.EQ.0) GO TO 52 - N = NSURF + 1 - CALL XMIT(-mxus,ZERO,WT(N)) - NO = 2*NZ + 1 - N = MIN0(NO,11) - 51 READ(IRD,1041) NAM, (work3(I),I=1,N) - 1041 FORMAT(13X,A4,1X,31F5.1) - N1 = N + 1 - IF(NO.GT.11) READ(IRD,1046) (work3(I),I=N1,NO) - 1046 FORMAT(20X,12F5.1) - IF(NAM.EQ.LAST) GO TO 56 - N1 = NSURF + 1 - DO 53 J=N1,NWIND - IF(NAM.EQ.NAMST(J)) GO TO 54 - 53 CONTINUE - if(iwr.gt.0)WRITE(IWR,2390) TIME,NAM - WRITE(io6,2390) TIME,NAM - 2390 FORMAT(' JOB ABORTED -- UNRECOGNIZED STATION NAME FOR UPPER AIR - 1 WIND DATA AT TIME = ',F6.0,' NAME = ',A4) - stop - 54 WT(J) = work3(1) - I1=1 -C -C IF A SURFACE STATION ALSO EXISTS AT THIS POINT, -C DO NOT USE UPPER AIR DATA IN LOWEST LAYER -C - DO 57 I = 1,NSURF - IF (NAM .EQ. NAMST(I)) I1 = 2 - 57 CONTINUE - IF (IEXTRP .LE. 0) I1=2 - DO 55 I=I1,NZ - K = 2*(I-1) + 2 -c -c --- check for missing values - if(work3(k).eq.edit.or.work3(k+1).eq.edit)go to 55 - US(I,J) = work3(K) - VS(I,J) = work3(K+1) - 55 CONTINUE - GO TO 51 - 56 CONTINUE -C -C PRINT INPUT UPPER AIR WIND DATA -C - if(iwr.gt.0)then - WRITE(IWR,2292) (I,I=1,NZ) - 2292 FORMAT(//,12X,'UPPER AIR WIND DATA ',/,12X,19('-'),//,11X, - 1 5('--- LEVEL ',I3,' --- ')) - WRITE(IWR,2293) - 2293 FORMAT(' STATION',3X,5(' U-CMPT V-CMPT '),/11X, - 1 5(' M/S M/S ')) -c - DO 58 L=1,NUPPER - LST = NSURF + L - WRITE(IWR,2294) NAMST(LST),(US(I,LST),VS(I,LST),I=1,NZ) - 2294 FORMAT(2X,A4,7X,5(F5.1,4X,F5.1,7X)) - 58 CONTINUE - endif -c -52 continue - return - end -c---------------------------------------------------------------------- - subroutine progrd(uprog,vprog,cellzc,utmxor,utmyor,time,nsece) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 061230 PROGRD -c S.DOUGLAS, SAI -c --- Modified by J. Scire 9/30/90 -c -C -C --- PURPOSE : THIS SUBROUTINE READS AND INTERPOLATES THE PROGNOSTIC -C MODEL OUTPUT TO THE DIAGNOSTIC MODEL GRID -c -c --- UPDATES: -c --- V6.2 Level 060215 to V6.216 Level 061230 (F.Robe) -c - Make sure to skip reading new record when subhourly timestep -c - Compare ending hour with prognostic hour to be consistent with MOD5 -c -c --- V5.6 Level 050328 to V6.2 Level 060215 (F.Robe) -c - Allow CALMET sub-hourly timesteps - only update with progn.model -c output on hourly basis -c - Cosmetic changes to header (struture: purpose,updates, etc) -C -c --- V5.6 (050328-FRR) explicit common replaced by include d4/d6.met -c -C INPUTS: -C UTMXOR (R) - UTM_EASTING ORIGIN OF THE CALMET GRID -C UTMYOR (R) - UTM_NORTHING ORIGIN OF THE CALMET GRID -C CELLZC(R ARRAY)- DIAGNOSTIC WIND MODEL CELL-CENTER HEIGHTS -C TIME (R) - CALMET SIMULATION TIME (hour) -c NSECE (I) - CALMET ending second of current timestep -C -c Parameters: MXNX, MXNY, MXNZ, MXNXP, MXNYP, MXNZP, IO6 -C -C OUTPUTS: UPROG (R ARRAY)- INTERPOLATED U-COMPONENT OF THE PROGNOSTIC -C WIND FIELD on CALMET GRID -C VPROG (R ARRAY)- INTERPOLATED V-COMPONENT OF THE PROGNOSTIC -C WIND FIELD on CALMET GRID -C -c -c -c --- PROGRD called by: DIAGNO -c --- PROGRD calls: XMIT -c -c --------------------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'grid.met' - include 'd4.met' - include 'd6.met' - -c Record access to progrd (060215) - COMMON /PROGSTEP/ ifirstpg,nfm3d - - DIMENSION UPROG(mxnx,mxny,*), VPROG(mxnx,mxny,*), - 1 UP(mxnxp,mxnyp,mxnzp), VP(mxnxp,mxnyp,mxnzp), - 2 CELLZC(*), Z(mxnzp), UTMP(mxnxp,mxnyp,mxnz), - 3 VTMP(mxnxp,mxnyp,mxnz), IP(4), JP(4), RS(4) - -c --- storage arrays (as uprog,vprog reset to 0 before every call - DIMENSION UPROGS(mxnx,mxny,mxnz), VPROGS(mxnx,mxny,mxnz) -c -c --- Minimum distance (km) in 1/r**2 interpolation - data rmin/0.001/ - - -c --- Do not read new data if sub-hourly timestep (only update on hourly -c --- basis (051128) - if (nsece.ne.0 .and. nsece.ne.3600 .and. ifirstpg.ne.0) then - do j=1,mxny - do i=1,mxnx - do k=1,mxnz - uprog(i,j,k)=uprogs(i,j,k) - vprog(i,j,k)=vprogs(i,j,k) - end do - end do - end do -c --- make sure to skip reading new record: 061230 - return - endif - - if (ifirstpg.eq.0) ifirstpg=1 - -C READ PROGNOSTIC MODEL OUTPUT - - 30 READ(IRDP) TIMEH -c * write(io6,*) -c * write(io6,*)'TIMEH = ',timeh - ITIME = TIMEH * 100 - READ(IRDP) NXP,NYP,NZP -c * write(io6,*)'NXP, NYP, NZP = ',nxp,nyp,nzp -c -c --- Check that array dimensions are not exceeded - if(nxp.gt.mxnxp.or.nyp.gt.mxnyp.or.nzp.gt.mxnzp)then - write(io6,*)'ERROR in subr. PROGRD -- Array dimensions ', - 1 'are too small for data being read' - write(io6,*)'Grid being read (NXP, NYP, NZP ) = ', - 1 nxp,nyp,nzp - write(io6,*)'Array dimensions (MXNXP, MXNYP, MXNZP) = ', - 1 mxnxp,mxnyp,mxnzp - stop - endif -c - READ(IRDP) UTMXOP,UTMYOP,DXKP -c * write(io6,*)'UTMXOP = ',utmxop,' UTMYOP = ',utmyop,' DXKP = ', -c * 1 dxkp - DYKP = DXKP - READ(IRDP) (Z(I),I=1,NZP) -c * write(io6,*)'Z = ',(z(i),i=1,nzp) - DO 10 K = 1,NZP - DO 10 J = 1,NYP - READ(IRDP) (UP(I,J,K),I=1,NXP) - 10 CONTINUE - DO 20 K = 1,NZP - DO 20 J = 1,NYP - READ(IRDP) (VP(I,J,K),I=1,NXP) - 20 CONTINUE -c * write(io6,*)'UP(1,1,1) = ',up(1,1,1) -c * write(io6,*)'VP(1,1,1) = ',vp(1,1,1) -c * write(io6,*)'CELLZC = ',(cellzc(n),n=1,nz) -c * write(io6,*)'UTMXOR = ',utmxor -c * write(io6,*)'UTMYOR = ',utmyor -c * write(io6,*)'TIME = ',time -c * write(io6,*)'DX = ',dx -c * write(io6,*)'DY = ',dy -C -C CHECK TIME -C -c --- TIME= beginning hour in CALMET (hourly) timestep (x 100) -c --- to be consistent with MOD5, ending time should be used (i.e. beg. time +1) -c --- with ending time between 0-23 (i.e. 0<=TIME<=2300) (061230) -c IT = TIME - IT = TIME +100 - if (IT.EQ.2400) IT=0 - - IF (ITIME .LT. IT) GO TO 30 - IF (ITIME .GT. IT) THEN - if(iwr.gt.0)WRITE(IWR,2010) TIME - WRITE(io6,2010) TIME - STOP - ENDIF -C -C INTERPOLATE PROGNOSTIC SOUNDINGS VERTICALLY TO DIAGNOSTIC MODEL -C LEVELS -C - DO 40 K = 1,NZ - DO 55 KP = 2,NZP - KPM1 = KP - 1 - IF (Z(KPM1) .LE. CELLZC(K) .AND. Z(KP) .GT. CELLZC(K)) THEN - DELZ1 = CELLZC(K) - Z(KPM1) - DELZ2 = Z(KP) - Z(KPM1) - DO 50 J = 1,NYP - DO 50 I = 1,NXP - UTMP(I,J,K) = UP(I,J,KPM1) + (UP(I,J,KP) - UP(I,J,KPM1)) - 1 * DELZ1/DELZ2 - VTMP(I,J,K) = VP(I,J,KPM1) + (VP(I,J,KP) - VP(I,J,KPM1)) - 2 * DELZ1/DELZ2 - 50 CONTINUE - ENDIF - 55 CONTINUE - IF (CELLZC(K) .LT. Z(1)) THEN - DO 60 J = 1,NYP - DO 60 I = 1,NXP - UTMP(I,J,K) = UP(I,J,1) - VTMP(I,J,K) = VP(I,J,1) - 60 CONTINUE - ENDIF - IF (CELLZC(K) .GE. Z(NZP)) THEN - DO 70 J = 1,NYP - DO 70 I = 1,NXP - UTMP(I,J,K) = UP(I,J,NZP) - VTMP(I,J,K) = VP(I,J,NZP) - 70 CONTINUE - ENDIF - 40 CONTINUE -c *** -c *** write layer #1 -c * ldate=.true. -c * messag='UTMP -- Layer 1 -- After 40 Loop' -c * call out(utmp(1,1,1),idum,1,5,ldate,messag,nx,ny) -c * messag='VTMP -- Layer 1 -- After 40 Loop' -c * call out(vtmp(1,1,1),idum,1,5,ldate,messag,nx,ny) -c *** -C -C INTERPOLATE PROGNOSTIC SOUNDINGS HORIZONTALLY TO DIAGNOSTIC MODEL -C GRID -C - DXK = DX * 0.001 - DYK = DY * 0.001 -C - DO 80 J = 1,NY - DO 80 I = 1,NX - X = (I - 1) * DXK - Y = (J - 1) * DYK -C -C CONVERT FROM LOCAL COORDINATES ON DIAGNOSTIC GRID TO LOCAL -C COORDINATES ON PROGNOSTIC GRID -C - X = X + UTMXOR - UTMXOP - Y = Y + UTMYOR - UTMYOP - IP(1) = X/DXKP + 1 - IP(2) = X/DXKP + 2 - IP(3) = IP(2) - IP(4) = IP(1) - JP(1) = Y/DYKP + 1 - JP(2) = JP(1) - JP(3) = Y/DYKP + 2 - JP(4) = JP(3) -C -C CALCULATE DISTANCE FROM PROGNOSTIC GRID POINTS TO DIAGNOSTIC GRID -C POINTS -C - NPTS = 4 - CALL XMIT(-NPTS,EDIT,RS) - DO 90 N = 1,NPTS - IF (IP(N) .LT. 1 .OR. JP(N) .LT. 1) GO TO 90 - IF (IP(N) .GT. NXP .OR. JP(N) .GT. NYP) GO TO 90 - RSX = X - (IP(N) - 1) * DXKP - RSY = Y - (JP(N) - 1) * DYKP - RS(N) = RSX**2 + RSY**2 - RS(N) = SQRT(RS(N)) - rs(n)=amax1(rs(n),rmin) - 90 CONTINUE -C -C PERFORM 1/R**2 INTERPOLATION -C - DO 100 K = 1,NZ - UNUM = 0. - VNUM = 0. - DENOM = 0. - NSUM = 0. - DO 110 N = 1,NPTS - IF (RS(N) .GT. EDITL) GO TO 110 - WT = 1./RS(N)**2 - UNUM = UNUM + UTMP(IP(N),JP(N),K) * WT - VNUM = VNUM + VTMP(IP(N),JP(N),K) * WT - DENOM = DENOM + WT - NSUM = NSUM + 1 - 110 CONTINUE - IF (NSUM .EQ. 0) THEN - if(iwr.gt.0)WRITE(IWR,2020) I,J,K - WRITE(io6,2020) I,J,K - STOP - ENDIF - UPROG(I,J,K) = UNUM/DENOM - VPROG(I,J,K) = VNUM/DENOM - 100 CONTINUE - 80 CONTINUE -c *** -c *** write layer #1 -c * ldate=.true. -c * messag='UPROG -- Layer 1 -- After 80 Loop' -c * call out(uprog(1,1,1),idum,1,5,ldate,messag,nx,ny) -c * messag='VPROG -- Layer 1 -- After 80 Loop' -c * call out(vprog(1,1,1),idum,1,5,ldate,messag,nx,ny) -c *** -C -C CONVERT TO M/S -C - DO 120 K = 1,NZ - DO 120 J = 1,NY - DO 120 I = 1,NX - UPROG(I,J,K) = UPROG(I,J,K) * 0.01 - VPROG(I,J,K) = VPROG(I,J,K) * 0.01 -c --- store variables for sub-hourly timestep access (060215) - uprogs(i,j,k)=uprog(i,j,k) - vprogs(i,j,k)=vprog(i,j,k) - 120 CONTINUE - -c *** -c *** write layer #1 -c * ldate=.true. -c * messag='UPROG -- Layer 1 -- After 120 Loop' -c * call out(uprog(1,1,1),idum,1,5,ldate,messag,nx,ny) -c * messag='VPROG -- Layer 1 -- After 120 Loop' -c * call out(vprog(1,1,1),idum,1,5,ldate,messag,nx,ny) -c *** -c *** write layer #2 -c * ldate=.true. -c * messag='UPROG -- Layer 2 -- After 120 Loop' -c * call out(uprog(1,1,2),idum,1,5,ldate,messag,nx,ny) -c * messag='VPROG -- Layer 2 -- After 120 Loop' -c * call out(vprog(1,1,2),idum,1,5,ldate,messag,nx,ny) -c * STOP -c *** -C - 2010 FORMAT('NO PROGNOSTIC OUTPUT AVAILABLE FOR TIME = ',F6.0) - 2020 FORMAT('NO PROGNOSTIC INTERPOLATION POSSIBLE FOR I = ',I2,' J = ', - 1I2,' K = ',I2) - RETURN - END -c---------------------------------------------------------------------- - subroutine qcksrt3(n,arr,arr2,arr3,arr4,arr5,arr6,arr7) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 061231 QCKSRT3 -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Sorts an aray ARR of length N into ascending numerical -c order using Quicksort algorithm. N is input; ARR is replaced on -c output by its sorted rearrangement. -c -c --- UPDATES: -c --- Level 941101 to V6.217 Level 061231 (F.Robe) -c Modified to sort 7 arrays -c -c --- Modified to sort 5 arrays MEF 11/01/94 -c --- Modified to sort 3 arrays EMI 9/11/92 -c -c --- QCKSRT3 called by: RDMM4 -c --- QCKSRT3 calls: none -c -c ------------------------------------------------------------------- - PARAMETER (M=7,NSTACK=50,FM=7875.,FA=211.,FC=1663. - * ,FMI=1.2698413E-4) -c -c Here M is the size of subarrays sorted by straight insertion, -c NSTACK is the required auxiliary storage, and the remaining constants -c are used by the random number generating statements. -c - DIMENSION ARR(N),ISTACK(NSTACK),arr2(n),arr3(n),arr4(n),arr5(n) - DIMENSION ARR6(N),ARR7(N) - - JSTACK=0 - L=1 - IR=N - FX=0. -10 IF(IR-L.LT.M)THEN - DO 13 J=L+1,IR - A=ARR(J) - b=arr2(J) - c=arr3(J) - d=arr4(J) - e=arr5(J) - f=arr6(J) - g=arr7(J) - - DO 11 I=J-1,1,-1 - IF(ARR(I).LE.A)GO TO 12 - ARR(I+1)=ARR(I) - arr2(I+1)=arr2(I) - arr3(I+1)=arr3(I) - arr4(I+1)=arr4(I) - arr5(I+1)=arr5(I) - arr6(I+1)=arr6(I) - arr7(I+1)=arr7(I) -11 CONTINUE - I=0 -12 ARR(I+1)=A - arr2(I+1)=b - arr3(I+1)=c - arr4(I+1)=d - arr5(I+1)=e - arr6(I+1)=f - arr7(I+1)=g -13 CONTINUE - IF(JSTACK.EQ.0)RETURN - IR=ISTACK(JSTACK) - L=ISTACK(JSTACK-1) - JSTACK=JSTACK-2 - ELSE - I=L - J=IR - FX=MOD(FX*FA+FC,FM) - IQ=L+(IR-L+1)*(FX*FMI) - A=ARR(IQ) - b=arr2(IQ) - c=arr3(IQ) - d=arr4(IQ) - e=arr5(IQ) - f=arr6(IQ) - g=arr7(IQ) - ARR(IQ)=ARR(L) - arr2(IQ)=arr2(L) - arr3(IQ)=arr3(L) - arr4(IQ)=arr4(L) - arr5(IQ)=arr5(L) - arr6(IQ)=arr6(L) - arr7(IQ)=arr7(L) -20 CONTINUE -21 IF(J.GT.0)THEN - IF(A.LT.ARR(J))THEN - J=J-1 - GO TO 21 - ENDIF - ENDIF - IF(J.LE.I)THEN - ARR(I)=A - arr2(I)=b - arr3(I)=c - arr4(I)=d - arr5(I)=e - arr6(I)=f - arr7(I)=g - GO TO 30 - ENDIF - ARR(I)=ARR(J) - arr2(I)=arr2(J) - arr3(I)=arr3(J) - arr4(I)=arr4(J) - arr5(I)=arr5(J) - arr6(I)=arr6(J) - arr7(I)=arr7(J) - I=I+1 -22 IF(I.LE.N)THEN - IF(A.GT.ARR(I))THEN - I=I+1 - GO TO 22 - ENDIF - ENDIF - IF(J.LE.I)THEN - ARR(J)=A - arr2(J)=b - arr3(J)=c - arr4(J)=d - arr5(J)=e - arr6(J)=f - arr7(J)=g - I=J - GO TO 30 - ENDIF - ARR(J)=ARR(I) - arr2(J)=arr2(I) - arr3(J)=arr3(I) - arr4(J)=arr4(I) - arr5(J)=arr5(I) - arr6(J)=arr6(I) - arr7(J)=arr7(I) - J=J-1 - GO TO 20 -30 JSTACK=JSTACK+2 - IF(JSTACK.GT.NSTACK)PAUSE 'NSTACK must be made larger.' - IF(IR-I.GE.I-L)THEN - ISTACK(JSTACK)=IR - ISTACK(JSTACK-1)=I+1 - IR=I-1 - ELSE - ISTACK(JSTACK)=I-1 - ISTACK(JSTACK-1)=L - L=I+1 - ENDIF - ENDIF - GO TO 10 - END -c---------------------------------------------------------------------- - subroutine rdhd(iform,io,ibyrn,ibjuln,ibhrn,ibsecn, - 1 ieyrn,iejuln,iehrn,iesecn, - 1 ibtz,nsta,ipack,dataver,idsta,anem,cname, - 2 rnlat,relon,maxs,clat,clon,datum,lstnloc) -c---------------------------------------------------------------------- - -c --- CALMET Version: 6.5.0 Level: 121203 RDHD -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Read the header records from a surface -c met. data file or a precipitation data file -c -c --- UPDATES: -c -c --- V6.321 (080325) to v6.4.0 Level 121203 (F.Robe) -c - Fix missing read statement for axtz in dataset v2.1 -c with full location information -c -c --- V6.223 (070702)to V6.321 (080325)(F.Robe) -c - Correct typo that stops a run with a SURF.DAT or -c PRECIP.DAT stating in its header that the surf./precip. records end on -c PRECIP.DAT the last day of the year at hour 24. -c -c --- V6.2 (060215) to V6.223 (070702)(F.Robe) -c - read axtz as formatted a8 when formatted surf.dat -c -c --- V5.543 (031215) to V6.2 (060215) (F.Robe) -c - Use explicit beginning/ending times with seconds -c - Read in SURF.DAT data version and pass the information -c back via calling list -c - New SURF.DAT/PRECIP.DAT (2.1) header: additional line for -c UTC time zone and beginning/ending seconds -c -c --- V5.542 (031126) to V5.543 (031215) (DGS) -c - Left-justify station name -c --- V5.541 (031017) to V5.542 (031126) (J. Scire) -c - Add CLAT and CLON to argument list to avoid -c local array dimensioning with a variable -c --- V5.5 (030402) to V5.54 (031017) (DGS) -c - Add station location flag and datum to arg list -c - Convert character lat/lon to reals -c --- V5.4 (991104) to V5.5 (030402) (DGS) -c - Add list-file unit to YR4 call -c - New header format -c - Transfer file headers to scratch file -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- INPUTS: -c IFORM - integer - Data format flag (0=data not used, -c 1=unformatted, 2=formatted) -c IO - integer - Fortran unit no. of input file -c MAXS - integer - Maximum number of stations -c -c Common block /QA/ variables: -c NCOMMOUT -c -c Parameters: IO6, IOX -c -c --- OUTPUT: -c IBYRN - integer - Beginning year of data (explicit) -c IBJULN - integer - Beginning Julian day number(explicit) -c IBHRN - integer - Beginning hour(explicit) -c IBSECN - integer - Beginning second (explicit) -c IEYRN - integer - Ending year of data (4 digits)(explicit) -c IEJULN - integer - Ending Julian day number(explicit) -c IEHRN - integer - Ending hour(explicit) -c IESECN - integer - Ending second (explicit) -c IBTZ - integer - Base time zone (8 = PST, 7 = MST, -c 6 = CST, 5 = EST) -c NSTA - integer - Number of stations -c IPACK - integer - Data packing code (0=unpacked, -c 1=packed) -c DATAVER - char*16 - Dataset version number -c IDSTA(MAXS) - int. array - Array of station identification -c codes -c ANEM(MAXS) - real array - Array of station anemometer hts -c CNAME(MAXS) - char array - Array of station names -c RNLAT(MAXS) - real array - Array of station N.latitudes -c RELON(MAXS) - real array - Array of station E.longitudes -c CLAT(MAXS) - char*16 - Array holding station latitudes -c CLON(MAXS) - char*16 - Array holding station longitudes -c DATUM - character - DATUM code for location -c LSTNLOC - logical - T: station location data found -c -c Common block /QA/ variables: -c NCOMMOUT -c -c --- RDHD called by: READHD -c --- RDHD calls: DEDAT, YR4, XTRACTLL -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - - include 'qa.met' - - real anem(maxs),rnlat(maxs),relon(maxs) - integer idsta(maxs) - character*4 cname(maxs),cnam,ctemp - character*16 clat(maxs),clon(maxs) - - character*4 xyunit - character*8 datum, pmap, axtz - character*12 daten - character*16 dataset,dataver - character*64 datamod - character*80 comment1 - character*33 blank33,break33 - character*132 blank,break - - logical lstnloc - - data blank33/' '/ - data break33/'.................................'/ - -c --- Set blank (132 characters) - blank(1:33)=blank33 - blank(34:66)=blank33 - blank(67:99)=blank33 - blank(100:132)=blank33 - -c --- Set break (132 characters) - break(1:33)=break33 - break(34:66)=break33 - break(67:99)=break33 - break(100:132)=break33 - -c --- Set location data flag to false - lstnloc=.FALSE. - - write(io6,*) - write(io6,*) - write(io6,*) - write(io6,'(a30,50x)')'Surface Met File Header ------' - write(io6,*) - - if(iform.eq.0)then -c --- data not used - nsta=0 - - else if(iform.eq.1)then -c --- File unformatted - read(io) dataset,dataver,datamod - write(io6,'(2a16,a64)') dataset,dataver,datamod -c --- Check for valid dataset name - if(dataset.NE.'SURF.DAT'.AND.dataset.NE.'PRECIP.DAT') then - write(io6,*) - write(io6,*) 'RDHD: Invalid dataset found' - write(io6,*) 'Dataset name found = ',dataset - write(io6,*) ' Dataset expected = SURF.DAT' - write(io6,*) ' or = PRECIP.DAT' - write(*,987) - stop 'Halted in RDHD' - endif -c --- To scratch file - write(iox,'(a132)') blank - write(iox,'(a132)') break - write(iox,'(a132)') blank - write(iox,'(2a16,a64)') dataset,dataver,datamod - ncommout=ncommout+4 - read(io) ncomment - do i=1,ncomment - read(io) comment1 - write(io6,'(a80)') comment1 -c --- To scratch file - write(iox,'(a80)') comment1 - ncommout=ncommout+1 - enddo - read(io) pmap - write(io6,'(a8)') pmap -c --- To scratch file - write(iox,'(a8)') pmap - ncommout=ncommout+1 - if(pmap.EQ.'NONE ') then - if (dataver.eq.'2.1') then -c --- UTC time zone - Convert to CALMET IBTZ time zone - ncommout=ncommout+1 - read(io) axtz - call utcbasr(axtz,xbtz) - ibtz=int(xbtz) - write(io6,'(a8)') axtz -c --- To scratch file - write(iox,'(a8)') axtz -c --- explicit time with seconds - read(io) ibegn,ibsecn,iendn,iesecn,nsta,ipack - write(io6,*)ibegn,ibsecn,iendn,iesecn,ibtz,nsta,ipack - write(iox,'(2(i12,i5),i12,i4)')ibegn,ibsecn,iendn, - : iesecn,nsta,ipack - else -c --- hour-ending time convention (pre 2.1 dataset) - read(io) ibeg,iend,ibtz,nsta,ipack - write(io6,*)ibeg,iend,ibtz,nsta,ipack - write(iox,'(2i12,i4,i12,i4)')ibeg,iend,ibtz,nsta,ipack - endif - read(io) (idsta(n),n=1,nsta) - write(io6,*)(idsta(n),n=1,nsta) -c --- To scratch file - write(iox,'(2i12,i4,i12,i4)')ibeg,iend,ibtz,nsta,ipack - do k=1,nsta - write(iox,'(i8)') idsta(k) - enddo - ncommout=ncommout+nsta+1 - elseif(pmap.EQ.'LL ') then - lstnloc=.TRUE. - read(io) datum,daten - read(io) ibeg,iend,ibtz,nsta,ipack - write(io6,'(a8,a10)') datum,daten - write(io6,'(a4)') xyunit -c --- To scratch file - write(iox,'(a8,a10)') datum,daten - write(iox,'(a4)') xyunit - if (dataver.eq.'2.1') then -c --- UTC time zone - Convert to CALMET IBTZ time zone - ncommout=ncommout+1 - read(io) axtz - call utcbasr(axtz,xbtz) - ibtz=int(xbtz) - write(io6,'(a8)') axtz -c --- To scratch file - write(iox,'(a8)') axtz -c --- explicit time with seconds - read(io) ibegn,ibsecn,iendn,iesecn,nsta,ipack - write(io6,*)ibegn,ibsecn,iendn,iesecn,nsta,ipack - write(iox,'(2(i12,i5),i12,i4)')ibegn,ibsecn,iendn, - : iesecn,ibtz,nsta,ipack - else -c --- hour-ending time convention (pre 2.1 dataset) 041123 - read(io) ibeg,iend,ibtz,nsta,ipack - write(io6,'(2i12,i4,i12,i4)')ibeg,iend,ibtz,nsta,ipack - write(iox,'(2i12,i4,i12,i4)')ibeg,iend,ibtz,nsta,ipack - endif - - ncommout=ncommout+3 - read(io) (idsta(n),n=1,nsta) - read(io) (cname(n),n=1,nsta) - read(io) (clat(n),n=1,nsta) - read(io) (clon(n),n=1,nsta) -c --- Remove leading blanks from CNAME - do n=1,nsta - cnam=cname(n) - do kk=1,4 - ctemp=' ' - if(cnam(1:1).EQ.' ') then - ctemp(1:3)=cnam(2:4) - cnam=ctemp - endif - enddo - cname(n)=cnam - enddo - if(dataset.EQ.'SURF.DAT') then - read(io) (anem(n),n=1,nsta) - do n=1,nsta - write(io6,*)idsta(n),cname(n),clat(n),clon(n),anem(n) -c --- To scratch file - write(iox,*)idsta(n),cname(n),clat(n),clon(n),anem(n) - ncommout=ncommout+1 - enddo - endif - if(dataset.EQ.'PRECIP.DAT') then - do n=1,nsta - write(io6,*)idsta(n),cname(n),clat(n),clon(n) -c --- To scratch file - write(iox,*)idsta(n),cname(n),clat(n),clon(n) - ncommout=ncommout+1 - enddo - endif - else - write(io6,*) - write(io6,*) 'RDHD: Invalid projection found' - write(io6,*) 'Projection found = ',pmap - write(io6,*) 'Projection expected = NONE or LL' - write(*,987) - stop 'Halted in RDHD' - endif - -c --- decode start and end times - if (dataver.eq.'2.1') then -c --- decode explicit starting and ending dates - call dedat(ibegn,ibyrn,ibjuln,ibhrn) - call dedat(iendn,ieyrn,iejuln,iehrn) - else -c --- decode h0ur-ending starting and ending dates - call dedat(ibeg,ibyr,ibjul,ibhr) - call dedat(iend,ieyr,iejul,iehr) - endif - -c - else if(iform.eq.2)then -c --- File formatted - ipack=0 - read(io,'(2a16,a64)') dataset,dataver,datamod - write(io6,'(2a16,a64)') dataset,dataver,datamod - if(dataset.NE.'SURF.DAT'.AND.dataset.NE.'PRECIP.DAT') then - write(io6,*) - write(io6,*) 'RDHD: Invalid dataset found' - write(io6,*) 'Dataset name found = ',dataset - write(io6,*) ' Dataset expected = SURF.DAT' - write(io6,*) ' or = PRECIP.DAT' - write(*,987) - stop 'Halted in RDHD' - endif -c --- To scratch file - write(iox,'(a132)') blank - write(iox,'(a132)') break - write(iox,'(a132)') blank - write(iox,'(2a16,a64)') dataset,dataver,datamod - ncommout=ncommout+4 - read(io,*) ncomment - write(io6,*) ncomment - do i=1,ncomment - read(io,'(a80)') comment1 - write(io6,'(a80)') comment1 -c --- To scratch file - write(iox,'(a80)') comment1 - ncommout=ncommout+1 - enddo - read(io,'(a8)') pmap - write(io6,'(a8)') pmap -c --- To scratch file - write(iox,'(a8)') pmap - ncommout=ncommout+1 - if(pmap.EQ.'NONE ') then - if (dataver.eq.'2.1') then -c --- Explicit time convention - -c --- UTC time zone - Convert to CALMET IBTZ time zone - read(io,'(a8)') axtz - call utcbasr(axtz,xbtz) - ibtz=int(xbtz) - write(io6,'(a8)') axtz -c --- To scratch file - ncommout=ncommout+1 - write(iox,'(a8)') axtz - - read(io,*)ibyrn,ibjuln,ibhrn,ibsecn,ieyrn,iejuln,iehrn, - : iesecn,nsta - write(io6,*)ibyrn,ibjuln,ibhrn,ibsecn,ieyrn,iejuln,iehrn, - : iesecn,nsta - write(iox,'(8i5,i12)')ibyrn,ibjuln,ibhrn,ibsecn,ieyrn, - : iejuln,iehrn,iesecn,nsta - else -c --- hour-ending dataset - read(io,*)ibyr,ibjul,ibhr,ieyr,iejul,iehr,ibtz,nsta - write(io6,*)ibyr,ibjul,ibhr,ieyr,iejul,iehr,ibtz,nsta -c --- To scratch file - write(iox,'(7i5,i12)')ibyr,ibjul,ibhr,ieyr,iejul,iehr, - & ibtz,nsta - endif - read(io,*)(idsta(n),n=1,nsta) - write(io6,*)(idsta(n),n=1,nsta) - do n=1,nsta - write(iox,'(i8)') idsta(n) - enddo - ncommout=ncommout+nsta+1 - elseif(pmap.EQ.'LL ') then - lstnloc=.TRUE. - read(io,'(a8,a10)') datum,daten - read(io,'(a4)') xyunit - write(io6,'(a8,a10)') datum,daten - write(io6,'(a4)') xyunit -c --- To scratch file - write(iox,'(a8,a10)') datum,daten - write(iox,'(a4)') xyunit - if (dataver.eq.'2.1') then -c --- explicit time with seconds -c --- UTC time zone - Convert to CALMET IBTZ time zone -c read(io) axtz - must be formatted (070702) -c --- v6.4.0, Level 121203 - read(io,'(a8)') axtz - call utcbasr(axtz,xbtz) - ibtz=int(xbtz) - write(io6,'(a8)') axtz -c --- To scratch file - ncommout=ncommout+1 - write(iox,'(a8)') axtz - read(io,*)ibyrn,ibjuln,ibhrn,ibsecn,ieyrn,iejuln,iehrn, - : iesecn,nsta - write(io6,*)ibyrn,ibjuln,ibhrn,ibsecn,ieyrn,iejuln,iehrn, - : iesecn,nsta - write(iox,'(8i5,i12)')ibyrn,ibjuln,ibhrn,ibsecn,ieyrn, - : iejuln,iehrn,iesecn,nsta - else -c --- hour-ending dataset - read(io,*)ibyr,ibjul,ibhr,ieyr,iejul,iehr,ibtz,nsta - write(io6,*)ibyr,ibjul,ibhr,ieyr,iejul,iehr,ibtz,nsta - write(iox,'(7i5,i12)')ibyr,ibjul,ibhr,ieyr,iejul,iehr, - & ibtz,nsta - endif - - ncommout=ncommout+3 - if(dataset.EQ.'SURF.DAT') then - do n=1,nsta - read(io,*)idsta(n),cname(n),clat(n),clon(n),anem(n) -c --- Remove leading blanks from CNAME - cnam=cname(n) - do kk=1,4 - ctemp=' ' - if(cnam(1:1).EQ.' ') then - ctemp(1:3)=cnam(2:4) - cnam=ctemp - endif - enddo - cname(n)=cnam - write(io6,*)idsta(n),cname(n),clat(n),clon(n),anem(n) -c --- To scratch file - write(iox,*)idsta(n),cname(n),clat(n),clon(n),anem(n) - ncommout=ncommout+1 - enddo - else - do n=1,nsta - read(io,*)idsta(n),cname(n),clat(n),clon(n) -c --- Remove leading blanks from CNAME - cnam=cname(n) - do kk=1,4 - ctemp=' ' - if(cnam(1:1).EQ.' ') then - ctemp(1:3)=cnam(2:4) - cnam=ctemp - endif - enddo - cname(n)=cnam - write(io6,*)idsta(n),cname(n),clat(n),clon(n) -c --- To scratch file - write(iox,*)idsta(n),cname(n),clat(n),clon(n) - ncommout=ncommout+1 - enddo - endif - else - write(io6,*) - write(io6,*) 'RDHD: Invalid projection found' - write(io6,*) 'Projection found = ',pmap - write(io6,*) 'Projection expected = NONE or LL' - write(*,987) - stop 'Halted in RDHD' - endif -c - else - write(io6,12)iform -12 format(//2x,'ERROR IN SUBR. RDHD -- invalid value of IFORM'/ - 1 5x,'IFORM = ',i10) - write(*,987) - stop 'Halted in RDHD' - endif - - -c --- Convert from hour-ending times to explicit times - - if (dataver.eq.'2.1') then -c --- explicit time with seconds- only check format and boundaries -c --- Make sure years are YYYY (Y2K) - call YR4(io6,ibyrn,ierrb) - call YR4(io6,ieyrn,ierre) - if(ierrb.NE.0 .OR. ierre.NE.0) stop 'Halted in RDHD - Y2K' - -c --- Hours from 0 to 23 - if (ibhrn.ge.24) then - nhinc=ibhrn-23 - ibhrn=23 -c --- 080325-call incr(io6,ibyn,ibjuln,ibhrn,nhinc) - call incr(io6,ibyrn,ibjuln,ibhrn,nhinc) - endif - if (iehrn.ge.24) then - nhinc=iehrn-23 - iehrn=23 -c --- 080325-call incr(io6,ieyn,iejuln,iehrn,nhinc) - call incr(io6,ieyrn,iejuln,iehrn,nhinc) - endif -c --- Convert seconds to hours - if(ibsecn.GE.3600) then - nhrinc=ibsecn/3600 - ibsecn=ibsecn-nhrinc*3600 - call INCR(io6,ibyrn,ibjuln,ibhrn,nhrinc) - endif - if(iesecn.GE.3600) then - nhrinc=iesecn/3600 - iesecn=iesecn-nhrinc*3600 - call INCR(io6,ieyrn,iejuln,iehrn,nhrinc) - endif - - else -c --- hour-ending dataset => compute explicit times -c --- Make sure years are YYYY (Y2K) - call YR4(io6,ibyr,ierrb) - call YR4(io6,ieyr,ierre) - if(ierrb.NE.0 .OR. ierre.NE.0) stop 'Halted in RDHD - Y2K' - -c --- hourly records only - ibsecn=0 - iesecn=0 - -c --- ending time is already explicit - iehrn=iehr - iejuln=iejul - ieyrn=ieyr - -c --- Shift back beginning hour-ending time by one hour - ibhrn=ibhr - ibjuln=ibjul - ibyrn=ibyr - - call INCR(io6,ibyrn,ibjuln,ibhrn,-1) - endif - -c --- Convert the character lat/lon to reals - if(lstnloc) then - do n=1,nsta - call XTRACTLL(io6,'LAT ',clat(n),rnlat(n)) - call XTRACTLL(io6,'LON ',clon(n),relon(n)) - enddo - endif - - return -987 format(1x,'ERROR in CALMET run - see CALMET.LST file') - end -c---------------------------------------------------------------------- - subroutine rdhdu(io,iolst,iox,ibyrun,ibjulun,ibhrun,ibsecun, - 1 ieyrun,iejulun,iehrun,iesecun,ptop,jdat, - 2 dataver,ifmt,lht,ltemp,lwd,lws,idstn,cname, - 3 rnlat,relon,elevm,datum,lstnloc) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 090511 RDHDU -c --- J. Scire, SRC -c -c --- PURPOSE: Read a set of upper air header records -c -c --- UPDATES: -c --- V6.32 (080801) to v6.327 (090511)(F.Robe) -c - Store dataset beginning time as specified in UP.DAT -c header V2.0and do not shift it by 1 hour -c --- v6.223 (070702) to V6.32 (080801)(F.Robe) -c - Allow new version of UP.DAT (version 2.2.) -c --- V6.221 (070327) to v6.223 (070702)(F.Robe) -c - Use proper year variable name for format2.0 in Y2K test -c -c --- V6.2 (060215) to V6.221 (070327) (F.Robe) -c - Use proper year variable names for format2.1 in Y2K test -c -c --- V5.543 (031215) to V6.2 (060215) (F.Robe) -c - Replace hour-ending by explicit beginning-ending times -c with seconds (passed to READHD via calling list) -c - New header format with UTC time zone -c for data version 2.1 (must be UTC+0000) -c - Pass dataset version number through calling list -c --- V5.54 (031017) to V5.543 (031215) (DGS) -c - Add station ID and name to arg list -c - Left-justify station name -c --- V5.5 (030402) to V5.54 (031017) (DGS) -c - Add station location data to arg list -c - Convert character lat/lon to reals -c --- V5.4 (991104) to V5.5 (030402) (DGS) -c - Add list-file unit to YR4 call -c - New header format -c - Transfer file headers to scratch file -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c --- Modified (2/98) by J. Scire to allow comma-delimited data format -c -c --- INPUTS: -c IO - integer - Fortran unit number of upper -c air data file to read -c IOLST - integer - Fortran unit number of list file -c IOX - integer - Fortran unit number of scratch -c -c -c Common block /QA/ variables: -c NCOMMOUT -c -c --- OUTPUT: -c IBYRUN - integer - Beginning year of data (GMT) (explicit) -c IBJULUN - integer - Beginning Julian day of data (GMT)(explicit) -c IBHRUN - integer - Beginning hour of data (GMT)(explicit) -c IBSECUN - integer - Beginning hour of data (GMT) (explicit) -c IEYRUN - integer - Ending year of data (GMT)(explicit) -c IEJULUN - integer - Ending Julian day of data (GMT)(explicit) -c IEHRUN - integer - Ending hour of data (GMT)(explicit) -c IESECUN - integer - BEginning hour of data (GMT) (explicit) -cc PTOP - real - Top pressure level extracted -c from original sounding -c JDAT - integer - Data source: 1=TD6201 data, -c 2=NCDC CD-ROM data, 3=other -c or unknown) -c DATAVER - char*16 - Dataset version number -c IFMT - integer - File format (1=slash-delimited -c (/) format (original format), -c 2=comma-delimited data records) -c LHT - logical - Flag indicating if level was -c eliminated if height missing -c LTEMP - logical - Flag indicating if level was -c eliminated if temperature missing -c LWD - logical - Flag indicating if level was -c eliminated if wind dir. missing -c LWS - logical - Flag indicating if level was -c eliminated if wind speed missing -c IDSTN - integer - Station ID -c CNAM - char*4 - Station name -c RNLAT - real - Station N.latitude -c RELON - real - Station E.longitude -c ELEVM - real - station elevation (m MSL) -c DATUM - character - DATUM code for location -c LSTNLOC - logical - T: station location data found -c -c Common block /QA/ variables: -c NCOMMOUT -c -c --- RDHDU called by: READHD -c --- RDHDU calls: YR4, XTRACTLL -c---------------------------------------------------------------------- - include 'qa.met' - - logical lht,ltemp,lwd,lws - logical lstnloc - - character*4 cname,ctemp - character*16 clat,clon - - character*4 xyunit - character*8 datum, pmap, axtz - character*12 daten - character*16 dataset,dataver - character*64 datamod - character*80 comment1 - character*33 blank33,break33 - character*132 blank,break - - data blank33/' '/ - data break33/'.................................'/ - -c --- Set blank (132 characters) - blank(1:33)=blank33 - blank(34:66)=blank33 - blank(67:99)=blank33 - blank(100:132)=blank33 - -c --- Set break (132 characters) - break(1:33)=break33 - break(34:66)=break33 - break(67:99)=break33 - break(100:132)=break33 - -c --- Set location data flag to false - lstnloc=.FALSE. - - write(iolst,*) - write(iolst,*) - write(iolst,*) - write(iolst,'(a30,50x)')'UP.DAT File Header -----------' - write(iolst,*) - - read(io,'(2a16,a64)') dataset,dataver,datamod - write(iolst,'(2a16,a64)') dataset,dataver,datamod -c --- Check first field of record 1 - if(dataset.EQ.'UP.DAT') then -c --- To scratch file - write(iox,'(a132)') blank - write(iox,'(a132)') break - write(iox,'(a132)') blank - write(iox,'(2a16,a64)') dataset,dataver,datamod - ncommout=ncommout+4 - read(io,*) ncomment - write(iolst,*) ncomment - do i=1,ncomment - read(io,'(a80)') comment1 - write(iolst,'(a80)') comment1 -c --- To scratch file - write(iox,'(a80)') comment1 - ncommout=ncommout+1 - enddo - read(io,'(a8)') pmap - write(iolst,'(a8)') pmap -c --- To scratch file - write(iox,'(a8)') pmap - ncommout=ncommout+1 - if(pmap.EQ.'NONE ') then -c --- Original 2 header records follow + UTC time header line if versin 2.1 - if (dataver.eq.'2.1'.or.dataver.eq.'2.2') then -c --- additional header line with UTC time zone - ncommout=ncommout+1 - read(io,'(a8)')axtz - write(iolst,'(a8)')axtz -c --- To scratch file - write(iox,'(a8)') axtz - read(axtz(5:8),'(i4)')itz - if(itz.ne.0) - : stop 'Time zone of subs. UP.DAT must be UTC+0000 STOP' - -c --- explicit beginning/ending times with seconds - read(io,123)ibyrun,ibjulun,ibhrun,ibsecun,ieyrun,iejulun, - & iehrun,iesecun,ptop,jdat,ifmt - write(iolst,123)ibyrun,ibjulun,ibhrun,ibsecun,ieyrun, - & iejulun,iehrun,iesecun,ptop,jdat,ifmt -c --- To scratch file - write(iox,123)ibyrun,ibjulun,ibhrun,ibsecun,ieyrun, - & iejulun,iehrun,iesecun,ptop,jdat,ifmt - else - read(io,122)ibyru,ibjulu,ibhru,ieyru,iejulu,iehru, - & ptop,jdat,ifmt - write(iolst,122)ibyru,ibjulu,ibhru,ieyru,iejulu,iehru, - & ptop,jdat,ifmt -c --- To scratch file - write(iox,122)ibyru,ibjulu,ibhru,ieyru,iejulu,iehru, - & ptop,jdat,ifmt - endif - read(io,124)lht,ltemp,lwd,lws - write(iolst,124)lht,ltemp,lwd,lws - write(iox,124)lht,ltemp,lwd,lws - - ncommout=ncommout+2 - - elseif(pmap.EQ.'LL ') then -c --- Header with location data - lstnloc=.TRUE. - read(io,'(a8,a10)') datum,daten - read(io,'(a4)') xyunit - write(iolst,'(a8,a10)') datum,daten - write(iolst,'(a4)') xyunit - write(iox,'(a8,a10)') datum,daten - write(iox,'(a4)') xyunit - - if (dataver.eq.'2.1'.or.dataver.eq.'2.2') then - -c --- additional header line with UTC time zone - ncommout=ncommout+1 - read(io,'(a8)')axtz - write(iolst,'(a8)')axtz -c --- To scratch file - write(iox,'(a8)') axtz - read(axtz(5:8),'(i4)')itz - if(itz.ne.0) - : stop 'Time zone of subst. UP.DAT must be UTC+0000 STOP' - -c --- explicit beginning/ending times with seconds - read(io,123)ibyrun,ibjulun,ibhrun,ibsecun,ieyrun,iejulun, - & iehrun,iesecun,ptop,jdat,ifmt - write(iolst,123)ibyrun,ibjulun,ibhrun,ibsecun,ieyrun, - & iejulun,iehrun,iesecun,ptop,jdat,ifmt -c --- To scratch file - write(iox,123)ibyrun,ibjulun,ibhrun,ibsecun,ieyrun, - & iejulun,iehrun,iesecun,ptop,jdat,ifmt - else - read(io,122)ibyru,ibjulu,ibhru,ieyru,iejulu,iehru, - & ptop,jdat,ifmt - write(iolst,122)ibyru,ibjulu,ibhru,ieyru,iejulu,iehru, - & ptop,jdat,ifmt -c --- To scratch file - write(iox,122)ibyru,ibjulu,ibhru,ieyru,iejulu,iehru, - & ptop,jdat,ifmt - endif - - read(io,124)lht,ltemp,lwd,lws - read(io,*) idstn,cname,clat,clon,ielevm -c --- Remove leading blanks from CNAME - do kk=1,4 - ctemp=' ' - if(cname(1:1).EQ.' ') then - ctemp(1:3)=cname(2:4) - cname=ctemp - endif - enddo - write(iolst,124)lht,ltemp,lwd,lws - write(iolst,*) idstn,cname,clat,clon,ielevm -c - -c --- To scratch file - write(iox,124)lht,ltemp,lwd,lws - write(iox,*) idstn,cname,clat,clon,ielevm - ncommout=ncommout+5 - else - write(iolst,*) - write(iolst,*) 'RDHDU: Invalid projection found' - write(iolst,*) 'Projection found = ',pmap - write(iolst,*) 'Projection expected = NONE or LL' - write(*,987) - stop 'Halted in RDHDU' - endif - - else -c --- Incorrect file type - write(iolst,12)dataset -12 format(//2x,'ERROR IN SUBR. RDHDU -- invalid file dataset'/ - 1 5x,'DATASET = ',a16/ - 2 5x,'EXPECTED UP.DAT') - write(*,987) - stop 'Halted in RDHDU' - endif - - - -c --- Convert hour-ending times to explicit times - if (dataver.eq.'2.1'.or.dataver.eq.'2.2') then -c --- Check year format -c -- bug fix: use 2.1 year format - call YR4(iolst,ibyrun,ierrb) - call YR4(iolst,ieyrun,ierre) - if(ierrb.NE.0 .OR. ierre.NE.0) stop 'Halted in RDHDU - Y2K' - -c --- Convert seconds to hours - if(ibsecun.GE.3600) then - nhrinc=ibsecun/3600 - ibsecun=ibsecun-nhrinc*3600 - call INCR(io6,ibyrun,ibjulun,ibhrun,nhrinc) - endif - if(iesecun.GE.3600) then - nhrinc=iesecun/3600 - iesecun=iesecun-nhrinc*3600 - call INCR(io6,ieyrun,iejulun,iehrun,nhrinc) - endif -c --- Convert hours to days - if (ibhrun.ge.24) then - nhinc=ibhrun-23 - ibhrun=23 - call incr(io6,ibyrun,ibjulun,ibhrun,nhinc) - endif - if (iehrun.ge.24) then - nhinc=iehrun-23 - iehrun=23 - call incr(io6,ieyrun,iejulun,iehrun,nhinc) - endif - - else -c --- hour-ending times - convert to explicit times -c --- Check year format -c call YR4(iolst,ibyrun,ierrb) - 070702 - call YR4(iolst,ibyru,ierrb) - call YR4(iolst,ieyru,ierre) - if(ierrb.NE.0 .OR. ierre.NE.0) stop 'Halted in RDHDU - Y2K' - -c --- Old format: records on the hour - ibsecun=0 - iesecun=0 -c --- Explicit ending time is the same as hour-ending ending time - ieyrun=ieyru - iejulun=iejulu - iehrun=iehru -c --- Convert to explicit time - ibyrun=ibyru - ibjulun=ibjulu - ibhrun=ibhru -c --- Instantaneous soundings so no need to back up one hour (090511) -c call INCR(io6,ibyrun,ibjulun,ibhrun,-1) - endif - -c --- If data type or format type missing, set to default values - if(jdat.eq.0)jdat=3 - if(ifmt.eq.0)ifmt=1 - -c --- Convert the character lat/lon and integer elevation to reals - if(lstnloc) then - call XTRACTLL(iolst,'LAT ',clat,rnlat) - call XTRACTLL(iolst,'LON ',clon,relon) - elevm=FLOAT(ielevm) - endif - -c --- Formats - -122 format(1x,6i5,f5.0,2i5) -123 format(1x,8i5,f5.0,2i5) -124 format(1x,4(4x,l1)) -987 format(1x,'ERROR in CALMET run - see CALMET.LST file') - - return - end -c---------------------------------------------------------------------- - subroutine rdhdow(iw,ibtz) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060218 RDHDOW -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Read a set of overwater header records -c -c --- UPDATES: -c --- v5.614 (051228) to v6.201 (060218) -c (1) Check for different datums in SEA.DAT and CALMET grid -c -c --- V5.613 (051227) to v5.614 (051228)(F.Robe) -c (1) Initialize twave and hwave with 9999 instead of -999. -c -c --- V5.61 (051111) to V5.613 (051227) (F.Robe) -c (1) Read new header (SEA.DAT version 2.11) with time zone, -c start date and end date (also new format (a132) for Station -c Name in OVRWAT.MET ) -c (2) Check that SEA.DAT time zone matches CALMET base time zone -c (SEA.DAT versions 2.11+) -c (3) Add ibtz to calling list -c (4) Initialize the Tair Sensor height (ZTAIR) and SST sensor -c depth (ZSST) arrays with missing values -c -c --- V5.6 (050328) to V5.61 (051111): -c (1) Store sea.dat version number for each file -c --- V5.545 (030402) to V5.6 (050328): -c (1) Check sea.dat version number against icoare value -c make sure twave, hwave exist if their values must be used -c (2) Initialize new variables TWAVE and HWAVE -c -c -c --- INPUTS: -c IW - integer - Index for overwater data file -c IBTZ - integer - CALMET base time zone -c -c Common block /QA/ variables: -c NCOMMOUT -c Common block /MAP/ variables: -c iutmzn,feast,fnorth, -c rnlat0,relon0,xlat1,xlat2, -c pmap,utmhem,datum,daten -c -c Parameters: IO6, IOX -c -c --- OUTPUT: -c -c Common block /QA/ variables: -c NCOMMOUT -c Common block /OVRWAT/ variables: -c IDOWSTA(mxows), CHOWSTA(mxows) -c lremap,rverow(mxows), -c iutmznow,feastow,fnorthow, -c rnlat0ow,relon0ow,xlat1ow,xlat2ow, -c pmapow,utmhemow,datumow,datenow, -c cactionow,vectiow,vectoow -c -c --- RDHDOW called by: READHD -c --- RDHDOW calls: ALLCAP, LRSAME, XTRACTLL, GLOBE1 -c---------------------------------------------------------------------- - include 'params.met' - - include 'ovrwat.met' - include 'map.met' - include 'qa.met' - - character*64 datamod - character*80 comment1 - -c --- time zone - character*8 awxtz - -c --- Local Variables - character*4 xyunitin,utmhemin - character*8 pmapin,datumin - character*12 datenin - character*16 dataset,dataver,blank16 - character*16 clat0in,clon0in,clat1in,clat2in - character*33 blank33,break33 - character*132 blank,break - - logical lutmin,llccin,lpsin,lemin,llazain,lttmin - logical LRSAME - logical lerror - -c --- For coordinate transformations - character*8 cmapi,cmapo - - data nlim/1/ - data blank16/' '/ - - data blank33/' '/ - data break33/'.................................'/ - - lerror=.FALSE. - -c --- Set blank (132 characters) - blank(1:33)=blank33 - blank(34:66)=blank33 - blank(67:99)=blank33 - blank(100:132)=blank33 - -c --- Set break (132 characters) - break(1:33)=break33 - break(34:66)=break33 - break(67:99)=break33 - break(100:132)=break33 - -c --- Initialize inputs - pmapin=' ' - - lutmin =.FALSE. - llccin =.FALSE. - lpsin =.FALSE. - lemin =.FALSE. - llazain=.FALSE. - lttmin =.FALSE. - - iutmznin=0 - utmhemin=' ' - - rlat0in=-999. - rlon0in=-999. - xlat1in=-999. - xlat2in=-999. - clat0in=blank16 - clon0in=blank16 - clat1in=blank16 - clat2in=blank16 - - feastin=0.0 - fnorthin=0.0 - xyunitin=' ' - - datumin=' ' - datenin=' ' - - dataset=blank16 - dataver=blank16 - - - write(io6,*) - write(io6,'(a30,50x)')'SEA.DAT File Header ----------' - write(io6,*) - -c --- Set file unit number - io=ioow(iw) - - read(io,'(2a16,a64)') dataset,dataver,datamod - write(io6,'(2a16,a64)') dataset,dataver,datamod -c --- Convert Dataset to upper case - do i=1,16 - call ALLCAP(dataset(i:i),nlim) - enddo - -c --- Check Dataset - if(dataset.NE.'SEA.DAT') then -c --- Incorrect file type - write(io6,12)dataset -12 format(//2x,'ERROR IN SUBR. RDHDOW -- invalid file dataset'/ - 1 5x,'DATASET = ',a16/ - 2 5x,'EXPECTED SEA.DAT') - lerror=.TRUE. - goto 999 - endif - - -c --- Check Dataver against ICOARE value - read(dataver(1:4),'(f4.2)')rverow(iw) - if((rverow(iw).LT.2.1).and.(icoare.lt.0) ) then -c --- Observed wave characteristics are required but not available - write(io6,13)icoare,dataver -13 format(//2x,'ERROR IN SUBR. RDHDOW -- invalid SEA.DAT format'/ - 1 5x,'EXPECTED SEA.DAT VERSION > 2.0 for ICOARE < 0'/ - 2 5x,'ICOARE = ',i4,' SEA.DAT version: ',a16/ ) - lerror=.TRUE. - goto 999 - endif -c -c --- Check Dataver to stop if sub-hourly records (for MOD6) - if(rverow(iw).GE.2.2) then -c --- dataset with sub-hourly records - write(io6,14)dataver -14 format(//2x,'ERROR IN SUBR. RDHDOW -- invalid SEA.DAT format'/ - 1 5x,'EXPECTED SEA.DAT VERSION < 2.2 for MOD5 CALMET'/ - 2 ' SEA.DAT version: ',a16/ ) - lerror=.TRUE. - goto 999 - - endif -c -c --- To scratch file - write(iox,'(a132)') blank - write(iox,'(a132)') break - write(iox,'(a132)') blank - write(iox,'(2a16,a64)') dataset,dataver,datamod - ncommout=ncommout+4 - read(io,*) ncomment - write(io6,*) ncomment - do i=1,ncomment - read(io,'(a80)') comment1 - write(io6,'(a80)') comment1 -c --- To scratch file - write(iox,'(a80)') comment1 - ncommout=ncommout+1 - enddo - -c --- Map projection - read(io,'(a8)') pmapin - write(io6,'(a8)') pmapin - do i=1,8 - call ALLCAP(pmapin(i:i),nlim) - enddo - if(pmapin.EQ.'UTM ') lutmin =.TRUE. - if(pmapin.EQ.'LCC ') llccin =.TRUE. - if(pmapin.EQ.'PS ') lpsin =.TRUE. - if(pmapin.EQ.'EM ') lemin =.TRUE. - if(pmapin.EQ.'LAZA ') llazain=.TRUE. - if(pmapin.EQ.'TTM ') lttmin =.TRUE. - -c --- Test for valid PMAPIN - if(lutmin.OR.llccin.OR.lpsin.OR.lemin.OR. - & llazain.OR.lttmin) then -c --- To scratch file - write(iox,'(a8)') pmapin - ncommout=ncommout+1 - else - write(io6,*) - write(io6,*) 'RDHDOW: Invalid PMAP = ',pmapin - write(io6,*) 'PMAP must be UTM,LCC,PS,EM,LAZA, or TTM' - lerror=.TRUE. - goto 999 - endif - -c --- Map projection parameters - if(LUTMIN) then - read(io,'(i4,a4)') iutmznin,utmhemin - write(io6,'(i4,a4)') iutmznin,utmhemin -c --- To scratch file - write(iox,'(i4,a4)') iutmznin,utmhemin - ncommout=ncommout+1 - elseif(LLCCIN) then - read(io,'(4a16)') clat0in,clon0in,clat1in,clat2in - read(io,*) feastin,fnorthin - write(io6,'(4a16)') clat0in,clon0in,clat1in,clat2in - write(io6,*) feastin,fnorthin -c --- To scratch file - write(iox,'(4a16)') clat0in,clon0in,clat1in,clat2in - write(iox,*) feastin,fnorthin - ncommout=ncommout+2 - elseif(LPSIN) then - read(io,'(3a16)') clat0in,clon0in,clat1in - write(io6,'(3a16)') clat0in,clon0in,clat1in -c --- To scratch file - write(iox,'(3a16)') clat0in,clon0in,clat1in - ncommout=ncommout+1 - elseif(LEMIN) then - read(io,'(2a16)') clat0in,clon0in - write(io6,'(2a16)') clat0in,clon0in -c --- To scratch file - write(iox,'(2a16)') clat0in,clon0in - ncommout=ncommout+1 - elseif(LLAZAIN.or.LTTMIN) then - read(io,'(2a16)') clat0in,clon0in - read(io,*) feastin,fnorthin - write(io6,'(2a16)') clat0in,clon0in - write(io6,*) feastin,fnorthin -c --- To scratch file - write(iox,'(2a16)') clat0in,clon0in - write(iox,*) feastin,fnorthin - ncommout=ncommout+2 - endif - if(clat0in(1:1).NE.' ') call XTRACTLL(io6,'LAT ',clat0in,rlat0in) - if(clon0in(1:1).NE.' ') call XTRACTLL(io6,'LON ',clon0in,rlon0in) - if(clat1in(1:1).NE.' ') call XTRACTLL(io6,'LAT ',clat1in,xlat1in) - if(clat2in(1:1).NE.' ') call XTRACTLL(io6,'LAT ',clat2in,xlat2in) - -c --- Map DATUM and DATE - read(io,'(a8,a10)') datumin,datenin - write(io6,'(a8,a10)') datumin,datenin - do i=1,8 - call ALLCAP(datumin(i:i),nlim) - enddo -c --- To scratch file - write(iox,'(a8,a10)') datumin,datenin - ncommout=ncommout+1 - -c --- XYUNIT - read(io,'(a4)') xyunitin - write(io6,'(a4)') xyunitin - do i=1,4 - call ALLCAP(xyunitin(i:i),nlim) - enddo -c --- To scratch file - write(iox,'(a4)') xyunitin - ncommout=ncommout+1 - -c --- Record 10: Time Zone and start/end dates -c --- (for Versions>=2.11) (051227) - if(rverow(iw).GE.2.10999) then -c --- time zone - read(io,'(a8)')awxtz - write(io6,'(a8)') awxtz - -c --- start and end dates - read(io,'(6i6)')iwbyr,iwbjdy,iwbhr, - & iweyr,iwejdy,iwehr - write(io6,'(6i6)')iwbyr,iwbjdy,iwbhr, - & iweyr,iwejdy,iwehr -c --- To scratch file - write(iox,'(a8)') awxtz - write(iox,'(6i6)')iwbyr,iwbjdy,iwbhr, - & iweyr,iwejdy,iwehr - ncommout=ncommout+2 - endif - -c --- Station identification -c --- Note: idowsta is i9 and chowsta is a132 for Versions 2.11+ - read(io,*) idowsta(iw),chowsta(iw) - write(io6,*) idowsta(iw),chowsta(iw) -c --- To scratch file - write(iox,*) idowsta(iw),chowsta(iw) - ncommout=ncommout+1 - -c --- QA header information -c ------------------------- - -c --- Test for valid time zone (versions 2.11+) - - if(rverow(iw).GE.2.10999) then - read(awxtz(4:6),'(i3)')iwhr - read(awxtz(7:8),'(i2)')iwmin - if(iwhr.lt.0)iwmin=-iwmin - xwbtz=iwhr+iwmin/60. -c --- Flip sign as base time convention is opposite UTC/GMT - xwbtz=-xwbtz - iwbtz=int(xwbtz) - if (iwbtz.ne.ibtz) then -c --- SEA.DAT time zone does not match base time zone - stop - write(io6,*) - write(io6,*) 'RDHDOW: Time zones mistmatch - STOP -' - write(io6,*) 'SEA.DAT time zone must match CALMET base', - : ' time zone' - write(io6,*) 'SEA.DAT time zone:', iwbtz,' (',awxtz,')' - write(io6,*) 'CALMET base time zone:', ibtz - lerror=.TRUE. - goto 999 - endif - - endif - -c --- Test for valid IUTMZN - if((iutmznin.LT.1 .OR. iutmznin.GT.60) .AND. LUTMIN) then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' IUTMZN should be 1 to 60' - write(io6,*)' SEA.DAT file: ',iutmznin - lerror=.TRUE. - endif -c --- Test for valid UTMHEM - if((utmhemin.NE.'N '.AND.utmhemin.NE.'S ') .AND. LUTMIN) then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' UTMHEM should be N or S' - write(io6,*)' SEA.DAT file: ',utmhemin - lerror=.TRUE. - endif -c --- Test for valid Units - if(xyunitin.NE.'KM ') then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' XY units must be KM' - write(io6,*)' SEA.DAT file: ',xyunitin - lerror=.TRUE. - endif - - - - -c --- Store info or compare with stored info -c ------------------------------------------ - if(iw.EQ.1) then -c --- Pass header data into /OVRWAT/ if this is the first station - pmapow=pmapin - iutmznow=iutmznin - utmhemow=utmhemin - rnlat0ow=rlat0in - relon0ow=rlon0in - xlat1ow=xlat1in - xlat2ow=xlat2in - datumow=datumin - datenow=datenin - feastow=feastin - fnorthow=fnorthin - -c --- Is a coordinate transformation needed for CALMET? -c --- Set translation vectors going from SEA.DAT (x,y) -c --- to CALMET projection (x,y) -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c --- SEA.DAT - iutmi=iutmznin - if(utmhemin.EQ.'S ' .AND. iutmznin.LT.900) iutmi=-iutmi - cmapi=pmapin - if(cmapi.EQ.'TTM ') cmapi='TM ' -c --- CALMET - iutmo=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmo=-iutmo - cmapo=pmap - if(cmapo.EQ.'TTM ') cmapo='TM ' - call GLOBE1(cmapi,iutmi,tmsone,xlat1in,xlat2in, - & rlat0in,rlon0in,feastin,fnorthin, - & cmapo,iutmo,tmsone,xlat1,xlat2, - & rnlat0,relon0,feast,fnorth, - & cactionow,vectiow,vectoow) -c --- Compare projections, transformation vectors and datums - lremap=.FALSE. - if(pmapin.NE.pmap) lremap=.TRUE. - if(datumin.NE.datum) lremap=.TRUE. - do i=1,9 - if(vectiow(i).NE.vectoow(i)) lremap=.TRUE. - enddo - - else -c --- Compare header data with previous overwater file -c --- Projection checks - if(pmapin.NE.pmapow) then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' Map projection PMAP does not match' - write(io6,*)' SEA.DAT file : ',pmapin - write(io6,*)' Previous file : ',pmapow - lerror=.TRUE. - endif - if(iutmznin.NE.iutmznow)then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' UTM zone does not match' - write(io6,*)' SEA.DAT file : ',iutmznin - write(io6,*)' Previous file : ',iutmznow - lerror=.TRUE. - endif - if(utmhemin.NE.utmhemow)then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' UTM Hemisphere does not match' - write(io6,*)' SEA.DAT file : ',utmhemin - write(io6,*)' Previous file : ',utmhemow - lerror=.TRUE. - endif -c --- Check lat/lon variables - if(clat0in(1:1).NE.' ') then - if(.not.LRSAME(0.0001,rlat0in,rnlat0ow))then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' RNLAT0 does not match' - write(io6,*)' SEA.DAT file : ',rlat0in - write(io6,*)' Previous file : ',rnlat0ow - lerror=.TRUE. - endif - endif - if(clon0in(1:1).NE.' ') then - if(.not.LRSAME(0.0001,rlon0in,relon0ow))then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' RELON0 does not match' - write(io6,*)' SEA.DAT file : ',rlon0in - write(io6,*)' Previous file : ',relon0ow - lerror=.TRUE. - endif - endif - if(clat1in(1:1).NE.' ') then - if(.not.LRSAME(0.0001,xlat1in,xlat1ow))then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' XLAT1 does not match' - write(io6,*)' SEA.DAT file : ',xlat1in - write(io6,*)' Previous file : ',xlat1ow - lerror=.TRUE. - endif - endif - if(clat2in(1:1).NE.' ') then - if(.not.LRSAME(0.0001,xlat2in,xlat2ow))then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' XLAT2 does not match' - write(io6,*)' SEA.DAT file : ',xlat2in - write(io6,*)' Previous file : ',xlat2ow - lerror=.TRUE. - endif - endif -c --- DATUM and DATE - if(datumin.NE.datumow .OR. datenin.NE.datenow)then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' DATUM or DATE does not match' - write(io6,*)' SEA.DAT file : ',datumin,datenin - write(io6,*)' Previous file : ',datumow,datenow - lerror=.TRUE. - endif -c --- False Easting, Northing - if(feastin.NE.feastow .OR. fnorthin.NE.fnorthow)then - write(io6,*) - write(io6,*)'RDHDOW: Problem for station: ',chowsta(iw) - write(io6,*)' False Easting/Northing does not match' - write(io6,*)' SEA.DAT file : ',feastin,fnorthin - write(io6,*)' Previous file : ',feastow,fnorthow - lerror=.TRUE. - endif - - endif - -c --- STOP now if error exists in the input file -999 if(LERROR) then - write(*,987) - stop 'Halted in RDHDOW' - endif - -c --- Formats -987 format(1x,'ERROR in CALMET run - see CALMET.LST file') - - -c --- Initialize the wave characteristics (HWAVE and TWAVE) -c dominant wave period - twave(iw)=9999. -c Significant wave height - hwave(iw)=9999. - -c --- Initialize Tair Sensor height and SST sensor depth (051227) - ZTAIR(iw)=9999. - ZSST(iw) =9999. - - return - end -c---------------------------------------------------------------------- - subroutine rdhd4 (dxmm5) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 110421 RDHD4 -c --- J. Scire, Earth Tech, Inc. -c --- Modified by M. Fernau -c Modified by F. Robe to allow UTM projection in MM4.DAT -c -c --- PURPOSE: Read the IWAQM-formatted header records from a MM4 file -c -c --- UPDATES -c --- v6.327(090511)to v6.334(110421)(F.Robe) -c - Compute MM4 gridsize and pass it via calling list -c -c --- V6.2 (060215) to v6.327(090511)(F.Robe) -c - Check that CALMET grid is within the prognostic sub-domain -c - Print out QA3D.DAT file sooner in the code (so it is available -c for QA-ing should the code stop because the CALMET grid is -c outside of the MM4 prognostic domain) -c -c --- V5.547 (041010) to V6.2 (060215)(F.Robe) -c - Compute array of nearest CALMET neighbors to each MM4 -c gridpoint - INEARG,JNEARG (mxnxp,mxyp) stored in MM4HDO.MET -c -c --- V5.546 (040924)to V5.547 (041010) (F. Robe) -c - Add variable nfm3d to common PROGSTEP (for multiple MM4 files) -c --- V5.542 (031126) to V5.546 (040924) (F. Robe) -c - Compute the positions of MM4 gridpoints relative to CALMET -c domain origin -c --- V5.541 (030515) to V5.542 (031126) (J. Scire) -c - Write MM4.DAT grid pts (X,Y,long,lat) to QA3D.DAT -c file -c --- V5.5 (030402) to V5.51 (030515) (DGS) -c - Add grid points to list file -c - MM4 DATUM is DATUM3D in /MM4HDO/ -c --- V5.4 (030119) to V5.5 (030402) (DGS) -c - Add list-file unit to JULDAY, INCR, YR4 calls -c - Add new COORDS (GLOBE1, GLOBE) -c - Change documentation: coordinates may be other than -c UTM or LLC -c --- V5.1-V5.3 030119 (FRR):initialization for NOOBS mode -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- INPUTS: -c -c Parameters: -c MXNXP, MXNYP, MXNZP, IO6, IO20, MXNX, MXNY, IO4,MXB3D -c Common block /MAP/: -c IUTMZN, UTMHEM, XLAT1, XLAT2, RELON0, RNLAT0, -c FEAST, FNORTH, DATUM -c Common block /GRID/: -c NX,NY,DGRID,XORIGR,YORIGR, -c Common block /MM4HDO/ variables: -c DATUM3D -c -c --- OUTPUT: -c -c Common block /MM4HDO/ variables: -c IBYRM, IBJULM, IBHRM, IEYRM, IEJULM, IEHRM, -c NXMM4, NYMM4, NZP, PTOPMM4, I1, J1, NXP, NYP, -c SIGMA(mxnzp), XLAT4(mxnxp,mxnyp), XLONG4(mxnxp,mxnyp), -c IELEV4(mxnxp,mxnyp),ILU4(mxnxp,mxnyp),XLCMM4(mxnxp,mxnyp), -c YLCMM4(mxnxp,mxnyp),IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4), -c IOUTMM5,DATUM3D -c INEARG(mxnxp,mxnyp), JNEARG((mxnxp,mxnyp) -c -c Common PROGSTEP variables (to RDMM4) -c ifirstpg,nfm3d -c -c --- RDHD4 called by: READHD -c --- RDHD4 calls: JULDAY, INCR, YR4, GLOBE1, GLOBE, INOUT -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - character*36 ctext - logical lprt -c -c --- Common blocks - include 'map.met' - include 'grid.met' - include 'mm4hdo.met' - include 'd6.met' - -c Initialisation for NOOBS option (common with RDMM4,READHD) - COMMON /PROGSTEP/ ifirstpg,nfm3d - -c --- For coordinate transformations - character*8 cmapi,cmapo - character*12 caction - character*4 c4hem - real*8 vecti(9),vecto(9) - -c --- CALMET corner points (090511) - real*8 xc(4),yc(4) - -c --- MM4 corner points (defining MM4 boundary)(090511) - real*8 xb(mxb3d),yb(mxb3d) - - dimension neari(4),nearj(4),dnear(4) - data lprt/.true./ - - -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c --- Set translation vectors going from N.lat/E.lon -c --- to projection(x,y)km - iutmo=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmo=-iutmo - cmapo=pmap - if(cmapo.EQ.'TTM ') cmapo='TM ' - cmapi='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cmapo,iutmo,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & caction,vecti,vecto) - -c -c ------------------------------------------------------------------ -c --- Read header record #1 (text date/time stamp for file creation) -c ------------------------------------------------------------------ - read(io20,10)ctext -10 format(a36) -c -c ---------------------------------------------------------- -c --- Read header record #2 (MM4 grid data) (revised format) -c ---------------------------------------------------------- -c *** read(io20,20)ibyrm,ibmom,ibdym,ibhrm,ieyrm,iemom,iedym,iehrm, -c ***1 nxmm4,nymm4,nzp,ptopmm4 -c *20 format(4i2,1x,4i2,3i4,f6.1) - read(io20,20)ibyrm,ibmom,ibdym,ibhrm,nhrsmm4, - 1 nxmm4,nymm4,nzp,ptopmm4 - 20 format(4i2,4i4,f6.1) - call YR4(io6,ibyrm,ierrb) - if(ierrb.NE.0) stop 'Halted in RDHD4' -c -c --- Calculate Julian day - call julday(io6,ibyrm,ibmom,ibdym,ibjulm) -c --- Uncomment if using other format -c *** call julday(io6,ieyrm,iemom,iedym,iejulm) -c -c --- Compute ending date/time (comment out if using other format) - ieyrm=ibyrm - iejulm=ibjulm - iehrm=ibhrm - call incr(io6,ieyrm,iejulm,iehrm,nhrsmm4) -c - -c ----------------------------------------------------- -c --- Read header record #3 (extraction subdomain data) -c ----------------------------------------------------- - read(io20,30)i1,j1,nxp,nyp -30 format(4i4) -c -c --- Note that MM4 data includes 8 mandatory levels (surface, 1000, -c --- 925, 850, 700, 500, 400, and 300 mb) plus NZP model levels - nzpp8 = nzp + 8 -c --- Check that array dimensions are not exceeded - if(nxp.gt.mxnxp.or.nyp.gt.mxnyp.or.nzpp8.gt.mxnzp)then - write(io6,*)'ERROR in subr. RDHD4 -- Array dimensions ', - 1 'are too small for data being read' - write(io6,*)'Grid being read (NXP, NYP, NZP, NZPP8) = ', - 1 nxp,nyp,nzp,nzpp8 - write(io6,*)'Array dimensions (MXNXP, MXNYP, MXNZP) = ', - 1 mxnxp,mxnyp,mxnzp - stop - endif -c -c ---------------------------------------- -c --- Next NZP records -- MM4 sigma levels -c ---------------------------------------- - do 40 n=1,nzp - read(io20,38)sigma(n) -38 format(f6.4) -40 continue -c -c ----------------------------------------------------- -c --- Print the MM4 header information to the list file -c --- (except for the gridded fields) -c ----------------------------------------------------- - if(lprt)then - write(io6,102)ctext -102 format(//1x,'Information read from MM4 data file'/ - 1 5x,'LABEL (CTEXT): ',a36) -c - write(io6,104)ibyrm,ibmom,ibdym,ibhrm,nhrsmm4, - 1 nxmm4,nymm4,nzp,ptopmm4 -104 format(/5x,'Date/time (YYYYMMDDHH) of MM4 data: '/ - 1 5x,' Start = ',i4,3i2,' (GMT)'/ - 2 5x,' No. hours = ',i4,/ - 3 5x,'Full MM4 model grid characteristics: '/ - 4 5x,' No. X cells = ',i4/ - 5 5x,' No. Y cells = ',i4/ - 6 5x,' No. layers = ',i4/ - 7 5x,' Top pressure level = ',f6.1,' (mb)') -c - ixlast=i1+nxp-1 - jylast=j1+nyp-1 - write(io6,106)i1,j1,ixlast,jylast -106 format(/5x,'Extraction subdomain in MM4.DAT file: '/ - 1 5x,' Beginning X = ',i4/ - 2 5x,' Beginning Y = ',i4/ - 3 5x,' Ending X = ',i4/ - 4 5x,' Ending Y = ',i4) -c - write(io6,108) -108 format(/5x,'MM4 sigma levels'/5x,'Level',5x,'Sigma'/) - do 110 i=1,nzp - write(io6,109)i,sigma(i) -109 format(4x,i4,6x,f6.4) -110 continue - endif -c -c -------------------------------------------------------------- -c --- Next NXP * NYP records -- lat., long., elevation, land use -c -------------------------------------------------------------- - - do 50 j=1,nyp - do 50 i=1,nxp - read(io20,48)iindex,jindex,xlat4(i,j),xlong4(i,j), - & ielev4(i,j),ilu4(i,j) -48 format(2i3,f7.3,f8.3,i5,i3) - -c --- Compute grid point locations from N.Lat and E.Lon - call GLOBE(io6,caction,datum3d,vecti,datum,vecto, - & xlong4(i,j),xlat4(i,j),xlcmm4(i,j),ylcmm4(i,j), - & idum,c4hem) -c -c --- QA check that I,J read match expected values -c - icheck=iindex-i1+1 - jcheck=jindex-j1+1 - if(icheck.ne.i.or.jcheck.ne.j)then - write(io6,*)'ERROR in subr. RDHD4 -- I,J do not match ', - 1 'values read on header record' - write(io6,*)'I, J = ',i,j - write(io6,*)'ICHECK, JCHECK = ',icheck,jcheck - stop - endif - -50 continue -c -c --- 110421- Compute MM5 gridsize in km - dxmm5= sqrt ( (xlcmm4(1,1)-xlcmm4(2,1))**2 + - : (ylcmm4(1,1)-ylcmm4(2,1))**2 ) -c -c ----------------------------------------------------- -c --- Print the MM4 grid points to the QA file -c ----------------------------------------------------- - if(lprt)then - open(io4,file='QA3D.DAT',status='unknown') -c - write(io4,*)' MM4.DAT Grid Points' - write(io4,*)' X Y Longitude Latitude' - write(io4,*)' (km) (km) (deg E) (deg N)' - do j=1,nyp - do i=1,nxp - write(io4,'(4f12.3)') xlcmm4(i,j),ylcmm4(i,j), - 1 xlong4(i,j),xlat4(i,j) - enddo - enddo -c - close(io4) - endif - -c ----------------------------------------------------------------------- -c --- Ensure that the CALMET domain is within the MM4 sub-domain (090511) -c ----------------------------------------------------------------------- -c --- MM4 boundary points -c --- Must include all boundary points and not just corner points -c --- because of possible curvature of MM4 domain in CALMET coord. system - - do nc=1,nyp - xb(nc)=xlcmm4(1,nc) - yb(nc)=ylcmm4(1,nc) - end do - do i=1,nxp-1 - nc=nyp+i - xb(nc)=xlcmm4(1+i,nyp) - yb(nc)=ylcmm4(1+i,nyp) - end do - do i=1,nyp-1 - nc=nyp+nxp-1+i - xb(nc)=xlcmm4(nxp,nyp-i) - yb(nc)=ylcmm4(nxp,nyp-i) - end do - do i=1,nxp-1 - nc=nyp+nxp+nyp-2+i - xb(nc)=xlcmm4(nxp-i,1) - yb(nc)=ylcmm4(nxp-i,1) - end do - -c --- total number of boundary points - nptbound=nyp+nxp+nyp+nxp-3 - -c --- CALMET corner points - delg= dgrid * .001 - xc(1) = xmap0 + (0.5 * delg) - yc(1) = ymap0 + (0.5 * delg) - xc(2) = xc(1) - yc(2) = yc(1) + (ny-1) * delg - xc(3) = xc(1) + (nx-1) * delg - yc(3) = yc(1) - xc(4) = xc(3) - yc(4) = yc(2) - -c - do nc=1,4 - - call inout(xc(nc),yc(nc),iflag,xb,yb,nptbound) - - if (iflag.eq.0) then -c --- calmet gridpoint is outside of MM4 subdomain ->stop - write(io6,*)'STOP - Subroutine RDHD4 -' - write(io6,*)'CALMET grid outside of prognostic grid' - write(6,*)'STOP - CALMET grid outside of prognostic grid' - write(io6,*)'Check plot files QAMETG.BNA and QA3D.DAT' - STOP - end if - - end do - -c ----------------------------------------------------------------- -c --- Find the 4 closest MM4 grid points to each CALMET grid point -c (assume CALMET domain is inside MM4 grid section) -c -c delg = dgrid * .001 ! already defined (090511) -c *** xcal = xorigr * .001 + (0.5 * delg) -c *** ycal = yorigr * .001 + (0.5 * delg) -c --- Compute CALMET grid coordinates in real space coordinates - xcal = xmap0 + (0.5 * delg) - ycal = ymap0 + (0.5 * delg) - - do i = 1,nx -c -c --- Find x/y for CALMET center points -c - xx = xcal + (i - 1) * delg - do j = 1,ny - yy = ycal + (j - 1) * delg - do k = 1,4 - neari(k) = 0 - nearj(k) = 0 - dnear(k) = 9.9E19 - enddo - - - do ii = 1,nxp - do jj = 1,nyp - - pdist = sqrt ((xlcmm4(ii,jj) - xx) ** 2 + - & (ylcmm4(ii,jj) - yy) **2) - - - do k = 1,4 - if (pdist .lt. dnear(k)) then - if (k .lt. 4) then - dnear(4) = dnear(3) - nearj(4) = nearj(3) - neari(4) = neari(3) - endif - if (k .lt. 3) then - dnear(3) = dnear(2) - nearj(3) = nearj(2) - neari(3) = neari(2) - endif - if (k .lt. 2) then - dnear(2) = dnear(1) - nearj(2) = nearj(1) - neari(2) = neari(1) - endif - dnear(k) = pdist - nearj(k) = jj - neari(k) = ii - goto 66 - endif - enddo - 66 continue - - enddo - enddo - - do k = 1,4 - igrab(i,j,k) = neari(k) - jgrab(i,j,k) = nearj(k) - enddo - - enddo - enddo - -c------------------------------------------------------------------- -c --- Find the closest CALMET grid point to each MM4 -c grid point (060213)v (stored in MM4HDO.MET) -c ------------------------------------------------------------------ - do i = 1,nxp - do j = 1,nyp - nearii = 1 - nearjj = 1 - dnearg=9.9E19 - - do ii = 1,nx - do jj = 1,ny - - xx = xcal + (ii - 1) * delg - yy = ycal + (jj - 1) * delg - - pdist = sqrt ((xlcmm4(i,j) - xx) ** 2 + - & (ylcmm4(i,j) - yy) **2) - - if (pdist .lt. dnearg) then - dnearg = pdist - nearii = ii - nearjj = jj - endif - - enddo - enddo - - inearg(i,j) = nearii - jnearg(i,j) = nearjj - - - enddo - enddo - -c --------------------------------------------------------------------- - -c --- 040924 (frr) Compute the MM5 gridpoints locations (in m) relative -c --- the CALMET domain origin - Done here rather than at each timestep -c --- in subrtoutine interpqr (also use units of meters not km) - np=0 - do 300 ip=1,nxp - do 300 jp=1,nyp - np=np+1 - x04(np)=(xlcmm4(ip,jp)-xmap0)*1000. - y04(np)=(ylcmm4(ip,jp)-ymap0)*1000. - 300 continue - - - -c Record first access to MM4 record (And first MM4.DAT file) - ifirstpg=0 - nfm3d=1 - - return - end -c---------------------------------------------------------------------- - subroutine rdhd5(mcloud,itwprog,npsta,dxmm5) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 RDHD5 -c F.Robe -c -c --- PURPOSE: Read the header records from a MM5.DAT or 3D.DAT file -c -c --- UPDATES: -c -c --- v6.334 to v6.5.0 (150223) -c - Trap and report error opening files (not found) -c -c --- v6.330 (101006) to v6.334 (110421) (FRR) -c - compute MM5 gridsize -c -c --- v6.328 (090615) to v6.330 (101006) (CEC) -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c -c --- v6.327(090511) to V6.328 (090615) -c - Move printing of first/last gridpoint lat/lon/elev to -c RDHD51, RDHD52 and RDHD53 so the info is printed out -c after each multiple file header is read in -c -c --- V6.32 (080205) to v6.327(090511)(F.Robe) -c - Check that CALMET grid is within the prognostic sub-domain -c -c --- v6.219 (070123)to V6.32 (080205)(F.Robe) -c - Allow 3D.DAT version 3.0 -c - Add npsta to rdhd5 and rdhd53 calling lists -c -c --- v6.217 (061231)to v6.219 (070123)(F.Robe) -c - Compute 4 closest ocean 3D.Dat gridpoint to ALL CALMET -c gridpoints (not just offshore gridpoints) -c -c --- V6.2 (060215) to v6.217 (061231)(F.Robe) -c - Allow icloud=4 option -c -c --- v5.56h (051113) to V6.2 (060215)(F.Robe) -c - Compute array of nearest CALMET neighbors to each MM5 -c gridpoint - INEARG,JNEARG (mxnxp,mxyp) stored in MM4HDO.MET -c -c --- V5.6f (050428)to v5.56h (051113)(F.Robe) -c - Check compatibility between dataset version and itwprog option -c (if itwprog=2, make sure deltaT is available in 3D.DAT file) -c - Get itwprog value from calling list and pass to rdhd53 -c - compute 4 closest ocean 3D.DAT gridpoints to each offshore -c CALMET gridpoints (igrabw,jgrabw) and store in MM4HDO -c - include GEO.MET -c -c --- V5.6 (050328) to V5.6f (050428)(F.Robe) -c - Remove npsta from calling list (no longer needed) -c -c --- V5.547 (041010) to V5.6 (050328)(F.Robe) -c - Remove ioutmm5 restriction on NPSTA=-1 as surface precipitation is -c is always part of the M3D record even if rainfall profiles (qr) -c are not -c --- V5.546 (040924) to V5.547 (041010) (F.Robe) -c - add variable file number (nfm3d) and change call -c to rdhd51/rdhd52/rdhd53 (necessary for multiple MM5.DAT) -c - explicit common replaced by include d6.met -c --- V5.542 (031126) to V5.546 (040924) (F. Robe) -c - Compute the positions of MM5 gridpoints relative to CALMET -c domain origin -c --- V5.541 (030402) to V5.542 (031126) (J. Scire) -c - Changes to allow new 3D.DAT file structure (Version 2.0) -c to be read while maintinaing backward compatibility with -c older MM5.DAT and 3D.DAT/M3D.DAT/MM53D.DAT files -c --- V5.4 (000602d) to V5.5 (030402) (DGS) -c - Change documentation: coordinates may be other than -c UTM or LLC -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c --- V5.0-V5.1 991104 (DGS): Allow either new or old header format -c -c --- INPUTS: -C MCLOUD INT - CLOUD FLAG - IF MCLOUD=3 or 4, compute cloud cover -C based on prognostic variables -C -c ITWPROG INT - Flag to use SEA.DAT or prognostic offshore -c temperatures (deltaT) -c 0 : use SEA.DAT air/sea temperatures and lapse rates -c 1 : use SEa.DAT temp and prognostic lapse rates -c 2 : use prognostic air/sea temperatures -c and lapse rates -c NPSTA integer Precipitation flag -c -1: use prognostic precipitation fields -c 0: no precipitation -c n>0: number of precipitation stations -c -c Parameters: -c MXNXP, MXNYP, MXNZP, IO6, IO20, MXNX, MXNY, MXB3D -c Common block /GRID/: -c NX,NY,DGRID,XORIGR,YORIGR -c Common block /FILNAM/: M3DDAT(mxm3d) -c Common block /MM4HDO/: NM3D,itwprog -c Common block /GEO/: ilandu,iwat1,iwat2 -c -c -c --- OUTPUT: -c -c Common block /MM4HDO/ variables: -c IBYRM, IBJULM, IBHRM, IEYRM, IEJULM, IEHRM, -c NXMM4, NYMM4, NZP, PTOPMM4, I1, J1, NXP, NYP, -c SIGMA(mxnzp), XLAT4(mxnxp,mxnyp), XLONG4(mxnxp,mxnyp), -c IELEV4(mxnxp,mxnyp),ILU4(mxnxp,mxnyp),XLCMM4(mxnxp,mxnyp), -c YLCMM4(mxnxp,mxnyp),X04(mxnxp*mxnyp),Y04(mxnxp*mxnyp), -c IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4),IOUTMM5 -c IGRABW(mxnx,mxny),JGRABW(mxnx,mxny) -c INEARG(mxnxp,mxnyp), JNEARG(mxnxp) -c -c -c --- RDHD5 called by: READHD -c --- RDHD5 calls: RDHD51, RDHD52, RDHD53, INOUT, OPEN_ERR -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - character*80 buff1,buff2 - character*12 cset3d - logical lprt -c -c --- Common blocks - include 'grid.met' - include 'mm4hdo.met' - include 'filnam.met' - include 'd6.met' - include 'geo.met' - -c COMMON /D6/ IRD,IWR,IFILE,IRDP -c - COMMON /PROGSTEP/ ifirstpg,nfm3d -c - dimension neari(4),nearj(4),dnear(4) - data lprt/.true./ - -c --- CALMET corner points (090511) - real*8 xc(4),yc(4) - -c --- MM5 corner points (defining MM5 boundary)(090511) - real*8 xb(mxb3d),yb(mxb3d) - -c --- FRR (09/2001) - non hourly mm5 data -c --- Flag for initialization in rdmm5 subroutine - ifirstpg = 0 - -c --- MM5.DAT file number - nfm3d=1 - -c --- Read first two records to determine file format -c --- iMM53d = 0 for MM5.DAT file structure -c --- iMM53d = 1 for 3D.DAT file structure prior to Version 2.0 -c --- iMM53d = 2 for 3D.DAT file structure, Version 2.x -c --- imm53d = 3 for 3D.DAT file structure, version 3.0 or later - read(io20,'(a)')buff1 - read(io20,'(a)')buff2 - -cc --- Step (1): Check for "3D.DAT" or "MM53D.DAT" on second -c --- record of file (indication of old 3D.DAT file structure -c --- prior to Version 2.0) - read(buff2,'(a12)')cset3d - - if(cset3d.eq.'3D.DAT'.or.cset3d.eq.'MM53D.DAT')then - imm53d=1 - else -c -c --- Step (2) check for new standard 3D.DAT file structure -c --- with dataset name, version and comments on first record - if(buff1(1:6).eq.'3D.DAT')then - imm53d=2 -c --- Version 3.x (explicit beg/end times with seconds) - if(buff1(17:17).eq.'3')imm53d=3 - else -c -c --- Structure does not fit 3D.DAT conventions -- assume -c --- file is in MM5.DAT format - imm53d=0 - endif - endif - - close(io20) - -c --- Check compatibility with ITWPROG (051113) - if (itwprog.eq.2 .and. imm53d.lt.2) then - write(io6,*) 'STOP in RDHD5 ' - write(io6,*) 'Error in Input Group 6 of CALMET.INP ' - write(io6,*) 'ITWPROG=2 incompatible with 3D.DAT dataset' - write(io6,*) '3D.DAT version # must be 2.0 or higher' - stop - endif - - -c frr 041010 - Multiple MM5.DAT -c open(io20,file=mm4dat,status='old') - open(io20,file=m3ddat(1),status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDHD5','3D.DAT File', - & m3ddat(1),io20) - -c ----------------------- -c --- Read header records -c ----------------------- - -c --- frr 050328 - keep track of multiple MM5.DAT files to open them - - if(imm53d.eq.0) then -c --- Data is in original MM5 format (No data set name) -c --- Record 1 includes a comment line - call rdhd51(nfm3d) -c - else if(imm53d.eq.1)then -c -c --- Data is in old 3D.DAT format prior to version 2.0 -c --- (Record 1 is title, Record 2 is dataset name, -c --- code version # and level #) - call rdhd52(nfm3d) - - else if(imm53d.eq.2.or.imm53d.eq.3)then -c -c --- Data is in new 3D.DAT format (dataset version 2.0 or -c --- 3.0) - call rdhd53(nfm3d,itwprog,npsta) - - else -c -c --- Unexpected value of imm53d -- write error message - write(io6,*)'Error in Subr. RDHD5 -- Unexpected value ', - 1 'of IMM53D -- IMM53D = ',imm53d - stop - endif -c - - -c --- 110421- Compute MM5 gridsize in km - dxmm5= sqrt ( (xlcmm4(1,1)-xlcmm4(2,1))**2 + - : (ylcmm4(1,1)-ylcmm4(2,1))**2 ) - - -c --- Print out after each new file is read in (elevations can change) -c --- 090615 -c -------------------------------------------------------- -c --- Print first and last lat/lon values to the list file -c -------------------------------------------------------- -c if(lprt)then -c write(io6,121)xlat4(1,1),xlong4(1,1),ielev4(1,1), -c & xlat4(nxp,nyp),xlong4(nxp,nyp),ielev4(nxp,nyp) -c121 format(/5x,' Lat./Lon./Elev. of First Cell: ',f9.4,f10.4,i6/ -c : 5x,' Lat./Lon./Elev. of Last Cell: ',f9.4,f10.4,i6) -c endif -c - - -c ---------------------------------------------------------------------- -c --- Ensure that the CALMET domain is within the M3D sub-domain (090511) -c ---------------------------------------------------------------------- -c --- M3D boundary points: -c --- Must include all boundary points and not just corner points -c --- because of possible curvature of M3D domain in CALMET coord. system - - do nc=1,nyp - xb(nc)=xlcmm4(1,nc) - yb(nc)=ylcmm4(1,nc) - end do - do i=1,nxp-1 - nc=nyp+i - xb(nc)=xlcmm4(1+i,nyp) - yb(nc)=ylcmm4(1+i,nyp) - end do - do i=1,nyp-1 - nc=nyp+nxp-1+i - xb(nc)=xlcmm4(nxp,nyp-i) - yb(nc)=ylcmm4(nxp,nyp-i) - end do - do i=1,nxp-1 - nc=nyp+nxp+nyp-2+i - xb(nc)=xlcmm4(nxp-i,1) - yb(nc)=ylcmm4(nxp-i,1) - end do - -c --- total number of boundary points - nptbound=nyp+nxp+nyp+nxp-3 - -c --- CALMET corner points - delg= dgrid * .001 - xc(1) = xmap0 + (0.5 * delg) - yc(1) = ymap0 + (0.5 * delg) - xc(2) = xc(1) - yc(2) = yc(1) + (ny-1) * delg - xc(3) = xc(1) + (nx-1) * delg - yc(3) = yc(1) - xc(4) = xc(3) - yc(4) = yc(2) - -c - do nc=1,4 - call inout(xc(nc),yc(nc),iflag,xb,yb,nptbound) - if (iflag.eq.0) then -c --- calmet gridpoint is outside of M3D subdomain ->stop - write(io6,*)'STOP - Subroutine RDHD5 -' - write(io6,*)'CALMET grid outside of prognostic grid' - write(6,*)'STOP - CALMET grid outside of prognostic grid' - write(io6,*)'Check plot files QAMETG.BNA and QA3D.DAT' - STOP - end if - end do - -c---------------------------------------------------------------- -c --- Find the 4 closest MM5 grid points to each CALMET grid point -c (assume CALMET domain is inside MM5 grid section) -c --------------------------------------------------------------- -c delg = dgrid * .001 ! Already defined (090511) - -c --- Compute CALMET grid coordinates in real space coordinates - xcal = xmap0 + (0.5 * delg) - ycal = ymap0 + (0.5 * delg) -c - do i = 1,nx -c -c --- Find x/y for CALMET center points -c - xx = xcal + (i - 1) * delg - do j = 1,ny - yy = ycal + (j - 1) * delg - do k = 1,4 - neari(k) = 0 - nearj(k) = 0 - dnear(k) = 9.9E19 - enddo - do ii = 1,nxp - do jj = 1,nyp - pdist = sqrt ((xlcmm4(ii,jj) - xx) ** 2 + - & (ylcmm4(ii,jj) - yy) **2) - do k = 1,4 - if (pdist .lt. dnear(k)) then - if (k .lt. 4) then - dnear(4) = dnear(3) - nearj(4) = nearj(3) - neari(4) = neari(3) - endif - if (k .lt. 3) then - dnear(3) = dnear(2) - nearj(3) = nearj(2) - neari(3) = neari(2) - endif - if (k .lt. 2) then - dnear(2) = dnear(1) - nearj(2) = nearj(1) - neari(2) = neari(1) - endif - dnear(k) = pdist - nearj(k) = jj - neari(k) = ii - goto 66 - endif - enddo -66 continue - - enddo - enddo - -c - do k = 1,4 - igrab(i,j,k) = neari(k) - jgrab(i,j,k) = nearj(k) - enddo - enddo - enddo -c - -c------------------------------------------------------------------- -c --- Find the 4 closest MM5 ocean grid points to each offshore -c CALMET grid point - only if itwprog=2 (051031-frr) -c (assume CALMET domain is inside MM5 grid section) -c ------------------------------------------------------------------ - if (itwprog.eq.2) then - - do 55 i = 1,nx -c -c --- Find x/y for CALMET center points - xx = xcal + (i - 1) * delg - - do 56 j = 1,ny - -c --- Process ALL CALMET points (070123) -c if (ilandu(i,j).lt.iwat1.or.ilandu(i,j).gt.iwat2) go to 56 - - yy = ycal + (j - 1) * delg - - nearii = 0 - nearjj = 0 - dnearr = 9.9E19 - - do 57 ii = 1,nxp - do 58 jj = 1,nyp - -c --- only process ocean 3D.DAT points - if (ilu4(ii,jj).ne.iluoc3d) go to 58 - - pdist = sqrt ((xlcmm4(ii,jj) - xx) ** 2 + - & (ylcmm4(ii,jj) - yy) **2) - if (pdist .lt. dnearr) then - dnearr = pdist - nearjj = jj - nearii = ii - endif - -58 continue -57 continue - - igrabw(i,j) = nearii - jgrabw(i,j) = nearjj - -56 continue -55 continue - - endif - - - -c------------------------------------------------------------------- -c --- Find the closest CALMET grid point to each MM5 -c grid point (060213)v (stored in MM4HDO.MET) -c ------------------------------------------------------------------ - do i = 1,nxp - do j = 1,nyp - nearii = 0 - nearjj = 0 - dnearg=9.9E19 - - do ii = 1,nx - do jj = 1,ny - - xx = xcal + (ii - 1) * delg - yy = ycal + (jj - 1) * delg - - pdist = sqrt ((xlcmm4(i,j) - xx) ** 2 + - & (ylcmm4(i,j) - yy) **2) - - if (pdist .lt. dnearg) then - dnearg = pdist - nearii = ii - nearjj = jj - endif - - enddo - enddo - - inearg(i,j) = nearii - jnearg(i,j) = nearjj - enddo - enddo - -c ------------------------------------------------------- - -c frr (09/01) check if prognostic precip data are available -c NPSTA>0 : use observations (precip data) -c NPSTA=0 : no precipitation data (neither obs nor MM5) -c NPSTA=-1: use MM5 data -c -c --- 050328: surface rainfall always available even if qr vertical -c --- profiles are not -c if (npsta.lt.0 )then -c if (ioutmm5.eq.81 .or. ioutmm5.eq.82 .or. -c : ioutmm5.eq.91 .or. ioutmm5.eq.92 )then -c write(io6,*)'WARNING - Subroutine RDHD5 -' -c write(io6,*)'MM5 precipitation data is not available' -c write(io6,*)'NPSTA must be reset - NPSTA =',NPSTA -c stop -c endif -c endif - -c --- 040924 (frr) Compute the MM5 gridpoints locations (in m) relative -c --- the CALMET domain origin - Done here rather than at each timestep -c --- in subrtoutine interpqr (also use units of meters not km) - np=0 - do 300 ip=1,nxp - do 300 jp=1,nyp - np=np+1 - x04(np)=(xlcmm4(ip,jp)-xmap0)*1000. - y04(np)=(ylcmm4(ip,jp)-ymap0)*1000. - 300 continue - - -c -c --- frr (09/01) -c --- test if cloud data can be computed from MM5 record -c --- Check that prognostic relative humidy is available - - icloud3 = 0 - if ( (ioutmm5.ge.82 .and. ioutmm5.le.85 ) .or. - : (ioutmm5.ge.92 .and. ioutmm5.le.95 ) ) icloud3=1 - -ccec101006 if ( icloud.ge.3 .and. icloud3.eq.0 ) then - if ( mcloud.ge.3 .and. icloud3.eq.0 ) then - write(io6,*)'Cloud cover cannot be computed from MM5 data' - write(io6,*)'No prognostic relative humidity available' - write(io6,*)'MCLOUD = ',mcloud - write(io6,*)'ioutmm5 = ',ioutmm5 - stop - endif -c - return - end -c---------------------------------------------------------------------- - subroutine rdhd51(nfm3d) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 RDHD51 -c F.Robe -c Modified by J. Scire (1/99), Zhong Wu (11/00), F.Robe (04) -c -c --- PURPOSE: Read MM5.DAT header records in original format. -c Record 1 includes title, program (not dataset) -c version and level -c Note that year is not Y2K format(i2) -c -c --- UPDATES -c -c --- v6.328 to v6.5.0 (150223) -c - Trap and report error opening files (not found) -c -c --- V6.223 (070702) to v6.328 (090615) -c - Read header records on 2nd, 3rd, ... MM5.DAT files rather -c than skipping these records. This will allow header record -c data such as ground elevations to change within a CALMET -c run (needed for 2005 RUC processing). -c - Print out location and elevations of first/last MM5 gridpoints -c in list file -c -c --- V5.547 (041010) to V6.223 (070702)(F.Robe) -c - Read in the actual LU from MM5.DAT since it is available -c rather than inferring it from zero elevation -c -c --- V5.542(031126) to V5.547 (041010) (F.Robe) -c - For multiple MM5.DAT files, skip headers -c (except for 1st file) -c - Explicit common replaced by include d6.met -c --- V5.541 (030515) to V5.542 (031126) (J. Scire) -c - Revise comments to reflect MM5.DAT format -c - Fix a write statement to refer to RDHD51 -c - Write MM5.DAT grid pts (X,Y,long,lat) to QA3D.DAT -c filec --- V5.5 (030402) to V5.51 (030515) (DGS) -c - Add grid points to list file -c - MM5 DATUM is DATUM3D in /MM4HDO/ -c --- V5.4 (000602d) to V5.5 (030402) (DGS) -c - Add list-file unit to JULDAY, INCR, YR4 calls -c - Add new COORDS (GLOBE1, GLOBE) -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c --- V5.0-V5.1 991104 (DGS): Allow either new or old header format -c -c --- INPUTS: -c N - INTEGER - number of the current MM5 file . -c -c Parameters: -c MXNXP, MXNYP, MXNZP, IO6, IO20, MXNX, MXNY,IO4 -c Common block /MAP/: -c IUTMZN, UTMHEM, XLAT1, XLAT2, RELON0, RNLAT0, -c FEAST, FNORTH, DATUM -c Common block /GRID/: -c NX,NY,DGRID,XORIGR,YORIGR -c Common block /MM4HDO/ variables: -c DATUM3D, NM3D -c Common block /FILNAM/ variables: -c M3DDAT(MXM3D) -c -c --- OUTPUT: -c -c Common block /MM4HDO/ variables: -c IBYRM, IBJULM, IBHRM, IEYRM, IEJULM, IEHRM, -c NXMM4, NYMM4, NZP, PTOPMM4, I1, J1, NXP, NYP, -c SIGMA(mxnzp), XLAT4(mxnxp,mxnyp), XLONG4(mxnxp,mxnyp), -c IELEV4(mxnxp,mxnyp),ILU4(mxnxp,mxnyp),XLCMM4(mxnxp,mxnyp), -c YLCMM4(mxnxp,mxnyp),X04(mxnxp*mxnyp),Y04(mxnxp*mxnyp), -c IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4),IOUTMM5,DATUM3D -c -c --- RDHD51 called by: RDHD5 ,MM5 -c --- RDHD51 calls: JULDAY, INCR, YR4, GLOBE1, GLOBE, OPEN_ERR -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - character*80 ctext - character*12 cver5,clab5 -c --- Increase line variable to 32 to include landuse -c character*26 cline - character*32 cline - logical lprt -c -c --- Common blocks - include 'map.met' - include 'grid.met' - include 'mm4hdo.met' - include 'filnam.met' - - include 'd6.met' -c COMMON /D6/ IRD,IWR,IFILE,IRDP - -c --- For coordinate transformations - character*8 cmapi,cmapo - character*12 caction - character*4 c4hem - real*8 vecti(9),vecto(9) -c -c --- Prognostic land use - integer ilu4p(mxnxp,mxnyp) - - data lprt/.true./ - - -c ------------------------------------------------------------------ -c --- Close current MM5.DAT and open next MM5.DAT- -c --- Skip header (Assumption: all MM5.DAT files have similar size/params) -c ------------------------------------------------------------------ - - if(nfm3d.gt.1) then - close(io20) - open(io20,file=m3ddat(nfm3d),status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDHD51','3D.DAT File', - & m3ddat(nfm3d),io20) -c --- V6.328 change - do NOT skip header records - write(io6,8)nfm3d,m3ddat(nfm3d) -8 format(/1x,'Reading MM5.DAT file number: ',i3/1x, - 1 'File name: ',a132) -c --- skip first 6 +nzp+ nxp*nyp headers -c *** do k=1,6+nzp+nxp*nyp -c *** read(io20,*) -c *** end do -c *** return - endif - - -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c --- Set translation vectors going from N.lat/E.lon -c --- to projection(x,y)km - iutmo=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmo=-iutmo - cmapo=pmap - if(cmapo.EQ.'TTM ') cmapo='TM ' - cmapi='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cmapo,iutmo,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & caction,vecti,vecto) -c -c -c ------------------------------------------------------------------ -c --- Read header record #1 (text date/time stamp for file creation) -c ------------------------------------------------------------------ - read(io20,10)ctext,cver5,clab5 -10 format(a80,2a12) -c -c ------------------------------------------------ -c --- Read header record #2 (CALMM5 output options) -c ------------------------------------------------ - read(io20,43)ioutw,ioutq,ioutc,iouti,ioutg - ioutmm5=81+10*ioutw+ioutq+ioutc+iouti+ioutg -43 format(5(i3)) -c ---------------------------------------------- -c --- Skip header record #3 (MM5 Map projection) -c ---------------------------------------------- - read(io20,*) -c ------------------------------------------------ -c --- Read header record #4 (CALMM5 output options) -c ------------------------------------------------ - read(io20,44) inhyd,imphys,icupa,ibltyp,ifrad,isoil, - : ifddaan,ifddaob -44 format(8(i3)) -c -------------------------------------------- -c --- Read header record #5 (CALMM5 grid data) -c -------------------------------------------- - read(io20,20)ibyrm,ibmom,ibdym,ibhrm,nhrsmm5, - 1 nxp,nyp,nzp - 20 format(4i2,i5,3i4) - call YR4(io6,ibyrm,ierrb) - if(ierrb.NE.0) stop 'Halted in RDHD51' -c -c --- Calculate Julian day - call julday(io6,ibyrm,ibmom,ibdym,ibjulm) - -c -c --- Compute ending date/time (comment out if using other format) - ieyrm=ibyrm - iejulm=ibjulm - iehrm=ibhrm - call incr(io6,ieyrm,iejulm,iehrm,nhrsmm5) -c -c ----------------------------------------------------- -c --- Read header record #6 (extraction subdomain data) -c ----------------------------------------------------- - read(io20,30)nx1,ny1,nx2,ny2,rxmin,rxmax,rymin,rymax - i1=nx1 - j1=ny1 -30 format(4i4,4(f8.2)) -c -c --- Check that array dimensions are not exceeded - if(nxp.gt.mxnxp.or.nyp.gt.mxnyp.or.nzp.gt.mxnzp)then - write(io6,*)'ERROR in subr. RDHD51 -- Array dimensions ', - 1 'are too small for data being read' - write(io6,*)'Grid being read (NXP, NYP, NZP) = ', - 1 nxp,nyp,nzp - write(io6,*)'Array dimensions (MXNXP, MXNYP, MXNZP) = ', - 1 mxnxp,mxnyp,mxnzp - stop - endif -c -c --------------------------------------------- -c --- Next NZP records -- MM5 half-sigma levels -c --------------------------------------------- - do 40 n=1,nzp - read(io20,38)sigma(n) -38 format(f6.3) -40 continue -c -c ----------------------------------------------------- -c --- Print the MM5 header information to the list file -c --- (except for the gridded fields) -c ----------------------------------------------------- - if(lprt)then - write(io6,101)ctext,cver5,clab5 -101 format(//1x,'Information read from MM5.DAT data file'/ - 1 5x,'Dataset Title (CTEXT): ',a80/ - 2 5x,'Program Version: ',a12/ - 3 5x,'Program Label: ',a12) -c - write(io6,102) inhyd,imphys,icupa,ibltyp,ifrad,isoil, - : ifddaan,ifddaob -102 format(/5x,'MM5 physics options: '/ - 1 5x,' Hydrostatic: ',i2/ - 1 5x,' Moisture scheme: ',i2/ - 1 5x,' Convection scheme: ',i2/ - 1 5x,' Boundary layer scheme: ',i2/ - 1 5x,' Radiation scheme ',i2/ - 1 5x,' Soil scheme: ',i2/ - 1 5x,' Analysis FDDA: ',i2/ - 1 5x,' Observation FDDA: ',i2) -c - write(io6,103)1,ioutw,ioutq,ioutc,iouti,ioutg -103 format(/5x,'CALMM5 output fields (1 = YES; 0 = NO): '/ - 1 5x,' Pressure, height,T,Wind speed and direction: ',i2/ - 1 5x,' Vertical velocity: ',i2/ - 1 5x,' RH and vapor mixing ratio: ',i2/ - 1 5x,' Cloud and rain mixing ratios: ',i2/ - 1 5x,' Ice and Snow mixing ratios: ',i2/ - 1 5x,' Graupel: ',i2) - -c - write(io6,104)ibyrm,ibmom,ibdym,ibhrm,nhrsmm5, - 1 nxp,nyp,nzp -104 format(/5x,'Date/time (YYYYMMDDHH) of MM5 data: '/ - 1 5x,' Start = ',i4,3i2,' (GMT)'/ - 2 5x,' No. hours = ',i4,/ - 3 5x,'Extraction Subdomain in MM5 file: '/ - 4 5x,' No. X cells = ',i4/ - 5 5x,' No. Y cells = ',i4/ - 6 5x,' No. layers = ',i4 ) -c - write(io6,106)nx1,ny1,nx2,ny2 -106 format(/5x,' Beginning X = ',i4/ - 2 5x,' Beginning Y = ',i4/ - 3 5x,' Ending X = ',i4/ - 4 5x,' Ending Y = ',i4) -c - write(io6,107)rymin,rymax,rxmin,rxmax -107 format(/5x,' Latitude range : ',f7.2,' - ',f7.2/ - : 5x,' Longitude range: ',f8.2, ' - ' ,f8.2) - - write(io6,108) -108 format(/5x,'MM5 half-sigma levels'/5x,'Level',5x,'Sigma'/) - do 110 i=1,nzp - write(io6,109)i,sigma(i) -110 continue -109 format(4x,i4,6x,f6.4) - endif -c -c ---------------------------------------------------- -c --- Next NXP * NYP records -- lat., long., elevation, land use -c ---------------------------------------------------- - do 50 j=1,nyp - do 50 i=1,nxp - read(io20,'(a32)') cline - if(cline(13:13).EQ.' ') then -c --- Early MM5.DAT format for these records - read(cline,47)iindex,jindex,xlat4(i,j),xlong4(i,j), - & ielev4(i,j), ilu4p(i,j) - else -c --- Revised MM5.DAT format for these records - read(cline,48)iindex,jindex,xlat4(i,j),xlong4(i,j), - & ielev4(i,j), ilu4p(i,j) - endif -47 format(2i3,f6.2,f8.2,i5,i3) -48 format(2i3,f7.3,f8.3,i5,i3) - - -c --- Fill in ILU4 array stored in MM4HDO.MET - ilu4(i,j)=ilu4p(i,j) - -c --- Compute grid point locations from N.Lat and E.Lon - call GLOBE(io6,caction,datum3d,vecti,datum,vecto, - & xlong4(i,j),xlat4(i,j),xlcmm4(i,j),ylcmm4(i,j), - & idum,c4hem) -c -c --- QA check that I,J read match expected values -c - icheck=iindex-i1+1 - jcheck=jindex-j1+1 - if(icheck.ne.i.or.jcheck.ne.j)then - write(io6,*)'ERROR in subr. RDHD5 -- I,J do not match ', - 1 'values read on header record' - write(io6,*)'I, J = ',i,j - write(io6,*)'ICHECK, JCHECK = ',icheck,jcheck - stop - endif -50 continue - -c --------------------------------------------- -c --- Print the MM5 grid points to the QA file -c --------------------------------------------- - if(lprt)then - open(io4,file='QA3D.DAT',status='unknown') -c - write(io4,*)' MM5.DAT Grid Points' - write(io4,*)' X Y Longitude Latitude' - write(io4,*)' (km) (km) (deg E) (deg N)' - do j=1,nyp - do i=1,nxp - write(io4,'(4f12.3)') xlcmm4(i,j),ylcmm4(i,j), - 1 xlong4(i,j),xlat4(i,j) - enddo - enddo -c - close(io4) - endif -c -c -------------------------------------------------------- -c --- Print first and last lat/lon values to the list file (090615) -c -------------------------------------------------------- - if(lprt)then - write(io6,121)xlat4(1,1),xlong4(1,1),ielev4(1,1), - & xlat4(nxp,nyp),xlong4(nxp,nyp),ielev4(nxp,nyp) -121 format(/5x,' Lat./Lon./Elev. of First Cell: ',f9.4,f10.4,i6/ - : 5x,' Lat./Lon./Elev. of Last Cell: ',f9.4,f10.4,i6) - endif -c - - return - end - -c---------------------------------------------------------------------- - subroutine rdhd52(nfm3d) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 RDHD52 -c Zhong-Xiang Wu -c -c --- PURPOSE: Read a 3D.DAT file in old format (prior to Version 2.0). -c Record 1 is title, Record 2 includes data set name, -c program (not dataset) version and level numbers. -c Note that year is Y2K format (i4). -c -c --- UPDATES: -c -c --- v6.328 to v6.5.0 (150223) -c - Trap and report error opening files (not found) -c -c --- V6.223 (070702) to v6.328 (090615) -c - Read header records on 2nd, 3rd, ... MM5.DAT files rather -c than skipping these records. This will allow header record -c data such as ground elevations to change within a CALMET -c run (needed for 2005 RUC processing). -c - Print out location and elevations of first/last MM5 gridpoints -c in list file -c -c --- V6.206 (060322) to V5.731 (070702) (F. Robe) -c - Read in the actual LU from MM5.DAT since it is available -c rather than inferring it from zero elevation -c -c --- V5.6 (041010) to V6.206 (060322)(F.Robe) -c - Assign ocean LU to zero elevation gridpoints (no land use -c is read from MM5 records in this format so substitute) -c -c --- V5.542 (031126) to V5.6 (041010) (F.Robe) -c - For multiple MM5.DAT files, skip headers -c (except for 1st file) -c - Explicit common replaced by include d6.met -c --- V5.541 (030515) to V5.542 (031126) (J. Scire) -c - Revise comments to reflect 3D.DAT format (prior -c to dataset Version 2.0) -c - Fix a write statement to refer to RDHD52 -c - Write 3D.DAT grid pts (X,Y,long,lat) to QA3D.DAT -c file -c --- V5.5 (030402) to V5.51 (030515) (DGS) -c - Add grid points to list file -c - MM4 DATUM is DATUM3D in /MM4HDO/ -c --- V5.4 (000602d) to V5.5 (030402) (DGS) -c - Add list-file unit to JULDAY, INCR, YR4 calls -c - Add new COORDS (GLOBE1, GLOBE) -c -c --- INPUTS: -c -c nfm3d - INTEGER - number of the current MM5 file -c -c Parameters: -c MXNXP, MXNYP, MXNZP, IO6, IO20, MXNX, MXNY,IO4 -c Common block /MAP/: -c IUTMZN, UTMHEM, XLAT1, XLAT2, RELON0, RNLAT0, -c FEAST, FNORTH, DATUM -c Common block /GRID/: -c NX,NY,DGRID,XORIGR,YORIGR -c Common block /MM4HDO/ variables: -c DATUM3D -c Common block /FILNAM/ variables: -c m3ddat(mxm3d) -c -c --- OUTPUT: -c -c Common block /MM4HDO/ variables: -c IBYRM, IBJULM, IBHRM, IEYRM, IEJULM, IEHRM, -c NXMM4, NYMM4, NZP, PTOPMM4, I1, J1, NXP, NYP, -c SIGMA(mxnzp), XLAT4(mxnxp,mxnyp), XLONG4(mxnxp,mxnyp), -c IELEV4(mxnxp,mxnyp),ILU4(mxnxp,mxnyp),XLCMM4(mxnxp,mxnyp), -c YLCMM4(mxnxp,mxnyp),IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4), -c IOUTMM5,DATUM3D -c -c --- RDHD52 called by: RDHD5 , MM5 -c --- RDHD52 calls: JULDAY, INCR, YR4, GLOBE1, GLOBE, OPEN_ERR -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - character*80 ctext - character*12 cver5,clab5,cset3d - logical lprt -c -c --- Common blocks - include 'map.met' - include 'grid.met' - include 'mm4hdo.met' - include 'filnam.met' - - include 'd6.met' -c COMMON /D6/ IRD,IWR,IFILE,IRDP - -c --- For coordinate transformations - character*8 cmapi,cmapo - character*12 caction - character*4 c4hem - real*8 vecti(9),vecto(9) -c -c --- Prognostic land use - integer ilu4p(mxnxp,mxnyp) - - data lprt/.true./ - -c ------------------------------------------------------------------ -c --- Close current MM5.DAT and open next MM5.DAT- -c --- Skip header (Assumption: all MM5.DAT files have similar size/params) -c ------------------------------------------------------------------ - if(nfm3d.gt.1) then - close(io20) - open(io20,file=m3ddat(nfm3d),status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDHD52','3D.DAT File', - & m3ddat(nfm3d),io20) -c --- V6.328 change - do NOT skip header records -c - write(io6,8)nfm3d,m3ddat(nfm3d) -8 format(/1x,'Reading 3D.DAT file number: ',i3/1x, - 1 'File name: ',a132) -c --- skip first 7 +nzp+ nxp*nyp headers -c *** do k=1,7+nzp+nxp*nyp -c *** read(io20,*) -c *** end do -c *** return - endif - - -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c --- Set translation vectors going from N.lat/E.lon -c --- to projection(x,y)km - iutmo=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmo=-iutmo - cmapo=pmap - if(cmapo.EQ.'TTM ') cmapo='TM ' - cmapi='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cmapo,iutmo,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & caction,vecti,vecto) -c -c ------------------------------------------------------------------ -c --- Read header record #1 (title) -c ------------------------------------------------------------------ - read(io20,10)ctext -10 format(a80) - -c ------------------------------------------------------------------ -c --- Read header record #2 (Data set nema, version and level) -c ------------------------------------------------------------------ - read(io20,11)cset3d,cver5,clab5 -11 format(3a12) -c -c ------------------------------------------------ -c --- Read header record #3 (CALMM5 output options) -c ------------------------------------------------ - read(io20,43)ioutw,ioutq,ioutc,iouti,ioutg - ioutmm5=81+10*ioutw+ioutq+ioutc+iouti+ioutg -43 format(5(i3)) - -c ------------------------------------------------ -c --- Skip header record #4 (MM5 Map projection) -c ------------------------------------------------ - read(io20,*) - -c ------------------------------------------------ -c --- Read header record #5 (CALMM5 output options) -c (Add 13 output options for surface variables) -c ------------------------------------------------ - read(io20,44) inhyd,imphys,icupa,ibltyp,ifrad,isoil - : ,ifddaan,ifddaob - : ,igrdt,ipbl,ishf,ilhf,iustr,iswdn - : ,ilwdn,ist1,ist2,ist3,ist4,ist5,ist6 -44 format(30(i3)) -c -------------------------------------------- -c --- Read header record #6 (CALMM5 grid data) -c -------------------------------------------- - read(io20,20)ibyrm,ibmom,ibdym,ibhrm,nhrsmm5, - 1 nxp,nyp,nzp - 20 format(i4,3i2,i5,3i4) - call YR4(io6,ibyrm,ierrb) - if(ierrb.NE.0) stop 'Halted in RDHD52' -c -c --- Calculate Julian day - call julday(io6,ibyrm,ibmom,ibdym,ibjulm) -c -c --- Compute ending date/time (comment out if using other format) - ieyrm=ibyrm - iejulm=ibjulm - iehrm=ibhrm - call incr(io6,ieyrm,iejulm,iehrm,nhrsmm5) -c -c ----------------------------------------------------- -c --- Read header record #7 (extraction subdomain data) -c ----------------------------------------------------- - read(io20,30)nx1,ny1,nx2,ny2,nz1,nz2, - & rxmin,rxmax,rymin,rymax - i1=nx1 - j1=ny1 -30 format(6i4,2f10.4,2f9.4) -c - -c --- Check that array dimensions are not exceeded - if(nxp.gt.mxnxp.or.nyp.gt.mxnyp.or.nzp.gt.mxnzp)then - write(io6,*)'ERROR in subr. RDHD52 -- Array dimensions ', - 1 'are too small for data being read' - write(io6,*)'Grid being read (NXP, NYP, NZP) = ', - 1 nxp,nyp,nzp - write(io6,*)'Array dimensions (MXNXP, MXNYP, MXNZP) = ', - 1 mxnxp,mxnyp,mxnzp - stop - endif -c --- Check consistency between nz1,nz2, and nzp - if(nzp.ne.nz2-nz1+1) then - write(io6,*)'Error in RDHD52: NZ1,NZ2 and NZP not consistent' - write(io6,*)'nz1,nz2,nzp:',nz1,nz2,nzp - stop - endif -c -c ---------------------------------------- -c --- Next NZP records -- MM5 half-sigma levels -c ---------------------------------------- - do 40 n=1,nzp - read(io20,38)sigma(n) -38 format(f6.3) -40 continue -c -c ----------------------------------------------------- -c --- Print the MM5 header information to the list file -c --- (except for the gridded fields) -c ----------------------------------------------------- - if(lprt)then - write(io6,101)ctext,cset3d,cver5,clab5 -101 format(//1x,'Information read from 3D.DAT file'/ - 1 5x,'Dataset Title (CTEXT): ',a80/ - 2 5x,'Dataset Name: ',a12/ - 3 5x,'Program Version: ',a12/ - 4 5x,'Program Level: ',a12) -c - write(io6,102) inhyd,imphys,icupa,ibltyp,ifrad,isoil, - : ifddaan,ifddaob -102 format(/5x,'MM5 physics options: '/ - 1 5x,' Hydrostatic: ',i2/ - 1 5x,' Moisture scheme: ',i2/ - 1 5x,' Convection scheme: ',i2/ - 1 5x,' Boundary layer scheme: ',i2/ - 1 5x,' Radiation scheme ',i2/ - 1 5x,' Soil scheme: ',i2/ - 1 5x,' Analysis FDDA: ',i2/ - 1 5x,' Observation FDDA: ',i2) - - - write(io6,1021)igrdt,ipbl,ishf,ilhf,iustr,iswdn - : ,ilwdn,ist1,ist2,ist3,ist4,ist5,ist6 -1021 format(/5x,'MM5 surface variable options: '/ - 1 5x,' Ground temperature: ',i2/ - 1 5x,' PBL: ',i2/ - 1 5x,' Sensible heat flux: ',i2/ - 1 5x,' Latent heat flux: ',i2/ - 1 5x,' Frictional velocity: ',i2/ - 1 5x,' Downward SW radiation: ',i2/ - 1 5x,' Downward LW radiation: ',i2/ - 1 5x,' Soil temp at layer 1: ',i2/ - 1 5x,' Soil temp at layer 2: ',i2/ - 1 5x,' Soil temp at layer 3: ',i2/ - 1 5x,' Soil temp at layer 4: ',i2/ - 1 5x,' Soil temp at layer 5: ',i2/ - 1 5x,' Soil temp at layer 6: ',i2) - - write(io6,103)1,ioutw,ioutq,ioutc,iouti,ioutg -103 format(/5x,'CALMM5 output fields (1 = YES; 0 = NO): '/ - 1 5x,' Pressure, height,T,Wind speed and direction: ',i2/ - 1 5x,' Vertical velocity: ',i2/ - 1 5x,' RH and vapor mixing ratio: ',i2/ - 1 5x,' Cloud and rain mixing ratios: ',i2/ - 1 5x,' Ice and Snow mixing ratios: ',i2/ - 1 5x,' Graupel: ',i2) - - write(io6,104)ibyrm,ibmom,ibdym,ibhrm,nhrsmm5, - 1 nxp,nyp,nzp -104 format(/5x,'Date/time (YYYYMMDDHH) of MM5 data: '/ - 1 5x,' Start = ',i4,3i2,' (GMT)'/ - 2 5x,' No. hours = ',i4,/ - 3 5x,'Extraction Subdomain in MM5 file: '/ - 4 5x,' No. X cells = ',i4/ - 5 5x,' No. Y cells = ',i4/ - 6 5x,' No. layers = ',i4 ) -c - write(io6,106)nx1,ny1,nz1,nx2,ny2,nz2 -106 format(/5x,' Beginning X = ',i4/ - 2 5x,' Beginning Y = ',i4/ - 3 5x,' Beginning Z = ',i4/ - 4 5x,' Ending X = ',i4/ - 5 5x,' Ending Y = ',i4/ - 6 5x,' Ending Z = ',i4) -c - write(io6,107)rymin,rymax,rxmin,rxmax -107 format(/5x,' Latitude range : ',f9.4,' - ',f9.4/ - : 5x,' Longitude range: ',f10.4, ' - ' ,f10.4) - - write(io6,108) -108 format(/5x,'MM5 half-sigma levels'/5x,'Level',5x,'Sigma'/) - do 110 i=1,nzp - write(io6,109)i,sigma(i) -110 continue -109 format(4x,i4,6x,f6.4) - endif -c -c ---------------------------------------------------- -c --- Next NXP * NYP records -- lat., long., elevation -c ---------------------------------------------------- - do 50 j=1,nyp - do 50 i=1,nxp -c --- read lu as available (070702) - read(io20,99)iindex,jindex,xlat4(i,j),xlong4(i,j), - & ielev4(i,j),ilu4p(i,j) - 99 format(2i4,f9.4,f10.4,i5,i3) -c --- LU is actually available in records -c --- assign ocean LU to zero elevation points (060322) -c if (ielev4(i,j).eq.0) then -c ilu4(i,j)=iluoc3d -c else -c --- make sure that not all points are flagged as ocean -c --- if by chance user input iluoc3d=0 -c ilu4(i,j)=iluoc3d+1 -c endif -c --- Fill in ILU4 array stored in MM4HDO.MET - ilu4(i,j)=ilu4p(i,j) - -c --- Compute grid point locations from N.Lat and E.Lon - call GLOBE(io6,caction,datum3d,vecti,datum,vecto, - & xlong4(i,j),xlat4(i,j),xlcmm4(i,j),ylcmm4(i,j), - & idum,c4hem) -c -c --- QA check that I,J read match expected values -c - icheck=iindex-i1+1 - jcheck=jindex-j1+1 - if(icheck.ne.i.or.jcheck.ne.j)then - write(io6,*)'ERROR in subr. RDHD52 -- I,J do not match ', - 1 'values read on header record' - write(io6,*)'I, J = ',i,j - write(io6,*)'ICHECK, JCHECK = ',icheck,jcheck - stop - endif -50 continue - -c --------------------------------------------- -c --- Print the MM5 grid points to the QA file -c --------------------------------------------- - if(lprt)then - open(io4,file='QA3D.DAT',status='unknown') -c - write(io4,*)' 3D.DAT Grid Points' - write(io4,*)' X Y Longitude Latitude' - write(io4,*)' (km) (km) (deg E) (deg N)' - do j=1,nyp - do i=1,nxp - write(io4,'(4f12.3)') xlcmm4(i,j),ylcmm4(i,j), - 1 xlong4(i,j),xlat4(i,j) - enddo - enddo -c - close(io4) - endif -c -c -c -------------------------------------------------------- -c --- Print first and last lat/lon values to the list file (090615) -c -------------------------------------------------------- - if(lprt)then - write(io6,121)xlat4(1,1),xlong4(1,1),ielev4(1,1), - & xlat4(nxp,nyp),xlong4(nxp,nyp),ielev4(nxp,nyp) -121 format(/5x,' Lat./Lon./Elev. of First Cell: ',f9.4,f10.4,i6/ - : 5x,' Lat./Lon./Elev. of Last Cell: ',f9.4,f10.4,i6) - endif -c - return - end -c---------------------------------------------------------------------- - subroutine rdhd53(nfm3d,itwprog,npsta) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 RDHD53 -c J. Scire, Earth Tech -c Adapted from RDHD52 -c -c --- PURPOSE: Read the header records from a file in 3D.DAT format -c (dataset Version 2.x or 3.x) -c -c --- UPDATES: -c -c --- v6.4.1 to v6.5.0 (150223) -c - Trap and report error opening files (not found) -c - Change write-statement format from 104 to 105 when reporting -c information to list file from subhourly 3D.DAT file (when -c imm53d=3) -c -c --- v6.4.0 (121203) to v6.4.1 (140716) -c - Enhance string-processing when checking for the dataset -c version of the input 3D.DAT file. Previous code halted when -c reading a 3D.DAT file prepared by CALTAPM because the dataset -c version was not properly compared to known values. -c -c --- v6.328 (090615) to v6.4.0 (121203) -c - Add checks for recognized dataset versions -c 2.0, 2.1, 2.11, 2.12, 2.13 -c 3.0, 3.1 -c - Halt with error message if 3D.DAT is generated by processor -c version with known errors. -c -c --- v6.327 (090511) to v6.328 (090615) -c - Read header records on 2nd, 3rd, ... MM5.DAT files rather -c than skipping these records. This will allow header record -c data such as ground elevations to change within a CALMET -c run (needed for 2005 RUC processing). -c - Print out location and elevations of first/last MM5 gridpoints -c in list file -c --- v6.32 (080205) to v6.327 (090511)(F.Robe) -c - Initialize MM5 seconds -c -c --- V6.206 (060322)to v6.32 (080205)(F.Robe) -c - Read in 3D.DAT version 3.x with explicit beg/end times with -c seconds (the header is the same as Version 2.x otherwise) -c - Check availability of precipitation and SST data if user -c wants to use them (could be blank if not available or not good -c in original prognostic datasets e.g. for RUC data) -c - Add npsta to calling list -c -c --- V5.611 (051113) to V6.206 (060322)(F.Robe) -c - fill in values for ILU4 for all values of ITWPROG -c -c --- V5.6 (041010) to V5.611 (051113) (F.Robe) -c - Read in 3D.DAT land use type and store in ILU4 array -c (in MM4HD0.MET) with minus sign for ocean gridpoints -c not surrounded by other ocean gridpoints -c - Change read format 11 to free read -c -c --- V5.542 (031126) to V5.6 (041010) (F.Robe) -c - For multiple MM5.DAT files, skip headers (except for 1st file) -c - Explicit common replaced by include d6.met -c -c --- INPUTS: -c -c NFM3D Integer - number of the current 3D.DAT file -c -c ITWPROG Integer - Offshore temperature option -c 0 : deltaT and OW lapse rates from SEA.DAT -c 1 : deltaT from SEA.DAT and OW lapse rates from -c 3D.DAT -c 2 : prognostic deltaT and lapse rates(from 3D.DAT) -c NPSTA integer Precipitation flag -c -1: use prognostic precipitation fields -c 0: no precipitation -c n>0: number of precipitation stations -c -c Parameters: -c MXNXP, MXNYP, MXNZP, IO6, IO20, MXNX, MXNY -c Common block /MAP/: -c IUTMZN, UTMHEM, XLAT1, XLAT2, RELON0, RNLAT0, -c FEAST, FNORTH, DATUM -c Common block /GRID/: -c NX,NY,DGRID,XORIGR,YORIGR -c Common block /MM4HDO/ variables: -c DATUM3D -c Common block /FILNAM/ variables: -c m3ddat(mxm3d) -c -c --- OUTPUT: -c -c Common block /MM4HDO/ variables: -c IBYRM, IBJULM, IBHRM, IEYRM, IEJULM, IEHRM, -c NXMM4, NYMM4, NZP, PTOPMM4, I1, J1, NXP, NYP, -c SIGMA(mxnzp), XLAT4(mxnxp,mxnyp), XLONG4(mxnxp,mxnyp), -c IELEV4(mxnxp,mxnyp),ILU4(mxnxp,mxnyp),XLCMM4(mxnxp,mxnyp), -c YLCMM4(mxnxp,mxnyp),IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4), -c IOUTMM5,NCOMM3D, CNAME3D, CVER3D, CTITLE3D, COMM3D, -c DATUM3D -c -c --- RDHD53 called by: RDHD5 -c --- RDHD53 calls: JULDAY, INCR, YR4, GLOBE1, GLOBE, OPEN_ERR -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - character*128 ctemp3d - character*5 crain - character*8 csst - logical lprt -c -c --- Common blocks - include 'map.met' - include 'grid.met' - include 'mm4hdo.met' - include 'filnam.met' - - COMMON /D6/ IRD,IWR,IFILE,IRDP - -c --- For coordinate transformations - character*8 cmapi,cmapo - character*12 caction - character*4 c4hem - real*8 vecti(9),vecto(9) -c -c --- Prognostic land use - integer ilu4p(mxnxp,mxnyp) - - data lprt/.true./ - -c --- Initialize seconds (090511) - nscmm5=0 - -c --- check that precipitation and/or SST are available (if required)(080205) - if(npsta.eq.-1.or.itwprog.eq.2) then - if(nfm3d.gt.1) then -c --- close previous file and open new one - close(io20) - open(io20,file=m3ddat(nfm3d),status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDHD53','3D.DAT File', - & m3ddat(nfm3d),io20) - endif - -c --- skip first 2+ncomm3d+3+nzp+nxp*nyp headers - read(io20,*) - read(io20,*)ncomm3d - do k=1,ncomm3d+3 - read(io20,*) - end do -c --- Read in nxp,nyp,nzp -c --- Versions 2.x: hours only - Version 3.x: with seconds (080205) - if (imm53d.eq.2) then - read(io20,20)ibyrm,ibmom,ibdym,ibhrm,nhrsmm5, - 1 nxp,nyp,nzp - else if (imm53d.eq.3) then - read(io20,21)ibyrm,ibmom,ibdym,ibhrm,ibsecm,nhrsmm5, - 1 nscmm5,nxp,nyp,nzp - endif -c --- skip remaining headers - do k=1,1+nzp+nxp*nyp - read(io20,*) - end do -c --- Check first record to see if precipitation field is blank - if (imm53d.eq.2) then -c --- (3D.DAT version 2.x) - read(io20,62) myr,mmo,mday,mhr,ix,jx, - & pmsl,crain,isnow,rads,radl,t2,qq2,wd10,ws10,csst -62 format(i4,3i2,2i3,f7.1,a5,i2,3f8.1,f8.2,2f8.1,a8) - else if (imm53d.eq.3) then -c --- (3D.DAT version 3.x and above(080205) - read(io20,63) myrb,mmob,mdayb,mhrb,msecb, - & myr,mmo,mday,mhr,msec,ix,jx, - & pmsl,crain,isnow,rads,radl,t2,qq2,wd10,ws10,csst -63 format(i4,3i2,i4,i5,3i2,i4,i4,i3,f7.1,a5,i2,3f8.1,f8.2,2f8.1,a8) - endif - - - if(crain(1:5).eq.' ' .and.npsta.eq.-1) then -c --- precip fields left blank: warn user and stop - write(6,*)' STOP in RDHD53 - Check list file' - write(6,*)' No prognostic precipitation data' - write(io6,*)'STOP in RDHD53' - write(io6,*)'No prognostic precipitation data' - write(io6,*)'Use NPSTA>=0' - stop - else if (csst(1:8).eq.' '.and.itwprog.eq.2) then -c --- SSTs fields left blank: warn user and stop - write(6,*)' STOP in RDHD53 - Check list file' - write(6,*)' No prognostic SST data' - write(io6,*)'STOP in RDHD53' - write(io6,*)'No prognostic SST data' - write(io6,*)'Select ITWPROG < 2' - stop - else -c --- Precipitation and SST available if needed - Proceed -c --- rewind and proceed if first file -c --- for next files, close and rewind below - if(nfm3d.eq.1) then - close(io20) - open(io20,file=m3ddat(nfm3d),status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDHD53','3D.DAT File', - & m3ddat(nfm3d),io20) - endif - endif - endif - -c --- 041010 - Multiple 3D.DAT files (Frr)- -c ------------------------------------------------------------------------ -c --- Close current 3D.DAT and open next 3D.DAT- -c --- v6.328 change - do NOT skip header records -c ------------------------------------------------------------------------ - if(nfm3d.gt.1) then - close(io20) - open(io20,file=m3ddat(nfm3d),status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDHD53','3D.DAT File', - & m3ddat(nfm3d),io20) - write(io6,8)nfm3d,m3ddat(nfm3d) -8 format(/1x,'Reading 3D.DAT file number: ',i3/1x, - 1 'File name: ',a132) -c --- skip first 2+ncomm3d+5+nzp+ nxp*nyp headers -c *** read(io20,*) -c read(io20,11)ncomm3d -c *** read(io20,*)ncomm3d -c *** do k=1,ncomm3d+5+nzp+nxp*nyp -c *** read(io20,*) -c *** end do -c *** return - endif - -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c --- Set translation vectors going from N.lat/E.lon -c --- to projection(x,y)km - iutmo=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmo=-iutmo - cmapo=pmap - if(cmapo.EQ.'TTM ') cmapo='TM ' - cmapi='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cmapo,iutmo,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & caction,vecti,vecto) -c -c ------------------------------------------------------------------ -c --- Read header record #1 (Dataset name, version and title -c ------------------------------------------------------------------ - read(io20,10)cname3d,cver3d,ctitle3d -10 format(2a16,a64) - -c --- Remove leading blanks from strings - cname3d=ADJUSTL(cname3d) - cver3d=ADJUSTL(cver3d) - ctitle3d=ADJUSTL(ctitle3d) - -c --- v6.4.0, Level 121203 -c --- Check for known dataset versions -c --- This will require code update for new 3D.DAT datasets - igood3d=0 - if(TRIM(cver3d).EQ.'2.0') then - igood3d=1 - elseif(TRIM(cver3d).EQ.'2.1') then - igood3d=1 - elseif(TRIM(cver3d).EQ.'2.11') then - igood3d=1 - elseif(TRIM(cver3d).EQ.'2.12') then - igood3d=1 - elseif(TRIM(cver3d).EQ.'2.13') then - igood3d=1 - elseif(TRIM(cver3d).EQ.'3.0') then - igood3d=1 - elseif(TRIM(cver3d).EQ.'3.1') then - igood3d=1 - endif - if(igood3d.EQ.0) then - write(io6,*) - write(io6,*)'ERROR in subr. RDHD53 -- dataset version' - write(io6,*)'Expected 2.0, 2.1, 2.11, 2.12, 2.13, '// - & 'or 3.0, 3.1' - write(io6,*)'Found 3D.DAT Dataset Version ',cver3d - stop 'Halted in RDHD53 -- See list file' - endif - -c ------------------------------------------------------------------ -c --- Read header record #2 (Number of comment lines) -c ------------------------------------------------------------------ -c read(io20,11)ncomm3d - read(io20,*)ncomm3d -c11 format(i4) - -c ------------------------------------------------------------------ -c --- Next "NCOMM3d" lines (comment lines) -c ------------------------------------------------------------------ - if(ncomm3d.gt.0)then - do i=1,ncomm3d - read(io20,12)ctemp3d -12 format(a132) -c --- Save first line of text for later printing - if(i.eq.1)comm3d=ctemp3d - enddo - endif - -c ------------------------------------------- -c --- Next header record (MM5 output options) -c ------------------------------------------- - read(io20,43)ioutw,ioutq,ioutc,iouti,ioutg - ioutmm5=81+10*ioutw+ioutq+ioutc+iouti+ioutg -43 format(5(i3)) - -c -------------------------------------------- -c --- Skip next header record (map projection) -c -------------------------------------------- - read(io20,*) - -c ------------------------------------------------ -c --- Next header record (MM5 output options) -c (Add 13 output options for surface variables) -c ------------------------------------------------ - read(io20,44) inhyd,imphys,icupa,ibltyp,ifrad,isoil - : ,ifddaan,ifddaob - : ,igrdt,ipbl,ishf,ilhf,iustr,iswdn - : ,ilwdn,ist1,ist2,ist3,ist4,ist5,ist6 -44 format(30(i3)) -c -------------------------------------- -c --- Next header record (MM5 grid data) -c -------------------------------------- -c --- Versions 2.x: hours only - Version 3.x: with seconds (080205) - if (imm53d.eq.2) then - read(io20,20)ibyrm,ibmom,ibdym,ibhrm,nhrsmm5, - 1 nxp,nyp,nzp - 20 format(i4,3i2,i5,3i4) - else if (imm53d.eq.3) then - read(io20,21)ibyrm,ibmom,ibdym,ibhrm,ibsecm,nhrsmm5, - 1 nscmm5,nxp,nyp,nzp - 21 format(i4,3i2,i4,i5,i5,3i4) - endif - call YR4(io6,ibyrm,ierrb) - if(ierrb.NE.0)then - write(io6,*)'Error encountered in Subr. YR4 ' - write(io6,*)'Execution stopping in Subr. RDHD53 ', - 1 '-- IERRB = ',ierrb - stop - endif -c -c --- Calculate Julian day - call julday(io6,ibyrm,ibmom,ibdym,ibjulm) -c -c --- Compute ending date/time (comment out if using other format) - ieyrm=ibyrm - iejulm=ibjulm - iehrm=ibhrm -c Use seconds (080205) -c call incr(io6,ieyrm,iejulm,iehrm,nhrsmm5) - nsecmm5=nscmm5+nhrsmm5*3600 - call incrs(io6,ieyrm,iejulm,iehrm,iesecm,nsecmm5) -c -c -------------------------------------------------- -c --- Next header record (extraction subdomain data) -c -------------------------------------------------- - read(io20,30)nx1,ny1,nx2,ny2,nz1,nz2, - & rxmin,rxmax,rymin,rymax - i1=nx1 - j1=ny1 -30 format(6i4,2f10.4,2f9.4) -c - -c --- Check that array dimensions are not exceeded - if(nxp.gt.mxnxp.or.nyp.gt.mxnyp.or.nzp.gt.mxnzp)then - write(io6,*)'ERROR in subr. RDHD53 -- Array dimensions ', - 1 'are too small for data being read' - write(io6,*)'Grid being read (NXP, NYP, NZP) = ', - 1 nxp,nyp,nzp - write(io6,*)'Array dimensions (MXNXP, MXNYP, MXNZP) = ', - 1 mxnxp,mxnyp,mxnzp - stop - endif -c --- Check consistency between nz1,nz2, and nzp - if(nzp.ne.nz2-nz1+1) then - write(io6,*)'Error in RDHD53: NZ1,NZ2 and NZP not consistent' - write(io6,*)'nz1,nz2,nzp:',nz1,nz2,nzp - stop - endif -c -c --------------------------------------------- -c --- Next NZP records -- MM5 half-sigma levels -c --------------------------------------------- - do 40 n=1,nzp - read(io20,38)sigma(n) -38 format(f6.3) -40 continue -c -c -------------------------------------------------------- -c --- Print the 3D.DAT header information to the list file -c --- (except for the gridded fields) -c -------------------------------------------------------- - if(lprt)then - write(io6,101)cname3d,cver3d,ctitle3d,comm3d -101 format(//1x,'Information read from 3D.DAT file'/ - 1 5x,'Dataset Name: ',a12/ - 2 5x,'Dataset Version: ',a12/ - 3 5x,'Dataset Title: ',a64/ - 4 5x,'First line of comments: ', - 5 8x,a132) -c - write(io6,102) inhyd,imphys,icupa,ibltyp,ifrad,isoil, - : ifddaan,ifddaob -102 format(/5x,'MM5 physics options: '/ - 1 5x,' Hydrostatic: ',i2/ - 1 5x,' Moisture scheme: ',i2/ - 1 5x,' Convection scheme: ',i2/ - 1 5x,' Boundary layer scheme: ',i2/ - 1 5x,' Radiation scheme ',i2/ - 1 5x,' Soil scheme: ',i2/ - 1 5x,' Analysis FDDA: ',i2/ - 1 5x,' Observation FDDA: ',i2) - - - write(io6,1021)igrdt,ipbl,ishf,ilhf,iustr,iswdn - : ,ilwdn,ist1,ist2,ist3,ist4,ist5,ist6 -1021 format(/5x,'MM5 surface variable options: '/ - 1 5x,' Ground temperature: ',i2/ - 1 5x,' PBL: ',i2/ - 1 5x,' Sensible heat flux: ',i2/ - 1 5x,' Latent heat flux: ',i2/ - 1 5x,' Frictional velocity: ',i2/ - 1 5x,' Downward SW radiation: ',i2/ - 1 5x,' Downward LW radiation: ',i2/ - 1 5x,' Soil temp at layer 1: ',i2/ - 1 5x,' Soil temp at layer 2: ',i2/ - 1 5x,' Soil temp at layer 3: ',i2/ - 1 5x,' Soil temp at layer 4: ',i2/ - 1 5x,' Soil temp at layer 5: ',i2/ - 1 5x,' Soil temp at layer 6: ',i2) - - write(io6,103)1,ioutw,ioutq,ioutc,iouti,ioutg -103 format(/5x,'MM5 output fields (1 = YES; 0 = NO): '/ - 1 5x,' Pressure, height,T,Wind speed and direction: ',i2/ - 1 5x,' Vertical velocity: ',i2/ - 1 5x,' RH and vapor mixing ratio: ',i2/ - 1 5x,' Cloud and rain mixing ratios: ',i2/ - 1 5x,' Ice and Snow mixing ratios: ',i2/ - 1 5x,' Graupel: ',i2) - if(imm53d.eq.3) then -c --- Include seconds (V3.0 - 080205) - write(io6,105)ibyrm,ibmom,ibdym,ibhrm,ibsecm,nhrsmm5, - 1 nscmm5,nxp,nyp,nzp - else - write(io6,104)ibyrm,ibmom,ibdym,ibhrm,nhrsmm5, - 1 nxp,nyp,nzp - endif - -104 format(/5x,'Date/time (YYYYMMDDHH) of MM5 data: '/ - 1 5x,' Start = ',i4,3i2,' (GMT)'/ - 2 5x,' No. hours = ',i4,/ - 3 5x,'Extraction Subdomain in MM5 file: '/ - 4 5x,' No. X cells = ',i4/ - 5 5x,' No. Y cells = ',i4/ - 6 5x,' No. layers = ',i4 ) -c -105 format(/5x,'Date/time (YYYYMMDDHH) of MM5 data: '/ - 1 5x,' Start = ',i4,3i2,' (GMT)'/ - 1 5x,' and = ',i4,' seconds'/ - 2 5x,' No. hours and seconds = ',i4,' and ',i4/ - 3 5x,'Extraction Subdomain in MM5 file: '/ - 4 5x,' No. X cells = ',i4/ - 5 5x,' No. Y cells = ',i4/ - 6 5x,' No. layers = ',i4 ) -c - - write(io6,106)nx1,ny1,nz1,nx2,ny2,nz2 -106 format(/5x,' Beginning X = ',i4/ - 2 5x,' Beginning Y = ',i4/ - 3 5x,' Beginning Z = ',i4/ - 4 5x,' Ending X = ',i4/ - 5 5x,' Ending Y = ',i4/ - 6 5x,' Ending Z = ',i4) -c - write(io6,107)rymin,rymax,rxmin,rxmax -107 format(/5x,' Latitude range : ',f9.4,' - ',f9.4/ - : 5x,' Longitude range: ',f10.4, ' - ' ,f10.4) - - write(io6,108) -108 format(/5x,'MM5 half-sigma levels'/5x,'Level',5x,'Sigma'/) - do 110 i=1,nzp - write(io6,109)i,sigma(i) -110 continue -109 format(4x,i4,6x,f6.4) - endif -c -c --------------------------------------------------------- -c --- Next NXP * NYP records -- lat., long., elevation, LU -c -------------------------------------------------------- - do 50 j=1,nyp - do 50 i=1,nxp - read(io20,99)iindex,jindex,xlat4(i,j),xlong4(i,j), - & ielev4(i,j),ilu4p(i,j) - 99 format(2i4,f9.4,f10.4,i5,i3) - -c --- Fill in ILU4 array stored in MM4HDO.MET - ilu4(i,j)=ilu4p(i,j) - -c --- Compute grid point locations from N.Lat and E.Lon - call GLOBE(io6,caction,datum3d,vecti,datum,vecto, - & xlong4(i,j),xlat4(i,j),xlcmm4(i,j),ylcmm4(i,j), - & idum,c4hem) -c -c --- QA check that I,J read match expected values -c - icheck=iindex-i1+1 - jcheck=jindex-j1+1 - if(icheck.ne.i.or.jcheck.ne.j)then - write(io6,*)'ERROR in subr. RDHD53 -- I,J do not match ', - 1 'values read on header record' - write(io6,*)'I, J = ',i,j - write(io6,*)'ICHECK, JCHECK = ',icheck,jcheck - stop - endif -50 continue - -c --- 051113 - Flag "true" ocean 3D.DAT gridpoints to be used -c --- for pronostic deltaT calculation if itwprog=2 -c --- "True" ocean (dot) gridpoints are defined as gridpoints surrounded -c --- by 4 ocean cross-gridpoints. This is necessary because all 3D.DAT -c --- scalar variables have been interpolated to MM5 dot points -c --- except for land use which is set at crosspoints -c --- Dot cross-point (i,j) is surrounded by dot-points -c --- (i,j),(i-1,j),(i,j-1) and (i-1,j-1) -c --- For border points (i=1 or j=1): average was done on 2 points only -c --- To get a meaningful offshore deltaT, the gridpoint has to be -c --- a "true" ocean gridpoint. - - if (itwprog.eq.2) then - noff=0 -c --- ocean LU category :iluoc3d (user-input stored in mm4hdo.met) - do 51 j=2,nyp - do 51 i=2,nxp -c ilu4(i,j)=ilu4p(i,j) - if (ilu4p(i,j) .eq. iluoc3d)then -c --- check if surrounding points are also ocean - if( (ilu4p(i-1,j).eq.iluoc3d) .and. - : (ilu4p(i,j-1).eq.iluoc3d) .and. - : (ilu4p(i-1,j-1).eq.iluoc3d) ) then -c --- "true" ocean - noff=noff+1 - else -c --- deltaT corrupted by land value -c --- reset land use to non ocean value - ilu4(i,j)=-ilu4p(i,j) - endif - endif -51 continue - - do j=2,nyp -c ilu4(1,j)=ilu4p(1,j) - if (ilu4p(1,j) .eq. iluoc3d)then -c --- check if surrounding points are also ocean - if(ilu4p(1,j-1).eq.iluoc3d) then -c --- "true" ocean - noff=noff+1 - else -c --- deltaT corrupted by land value -c --- reset land use to non ocean value - ilu4(1,j)=-ilu4p(1,j) - endif - endif - enddo - - do i=2,nxp -c ilu4(i,1)=ilu4p(i,1) - if (ilu4p(i,1) .eq. iluoc3d)then -c --- check if surrounding points are also ocean - if(ilu4p(i-1,1).eq.iluoc3d) then -c --- "true" ocean - noff=noff+1 - else -c --- deltaT corrupted by land value -c --- reset land use to non ocean value - ilu4(i,1)=-ilu4p(i,1) - endif - endif - enddo -c ilu4(1,1)=ilu4p(1,1) - if (ilu4p(1,1).eq.iluoc3d) noff=noff+1 - - -c --- There must be at least one ocean point for the option itwprog=2 -c --- to be meaningful (051031)- Otherwise stop - - if (noff.eq.0) then - write(io6,*)'STOP in RDHD53' - write(io6,*)'There are no true offshore 3D.DAT gridpoints' - write(io6,*)'Option ITWPROG=2 is not possible' - endif - - endif - -c ----------------------------------------------- -c --- Print the 3D.DAT grid points to the QA file -c ----------------------------------------------- - if(lprt)then - open(io4,file='QA3D.DAT',status='unknown') -c - write(io4,*)' 3D.DAT Grid Points' - write(io4,*)' X Y Longitude Latitude' - write(io4,*)' (km) (km) (deg E) (deg N)' - do j=1,nyp - do i=1,nxp - write(io4,'(4f12.3)') xlcmm4(i,j),ylcmm4(i,j), - 1 xlong4(i,j),xlat4(i,j) - enddo - enddo -c - close(io4) - endif -c -c -c -------------------------------------------------------- -c --- Print first and last lat/lon values to the list file (090615) -c -------------------------------------------------------- - if(lprt)then - write(io6,121)xlat4(1,1),xlong4(1,1),ielev4(1,1), - & xlat4(nxp,nyp),xlong4(nxp,nyp),ielev4(nxp,nyp) -121 format(/5x,' Lat./Lon./Elev. of First Cell: ',f9.4,f10.4,i6/ - : 5x,' Lat./Lon./Elev. of Last Cell: ',f9.4,f10.4,i6) - endif - -c --- v6.4.0, Level 121203 -c -------------------------------------------------------- -c --- Final QA Assessment -c -------------------------------------------------------- -c --- QA known problems for specific processor versions identified in -c --- the first comment record -c --- Problem #1: CALWRF versions through CALWRF 1.4, Level: 100322 - if(INDEX(comm3d,'CALWRF').NE.0) then - n1=INDEX(comm3d,'Level: ')+7 - n2=n1+5 - read(comm3d(n1:n2),'(i6)') ilev - if(ilev.LE.100322) then - write(io6,*) - write(io6,*)'HALTING: 3D.DAT file precipitation rate '// - & 'may not be correct.' - write(io6,*) TRIM(comm3d) - write(io6,*)'The CALWRF processor through Version 1.4 '// - & 'included precipitation totals accumulated ' - write(io6,*)'during the spin-up period when reporting '// - & 'hourly precipitation rates for the first 2 ' - write(io6,*)'hours after each spin-up (WRF restart) in '// - & 'the 3D.DAT file.' - stop 'Halted in RDHD53 -- See list file' - endif - endif - - return - end -c ---------------------------------------------------------------------- - subroutine rdhdmet -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 RDHDMET -c F.Robe -c -c --- PURPOSE: Read the header records from an IGF-CALMET.DAT file -c Set up the map projection/datum transfo parameters -c and compute the wind direction adjustments if LCC -c -c --- UPDATES: -c -c --- v6.4.0 to v6.5.0 (150223) -c - Trap and report error opening files (not found) -c -c --- v6.324 (080421) to v6.4.0 (121203) -c - Add wind dir. rotation for Polar Stereographic projection -c - Version string is a12 -c -c --- v6.323(080411) to v6.324 (080421)(F. Robe) -c - Accept different datum/map projections and set up the -c correponding transformation parameters (stored in IGF.MET) -c Compute the IGF-CALMET gridpoint coordinates in the current -c CALMET map/datum as well as the wind direction adjustments -c if the IGF and or current CALMET map projections are Lambert -c conformal -c - Compute current CALMET x,y coordinates and stored them in -c GRID.MET for use in RDCALMET -c - Correct typo (clabxp instead of clabxi) - Does not affect -c results -c --- V6.302 (070929) to v6.323(080411) (FRR) -c - Only print out ending times in LST file if IGF-CALMET version 2.1 -c (undefined ending times otherwise which might stop compilation) -c --- V6.301 (070927) to V6.302 (070929) (JSS) -c - Update documentation on routines calling subr. & called by -c - Modify calls to RDR2D, RDR1D, RDI2D to include IO6 -c --- V6.220 (070127) to V6.301 (070927) (FRR) -c - Extend IGF option to read in coarse MOD6 CALMET fields -c - Check lcalgridi value sooner -c -c --- v6.211 (060414) to V6.220 (070127) (FRR) -c - Define lcalgrdi as logical and perform tests on False/true -c rather than 0/1 -c -c --- V5.711 (060106) to v6.211 (060414) (DGS) -c - DATENI was not declared -c - I2DMET was not assigned (remained at 0) -c -c -c Parameters: -c MXNXi, MXNYi, MXNZi, IO6, IO18, MXNX, MXNY -c Common block /FILNAM/: igfDAT(mxigf) -c common block /IGF/nfigf,Nigf -c common block /MAP/datum,pmap -c Common block /GRID/:NX,NY, xabskm(mxnx),yabskm(mxny) -c -c --- OUTPUT: -c -c common block /IGF/nfigf,Nigf, mtver,CELLZCi(mxnzi), -c IBYRi, IBJULi, IBHRi, ibsec,IEYRi, IEJULi, IEHRi, -c NEARSi(mxnxi,mxnyi),NSSTAi,NPSTAi,JBTZi, -c ieseci,xigf(mxnxi,mxnyi),yigf(mxnxi,mxnyi) -c xigf0(mxnxi,mxnyi),yigf0(mxnxi,mxnyi),z0i(mxnxi,mxnyi), -c igrabi(mxnx,mxny,4), jgrabi(mxnx,nxny4) -c kdathrei,nsecei, -c lremapigf,LCCIGF,DWDI(mxnxi,mxnyi) -c LPSIGF -c -c -c --- RDHDMET called by: READHD, RDMET2 -c --- RDHDMET calls: UTCBASR, JULDAY, INCR, RDR1D, RDR2D, RDI2D, -c GLOBE1, GLOBE1, OPEN_ERR -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c -c --- Local Parameters -c -------------------- - - real xbuf(mxnxi,mxnyi) - real elevi(mxnxi,mxnyi) - real xsstai(mxss),ysstai(mxss), xustai(mxus),yustai(mxus) - real xpstai(mxps),ypstai(mxps),xlaii(mxnxi,mxnyi) - real zfacei(mxnzi+1) - integer ilui(mxnxi,mxnyi),neari(4),nearj(4) - real dnear(4) -c - character*80 title(3) - character*8 vermeti,levmeti,pmapi - character*8 clabel,clabxs,clabys,clabxu,clabyu,clabxp,clabyp - character*8 clabz0,clablu,clabte,clablai,clabnss -c -c --- For coordinate transformations - character*8 cmapi,cmapo,datumi - character*12 cactioni,dateni,cactionlli - character*4 cigfhem, c4hem - real*8 vectii(9),vectoi(9) - real*8 vectilli(9),vectolli(9) - - real xlonigf(mxnxi,mxnyi), xlatigf(mxnxi,mxnyi) - - character*16 dataset,dataver - character*33 blank33 - character*64 datamod - character*80 doc1 - character*132 comment1,blank - - character*8 axtzi - - logical lprt,llconfi,lcalgrdi - -c --- Common blocks - include 'grid.met' - include 'filnam.met' - include 'map.met' - include 'igf.met' - - data lprt/.true./ - - data blank33/' '/ - -c --- Set blank (132 characters) - blank(1:33)=blank33 - blank(34:66)=blank33 - blank(67:99)=blank33 - blank(100:132)=blank33 - - -c --- Initialize begin/end time flag -c --- 0: end-time (no seconds) (MOD5) -c --- 1: begin-time / end-time (MOD6) - mtver=1 - -c --- Initialize IGF time stamp - kdathrei=0 - nsecei=0 - - - if (nfigf.gt.1 .and. nfigf.le.nigf) then -c --- Close previous file - close(io18) - else if (nfigf.gt.nigf) then -c --- no more files - STop - write(io6,*) ' STOP in RDHDMET' - write(io6,*) ' Unexpected End of IGF-CALMET records' - stop 'RDHDMET: Unexpected End of IGF-CALMET records' - endif - -c --- Read and test first record to determine header format -c --- Record #1 - File Declaration -- 24 words - open(io18,file=igfdat(nfigf),status='old',form='unformatted', - & iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDHDMET','IGF File', - & igfdat(nfigf),io18) - - read(io18) dataset,dataver,datamod - ifilver=0 - if(dataset.EQ.'CALMET.DAT') ifilver=1 - REWIND(io18) - - - if(ifilver.EQ.1) then -c --- Assign 2D flag (2D vars are in this file version) - i2dmet=1 -c -c --- Record #1 - File Declaration -- 24 words - read(io18) dataset,dataver,datamod -c -c --- Record #2 - Number of comment lines -- 1 word - read(io18) ncom -c --- Loop over comment records - if(Lprt) then - write(io6,*) - write(io6,*)'IGF-CALMET Control file information:' - write(io6,*) - endif - do i=1,ncom - comment1=blank - read(io18) comment1 - if(i.EQ.1) then -c --- Save model version line - doc1=comment1(1:80) - elseif(i.LE.4) then -c --- Save 3 title lines - title(i-1)=comment1(1:80) - endif - if(lprt) write(io6,*) comment1 - enddo -c -c --- record #NCOM+3 - run control parameters -- 37 words - if (dataver.eq.'2.1') then -c --- CALMET.DAT with explicit beg./ending times, seconds, and -c --- UTC timezone as string - read(io18) ibyri,ibmoi,ibdyi,ibhri,ibseci,ieyri,iemoi, - 1 iedyi,iehri,ieseci,axtzi,irlgi,irtypei, - 1 nxi, nyi, nzi, dgridi, xorigri, yorigri, iwfcodi, nsstai, - 2 nustai, npstai, nowstai, nlui, iwat1i, iwat2i, lcalgrdi, - 3 pmapi,datumi,dateni,feasti,fnorthi,cigfhem, - 4 iutmzni,rnlat0i,relon0i,xlat1i,xlat2i - -c --- Convert UTC time zone to IBTZ time zone - call utcbasr(axtzi,xbtzi) - jbtzi=int(xbtzi) - - - call julday(io6,ibyri,ibmoi,ibdyi,ibjuli) - call julday(io6,ieyri,iemoi,iedyi,iejuli) - - else -c --- CALMET with hour-ending times (1-hour timestep) - mtver=0 - read(io18) ibyri,ibmoi,ibdyi,ibhri,jbtzi,irlgi,irtypei, - 1 nxi, nyi, nzi, dgridi, xorigri, yorigri, iwfcodi, nsstai, - 2 nustai, npstai, nowstai, nlui, iwat1i, iwat2i, lcalgrdi, - 3 pmapi,datumi,dateni,feasti,fnorthi,cigfhem, - 4 iutmzni,rnlat0i,relon0i,xlat1i,xlat2i - endif - - - endif -c - if(ifilver.EQ.0) then -c --- Read older CALMET header records -c -c --- CALMET with hour-ending times - mtver=0 -c -c --- Assign 2D flag (2D vars are NOT in this file version) - i2dmet=0 -c -c --- record #1 - run title -- 60 words - read(io18)title -c -c --- record #2 - run control parameters -- 26 words -c --- (vermeti, levmeti are both 8 bytes) - read(io18)vermeti,levmeti,ibyri,ibmoi,ibdyi,ibhri,jbtzi,irlgi, - 1 irtypei,nxi, nyi, nzi, dgridi, xorigri, yorigri, iutmzni, - 2 iwfcodi, nsstai,nustai, npstai, nowstai, nlui, iwat1i, iwat2i, - 3 lcalgrdi -c --- older CALMET: assume datum=NWS-84 - datumi='NWS-84 ' - - -c --- All fields must be available for nested options: - if (lcalgrdi) then -c ok - else - write(io6,*)'STOP in RDHDMET' - write(io6,*)'Not all required fields are available in ', - : 'initial CALMET.DAT for IGFMEt option' - write(io6,*)'AS LCALGRD in IGF-CALMET is set to FALSE ' - write(io6,*)' STOP in RDHDMET' - STOP 'STOP IN RDHDMET - Check list file' - endif - -c --- New record -- #3 - additional run control data -- 8 words -c --- This record was introduced in CALMET Version 5.0 (980304) - read(levmeti(1:6),'(i6)') ilevmet - read(vermeti(1:6),'(f6.0)') rvermet - if(ilevmet.GE.980304 .OR. rvermet.GT.5.1) then -c --- New header record format - read(io18)xlat0i,xlon0i,llconfi,coneci,xlat1i,xlat2i, - & rlat0i,rlon0i - endif -c -c --- Recast map projection information - if(LLCONFi) then - pmapi='LCC ' - else - pmapi='UTM ' - endif - -c --- Convert to new format variables (North lat and EAST long) - rnlat0i=xlat0i - relon0i=-xlon0i - - endif - -c --- Check that datum and map projection match those in current calmet: -c --- This is now allowed (080314) -c if ( (pmapi.ne.pmap) .or. (datumi.ne.datum)) then -c write(io6,*)' STOP in RDHDMET ' -c write(io6,*)' IGF Datum and map projection do not match' -c write(io6,*)' Current datum:',datum, -c : ' and map projection:',pmap -c write(io6,*)' IGF datum: ',datumi, -c : ' and map projection:',pmapi -c -c STOP' STOP in RDHDMET - Datum/map projection do not match ' -c endif - - -c --- Convert hour-ending times to beginning and ending julian dates - if (mtver.eq.0) then - call julday(io6,ibyri,ibmoi,ibdyi,ibjuli) - call incr(io6,ibyri,ibjuli,ibhri,-1) - ibseci=0 - - ieyri=ibyri - iejuli=ibjuli - iehri=ibhri - ieseci=0 - call incr(io6,ieyri,iejuli,iehri,irlgi) - endif - -c --- Check that array dimensions have been sized properly - if(nxi.gt.mxnxi.or.nyi.gt.mxnyi.or.nzi.gt.mxnzi)then - write(io6,2354)nxi,mxnxi,nyi,mxnyi,nzi,mxnzi -2354 format(/1x,'ERROR -- Array dimensions are too small for ', - 1 'the data in the IGF-CALMET.DAT file'/ - 2 5x,'nxi = ',i5,4x,'MXnxi = ',i5/ - 3 5x,'nyi = ',i5,4x,'MXnyi = ',i5/ - 4 5x,'nzi = ',i5,4x,'MXnzi = ',i5/) - stop - endif -c -c --- record #4 - cell face heights (NZ + 1 words) - nzi1=nzi+1 - call rdr1d(io18,mtver,io6,zfacei,nzi1,clabel,idum,idum,idum,idum) - -c --- IGF-CALMET levels - do ki=1,nzi - cellzci(ki)= (zfacei(ki)+zfacei(ki+1))/2. - end do -c -c -c --- records #5 & 6 - x, y coordinates of surface stations -c --- (NSSTAi words each record) - if(nsstai.gt.0)then - call rdr1d(io18,mtver,io6,xsstai,nsstai,clabxs,idum,idum,idum, - 1 idum) - call rdr1d(io18,mtver,io6,ysstai,nsstai,clabys,idum,idum,idum, - 1 idum) - endif -c -c --- records #7 & 8 - x, y coordinates of upper air stations -c --- (NUSTA words each record) - if(nustai.gt.0)then - call rdr1d(io18,mtver,io6,xustai,nustai,clabxu,idum,idum,idum, - 1 idum) - call rdr1d(io18,mtver,io6,yustai,nustai,clabyu,idum,idum,idum, - 1 idum) - endif -c -c --- records #9 & 10 - x, y coordinates of precipitation stations -c --- (NPSTA words each record) - if(npstai.gt.0)then - call rdr1d(io18,mtver,io6,xpstai,npstai,clabxp,idum,idum,idum, - 1 idum) - call rdr1d(io18,mtver,io6,ypstai,npstai,clabyp,idum,idum,idum, - 1 idum) - endif -c -c --- record #11 - surface roughness lengths (NX * NY words) - call rdr2d(io18,mtver,io6,z0i,xbuf,mxnxi,mxnyi,nxi,nyi, - 1 clabz0,idum,idum,idum,idum,ieof) -c -c --- record #12 - land use categories (NX * NY words) - call rdi2d(io18,mtver,io6,ilui,xbuf,mxnxi,mxnyi,nxi,nyi, - 1 clablu,idum,idum,idum,idum) -c -c --- record #13 - elevations (NX * NY words) - call rdr2d(io18,mtver,io6,elevi,xbuf,mxnxi,mxnyi,nxi,nyi, - : clabte,idum,idum,idum,idum,ieof) - -c --- record #14 - leaf area index (NX * NY words) - call rdr2d(io18,mtver,io6,xlaii,xbuf,mxnxi,mxnyi,nxi,nyi, - 1 clablai,idum,idum,idum,idum,ieof) - -c --- record #15 - nearest surface station to each grid point -c (NX * NY words) - if(nsstai.ge.1)then - call rdi2d(io18,mtver,io6,nearsi,xbuf,mxnxi,mxnyi,nxi,nyi, - 1 clabnss,idum,idum,idum,idum) - endif - - - if (lprt) then - -c --- Write run parameters from CALMET header records - write(io6,*)'Data read from header records of IGF-CALMET file: ' - write(io6,'(1x,a132)')igfdat(nfigf) - write(io6,*) - if(ifilver.EQ.1) then - write(io6,'(2a16,a64)')dataset,dataver,datamod - write(io6,*) - endif - write(io6,102)title -102 format(3(1x,a80/)) - if(ifilver.EQ.0) then - write(io6,104)vermeti,levmeti - -c --- v6.4.0, Level 121203 -104 format(1x,'CALMET Version: ',a12,3x,'Level: ',a8) - - else - write(io6,'(a80)') doc1 - endif - if (mtver.eq.1) then - write(io6,*)' MOD6 version with explicit times and seconds' - else - write(io6,*)' MOD5 version with hour-ending times' - endif - write(io6,*) - write(io6,*)' Input Group #0 parameters ---' - write(io6,*)' NUSTA = ',nustai - write(io6,*)' NOWSTA = ',nowstai - write(io6,*) - write(io6,*)' Input Group #1 parameters ---' - write(io6,*)' IBYR = ',ibyri - write(io6,*)' IBMO = ',ibmoi - write(io6,*)' IBDY = ',ibdyi - write(io6,*)' IBHR = ',ibhri - write(io6,*)' IBSEC = ',ibseci - if (dataver.eq.'2.1') then - write(io6,*)' IEYR = ',ieyri - write(io6,*)' IEMO = ',iemoi - write(io6,*)' IEDY = ',iedyi - write(io6,*)' IEHR = ',iehri - write(io6,*)' IESEC = ',ieseci - endif - write(io6,*)' IBTZ = ',jbtzi - write(io6,*)' IRLG = ',irlgi - write(io6,*)' IRTYPE = ',irtypei - write(io6,*)' LCALGRD = ',lcalgrdi - write(io6,*) - write(io6,*)' Input Group #2 parameters ---' - write(io6,*)' PMAP = ',pmapi - write(io6,*)' DATUM = ',datumi - write(io6,*)' NIMADATE= ',dateni - write(io6,*)' FEAST = ',feasti - write(io6,*)' FNORTH = ',fnorthi - if(PMAPi.EQ.'UTM ') then - write(io6,*)' IUTMZN = ',iutmzni - write(io6,*)' UTMHEM = ',cigfhem - else - write(io6,*)' XLAT1 = ',xlat1i - write(io6,*)' XLAT2 = ',xlat2i - write(io6,*)' RNLAT0 = ',rnlat0i - write(io6,*)' RELON0 = ',relon0i - endif - write(io6,*)' NX = ',nxi - write(io6,*)' NY = ',nyi - write(io6,*)' DGRID = ',dgridi - write(io6,*)' XORIGR = ',xorigri - write(io6,*)' YORIGR = ',yorigri - write(io6,*)' NZ = ',nzi - write(io6,203)(zfacei(n),n=1,nzi1) -203 format(1x,'ZFACE = ',10(f9.3,', ')) - write(io6,*) - write(io6,*)' Land Use parameters from GEO.DAT ---' - write(io6,*)' NLU = ',nlui - write(io6,*)' IWAT1 = ',iwat1i - write(io6,*)' IWAT2 = ',iwat2i - write(io6,*) - write(io6,*)' Input Group #4 parameters ---' - write(io6,*)' NSSTA = ',nsstai - write(io6,*)' NPSTA = ',npstai - write(io6,*) - write(io6,*)' Input Group #5 parameters ---' - write(io6,*)' IWFCOD = ',iwfcodi - - endif -c - -c --------------------------------------------------------------- -c --- Is a coordinate transformation needed for CALMET? (080314) -c ---------------------------------------------------------------- -c --- Set translation vectors going from IGF-CALMET (x,y) -c --- to current CALMET projection (x,y) -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c --- IGF-CALMET - iutmi=iutmzni - if(cigfhem.EQ.'S ' .AND. iutmzni.LT.900) iutmi=-iutmi - cmapi=pmapi - if(cmapi.EQ.'TTM ') cmapi='TM ' -c --- CALMET - iutmo=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmo=-iutmo - cmapo=pmap - if(cmapo.EQ.'TTM ') cmapo='TM ' - call GLOBE1(cmapi,iutmi,tmsone,xlat1i,xlat2i, - & rnlat0i,relon0i,feasti,fnorthi, - & cmapo,iutmo,tmsone,xlat1,xlat2, - & rnlat0,relon0,feast,fnorth, - & cactioni,vectii,vectoi) -c --- Compare projections, transformation vectors and datums - lremapigf=.FALSE. - if(pmapi.NE.pmap) lremapigf=.TRUE. - if(datumi.NE.datum) lremapigf=.TRUE. - do i=1,9 - if(vectii(i).NE.vectoi(i)) lremapigf=.TRUE. - enddo - - -c ----------------------------------------------------------------- -c --- Compute IGF-CALMET (x,y) in current CALMET coordinate system -c ---------------------------------------------------------------- -c --- Remap if necessary (080314) - - do 50 j=1,nyi - do 50 i=1,nxi -c --- (x,Y) in IGF-coordinate system in km - xigf0(i,j) = (xorigri + (i-0.5)*dgridi)*0.001 - yigf0(i,j) = (yorigri + (j-0.5)*dgridi)*0.001 -c --- remap to current coordinate system if different - if(LREMAPIGF) then - call GLOBE(io6,cactioni,datumi,vectii,datum, - & vectoi,xigf0(i,j),yigf0(i,j), - & xigf(i,j),yigf(i,j),idum,c4hem) - else - xigf(i,j) = xigf0(i,j) - yigf(i,j) = yigf0(i,j) - endif -50 continue - - -c --------------------------------------------------------------- -c --- Compute the wind direction adjustement if LCC and/or LCCIGF -c --- or if PS and/or LPSIGF -c --------------------------------------------------------------- - -c --- v6.4.0, Level 121203 -c --- Initialize IGF logicals for LCC and PS - LCCIGF=.FALSE. - LPSIGF=.FALSE. -c --- Set Polar Stereographic - if(pmapi.EQ.'PS ') lpsigf=.TRUE. -c --- Set Lambert CC - - if(pmapi.EQ.'LCC ') lccigf =.TRUE. - -c --- Initialize wind direction shift - do 54 j=1,nyi - do 54 i=1,nxi - dwdi(i,j) = 0 -54 continue - -c --- Skip if same map projection/datums - if (.not.lremapigf) goto 555 - - -c --- First from LCC-IGF to true North - IF (LCCIGF)then - -c --- Calculate cone constant for LCC (used to adjust winds) - coneci=0.0 - d2r = 0.0174533 -c --- Use absolute value of latitudes, then adjust y coordinate -c --- later if in Southern Hemisphere - coneci = log(cos(abs(xlat1i)*d2r) / cos(abs(xlat2i)*d2r)) - coneci = coneci/(log(tan(d2r*(45.-abs(xlat1i)/2.)) / - & tan(d2r * (45. - abs(xlat2i) / 2.)))) - -c --- v6.4.0, Level 121203 -c --- Add logic for Polar Stereographic cone = 1.0 - elseif(LPSIGF) then - coneci=1.0 - else - coneci=0.0 - endif -c --- Apply conversion - if(LCCIGF .OR. LPSIGF) then - -c --- Compute conversion parameters to latitude-longitude -c --- In IGF system - - iutmi=iutmzni - if(cigfhem.EQ.'S ' .AND. iutmzni.LT.900) iutmi=-iutmi - cmapi=pmapi - if(cmapi.EQ.'TTM ') cmapi='TM ' - cmapo='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,iutmi,tmsone,xlat1i,xlat2i, - & rnlat0i,relon0i,feasti,fnorthi, - & cmapo,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cactionlli,vectilli,vectolli) - - do 51 j=1,nyi - do 51 i=1,nxi -c --- Compute lat, longitude in IGF-CALMET coord system - call GLOBE(io6,cactionlli,datumi,vectilli,datumi, - & vectolli,xigf0(i,j),yigf0(i,j), - & xlonigf(i,j),xlatigf(i,j),izone,c4hem) - -c --- assumes xlonigf and relon0i ae positive in Eastern Hem. - dloni = -relon0i + xlonigf(i,j) - -c --- Code to handle 180 degree longitude straddle - if (dloni.gt. 180.) dloni = dloni - 360. - if (dloni.lt. -180.) dloni = dloni + 360. -c --- compute wind direction adjustment (to be added to wd IGF) - if (xlat1i .lt. 0.) then -c --- Southern Hemisphere - dwdi(i,j)=-(coneci * dloni) - else -c --- Northern Hemisphere - dwdi(i,j) = +(coneci * dloni) - end if - -51 continue - - endif - -c --- v6.4.0, Level 121203 -c --- Then from true North to LCC-Current -c --- or to Polar Stereographic - Current - if(LLCC .OR. LPS) then - -c --- Compute conversion parameters to latitude-longitude -c --- At this point, the conversion parameters to lat, long -c --- have not been computed yet (they will be in microi) -c --- so have to compute them first and called them differently -c --- to prevent any risk of contamination - iutmi=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmi=-iutmi - cmapi=pmap - if(cmapi.EQ.'TTM ') cmapi='TM ' - cmapo='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,iutmi,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & cmapo,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cactionlli,vectilli,vectolli) - - do 52 j=1,nyi - do 52 i=1,nxi -c --- Compute lat, longitude in current CALMET coord system - call GLOBE(io6,cactionlli,datum,vectilli,datum,vectolli, - & xigf(i,j),yigf(i,j),xlonigf(i,j),xlatigf(i,j), - & izone,c4hem) - - -c --- assumes xlonigf is positive in Eastern Hem.(rlon0 is not) - dlon = rlon0 + xlonigf(i,j) -c --- Code to handle 180 degree longitude straddle - if (dlon .gt. 180.) dlon = dlon - 360. - if (dlon.lt. -180.) dlon = dlon + 360. - -c --- compute wind direction adjustment (to be added to wd IGF) -c --- and combine with IGF-LCC shift if any - if (xlat1 .lt. 0.) then -c --- Southern Hemisphere - dwdi(i,j)=dwdi(i,j)+(conec * dlon) - else -c --- Northern Hemisphere - dwdi(i,j)=dwdi(i,j)-(conec * dlon) - end if - -52 continue - endif - -555 continue - -c ----------------------------------------------- -c --- Print the IGF-CALMET.DAT grid points to the QA file -c ----------------------------------------------- - if(lprt)then - open(io4,file='QAIGF.DAT',status='unknown') -c - write(io4,*)' IGF-CALMET.DAT Grid Points' - write(io4,*)' X Y ' - write(io4,*)' (km) (km) ' - do j=1,nyi - do i=1,nxi - write(io4,'(2f12.3)') xigf(i,j),yigf(i,j) - enddo - enddo -c - close(io4) - endif -c - -c---------------------------------------------------------------- -c --- Find the 4 closest coarse IGF-CALMET grid points to each current -c CALMET grid point(assume CALMET domain is inside coarse CALMET -c grid section) -c --------------------------------------------------------------- - delg = dgrid * .001 - -c --- Compute CALMET grid coordinates in real space coordinates - xcal = xmap0 + (0.5 * delg) - ycal = ymap0 + (0.5 * delg) -c - do i = 1,nx -c -c --- Find x/y for CALMET center points -c -c --- Compute and store current CALMET (x,y) in GRID.MET (080421) - xabskm(i) = xcal + (i - 1) * delg - do j = 1,ny - yabskm(j) = ycal + (j - 1) * delg - do k = 1,4 - neari(k) = 0 - nearj(k) = 0 - dnear(k) = 9.9E19 - enddo - do ii = 1,nxi - do jj = 1,nyi - pdist = sqrt ((xigf(ii,jj) - xabskm(i)) ** 2 + - & (yigf(ii,jj) - yabskm(j)) **2) - do k = 1,4 - if (pdist .lt. dnear(k)) then - if (k .lt. 4) then - dnear(4) = dnear(3) - nearj(4) = nearj(3) - neari(4) = neari(3) - endif - if (k .lt. 3) then - dnear(3) = dnear(2) - nearj(3) = nearj(2) - neari(3) = neari(2) - endif - if (k .lt. 2) then - dnear(2) = dnear(1) - nearj(2) = nearj(1) - neari(2) = neari(1) - endif - dnear(k) = pdist - nearj(k) = jj - neari(k) = ii - goto 66 - endif - enddo - 66 continue - enddo - enddo - do k = 1,4 - igrabi(i,j,k) = neari(k) - jgrabi(i,j,k) = nearj(k) - enddo - enddo - enddo - return - end -c --------------------------------------------------------------------- - subroutine RDCALMET(cellzc,uigf,vigf) -c --------------------------------------------------------------------- -C -c --- CALMET Version: 6.5.0 Level: 121203 RDCALMET -c F.Robe - -c --- PURPOSE : READ AND INTERPOLATE EXISTING CALMET WIND FIELDS ONTO -c THE CURRENT CALMET GRID (for effective nested grid -c option). -c -c --- UPDATES: -c -c --- v6.324 (080421) to v6.4.0 (121203) -c - Add wind dir. rotation for Polar Stereographic projection -c -c --- V6.301 Level 070927 to v6.324 Level 080421(FRR) -c - Perform wind direction rotation if IGF and current coord. -c systems are not identical and at least one of them is LCC. -c (Part of allowing different datums/projection in IGF and -c current CALMET) -c - Use x,y stored in GRID.MET rather than computing them again -c at every timestep -c -c --- V6. level 060106 to V6.301 Level 070927 (FRR) -c - Change calling list to RDMET2 to allow for MOD6 IGF CALMET -c - Add check whether need to read a new IGF record -c -C --- INPUTS: CELLZC R-ARRAY - CURRENT CALMET CELL-CENTER HEIGHTS -c -c --- Common /IGF/:z0i (mxnxi,mxnyi),cellzci(mxnzi), -c igrabi(mxnx,mxny,4),jgrabi(mxnx,mxny,4) -C IGFMOD,LCCIGF,DWDI(mxnxi,mxnyi) -c lremapigf -c LPSIGF -c --- common/GEN/: ndathrb,nsecb,ndathre,nsece,ibtz -c --- common/GRID/: xabskm(mxnx),yabskm(mxny) -C -C OUTPUTS: -C UIGF R-ARRAY - U-COMPONENT OF THE IGF-CALMET WIND FIELD -C INTERPOLATED TO CALMET GRID -C VIGF R-ARRAY - V-COMPONENT OF THE IGF-CALMET WIND FIELD -C INTERPOLATED TO CALMET GRID -c -C OTHER VARIABLES: -C NXi INT - NO. OF PROGNOSTIC MODEL GRID POINTS IN THE -C X-DIRECTION -C NYi INT - NO. OF PROGNOSTIC MODEL GRID POINTS IN THE -C Y-DIRECTION -C NZi INT - NO. OF PROGNOSTIC MODEL LEVELS -c -c Parameters: MXNX, MXNY, MXNZ, MXNXi, MXNYi, MXNZi, IO6 -c -c --- RDCALMET called by: DIAGNO -c --- RDCALMET calls: JULDAY, INDECR, R2INTERP, ESAT, YR4 -c R2INTERP2, RDMET2, GLOBE -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'gen.met' - include 'map.met' - include 'grid.met' - include 'metgrd.met' - - include 'd4.met' - include 'd6.met' - include 'igf.met' - - DIMENSION Uigf(mxnx,mxny,mxnz), Vigf(mxnx,mxny,mxnz), - 1 UP(mxnxi,mxnyi,mxnzi), VP(mxnxi,mxnyi,mxnzi), - 1 UDAT(mxnxi,mxnyi,mxnz),VDAT(mxnxi,mxnyi,mxnz), - 2 CELLZC(mxnz) - - - -c --- Express current timestep in IGF-CALMET base time zone (jbtzi) - jdathrb=ndathrb - call dedat(jdathrb,jyrb,jjulb,jhrb) - idtz=ibtz-jbtzi - call incr(io6,jyrb,jjulb,jhrb,idtz) - jdathrb=jyrb*100000+jjulb*100+jhrb - - jdathre=ndathre - call dedat(jdathre,jyre,jjule,jhre) - idtz=ibtz-jbtzi - call incr(io6,jyre,jjule,jhre,idtz) - jdathre=jyre*100000+jjule*100+jhre - -c --- Check if last read IGF record is still valid for the current timestep -c --- if so, do not read any new records - - call deltsec(jdathre,nsece,kdathrei,nsecei,ndelsec) - if(kdathrei.ne.0.and.ndelsec.ge.0) return - - -c --- Read in IGF-CALMET data - call rdmet2(jdathre,nsece,up,vp) - -c --- Correct wind direction if coordinates systems are different -c --- and either one is Lambert Conformal - -c --- v6.4.0, Level 121203 -c --- or Polar Stereographic - if((LREMAPIGF). AND. - & (LLCC .OR. LCCIGF .OR. LPS .OR. LPSIGF)) then - - do 4 k=1,nzi - do 4 j=1,nyi - do 4 i=1,nxi - -c --- compute wind speed and direction in IGF map system - ws=sqrt(up(i,j,k)**2+vp(i,j,k)**2) - if(ws.gt.1.e-9)then - wd=270.-57.295778*atan2(vp(i,j,k),up(i,j,k)) - wd=amod(wd,360.) -c --- Add wind direction correction - wd=wd+dwdi(i,j) -c --- Revert to u,v in current map system - dir=0.0174533*wd - up(i,j,k)=-ws*sin(dir) - vp(i,j,k)=-ws*cos(dir) - endif - -4 continue - - endif - - -c --- Loop over coarse IGF-CALMET gridpoints: - do 5 j=1,nyi - do 5 i=1,nxi - -C --- INTERPOLATE PROGNOSTIC SOUNDINGS VERTICALLY TO DIAGNOSTIC -C --- MODEL LEVELS - DO 75 K = 1,NZ -c -c --- Persist data below bottom level - IF(CELLZC(K).LT.cellzci(1))then - UDAT(I,J,K)=UP(I,J,1) - VDAT(I,J,K)=VP(I,J,1) - -c --- Persist data above top CALMET level - else if(CELLZC(K).GE.cellzci(nzi))then - UDAT(I,J,K)=UP(I,J,nzi) - VDAT(I,J,K)=VP(I,J,nzi) - -c --- Interpolate to CALMET level from surrounding IGF-CALMET levels - else - DO KP = 2,nzi - KPM1 = KP - 1 - IF(cellzci(KPM1).LE.CELLZC(K).AND. - 1 cellzci(KP).GT.CELLZC(K))THEN - ratio1=(CELLZC(K)-cellzci(KPM1))/ - 1 (cellzci(KP)-cellzci(KPM1)) - UDAT(I,J,K)=UP(I,J,KPM1)+(UP(I,J,KP)-UP(I,J,KPM1)) - 1 *ratio1 - VDAT(I,J,K)=VP(I,J,KPM1)+(VP(I,J,KP)-VP(I,J,KPM1)) - 1 *ratio1 - - go to 77 - endif - enddo -77 continue - endif -c -c --- Replace winds below first IGF-CALMET level with -c --- extrapolated logarithmic profile winds. This is unlikely to -c --- happen as usually CALMET first level is at 10m but cannot -c --- be ruled out -c -c --- Use a logarithmic profile to extrapolate winds down toward -c --- the surface - if(cellzc(k).lt.cellzci(1))then - xlnzo=alog(z0i(i,j)) -c --- cellzci(1) is the lowest true MM5 half-sigma level - xlnz2=alog(cellzci(1)) -c --- CELLZC(k) is the CALMET grid point height - xlnz1=alog(cellzc(k)) -c --- Logarithmic profile scaling factor - ratio2=(xlnz1-xlnzo)/(xlnz2-xlnzo) - - UDAT(I,J,K)=ratio2*UP(I,J,1) - VDAT(I,J,K)=ratio2*VP(I,J,1) - endif - -75 CONTINUE - - -c --- end of loop on nxi,nyi (IGF-CALMET gridpoints) -5 continue - - - 997 continue -C -C INTERPOLATE PROGNOSTIC SOUNDINGS HORIZONTALLY TO DIAGNOSTIC MODEL -C GRID -C --- Use stored values of current grid coordinates (080421) -c --- Convert diagnostic grid spacing from m to km -c dxk = dx * 0.001 -c dyk = dy * 0.001 -c -c --- Compute cell center x,y of diagnostic grid cell (1,1) -c *** xorigcc = utmxor + (0.5*dxk) -c *** yorigcc = utmyor + (0.5*dyk) -c --- Compute diagnostic grid coordinates in real space -c xorigcc = xmap0 + (0.5 * dxk) -c yorigcc = ymap0 + (0.5 * dyk) -c -c --- Loop over diagnostic grid - do 125 j = 1,ny -c --- Compute Y of cell center -c y = yorigcc + (j - 1) * dyk - do 125 i = 1,nx -c --- Compute X of cell center -c x = xorigcc + (i - 1) * dxk - - do 121 k = 1,nz - -c --- Interpolate horizontally from igf-calmet grid to diagnostic -c --- grid x,y using inverse distance squared at four nearest points. -c - call r2interpi(i,j,xabskm(i),yabskm(j),udat,k,uigf(i,j,k)) - call r2interpi(i,j,xabskm(i),yabskm(j),vdat,k,vigf(i,j,k)) - - 121 continue - - - - 125 continue -c --- end of loop on calmet grid - - - return - end -c---------------------------------------------------------------------- - subroutine rdmet2(jdathre,jsece,umet,vmet) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070929 RDMET2 -c F.Robe, Earth Tech -c -c -c --- PURPOSE: Read CALMET meteorological data for one hour -c If old CALMET format, interpolates 1-D arrays -c of ipcode, rho and rh to fill 2-D arrays -c -c --- Updates: -c V6.301 Level 070927 to V6.302 Level 070929 (JSS) -c - Modify calls to RDR1D, RDI1D, RDR2D, RDI2D to include IO6 -c 060601 to V6.301 Level 070927 (FRR) -c - Read MOD5 and MOD6 records -c -c --- INPUTS: -c jDATHRE - integer - Ending Date & hour of required data -c (YYYYJJJHH) in IGF CALMET -c timezone -c jSECE - integer - Ending.second of required data in IGF -c CALMET timezone -c -c -c Common block /IGFMET/ variables: -c NXi, NYi, NZi, NEARSi, NSSTAi, NPSTAi, I2DMET,JBTZi,MTVER, -c KDATHREI,NSECEI -c -c Parameters: -c MXNZMP1, IO6, IO18 -c -c --- OUTPUT: -c -c UMET(mxni,mxnyi,mxnzi) - real - U component of the wind (m/s) -c at each IGF-CALMET grid point -c VMET(mxni,mxnyi,mxnzi) - real - V-component of the wind (m/s) -c at each IGF-CALMET grid point -c -c --- RDMET2 called by: RDCALMET -c --- RDMET2 calls: RDHDMET, RDR1D, RDR2D, RDI1D, RDI2D, YR4,DELTSEC -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.met' - include 'igf.met' -c - real umet(mxnxi,mxnyi,mxnzi),vmet(mxnxi,mxnyi,mxnzi) - real tmet(mxnxi,mxnyi,mxnzi) - real rmm(mxnxi,mxnyi) -c real wrk1(nwork) - real wrk1(mxnxi*mxnyi) - real tempss(mxss),rhoss(mxss),qswss(mxss) - real wdiv(mxnxi,mxnyi,mxnzi) - real temp2d(mxnxi,mxnyi),rho2d(mxnxi,mxnyi),qsw2d(mxnxi,mxnyi) - integer irh2d (mxnxi,mxnyi),ipcode2d(mxnxi,mxnyi) - -c --- Micromet variables: - real ustari(mxnxi,mxnyi),ZIi(mxnxi,mxnyi),ELi(mxnxi,mxnyi) - real WSTARi(mxnxi,mxnyi) - integer IPGTi(mxnxi,mxnyi) - - integer irhss(mxss),ipcode(mxss) -c - character*8 clabel - character*8 clabexp -c - - -c --- Begin reading data records for one time period -1 continue -c - -c --- Track date-hr of end of this period to check for problems in file -c --- (end-times are available in new and old formats) - kdathre=0 - ksece=0 -c -c --- read the U, V wind components - do 10 iz=1,nzi - call rdr2d(io18,mtver,io6,umet(1,1,iz),wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb1,nsecb1,ndathre1,nsece1,ieof) - if(ieof.EQ.1) then -c --- Reached end of CALMET.DAT file; check for another file - nfigf=nfigf+1 - call RDHDMET -c --- read again (in new file) - call rdr2d(io18,mtver,io6,umet(1,1,iz),wrk1,mxnxi,mxnyi,nxi, - 1 nyi,clabel,ndathrb1,nsecb1,ndathre1,nsece1,ieof) - endif -c - -c --- Compute IGF timestep (done only once) - if(kdathrei.eq.0)then - if (mtver.eq.0) then - istepi=3600 - else - call deltsec(ndathrb1,nsecb1,ndathre1,nsece1,istepi) - endif - endif - -c --- Check that record label matches expected label - clabexp='U-LEV' - write(clabexp(6:8),'(i3)')iz - if(clabel.ne.clabexp)go to 999 -c - - call rdr2d(io18,mtver,io6,vmet(1,1,iz),wrk1,mxnxi,mxnyi,nxi, - 1 nyi,clabel,ndathrb2,nsecb2,ndathre2,nsece2,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp(1:1)='V' - if(clabel.ne.clabexp)go to 999 -c - -c --- Use the W wind component (conditional) for w-divergence -c --- Values of lcalgrdp=off have been screend out in RDHDMET -c if(lcalgrdp)then - call rdr2d(io18,mtver,io6,wdiv(1,1,iz),wrk1,mxnxi,mxnyi,nxi, - 1 nyi,clabel,ndathrb3,nsecb3,ndathre3,nsece3,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp(1:5)='WFACE' - if(clabel.ne.clabexp)go to 999 - if(ndathre2.ne.ndathre3 .OR. nsece2.ne.nsece3) goto 2999 -c endif -c - - if(ndathre1.ne.ndathre2 .OR. nsece1.ne.nsece2) goto 2999 - if(kdathre.eq.0)then -c --- first vertical level - kdathre=ndathre1 - ksece=nsece1 - - else if(ndathre1.ne.kdathre .OR. nsece1.ne.ksece)then -c --- date/time does not match value for previous layer - ndathre=ndathre1 - nsece=nsece1 - go to 3999 - endif -10 continue -c -c --- Read the 3-D temperature field -c --- Values of lcalgrdp=off have been screend out in RDHDMET -c if(lcalgrdp)then - clabexp='T-LEV' - do 12 iz=1,nzi - call rdr2d(io18,mtver,io6,tmet(1,1,iz),wrk1,mxnxi,mxnyi,nxi, - 1 nyi,clabel,ndathrb,nsecb,ndathre,nsece,ieof) - - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif -c - write(clabexp(6:8),'(i3)')iz - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -12 continue -c endif -c - -c --- read other 2-D meteorological fields -c -c --- PGT stability class - call rdi2d(io18,mtver,io6,ipgti,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece) - clabexp='IPGT' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 - -c --- FRICTION VELOCITY - call rdr2d(io18,mtver,io6,ustari,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp='USTAR' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c -c --- MIXING HEIGHT - call rdr2d(io18,mtver,io6,zii,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp='ZI' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c -c --- MONIN-OBUKHOV LENGTH - call rdr2d(io18,mtver,io6,eli,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp='EL' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c -c --- CONVECTIVE VELOCITY SCALE - call rdr2d(io18,mtver,io6,wstari,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp='WSTAR' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c -c --- PRECIPITATION DATA - if(npstai.ne.0)then - call rdr2d(io18,mtver,io6,rmm,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - endif - -c -c frr (09/01) -c --- NOOBS CALMET: full 2-D fields of the following variables instead -c --- of 1-D fields (values at the surface stations only) -c - Air temperature (deg. K), -c - Air density (kg/m**3), -c - Short-wave solar radiation (W/m**2), -c - Relative humidity (percent), -c - Precipitation code - - if(i2dmet.EQ.1) then - -c --- New CALMET output format - 2D arrays - - - call rdr2d(io18,mtver,io6,temp2d,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp='TEMPK' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c - call rdr2d(io18,mtver,io6,rho2d,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp='RHO' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c - call rdr2d(io18,mtver,io6,qsw2d,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece,ieof) - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - clabexp='QSW' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c - call rdi2d(io18,mtver,io6,irh2d,wrk1,mxnxi,mxnyi,nxi,nyi, - 1 clabel,ndathrb,nsecb,ndathre,nsece) - clabexp='IRH' - if(ieof.EQ.1) then - write(*,*) - stop 'RDMET2: Unexpected EOF in CALMET records' - endif - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c -c --- Precipitation code at surface stations - - if(npstai.ne.0)then - call rdi2d(io18,mtver,io6,ipcode2d,wrk1,mxnxi,mxnyi, - 1 nxi,nyi,clabel,ndathrb,nsecb,ndathre,nsece) - clabexp='IPCODE' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 - endif - - - elseif(i2dmet.EQ.0) then -c --- read 1-D meteorological fields: -c Air temp. (deg. K), -c Air density (kg/m**3), -c Short-wave solar radiation (W/m**2), -c Relative humidity (percent), -c Precipitation code - call rdr1d(io18,mtver,io6,tempss,nsstai,clabel,ndathrb,nsecb, - : ndathre,nsece) - clabexp='TEMPK' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c - call rdr1d(io18,mtver,io6,rhoss,nsstai,clabel,ndathrb,nsecb, - : ndathre,nsece) - clabexp='RHO' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c - call rdr1d(io18,mtver,io6,qswss,nsstai,clabel,ndathrb, - : nsecb,ndathre,nsece) - clabexp='QSW' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c - call rdi1d(io18,mtver,io6,irhss,nsstai,clabel,ndathrb,nsecb, - : ndathre,nsece) - clabexp='IRH' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 -c -c --- Precipitation code at surface stations - if(npstai.gt.0)then - call rdi1d(io18,mtver,io6,ipcode,nsstai,clabel,ndathrb, - 1 nsecb,ndathre,nsece) - clabexp='IPCODE' - if(clabel.ne.clabexp)go to 999 - if(ndathre.ne.kdathre .OR. nsece.ne.ksece)go to 3999 - endif - - else - write(*,*)'Subr. RDMET2: Invalid I2DMET = ',i2dmet - stop - endif - -c --- Enforce YYYY format - kyr=kdathre/100000 - kdyhr=kdathre-kyr*100000 - call YR4(io6,kyr,ierr) - if(ierr.NE.0) then - write(*,*) - stop 'Halted in RDMET2 - not YYYY format in IGF-CALMET' - endif - kdathre=kyr*100000+kdyhr - -c --- Save CALMEt-IGF ending time in the IGF.MET common file - kdathrei=kdathre - nsecei=ksece - -c --- Check to see if required date-time has been read - call deltsec(jdathre,jsece,kdathre,ksece,ndelsec) - - if(ndelsec.lt.0)then -c --- Obtain next time period in MET file - go to 1 - elseif(ndelsec.ge.istepi)then - write(io6,*)'ERROR in subr. RDMET2 -- current hour not found ', - 1 'in the IGF-MET data file (MOD5)' - write(io6,*)' -- Current ending date/hour/sec = ',jdathre,jsece - write(io6,*)' -- Last date/hour read = ',kdathre,ksece - write(*,*) - stop 'Halted in RDMET2 -- see list file.' - endif -c - - return -c -c --- Write error messages -- incorrect record label read -999 continue - write(io6,1001)clabel,clabexp -1001 format(/1x,'ERROR in subr. RDMET2 -- incorrect record label ', - 1 'read from MET data file'//1x,'Label read = ',a8/ - 2 1x,'Label expected = ',a8) - write(*,*) - stop 'Halted in RDMET2 -- see list file.' -c -c --- date/time variables do not match -2999 continue - write(io6,*)'ERROR in subr. RDMET2 -- date/time variables ', - 1 'do not match -- ndathre1 = ',ndathre1,' ndathre2 = ',ndathre2, - 2 ' ndathre3 = ',ndathre3 - write(*,*) - stop 'Halted in RDMET2 -- see list file.' -3999 continue - write(io6,*)'ERROR in subr. RDMET2 -- date/time variables ', - 1 'do not match -- ndathre = ',ndathre,' KDATHR = ',kdathre - write(*,*) - stop 'Halted in RDMET2 -- see list file.' - end -c---------------------------------------------------------------------- - subroutine rdmm4(cellzc,udat,vdat,uprog,vprog, -ccec101006 1 tprog,vptprog,icloud,ccgrid,iceilg,rho,npsta) - 1 tprog,vptprog,mcloud,ccgrid,iceilg,rho,npsta) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 RDMM4 -c E. Insley, Earth Tech, Inc. -c --- Modified by M. Fernau, J. Scire, F. Robe -c Modified by F. Robe, TRC -c -c --- UPDATES: -c -c --- v6.4.0 to v6.5.0 (150223) -c - Trap and report error opening files (not found) -c -c --- v6.330 (101006) to v6.4.0 (121203) -c - Add wind dir. rotation for Polar Stereographic projection -c -c --- V6.32 (080205) to V6.330 (101006) (CEC) -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c -c --- v6.31 (071207) to v6.32 (080205)(F. Robe) -c - Remove prog LST times from calling list (never used) -c -c --- V6.223 (070702) to v5.81 (071207)(F. Robe) -c - At the first timestep, use the current hour MM4 soundings -c to initialize TZo,ZL0 used in MIXDT2 to compute the convective -c mixing height growth (in the unlikely event, the first timestep -c is convective) -c -c --- V6.222 (070404) to V6.223 (070702) to (F. Robe) -c - Replace calls to r2interp by calls to r2interp2 to interpolate -c rhop, rh850, rh, and ccp as r2interp2 is designed for 2D arrays -c while r2interp is for a slice of a 3D array -c - Use modified cinterp calling list - -c -c --- V6.220 (070206) to V6.222 (070404) (F. Robe) -c - Initialize nlevag1,TZ,ZL at fist call to subroutine -c (does not affect results but can stop execution with some -c compilers) -c -c --- v6.218 (070113) to V6.220 (070206) (F. Robe) -c - Compute ceiling height based on high/middle/low cloud -c covers (ICLOUD=4 option only) if qc not available -c -c --- V6.217 (061231) to v6.218 (070113) -c - Bug fix: correct date comparison s.t. ok at midnight -c -c --- V6.216 (061230) to v6.217 (061231) -c - Implement icloud=4 option (cloud cover based on -c RH using MM5toGrads algorithm) -c - Sort out RH and Press arrays by ascending heights -c (call to updated qcksrt3 subroutine) -c - Use rhprog as scalar not as array (save space) -c -c --- v6.210 (060408)to V6.216 (061230)(F.Robe) -c - Bug fix:correct record dates comparison so that -c the MM4 fields used in CALMET are updated on an -c hourly basis. In particular make sure to take -c nsece into account (can be =3600sec i.e. 1 hour) -c -c --- v6.206 (060322)to v6.210 (060408) (F.Robe) -c - Change array name irhprog(mxnx,mxny) to irhpg (mxnx,mxny) -c -c --- V6.2 (060215) to v6.206 (060322) (F.Robe) -c - Do not use Stull night cooling overwater but extrapolate -c down from lowest 2 MM4 levels -c -c --- V6.0 (051128) to V6.2 (060215)(F.Robe) -c - Change sinalp argument to take into account new sinalp -c array index range -c - Replace real argument deltas by integer ndeltas in -c call to deltsec -c - Bug fix: Use solar angle at nearest CALMET gridpoint to -c determine sunrise/sunset on MM5 grid rather than solar angle -c on CALMET grid (indices and possibly array dimension mismatch -c if NXP> MXNX and/or NYP>MXNY) -c -c --- V5.611 Level 051113 to V6.0 (051128)(F.Robe) -c - Use explicit beginning current times -c - Store UDAT,VDAT,UPROG,VPROG in UDATS,VDATS,UPROGS,VPROGS -c when new data is read so they can be used when data is not -c read in (sub-hourly CALMET timesteps) (necessary because -c UDAT,VDAT,UPROG,VPROG are reset to zero before every call -c to RDMM4 -c -c --- V5.6 Level 050328 to v5.611 Level 051113 (F.Robe) -c - Use index1 instead index+1 in call to STULL (F.Robe) -c -c --- Version V5.548b Level 050113 to V5.6 Level 050328 -c - use previous hour soundings to compute lapse rates above -c previous hour mixing height instead of current hour -c lapse rates to avoid unrealistic overgrowth of mixing height -c (used in MIXDT2 - itprog>0 mode) -c -c --- V5.547 (041016) to V5.548b (050113) (F.Robe) -c - Make sure no duplicate z levels are used in subroutines -c STULL0,STULL -c -c --- V5.546 (040924) to V5.547 (041016) (F.Robe) -c - Add ability to read multiple (consecutive or overlapping) -c MM4.DAT files -c - explicit common replaced by include d4/d6.met -c -c --- V5.53 (030709) to V5.546 (040924) (DGS) -c - Reset pressure check from 8500 to 850 (millibars) -c The code had been written for pressure in tenths of -c millibars, but the pressure has been converted to -c millibars, so level 1 of the RH profile was selected -c instead. -c --- V5.52 (030515) to V5.53 (030709) (F.Robe) -c - Remove spurious statement (bug fix) -c --- V5.5 (030402) to V5.5 (030402) (J. Scire) -c - Add checks to MM4.DAT read statements to confirm -c MM4 I,J indexes read match expected values -c --- V5.4 (030119) to V5.5 (030402) (DGS) -c - Add list-file unit to JULDAY, INDECR, YR4 calls -c - LLCONF replaced with LLCC -c - /MAP/ replaces /LON/ -c - Change documentation: coordinates may be other than -c UTM or LLC -c V5.3 - frr 030119: NOOBS version for MM4 data as well (hourly -c MM4 records only) -c -c -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -C THIS SUBROUTINE READS AND INTERPOLATES THE MM4 PROGNOSTIC MODEL -C OUTPUT TO THE DIAGNOSTIC MODEL GRID -C -C INPUTS: CELLZC R-ARRAY - DIAGNOSTIC WIND MODEL CELL-CENTER HEIGHTS -C -C OUTPUTS: UDAT R-ARRAY - U-COMPONENT OF THE WIND PROGNOSTIC HORIZONTAL -C GRID INTERPOLATED TO CALMET LEVELS -C VDAT R-ARRAY - V-COMPONENT OF THE WIND PROGNOSTIC HORIZONTAL -C GRID INTERPOLATED TO CALMET LEVELS -C UPROG R-ARRAY - U-COMPONENT OF THE PROGNOSTIC WIND FIELD -C INTERPOLATED TO CALMET GRID -C VPROG R-ARRAY - V-COMPONENT OF THE PROGNOSTIC WIND FIELD -C INTERPOLATED TO CALMET GRID -C TPROG R-ARRAY - PROGNOSTIC TEMPERATURE FIELD -C INTERPOLATED TO CALMET GRID -C VPTPROG R-ARRAY - PROGNOSTIC VIRTUAL POTENTIAL TEMPERATURE -c FIELD INTERPOLATED TO CALMET GRID -c CCGRID R-ARRAY - Gridded cloud cover computed with MM4 -c Relative humidity (if mcloud=3 or 4) -c ICEILG I-ARRAY - ceiling height -c RHO R-ARRAY - 2-D surface air density on CALMET grid -c -c NPSTA INT - Precipitation flag:use MM5 if NPSTA=-1 -C -c OUTPUT VIA COMMON MM5TEMP -c ZL R-ARRAY - ELEVATION ABOVE GROUND OF MM5 LEVELS AT -C MM5 GRIDPOINT CLOSEST TO GIVEN CALMET -C GRIDPOINT. Artificial zl=0 level added -c TZ R-ARRAY - VERTICAL PROGNOSTIC TEMPERATURE PROFILE -C AT GIVEN CALMET GRIDPOINT BASED ON CLOSEST -C MM5 GRIDPOINT. Surface temperature is -c copied from first MM5 level . -c Not interpolated in time: past (or present) -c time (NOT future) is passed to MIXHT2/MIXDT2 -c This is consistent with using most recent past -c upper air sounding in MIXHT/MIXDT -c -c -c -c OUTPUT VIA COMMON SURFPROF -c iRHPG I-ARRAY - SURFACE RELATIVE HUMIDITY INTERPOLATED -C TO CALMET GRID (IN PERCENT) -c IPCODEPG I-ARRAY - SURFACE PRECIPITATION CODE INTERPOLATED -C TO CALMET GRID (0: NO PRECIP - 10: LIQUID -C 20: FROZEN - 9999: MISSING) -c OUTPUT VIA COMMON METGRD -c RMM R-ARRAY - PRECIPITATION RATE (mm/hr) on calmet grid -C -C OTHER VARIABLES: -C NXP INT - NO. OF PROGNOSTIC MODEL GRID POINTS IN THE -C X-DIRECTION -C NYP INT - NO. OF PROGNOSTIC MODEL GRID POINTS IN THE -C Y-DIRECTION -C NZP INT - NO. OF PROGNOSTIC MODEL LEVELS -C NLEVAG INT - NO. OF PROGNOSTIC MODEL LEVELS ABOVE GROUND -C XMAP0 REAL - LOCATION OF ORIGIN (X IN KM) IN REAL SPACE -C COORDINATES -C YMAP0 REAL - LOCATION OF ORIGIN (Y IN KM) IN REAL SPACE -C COORDINATES -C -c Parameters: MXNX, MXNY, MXNZ, MXNXP, MXNYP, MXNZP, IO6 -c -c --- RDMM4 called by: DIAGNO -c --- RDMM4 calls: JULDAY, INDECR, QCKSRT3, R2INTERP, ESAT, YR4 -c OPEN_ERR -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'gen.met' - include 'map.met' - include 'grid.met' -c frr 030119 set the precipitation rate rmm - include 'metgrd.met' - - - include 'd4.met' - include 'd6.met' - include 'mm4hdo.met' - - common/mm4dum/ix,jx,zdum,wddum,wsdum,pdum,itdum,idddum - -c --- Multiple MM4.DAT filenames - include 'filnam.met' - -c frr 030119 - 050328 (use previous,not current, hour) -c common with mixdt2 (computation of mixing height in noobs mode) - common/mm5temp/nlevag0,zl0(mxnx,mxny,mxnzp+1), - : tz0(mxnx,mxny,mxnzp+1) - -c common with surfvar: 2D surface prognostic data - common /surfprog/irhpg(mxnx,mxny),ipcodepg(mxnx,mxny) - -c -c Initialisation in RDHD4 -c --- number of current mm5 file (nfm3d) - COMMON /PROGSTEP/ ifirstpg,nfm3d - - DIMENSION UPROG(mxnx,mxny,*), VPROG(mxnx,mxny,*), - 1 UP(mxnxp,mxnyp,mxnzp), VP(mxnxp,mxnyp,mxnzp), - 1 UDAT(mxnxp,mxnyp,mxnz), VDAT(mxnxp,mxnyp,mxnz), - 2 CELLZC(*),z(mxnzp),ws(mxnzp),wd(mxnzp), - & zp(mxnxp,mxnyp,mxnzp), - & t(mxnzp),tp(mxnxp,mxnyp,mxnzp), - & tmm4(mxnxp,mxnyp,mxnz),tprog(mxnx,mxny,*), - & vpt1(mxnzp),vptp(mxnxp,mxnyp,mxnzp), - & vptdat(mxnxp,mxnyp,mxnz),vptprog(mxnx,mxny,*), -c frr 030119 - & rh850pg(mxnx,mxny),rh850(mxnxp,mxnyp), - & rh(mxnxp,mxnyp), - & ccgrid(mxnx,mxny),iceilg(mxnx,mxny), - & rhop(mxnxp,mxnyp),rho(mxnx,mxny), - & rain(mxnxp,mxnyp),indx(mxnxp,mxnyp), - & pt20(mxnxp,mxnyp), pt30(mxnxp,mxnyp), - & tsurf(mxnxp,mxnyp), - & zl(mxnx,mxny,mxnzp+1),tz(mxnx,mxny,mxnzp+1), -c frr 061230 -070206 - & rhp1(mxnzp),rhp(mxnxp,mxnyp,mxnzp), - & press(mxnzp),pp(mxnxp,mxnyp,mxnzp), - & ccp(mxnxp,mxnyp),ceilp(mxnxp,mxnyp) - -c --- Storage arrays for sub-hourly CALMET timesteps - DIMENSION UPROGS(mxnx,mxny,mxnz), VPROGS(mxnx,mxny,mxnz), - 1 UDATS(mxnxp,mxnyp,mxnz), VDATS(mxnxp,mxnyp,mxnz) - - save uprogs,vprogs,udats,vdats - -c --- Only update on an hourly basis, Not at every CALMET timestep (060215) -c if (nsece.ne.0 .and. ifirstpg.ne.0) then -c --- bug fix (061230) - if (nsecb.ne.0 .and. ifirstpg.ne.0) then - -c --- Fill in with stored variables - do k=1,mxnz - do j=1,mxny - do i=1,mxnx - uprog(i,j,k)=uprogs(i,j,k) - vprog(i,j,k)=vprogs(i,j,k) - end do - end do - do j=1,mxnyp - do i=1,mxnxp - udat(i,j,k)=udats(i,j,k) - vdat(i,j,k)=vdats(i,j,k) - end do - end do - end do - - return - - endif - -c --- BUG FIX: ifirstpg should not be updated here (it is later) otherwise -c --- pt20,pt30 are not initialized and surface temp. are zeroes (i.e. crash -c --- when itprog=2 and computes lapse rates incorrectly when itprog=1 -c --- frr 061230 -c if (ifirstpg.eq.0) ifirstpg=1 - -c --- Initialize variables (070404) - if (ifirstpg.eq.0) then - nlevag1=0 - do k=1,mxnzp+1 - do j=1,mxny - do i=1,mxnx - tz(i,j,k)=0. - zl(i,j,k)=0. - end do - end do - end do - endif - -***** -c -c --- Initialize constants - deg2rad=0.0174533 -C -c --- Set number of levels to read; sfc and mandatory (1st 8 levels) -c --- plus nzp significant levels - nlev = 8+nzp -c --- Loop over each grid cell in extraction subdomain - 1 continue - do 5 j=1,nyp - do 5 i=1,nxp -c --- Read date record of data portion -c frr 030119 : read all variables of first record in MM4.DAT -c read(io20,60,end=999) myr,mmo,mday,mhr,ix,jx - read(io20,60,end=999)myr,mmo,mday,mhr,ix,jx, - : pmsl,rain(i,j),isnow -60 format(4i2,2i3,f7.1,f5.2,i2) -c60 format(4i2,2i3) - -c --- Check that MM4 grid point I,J read match expected values - ixexpect=i+i1-1 - jxexpect=j+j1-1 - if(ix.ne.ixexpect.or.jx.ne.jxexpect)then - write(io6,960)myr,mmo,mday,mhr,ix,jx,ixexpect,jxexpect -960 format(1x,'Error in Subr. RDMM4 -- Error in MM4.DAT file'/ - 1 1x,'MM4 grid point I,J do not match expected values'/ - 2 1x,'MM4 date/time: Yr: ',i4,1x,'Mo: ',i2,1x,'Day: ',i2, - 3 1x,'Hr: ',i2,' (GMT)'/ - 4 1x, 'MM4 I,J: ',2i4/ - 5 1x,'Expected I,J: ',2i4) -c - print *,'Error in Subr. RDMM4 -- Error in MM4.DAT file' - print *,'MM4 grid point I,J do not match expected values' - stop - endif -c - call YR4(io6,myr,ierr) - if(ierr.NE.0) stop 'Halted in RDMM4' -c --- Convert date/time from GMT to LST - call julday(io6,myr,mmo,mday,mjul) - idtz = 0 - ibtz - call indecr(io6,myr,mjul,mhr,idtz,0,23) -c -c --- Check whether data are beyond current time step -c --- (this should not happen because checked in READHD) - mdathr=myr*100000+mjul*100+mhr -c if (mdathr .gt. ndathr) then -c --- explicit times (060215) -c --- take into account seconds (can be 3600sec =1hr) 061230 and midnight (070113) -c if (mdathr .gt. ndathre) then -c if (mdathr .gt. (ndathrb+1)) then - call deltsec(ndathre,nsece,mdathr,0,ndeltas) - if (ndeltas.gt.0) then - write(io6,*) ' MM4 data record is beyond CALMET time step: ' -c write(io6,*) myr,mjul,mhr,nyr,njul,nhr,i,j,ix,jx - write(io6,*) myr,mjul,mhr,nyrb,njulb,nhrb,i,j,ix,jx - print *,'MM4 data record is beyond CALMET time step - STOP -' - stop - endif -c -c --- Check whether need to skip a record - iskip = 0 - -c if (mdathr .lt. ndathr) iskip = 1 -c if (mdathr .lt. ndathre) iskip = 1 -c --- bug fix (061230) - ndathre does not properly reflect the end of an hour because -c --- it does not take into account nsece which is 3600sec at the end of the hour - if (mdathr .lt. (ndathrb+1)) iskip = 1 - -c -c --- Read data levels - if(iskip.EQ.0) then -c --- Want to use these data levels - -c030119 initialize RH array - rh850(i,j)=0. - -c030119 convert rainfall rate from cm/hr to mm/hr - rain(i,j)= rain(i,j)*10. - - do 35 n=1,nlev -c --- Read sfc and mandatory (1st 8 levels) + nzp significant levels - read(io20,70) press(n),z(n),itmp,idd,wd(n),ws(n) - -70 format(f5.1,f6.0,i4,i2,f4.0,f2.0) -c --- Adjust temperature to correct value and sign -c (0.1 degrees; odd number = negative) - xneg = 1. - if (mod(itmp,2) .ne. 0) xneg = -1. - t(n) = xneg * float(itmp) / 10. -c --- Adjust dew point depression (< 56 = 0.1 degrees C; >= 56 -c = whole degrees C - 50.) -c --- RH1 is work variable: 1st = dew point depression, then -c dew point, then relative humidity - if (idd .lt. 56) then - rh1 = float(idd) / 10. - else - rh1 = float(idd) - 50. - end if -c --- Convert dew point depression to dew point - rh1 = t(n) - rh1 -c --- Calculate relative humidity using empirical formula from -c Bosen (Monthly Weather Review, vol 86, pg 486 [1958]) - ztmp = 1.8 * t(n) + 32. - zdp = 1.8 * rh1 + 32. - xnum = 173. - 0.1 * ztmp + zdp - xdenom = 173. + 0.9 * ztmp - rh1 = (xnum / xdenom) ** 8.0 - rh1 = rh1 * 100. - if (rh1 .gt. 100.) rh1 = 100. -c 061230 (frr) - rhp1(n)=rh1 - -c 030119 (frr) -c 040924 (dgs) -c --- Store RH at (near) 850 mb for cloud cover computation -c Allow for surface pressure < 850mb (happens e.g. SW Wyoming) - if (n.eq.1 .or. press(n).gt.850.)rh850(i,j)=rh1 - -c --- Convert Celsius temperature to Kelvins - tairc = t(n) - t(n) = t(n) + 273.15 - -c --- Calculate potential temperature - pt1 = t(n) * ((1000./press(n)) ** 0.286) -c -c --- compute saturation and actual water vapor pressure (mb) -c --- (NOTE: ESAT function uses temperature in deg. C) -c --- (constant 0.01 converts rh from percent to fraction) - es = esat(tairc) - e = 0.01 * rh1 * es -c -c --- compute actual mixing ratio (g h20/g dry air) - w = 0.622 * e / (press(n) - e) -c --- compute specific humidity - q = w / (1 + w) -c --- compute virtual potential temperature - vpt1(n) = pt1 * (1. + 0.61 * q) -c --- Adjust heights from msl to ht above local ground - z(n) = z(n) - float(ielev4(i,j)) - -c frr 030119 Surface RH and rho - if (n.eq.1) then - rh(i,j)=rh1 - rhop(i,j)= 0.3484321*press(1)/t(1) - endif -35 continue -c -c *** Replace above sfc 1000mb calm winds with sfc winds -c *** (fix needed for initial IWAQM data) -c *** if(z(2).GE.z(1))then -c *** if(wd(2).LT. 0.001 .AND. ws(2).LT.0.001)then -c *** wd(2) = wd(1) -c *** ws(2) = ws(1) -c *** endif -c *** endif - -c --- Sort arrays by ascending height - call qcksrt3(nlev,z,wd,ws,t,vpt1,rhp1,press) - -c frr 030119 Several pressure levels can be recorded at the same height -c (owing to round-off errors). Only keep one level per height -c => delete one level - nlevok=nlev - do k=1,nlev-1 - if (z(k).eq.z(k+1))then - do kk=k+1,nlevok-1 - z(kk)=z(kk+1) - wd(kk)=wd(kk+1) - ws(kk)=ws(kk+1) - t(kk)=t(kk+1) - vpt1(kk)=vpt1(kk+1) - rhp1(kk)=rhp1(kk+1) - press(kk)=press(kk+1) - end do - nlevok=nlevok-1 - endif - end do - -c --- Convert wd,ws to u,v components and store in grid arrays -c --- Store temperature in grid array -c --- Store RH in grid array - nlevag=0 -c do 45 k=1,nlev - do 45 k=1,nlevok - if(z(k).GE.-0.0001)then -c --- Use only above ground level - nlevag = nlevag + 1 - -c --- v6.4.0, Level 121203 - if(LLCC .OR. LPS) then - -c --- Convert wd from true north (south) to Lambert Conformal -c --- map north (south) -c --- MM4 west longitudes are negative but RLON0 is positive - dlong = rlon0 + xlong4(i,j) -c --- Code to handle 180 degree longitude straddle - if (dlong .gt. 180.) dlong = dlong - 360. - if (dlong .lt. -180.) dlong = dlong + 360. - if (xlat1 .lt. 0.) then -c --- Southern Hemisphere - wdmap = wd(k) + (conec*dlong) - else -c --- Northern Hemisphere - wdmap = wd(k) - (conec*dlong) - end if - if(wdmap.LT.0.) wdmap = wdmap + 360. - if(wdmap.GT.360.) wdmap = wdmap - 360. - wd(k) = wdmap - endif -c --- Convert ws from knots to m/s, - ws(k) = ws(k) * 0.51444 - wdrad = deg2rad*wd(k) - up(i,j,nlevag) = -ws(k) * sin(wdrad) - vp(i,j,nlevag) = -ws(k) * cos(wdrad) - tp(i,j,nlevag) = t(k) - vptp(i,j,nlevag) =vpt1(k) - zp(i,j,nlevag) = z(k) - rhp(i,j,nlevag)= rhp1(k) - pp(i,j,nlevag)=press(k) - endif -45 continue - - -c --- INDEX is the height of the lowest true half-sigma MM4 level - if(zp(i,j,1).lt.1.0)then -c --- MM4 level at the ground surface is not a half-sigma level - index=2 - else -c --- Lowest MM4 level is above the surface - index=1 - endif - indx(i,j)=index - -c frr 030119 - Determine whether day or night for temp. extrapolation -c if (mhr.eq.0)then -c sina=sinalp(i,j,24) -c else -c sina=sinalp(i,j,mhr) -c endif -c -c --- Use nearest CALMET gridpoint (i,j loops over MM4 grid at this point -c --- and sinalp is defined on CALMET grid) -c --- Only hourly MM4 records and explicit MM4 time is interpreted as -c --- hour-ending time. Therefore use sinalp at (mhr-1/2) i.e. sinalp(i,j,mhr+1) -c --- because in MOD6, sinalp has 26 values ranging from 23:30 previous day -c --- to 0:30 on next day - sina=sinalp(inearg(i,j),jnearg(i,j),mhr+1) - -c frr 030106 -c initialize pot.temp history for temp extrapolation - if (ifirstpg.eq.0) then -c --- Make sure not to pass duplicate levels to subroutine (050113-frr) - if (zp(i,j,index).ne.zp(i,j,index+1))then - index1=index+1 - else - index1=index+2 - endif - call stull0(vptp(i,j,index) ,zp(i,j,index), - : vptp(i,j,index1),zp(i,j,index1), - : pt20(i,j),pt30(i,j)) - endif - -c Record pot.temp before sunset for extrapolation at night -c record even if cellzc(k) not below lowest MM4 level at that -c time because this may change during the night (MM4 levels -c are usually not fixed in Z (but in sigma or p) -c assume virt pot. temp ~ pot. temp. - if (sina.gt.0)then - pt20(i,j) = vptp(i,j,index) - pt30(i,j) = vptp(i,j,index+1) - endif - - -C --- INTERPOLATE PROGNOSTIC SOUNDINGS VERTICALLY TO DIAGNOSTIC -C --- MODEL LEVELS - DO 75 K = 1,NZ -c -c --- Persist data below bottom level - IF(CELLZC(K).LT.zp(i,j,1))then - UDAT(I,J,K)=UP(I,J,1) - VDAT(I,J,K)=VP(I,J,1) - TMM4(I,J,K)=TP(I,J,1) - VPTDAT(I,J,K)=VPTP(I,J,1) -c -c --- Persist data above top MM4 level - else if(CELLZC(K).GE.zp(i,j,nlevag))then - UDAT(I,J,K)=UP(I,J,nlevag) - VDAT(I,J,K)=VP(I,J,nlevag) - TMM4(I,J,K)=TP(I,J,nlevag) - VPTDAT(I,J,K)=VPTP(I,J,nlevag) -c -c -c --- Interpolate to CALMET level from surrounding MM4 levels - else - DO KP = 2,nlevag - KPM1 = KP - 1 - IF(zp(i,j,KPM1).LE.CELLZC(K).AND. - 1 zp(i,j,KP).GT.CELLZC(K))THEN - ratio1=(CELLZC(K)-zp(i,j,KPM1))/ - 1 (zp(i,j,KP)-zp(i,j,KPM1)) - UDAT(I,J,K)=UP(I,J,KPM1)+(UP(I,J,KP)-UP(I,J,KPM1)) - 1 *ratio1 - VDAT(I,J,K)=VP(I,J,KPM1)+(VP(I,J,KP)-VP(I,J,KPM1)) - 1 *ratio1 - TMM4(I,J,K)=TP(I,J,KPM1)+(TP(I,J,KP)-TP(I,J,KPM1)) - 1 *ratio1 - VPTDAT(I,J,K)=VPTP(I,J,KPM1)+(VPTP(I,J,KP)- - 1 VPTP(I,J,KPM1))*ratio1 - go to 77 - endif - enddo -77 continue - endif -c -c --- Replace winds below first MM4 half-sigma level with -c --- extrapolated logarithmic profile winds. Ignore MM4 surface -c --- (Z=0) winds, -c -c --- Use a logarithmic profile to extrapolate winds down toward -c --- the surface - if(cellzc(k).lt.zp(i,j,index))then -c --- Assume a typical roughness length for extrapolation -c --- purposes - zoave=0.5 - xlnzo=alog(zoave) -c --- ZP(i,j,index) is the lowest true MM4 half-sigma level - xlnz2=alog(zp(i,j,index)) -c --- CELLZC(k) is the CALMET grid point height - xlnz1=alog(cellzc(k)) -c --- Logarithmic profile scaling factor - ratio2=(xlnz1-xlnzo)/(xlnz2-xlnzo) - UDAT(I,J,K)=ratio2*UP(I,J,index) - VDAT(I,J,K)=ratio2*VP(I,J,index) - -c -c frr 030119 Extrapolate temperature downwards assuming dry adiabatic -c during the day and Stull cooling profile at night - if (sina .le. 0.) then -c nighttime -c --- Make sure not to pass duplicate levels to subroutine (050113-frr) - if (zp(i,j,index).ne.zp(i,j,index+1))then - index1=index+1 - else - index1=index+2 - endif -c --- Differentiate between land/water (no sharp cooling as parameterized by -c --- Stull over ocean) (060322) - if (ilu4(i,j).eq.iluoc3d) then -c --- ocean - zx=(cellzc(k)-zp(i,j,index))/ - : (zp(i,j,index1)-zp(i,j,index)) - vptdat(i,j,k)=vptp(i,j,index) - : +zx*(vptp(i,j,index1)-vptp(i,j,index)) - else -c --- land - - call stull(zp(i,j,index) ,vptp(i,j,index),pt20(i,j), - : zp(i,j,index1),vptp(i,j,index1), - : pt30(i,j),cellzc(k),vptdat(i,j,k)) - endif - -c compute T from theta and z -c note that pressure is not sorted by qcksrt3 so -c initial pressure levels do not correspond to initial z -c => use t=theta *exp(AZ)*B , and 2 levels to determine A and B - A=log( (tp(i,j,index)*vptp(i,j,index+1))/ - : (tp(i,j,index+1)*vptp(i,j,index)) )/ - : (zp(i,j,index)-zp(i,j,index+1)) - B=exp(-A*zp(i,j,index))*tp(i,j,index)/vptp(i,j,index) - - tmm4(i,j,k)= vptdat(i,j,k)*exp(a*cellzc(k))*B - else -c daytime: assume "dry" adiab and constant theta virt) - vptdat(i,j,k)=vptdat(i,j,1) - TMM4(I,J,K)= tp(i,j,index)+ - : 0.0098*(zp(i,j,index)-cellzc(k)) - endif - - - endif - -75 CONTINUE - - -c frr 030119 Extrapolate temperature down to the surface - - if (sina .le. 0.) then -c nighttime -c --- Make sure not to pass duplicate levels to subroutine (050113-frr) - if (zp(i,j,index).ne.zp(i,j,index+1))then - index1=index+1 - else - index1=index+2 - endif - if (ilu4(i,j).eq.iluoc3d) then -c --- ocean - zx=-zp(i,j,index)/ - : (zp(i,j,index1)-zp(i,j,index)) - ptsurf=vptp(i,j,index) - : +zx*(vptp(i,j,index1)-vptp(i,j,index)) - else -c --- land - call stull(zp(i,j,index) ,vptp(i,j,index),pt20(i,j), - : zp(i,j,index1),vptp(i,j,index1), - : pt30(i,j),0.,ptsurf) - endif - -c compute T from theta and z -c note that pressure is not sorted by qcksrt3 so -c initial pressure levels do not correspond to initial z -c => use t=theta *exp(AZ)*B , and 2 levels to determine A and B - A=log( (tp(i,j,index)*vptp(i,j,index+1))/ - : (tp(i,j,index+1)*vptp(i,j,index)) )/ - : (zp(i,j,index)-zp(i,j,index+1)) - B=exp(-A*zp(i,j,index))*tp(i,j,index)/vptp(i,j,index) - tsurf(i,j)= ptsurf*B - - else -c daytime: assume "dry" adiab and constant theta virt) -c frr 030709: bug vptdat(i,j,k)=vptdat(i,j,index) - Tsurf(I,J)= tp(i,j,index)+0.0098*zp(i,j,index) - endif - - if (ifirstpg.eq.0 .and. i.eq.nxp .and. j.eq.nyp) ifirstpg=1 - - else - do 65 n=1,nlev -c --- "Read" (skip) data - read(io20,70) pdum,zdum,itdum,idddum,wddum,wsdum -65 continue - endif -5 continue -c - - -c --- Do another iteration through the i,j loop if current time not yet reached - if (iskip .eq. 1) goto 1 -c - -c --- Compute cloud cover on MM4 grid if icloud=4 -c --- Method 4 (MM5toGrads): cloud cover from prognostic relative humidity -c --- at all levels - Ceiling height -ccec101006 if (icloud.eq.4) call cloud4(nxp,nyp,nlev,rhp,pp,zp,ccp,ceilp) - if (mcloud.eq.4) call cloud4(nxp,nyp,nlev,rhp,pp,zp,ccp,ceilp) - - goto 997 -c -c --- ran out of data -c - 999 if (iskip .eq. 1) then - write(io6,*) ' ran out of MM4 data before start!' - stop -c --- open next MM4.DAT file if available and skip header - else if (nfm3d.lt.nm3d) then - nfm3d=nfm3d+1 - close(io20) - open(io20,file=m3ddat(nfm3d),status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(io6,'RDMM4','MM4.DAT File', - & m3ddat(nfm3d),io20) - do nn=1,3+nzp+nxp*nyp - read(io20,*) - end do - goto 1 - else - write(io6,*) ' ran out of MM4 data during run...' - stop - end if - 997 continue -C -C INTERPOLATE PROGNOSTIC SOUNDINGS HORIZONTALLY TO DIAGNOSTIC MODEL -C GRID -C -c --- Convert diagnostic grid spacing from m to km - dxk = dx * 0.001 - dyk = dy * 0.001 -c -c --- Compute cell center x,y of diagnostic grid cell (1,1) -c *** xorigcc = utmxor + (0.5*dxk) -c *** yorigcc = utmyor + (0.5*dyk) -c --- Compute diagnostic grid coordinates in real space - xorigcc = xmap0 + (0.5 * dxk) - yorigcc = ymap0 + (0.5 * dyk) -c - -c 030119 interpolate rainfall - if (npsta.eq.-1) then - call interpqr(rain,rmm) - endif - -c --- Loop over diagnostic grid - do 125 j = 1,ny -c --- Compute Y of cell center - y = yorigcc + (j - 1) * dyk - do 125 i = 1,nx -c --- Compute X of cell center - x = xorigcc + (i - 1) * dxk - -c --- Interpolate horizontally from prognostic grid to diagnostic -c --- grid x,y using inverse distance squared at four nearest points. -c - do 126 k = 1,nz - call r2interp(i,j,x,y,udat,k,uprog(i,j,k)) - call r2interp(i,j,x,y,vdat,k,vprog(i,j,k)) - call r2interp(i,j,x,y,tmm4,k,tprog(i,j,k)) - call r2interp(i,j,x,y,vptdat,k,vptprog(i,j,k)) -126 continue - - -c frr (030119) - Interpolate horizontally surface variables onto CALMET grid -c Surface density -c --- 070702: use r2interp2 for 2D array rather than r2interp -c call r2interp(i,j,x,y,rhop,1,rho(i,j)) - call r2interp2(i,j,x,y,rhop,rho(i,j)) - -c Surface RH -c --- 070702: use r2interp2 for 2D array rather than r2interp -c call r2interp(i,j,x,y,rh,1,rhprog) - call r2interp2(i,j,x,y,rh,rhprog) - irhpg(i,j) = int(rhprog) - -c RH at 850 mb -c --- 070702: use r2interp2 for 2D array rather than r2interp -c call r2interp(i,j,x,y,rh850,1,rh850pg(i,j)) - call r2interp2(i,j,x,y,rh850,rh850pg(i,j)) - - -c precip code (10 for liquid (isnow=0), 20 for frozen (isnow=1)) - if (npsta.eq.-1 .and. rmm(i,j).gt.0. ) then - if (tprog(i,j,1).lt.273.15) then - ipcodepg(i,j)=20 - else - ipcodepg(i,j)=10 - endif - else - ipcodepg(i,j)=0 - endif - -c --- cloud cover and ceiling height if icloud=4 -ccec101006 if (icloud.eq.4)then - if (mcloud.eq.4)then -c --- 070702: use r2interp2 for 2D array rather than r2interp -c call r2interp(i,j,x,y,ccp,1,ccgrid(i,j)) - call r2interp2(i,j,x,y,ccp,ccgrid(i,j)) -c --- 070702: modified cinterp to deal with 2D arrays -c call cinterp(i,j,x,y,ceilp,1,ceilg) - call cinterp(i,j,x,y,ceilp,ceilg) - iceilg(i,j)=int(ceilg/30.48) - endif - -c 030119 Vertical profiles of temperatures (for mixing heights in MIXDT2) -c Use above surface MM4 levels ( index -> top)- add one for surface -c 050328 first save previous hour value - nlevag0=nlevag1 - nlevag1=nlevag+1 - -c 050328 Save previous hour soundings to compute previous hour lapse rate in MIXDT - do 622 k = 1,nlevag0 - tz0(i,j,k)=tz(i,j,k) - zl0(i,j,k)=zl(i,j,k) - 622 continue - -c --- Update progn.temperature soundings with current hour values - - index=indx(igrab(i,j,1),jgrab(i,j,1)) - do 722 k = 2,nlevag1+1-index - tz(i,j,k) = tp(igrab(i,j,1),jgrab(i,j,1),index+k-2) - zl(i,j,k) = zp(igrab(i,j,1),jgrab(i,j,1),index+k-2) - 722 continue - do 723 k=nlevag1+2-index,nlevag1 - tz(i,j,k) = tz(i,j,k-1) - zl(i,j,k) = zl(i,j,k-1)+1. - 723 continue - zl(i,j,1) = 0. - tz(i,j,1)=tsurf(igrab(i,j,1),jgrab(i,j,1)) - -c --- Fill in temp soundings with current value for the first valid timestep -c --- to avoid all zeroes in MIXDT2 if first timestep is convective (071207) - if (ifirstpg.eq.1) then - nlevag0=nlevag1 - if(i.eq.nx.and.j.eq.ny) ifirstpg=2 - do 6622 k = 1,nlevag0 - tz0(i,j,k)=tz(i,j,k) - zl0(i,j,k)=zl(i,j,k) - 6622 continue - endif - - -125 continue - - -c frr(030119) compute cloud cover if icloud=3 -ccec101006 if (icloud.eq.3) then - if (mcloud.eq.3) then -c --- Method 3 (Teixera): cloud cover from prognostic relative humidity at 850 mb - call cloud3(nx,ny,rh850pg,ccgrid) - endif - -c --- set constant ceiling height at 8000ft (for icloud=3) -ccec101006 if (icloud.eq.3) then - if (mcloud.eq.3) then - do 138 j=1,ny - do 138 i=1,nx - iceilg(i,j) = 80 -138 continue - - endif - - -c --- Store variables for sub-hourly timesteps (060215) - do k=1,mxnz - do j=1,mxny - do i=1,mxnx - uprogs(i,j,k)=uprog(i,j,k) - vprogs(i,j,k)=vprog(i,j,k) - end do - end do - do j=1,mxnyp - do i=1,mxnxp - udats(i,j,k)=udat(i,j,k) - vdats(i,j,k)=vdat(i,j,k) - end do - end do - end do - - - return - end -c---------------------------------------------------------------------- - subroutine rdmm5(cellzc,udat,vdat,uprog,vprog,tprog,vptprog, -ccec101006 1 icloud,ccgrid,iceilg,rho,npsta,itwprog) - 1 mcloud,ccgrid,iceilg,rho,npsta,itwprog) -c---------------------------------------------------------------------- -C -c --- CALMET Version: 6.5.0 Level: 140716 RDMM5 -c F.Robe -c --- Modified by M. Fernau, F.Robe ,J. Scire (Earth Tech Inc.) -c --- Modified by F. Robe, TRC -c -c --- UPDATES: -c -c --- v6.4.0 (121203) to v6.4.1 (140716) -c - Enhance string-processing when checking for the dataset -c version of the input 3D.DAT file. Previous code halted when -c reading a 3D.DAT file prepared by CALTAPM because the dataset -c version was not properly compared to known values. -c -c --- v6.330 (101006) to v6.4.0 (121203) -c - Add wind dir. rotation for Polar Stereographic projection -c - Add liquid water processing for AUX file -c - Revise test on CVER3D for change in water variables format -c so that older format is used only for version 2.0 (logic -c was not correct for versions greater than 2.1) -c -c --- v6.327 (090511) to v6.330 (101006) (CEC) -c (1) Change ICLOUD into MCLOUD (and ICLDOUT) -c -c --- v6.326 (080709) to v6.327(090511) (F.RobE) -c (1) Initialize qc and qr that may not be read from MM5 -c -c --- V6.325 (080512) to v6.326 (080709) -c (1) Modify timecheck in RDMM5 for the case of multiple overlapping -c MM5 input data files to avoid the simulation to stop one hour -c short. Results not affected by this fix -c (2) Fixed typo in error message -c (3) Only call cloud4 if new valid data (icloud=4 option) -c Note: if compiling with linux 64bits, the -Msave compilation -c flag must be on otherwise some variables can take random -c values (e.g. msec, nlevag1 and probably others) -c -c --- v6.323 (080411) to V6.325 (080512) (F.Robe) -c - Bug fix: Update values of gridpoint location in the call to -c cinterp and r2interp2 (flagged by Bruno Santos) -c Affects computation of prognostic ceiling height. -c - Apply temperature interpolation overwater at CALMEt levels -c below lowest M3D level to actual temperature array -c when ITWPROG=2 (flagged by Bruno Santos) -c -c --- v6.321 (080325)to v6.323 (080411) -c - Bug fix: check values of ceiling heights at both t1 and t2 -c before performing a time interpolation (suggested by Bruno Santos) -c --- V6.32 (080205) to v6.321 (080325) (FRR) -cc - Save isec1, isec2 to make sure their values are saved from one -c timestep to the next. Otherwise can assume wrong values and -c cause crash with some compilers. -c --- V6.31 (071207) to V6.32 (080205) -c - Allow sub-hourly prognostic timesteps (equal or larger than -c CALMET timesteps) but still only instantaneous records -c Note: 3D.DAT version 3.0 has explicit beginning and end times -c with seconds. For instantaneous records: beginning time=end time -c - Remove Progn LST times from calling list (never used) -c - Add npsta to rdhd53 calling list -c -c --- V6.3 (070717)to V6.31 (071207) (FRR) -c - Keep searching for first valid MM5 record through subsequent -c MM5 files (and do not give up after first one) -c - Enforce bounds on dtinc value (0<=dtinc<=1) -c - Make sure that the current and future timesteps are always -c in memory (it1,it2) and never the previous and current timesteps -c (except for the last simulation timestep) for consistency with MOD5, -c propercomputing of previous hour temperature sounding, proper -c initialization of Stull surface temperature cooling, and to avoid -c the potential of not having the proper records to compute the last -c timesteps correctly -c - Removed previous (commented) bug lines (cleaning up) -c -c --- V6.223 (070702) to V6.3 (070717)(F. Robe) -c - Store the previous hour prognostic lapse rate rather than the -c current hour lapse rate to compute mixing height growth -c (TZ0,ZL0) -c - Make sure the 2 MM5 records read in are the current time and the -c following time, in all cases. -c -c --- V6.222 (070404) to V6.223 (070702) to (F. Robe) -c - Replace calls to r2interp by calls to r2interp2 to interpolate -c rh850, ccp, and qctot as r2interp2 is designed for 2D arrays -c while r2interp is for a slice of a 3D array -c - Use modified cinterp calling list -c - Interpolate ceiling height from cloud=4 option with cinterp -c rather than r2interp (using modified cinterp for 2D arrays) -c - spatially interpolate ccp only for icloud=4 -c - Only fill in indx array when valid records (not when skipping) -c (useless and besides, index not definied when skipping records) -c -c --- V6.221 (070327) to V6.222 (070404)(F. Robe) -c - Initialize nlevag1,TZ1,ZL1 at first call (does not -c affect results but will stop some compilers) -c -c --- V6.220 (070206) to V6.221 (070327)(F. Robe) -c --- Modifications suggested by B. Brashers) -c - Modify computation of RHOP such that it is -c properly initialized at each timestep/gridpoint and is -c computed at the surface. The non-initialization of RHOP -c could produce wrong values with some compilers (e.g. PGI -c in Linux) -c -c -- V6.217 (061231) to V6.220 (070206) (F. Robe) -c - Compute ceiling height based on high/middle/low cloud -c covers (ICLOUD=4 option only) if qc not available -c -c --- V6.213 (060525)to V6.217 (061231) (F. Robe) -c - implement new option to compute cloud cover from -c prognostic relative humidity (icloud=4; MM5toGrads -c algorithm) -c -c --- V6.210 (060408)to V6.213 (060525)(D. Strimaitis) -c - Change nsec1 (not initialized) to isec1 (initialized -c to 0) in call to DELTSEC -c -c --- V6.206 (060322)to V6.210 (060408)(F.Robe) -c - Change array name irhprog(mxnx,mxny) to irhpg (mxnx,mxny) -c -c --- V6.205 (060309) to V6.206 (060322)(F.Robe) -c - Store previous hour prognostic temperature profile in TZO -c instead of '2-hour-ago' progn. temp.(important for mixing height -c growth when prognostic lapse rates are used itprog=1,2; itwprog=1) -c No need for TZ2,ZL2 arrays anylonger -c - Extrapolate progn. temp. down to surface overwater using -c prognostic SSTs or adiabatic profile (formely used Stull -c cooling is not appropriate overwater, only land) -c -c --- V6.2 Level 060215 to V6.205 (060309)(F.Robe) -c - Change argument type from real to integer in call to delsec -c -c --- V5.611 Level 051113 to V6.2 Level 060215 (F.Robe) -c - Implement time interpolation to sub-hourly CALMET timesteps -c - Use explicit explicit current times: note that current time -c is defined here by the ending time of the CALMET timestep -c whereas MM5 timestamp is an instantaneous time, which in MOD5 -c we matched with the CALMET time (i.e. ending time of the -c CALMET timestep) -c - Save local variables from one timestep to the next -c - Replace real argument deltas by integer ndeltas in -c call to deltsec -c - Bug fix: Use solar angle at nearest CALMET gridpoint to -c determine sunrise/sunset on MM5 grid rather than solar angle -c on CALMET grid (indices and possibly array dimension mismatch -c if NXP> MXNX and/or NYP>MXNY) -c - Move sina computation outside of k loop and take new sinalp -c array index range into account -c -c -c --- V5.61 Level 051111 to V5.611 Level 051113 -c --- Modified by F.Robe -c - itwprog in calling list -c - Read in extended surface variables for imm53d=2 -c (3D.DAT version 2.0 and higher) -c - Store surface temp, rh/temp/height at first -c half-sigma level in M3DMET.MET for use in -c WATERP/WATER2P subroutines -c - Use index1 instead of index+1 in call to STULL -c only affects datsets with redundant lowest levels -c (fix was only partially implemented before) -c -c --- V5.6g Level 051109 to V5.61 Level 051111 -c - Fix errant test on IFIRSTPG from EQ to LE (problem with -c skipping first hours -c -c --- V5.6 Level 050328 to V5.6g Level 051109 -c --- Modified by F.Robe -c - Read new moisture variable format (CVER3D=2.1) -c - Bug fix for last timestep at end of leap year -c -c --- Version V5.548c Level 050125 to V5.6 Level 050328 -c --- Modified by F.Robe -c - use previous hour soundings to compute lapse rates above -c previous hour mixing height instead of current hour -c lapse rates to avoid unrealistic overgrowth of mixing height -c (used in MIXDT2 - itprog>0 mode) -c -c --- Version V5.548b Level 050113 to V5.548c Level 050125 -c --- Modified by F.Robe -c - Save it1,it2 as some compilers do not automatically save -c local variables from one timestep to the next -c -c --- V5.547 (041016) to V5.548b (050113)(F.Robe) -c - Add check to avoid duplicate prognostic levels in vertical -c temperature extrapolation (STULL0,STULL) -c -c --- V5.541(030528) to V5.547 (041016) (F.Robe) -c - Add ability to read multiple (consecutive or overlapping) -c MM5.DAT files -c - Explicit common replaced by include d4/d6.met -c -c --- V5.51 (030515) to V5.52 (030528) (F. Robe) -c - correction to ensure a smooth transition from -c Dec 31 to Jan 1 (if period straddles these dates) -c -c --- V5.5 (030402) to V5.51 (030515) (J. Scire) -c - correction to ensure IGF is defined when conducting -c 1-hour run -c - add check to ensure MM5/3D.DAT grid point I,J read -c match expected values -c -c --- V5.4 (030214) to V5.5 (030402) (DGS) -c - Add list-file unit to JULDAY, INDECR, YR4 calls -c - LLCONF replaced with LLCC -c - /MAP/ replaces /LON/ -c - Change documentation: coordinates may be other than -c UTM or LLC -c -c --- V5.3 (030119) to V5.4 (030214) (CEC) -c - Initialise precipitation with current hour -c -c --- V5.3 Allow non hourly data (F.Robe) -c Compute cloud cover from MM5 relative humidity -c Interpolate 3D temperature field + precip on CALMET grid -c -c --- V5.2 000602d (Zhong WU) -c Modify code to read 3D.DAT format -c IMM53D flag was added to mm4hdo.met -c -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -C THIS SUBROUTINE READS AND INTERPOLATES THE MM5 PROGNOSTIC MODEL -C OUTPUT (formatted by CALMM5) TO THE DIAGNOSTIC MODEL GRID -c frr (09/01) -C It also linearly interpolates the MM5 data in time for non-hourly -C MM5 timesteps (dry adiabatic lapse rate in convective B-L -c is imposed in TEMP3D not here) -C -C -C INPUTS: CELLZC R-ARRAY - DIAGNOSTIC WIND MODEL CELL-CENTER HEIGHTS -C -C MCLOUD INT - CLOUD FLAG -c - IF MCLOUD=3, compute cloud cover from MM5 relative -C humidity at 850 mb(Teixeira, 2001) -c - IF MCLOUD=4, compute cloud cover from MM5 relative -C humidity at all levels (MM5toGrads algorithm) -c -c ITWPROG Int - Offshore temperature option -c 0 : deltaT and OW lapse rates from SEA.DAT -c 1 : deltaT from SEA.DAT and OW lapse rates from -c 3D.DAT -c 2 : prognostic deltaT and lapse rates(from 3D.DAT) -C -C INPUT VIA COMMON GEN.MET: -c NDATHRE INT - eXPLICIT ENDING TIME OF CURRENT CALMET TIMESTEP -c NSECE INT - ENDING SECOND OF CURRENT CALMET TIMESTEP -C -C OUTPUTS: UDAT R-ARRAY - U-COMPONENT OF THE WIND PROGNOSTIC HORIZONTAL -C GRID INTERPOLATED TO CALMET LEVELS -C VDAT R-ARRAY - V-COMPONENT OF THE WIND PROGNOSTIC HORIZONTAL -C GRID INTERPOLATED TO CALMET LEVELS -C UPROG R-ARRAY - U-COMPONENT OF THE PROGNOSTIC WIND FIELD -C INTERPOLATED TO CALMET GRID -C VPROG R-ARRAY - V-COMPONENT OF THE PROGNOSTIC WIND FIELD -C INTERPOLATED TO CALMET GRID -C TPROG R-ARRAY - PROGNOSTIC TEMPERATURE FIELD -C INTERPOLATED TO CALMET GRID -C VPTPROG R-ARRAY - PROGNOSTIC VIRTUAL POTENTIAL TEMPERATURE -c FIELD INTERPOLATED TO CALMET GRID -c CCGRID R-ARRAY - Gridded cloud cover computed with MM5 -c Relative humidity (if mcloud=3 or 4) -c ICEIL I-ARRAY - ceiling height (lowest MM5 level) -c with non zero qc (for ioutmm5>82 and mcloud=3,4) -c RHO R-ARRAY - 2-D surface air density on CALMET grid -c NPSTA INT - PRecipitation flag:use MM5 if NPSTA=-1 -c -C -c OUTPUT VIA COMMON MM5TEMP -c ZL0 R-ARRAY - ELEVATION ABOVE GROUND OF MM5 LEVELS AT -C MM5 GRIDPOINT CLOSEST TO GIVEN CALMET -C GRIDPOINT. Artificial zl=0 level added -c TZ0 R-ARRAY - VERTICAL PROGNOSTIC TEMPERATURE PROFILE -C AT GIVEN CALMET GRIDPOINT BASED ON CLOSEST -C MM5 GRIDPOINT. Surface temperature is -c copied from first MM5 level . -c Not interpolated in time: past (or present) -c time (NOT future) is passed to MIXHT2/MIXDT2 -c This is consistent with using most recent past -c upper air sounding in MIXHT/MIXDT -c -c -c OUTPUT VIA COMMON SURFPROF -c iRHPG I-ARRAY - SURFACE RELATIVE HUMIDITY INTERPOLATED -C TO CALMET GRID (IN PERCENT) -c IPCODEPG I-ARRAY - SURFACE PRECIPITATION CODE INTERPOLATED -C TO CALMET GRID (0: NO PRECIP - 10: LIQUID -C 20: FROZEN - 9999: MISSING) -c OUTPUT VIA COMMON METGRD -c RMM R-ARRAY - PRECIPITATION RATE (mm/hr) on calmet grid -c -c OUTPUT VIA COMMON M3DMET -c TAIRP(mxnxp*mxnyp) R-ARRAY - air temperature at first half-sigma -c level at each 3D.DAT gridpoint -c (in degrees kelvin) -c SSTP(mxnxp*mxnyp) R-ARRAY - surface temperature at each 3D.DAT -c gridpoint (in degrees kelvin) -c RHP(mxnxp*mxnyp) R-ARRAY - relative humidity at first half-sigma -c level at each 3D.DAT gridpoint (in %) -c -c Z1P(mxnxp*mxnyp) R-ARRAY - height above ground of first half-sigma -c level at each 3D.DAT gridpoint(in m) -c -C -C OTHER VARIABLES: -C NXP INT - NO. OF PROGNOSTIC MODEL GRID POINTS IN THE -C X-DIRECTION -C NYP INT - NO. OF PROGNOSTIC MODEL GRID POINTS IN THE -C Y-DIRECTION -C NZP INT - NO. OF PROGNOSTIC MODEL LEVELS -C NLEVAG INT - NO. OF PROGNOSTIC MODEL LEVELS ABOVE GROUND -C XMAP0 REAL - LOCATION OF ORIGIN (X IN KM) IN REAL SPACE -C COORDINATES -C YMAP0 REAL - LOCATION OF ORIGIN (Y IN KM) IN REAL SPACE -C COORDINATES -C -c Parameters: MXNX, MXNY, MXNZ, MXNXP, MXNYP, MXNZP, IO6 -c -c --- RDMM5 called by: DIAGNO -c --- RDMM5 calls: JULDAY, INDECR, QCKSRT3, R2INTERP, ESAT, YR4 -c R2INTERP2, RDHD51,RDHD52 -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'gen.met' - include 'map.met' - include 'grid.met' - include 'metgrd.met' - - include 'd4.met' - include 'd6.met' -c COMMON /D4/ EDIT,EDITL,IEDIT,IEDITL -c COMMON /D6/ IRD,IWR,IFILE,IRDP - include 'mm4hdo.met' -c --- 051113 - include 'm3dmet.met' - - common/mm4dum/ix,jx,zdum,wddum,wsdum,pdum,itdum,idddum - - COMMON /PROGSTEP/ ifirstpg,nfm3d - -c --- v6.4.0, Level 121203 - include 'auxdat.met' - -c common with mixdt2 (computation on mixing height in noobs mode) -c share last hour temperature profile to compute T jump above MH - common/mm5temp/nlevag0,zl0(mxnx,mxny,mxnzp+1), - : tz0(mxnx,mxny,mxnzp+1) - -c common with surfvar: 2D surface prognostic data - common /surfprog/irhpg(mxnx,mxny),ipcodepg(mxnx,mxny) - -c -c --- FRR for zl,tz take prognostic point closest to -c calmet i,j point igrab(i,j,1) - - - Character*80 buff - DIMENSION UPROG(mxnx,mxny,*), VPROG(mxnx,mxny,*), - 1 UP(mxnxp,mxnyp,mxnzp), VP(mxnxp,mxnyp,mxnzp), - 1 UDAT(mxnxp,mxnyp,mxnz), VDAT(mxnxp,mxnyp,mxnz), - 2 CELLZC(*),z(mxnzp),ws(mxnzp),wd(mxnzp), - 2 zp(mxnxp,mxnyp,mxnzp), - & t(mxnzp),tp(mxnxp,mxnyp,mxnzp), - & tmm4(mxnxp,mxnyp,mxnz),tprog(mxnx,mxny,*), - & vpt1(mxnzp),vptp(mxnxp,mxnyp,mxnzp), - & vptdat(mxnxp,mxnyp,mxnz),vptprog(mxnx,mxny,*), -c frr (09/01) previous and next time step values (for time interpolation) - & uprog1(mxnx,mxny,mxnz), vprog1(mxnx,mxny,mxnz), - & uprog2(mxnx,mxny,mxnz), vprog2(mxnx,mxny,mxnz), - & tprog1(mxnx,mxny,mxnz), vptprog1(mxnx,mxny,mxnz), - & tprog2(mxnx,mxny,mxnz), vptprog2(mxnx,mxny,mxnz), - & UDAT1(mxnxp,mxnyp,mxnz), VDAT1(mxnxp,mxnyp,mxnz), - & UDAT2(mxnxp,mxnyp,mxnz), VDAT2(mxnxp,mxnyp,mxnz), -c frr (09/01) additional variables for noobs case - & rhop(mxnxp,mxnyp),rho(mxnx,mxny), - & ccgrid(mxnx,mxny),iceilg(mxnx,mxny),qcprog(mxnx,mxny), - & ceil(mxnxp,mxnyp),qctot(mxnxp,mxnyp), - & rh(mxnxp,mxnyp,mxnzp),rhprog(mxnx,mxny), - & rain(mxnxp,mxnyp), -c frr (09/01) new variables for combined noobs and nonhourly - & rmm1(mxnx,mxny),rmm2(mxnx,mxny), - & rho1(mxnx,mxny),rho2(mxnx,mxny), - & irhprog1(mxnx,mxny),irhprog2(mxnx,mxny), - & iceilg1(mxnx,mxny),iceilg2(mxnx,mxny), - & qcprog1(mxnx,mxny),qcprog2(mxnx,mxny), -c frr 040225 - & zl1(mxnx,mxny,mxnzp+1),tz1(mxnx,mxny,mxnzp+1), -c frr (070717) - & zl2(mxnx,mxny,mxnzp+1),tz2(mxnx,mxny,mxnzp+1), -c frr 021105: RH at 850mb for cloud subroutine - & rh850pg1(mxnx,mxny),rh850pg2(mxnx,mxny), - & rh850pg(mxnx,mxny),rh850(mxnxp,mxnyp), -c frr 030106 - & pt20(mxnxp,mxnyp),pt30(mxnxp,mxnyp),pt(mxnzp),ip(mxnzp), - & indx(mxnxp,mxnyp),tsurf(mxnxp,mxnyp), -c frr 051113 - & sstp1(mxnxp,mxnyp),sstp2(mxnxp,mxnyp),rhp1(mxnxp,mxnyp), - & rhp2(mxnxp,mxnyp),tairp1(mxnxp,mxnyp),tairp2(mxnxp,mxnyp), - & z1p1(mxnxp,mxnyp),z1p2(mxnxp,mxnyp), -c frr 061231-070206 - & pp(mxnxp,mxnyp,mxnzp),ccp (mxnxp,mxnyp), - & ceil4(mxnxp,mxnyp),ccgrid1(mxnx,mxny),ccgrid2(mxnx,mxny) - -c --- v6.4.0, Level 121203 -c --- 3D.DAT cloud liquid water content (LWC) profile for current cell - real qcpzp(mxnzp), qcpz(mxnz) -c --- 3D.DAT interface heights (mAGL) for current cell - real zfacep(mxnzp+1) -c --- LWC profile for CALMET layers (stored on M3D grid) - real qcijpz(mxnxp,mxnyp,mxnz) -c --- Cloud LWC properties above CALMET top (stored on M3D grid) - real zupbotp(mxnxp,mxnyp), zuptopp(mxnxp,mxnyp) - real qcavgp(mxnxp,mxnyp) -c --- Cloud LWC properties stored on CALMET grid (current and future) - real qcup1(mxnx,mxny),qcup2(mxnx,mxny) - real zuptop1(mxnx,mxny),zuptop2(mxnx,mxny) - real zupbot1(mxnx,mxny),zupbot2(mxnx,mxny) - real qc3d1(mxnx,mxny,mxnz),qc3d2(mxnx,mxny,mxnz) -c --- Print debug - logical ldbaux - -c --- Explicit beginning-end times with seconds (080205) -c --- No sub-hourly frequency for 3D.DAT records at this point (060215) -c data isec1/0/,isec2/0/ - -c --- Make sure to keep it1,it2,isec1,isec2 in memory for next time step -c --- (050125-080325) - save it1,it2,isec1,isec2 - -c --- Initialise variables at first access to MM5 data records -c --- (flag initialized in rdhd5) - if (ifirstpg.eq.0) then - it1=0 - it2=0 - isec1=0 - isec2=0 - msec=0 - nlevag1=0 - - -c --- 051113 - Variables for M3DMET.MET - do 556 j = 1,mxnyp - do 556 i = 1,mxnxp - sstp1(i,j) = 0. - sstp2(i,j) = 0. - rhp1(i,j) = 0. - rhp2(i,j) = 0. - tairp1(i,j) = 0. - tairp2(i,j) = 0. - z1p1(i,j) = 0. - z1p2(i,j) = 0. -556 continue - - do 55 k = 1,mxnz - do 56 j = 1,mxnyp - do 56 i = 1,mxnxp - udat1(i,j,k) = 0. - vdat1(i,j,k) = 0. - udat2(i,j,k) = 0. - vdat2(i,j,k) = 0. -56 continue - do 57 j = 1,mxny - do 57 i = 1,mxnx - uprog1(i,j,k) = 0. - vprog1(i,j,k) = 0. - tprog1(i,j,k) = 0. - vptprog1(i,j,k) = 0. - uprog2(i,j,k) = 0. - vprog2(i,j,k) = 0. - tprog2(i,j,k) = 0. - vptprog2(i,j,k) = 0. - -57 continue -55 continue - - - do 58 j = 1,mxny - do 58 i = 1,mxnx - qcprog1(i,j)=0. - iceilg1(i,j)=0 - irhprog1(i,j)=0 - rho1(i,j) = 0. - rmm1(i,j) = 0. - rh850pg1(i,j)=0. - ccgrid1(i,j)=0. - qcprog2(i,j)=0. - iceilg2(i,j)=0 - irhprog2(i,j)=0 - rho2(i,j) = 0. - rmm2(i,j) = 0. - rh850pg2(i,j)=0. - ccgrid2(i,j)=0. -58 continue - - do 59 k = 1,mxnzp+1 - do 59 j = 1,mxny - do 59 i = 1,mxnx - tz1(i,j,k)=0. - zl1(i,j,k)=0. - tz2(i,j,k)=0. - zl2(i,j,k)=0. -59 continue - -c --- v6.4.0, Level 121203 - do k=1,mxnz - do j=1,mxny - do i=1,mxnx - qc3d1(i,j,k)=0. - qc3d2(i,j,k)=0. - enddo - enddo - enddo - do j=1,mxny - do i=1,mxnx - qcup1(i,j)=0. - zuptop1(i,j)=0. - zupbot1(i,j)=0. - qcup2(i,j)=0. - zuptop2(i,j)=0. - zupbot2(i,j)=0. - enddo - enddo - - endif - -c -c last hour temperature profile for use in MIXDT2 (Mix.H. growth)(070717) - nlevag0= nlevag1 - do 1221 i = 1,nx - do 1221 j = 1,ny - do 1222 k = 1,mxnzp+1 - tz0(i,j,k) = tz1(i,j,k) - zl0(i,j,k) = zl1(i,j,k) -1222 continue -1221 continue - -c --- Check if last step in calmet run - -c --- (But only if run length > 1 hour (JSS, 4/2003)) -c --- If so, do no read next mm5 record - - if ( nendhr.eq.1 .and. ifirstpg.ne.0) then -c --- skip reading - goto 555 - endif - - -c --- Read new data every isteppg hours. -c --- In between, linearly interpolate in time - - - call deltsec(it1,isec1,ndathre,nsece,ndelta1) - call deltsec(ndathre,nsece,it2,isec2,ndelta2) - - if(ndelta1.ge.0 .and. ndelta2.gt.0 ) then - -c --- linearly interpolate in time - do not read any new mm5 data - goto 555 - - else - -c --- Read new data - -c --- Initialize constants - deg2rad=0.0174533 - -C -c --- Initialize data that may not be read from CALMM5 - irh=0 - q=0. -c --- Additionally (090511) - qc=0. - qr=0. - -c --- Number of vertical levels - nlev = nzp - -c --- Loop over each grid cell in extraction subdomain -1 continue - do 5 j=1,nyp - do 5 i=1,nxp - - - i850=0 - -c --- initialize integrated cloud water content and ceiling height - qctot(i,j) = 0 - ceil(i,j) = 0 - ceil4(i,j) = 0 - -c --- Read date record of data portion (with seconds if any -080205) - if(imm53d.eq.0) then - read(io20,60,end=999) myr,mmo,mday,mhr,ix,jx - & ,pmsl,rain(i,j),isnow -c frr (09/01)- rain array -60 format(4i2,2i3,f7.1,f5.2,i2) - else if (imm53d.eq.1) then - read(io20,61,end=999) myr,mmo,mday,mhr,ix,jx - & ,pmsl,rain(i,j),isnow,rads,radl -61 format(i4,3i2,2i3,f7.1,f5.2,i2,2f8.1) - else if (imm53d.eq.2) then -c --- Read extended list of surface variables (051113) -c --- (3D.DAT version 2.0 and above) - read(io20,62,end=999) myr,mmo,mday,mhr,ix,jx, - & pmsl,rain(i,j),isnow,rads,radl,t2,qq2,wd10,ws10,sstp2(i,j) -62 format(i4,3i2,2i3,f7.1,f5.2,i2,3f8.1,f8.2,3f8.1) - else if (imm53d.eq.3) then -c --- Read extended list of surface variables with explicit -c --- beginning/end times with seconds -c --- (3D.DAT version 3.0 and above(080205) - read(io20,63,end=999) myrb,mmob,mdayb,mhrb,msecb, - & myr,mmo,mday,mhr,msec,ix,jx, - & pmsl,rain(i,j),isnow,rads,radl,t2,qq2,wd10,ws10,sstp2(i,j) -c --- So far only accept instantaneous records (080205) - call julday(io6,myrb,mmob,mdayb,nbjul) - call julday(io6,myr,mmo,mday,nejul) - nbdathr=myrb*100000+nbjul*100+mhrb - nedathr=myr *100000+nejul*100+mhr - call deltsec(nbdathr,msecb,nedathr,msec,idt) - if(idt.ne.0) then - write(6,*)'STOP in RDMM5 - See list file' - write(io6,*)'STOP in RDMM5' - write(io6,*)'Prognostic records must be instantaneous' - write(io6,*)'Beginning GMT time:',nbdathr,'- ',msecb - write(io6,*)'End GMT time:',nedathr,'- ',msec - stop - endif -63 format(i4,3i2,i4,i5,3i2,i4,i4,i3,f7.1,f5.2,i2, - : 3f8.1,f8.2,3f8.1) - endif -c -c --- Check if surface temperature data (sstp) are in 3D.DAT -c when itwprog=2 (051113) -c --- Missing SST are flagged by CALRUC with 0. for RUC data, -c and by CALETA with -999 for ETA model, while missing -c --- data are often flagged with 999 or 9999. -c --- SST are in kelvins in MM5 => check if 150< sst< 350 - - if ( (itwprog.eq.2).and. - : ((sstp2(i,j).lt.150).or.(sstp2(i,j).gt.350)) )then - write(6,*)'STOP in RDMM5 - Check list file' - write(io6,*)'STOP in RDMM5' - write(io6,*)'ITWPROG =2 requires SST in 3D.DAT file ' - write(io6,*)'But there is no valid surface temp. in 3D.DAT' - write(io6,*)'STOP' - stop - endif - -c --- Check that MM5/3D.DAT grid point I,J read match expected values - ixexpect=i+i1-1 - jxexpect=j+j1-1 - if(ix.ne.ixexpect.or.jx.ne.jxexpect)then - write(io6,960)myr,mmo,mday,mhr,ix,jx,ixexpect,jxexpect -960 format(1x,'Error in Subr. RDMM5 -- Error in MM5.DAT/', - 1 '3D.DAT file'/ - 2 1x,'MM5/3D grid point I,J do not match expected values'/ - 3 1x,'MM5/3D date/time: Yr: ',i4,1x,'Mo: ',i2,1x,'Day: ',i2, - 4 1x,'Hr: ',i2,' (GMT)'/ - 5 1x,' MM5/3D I,J: ',2i4/ - 6 1x,'Expected I,J: ',2i4) -c - print *,'Error in Subr. RDMM5 -- Error in MM5/3D.DAT file' - print *,'MM5/3D grid point I,J do not match expected ', - 1 'values' - stop - endif -c --- convert rain in cm accumulated over the hour into mm/hr - rain(i,j)=rain(i,j)*10. - - call YR4(io6,myr,ierr) - if(ierr.NE.0) stop 'Halted in RDMM5' -c --- Convert date/time from GMT to LST - call julday(io6,myr,mmo,mday,mjul) - idtz = 0 - ibtz - call indecr(io6,myr,mjul,mhr,idtz,0,23) -c -c --- Check if no gap in MM5 records -c MM5 Time (LST) - mdathr=myr*100000+mjul*100+mhr - -c Compute current time+ MM5 timestep in yyyyjulhr format -c Use explicit ending time (60202) - nsyr=nyrb - nsjul=njulb - nshr=nhrb - nssec=nsece - call incrs(io6,nsyr,nsjul,nshr,nssec,isteppgs) - nsdathr=nsyr*100000+nsjul*100+nshr -c --- MM5 times with seconds (080205) -c call deltsec(nsdathr,nssec,mdathr,0,ndeltas) - call deltsec(nsdathr,nssec,mdathr,msec,ndeltas) - -c if (mdathr .gt. nsdathr ) then - if (ndeltas.gt.0) then - write(io6,*) - write(io6,*) ' ERROR - in Subroutine RDMM5 - STOP' - write(io6,*) ' Gap in MM5 record' - write(io6,*) ' Current ending LST TIME (yyyyjulhr-sec): ', - : ndathre,' - ',nsece - write(io6,*) ' Current LST MM5 TIME (yyyyjulhr - sec): ', - : it2,' - ',isec2 - write(io6,*) ' Next LST MM5 TIME (yyyyjulhr - sec): ', - : mdathr,' - ',msec - write(io6,*) ' MM5 Timestep:', isteppgs - stop 'STOP in RDMM5 - GAP in records- Check list file' - endif -c - -c --- initialize surface density (070327 -BAB) - rhop(i,j)=0. - irho=0 - -c --- Check whether need to skip a record - iskip = 0 - -c --- Always read in the next MM5 record, except for first valid record -c --- Check include seconds (060215)- With non z -c --- Sub-hourly timesteps- Explicit times (051128) with seconds(080205) -c call deltsec(mdathr,0,ndathre,nsece,ndeltskip) - call deltsec(mdathr,msec,ndathre,nsece,ndeltskip) - - if (ndeltskip.ge.isteppgs) iskip=1 - -c --- Always have current and future timesteps in memory,even at the -c --- start (otherwise can trigger keeping past and current during -c --- the whole simulation (not good for previous hour soundings and Stull) -c if (ndeltskip.eq.isteppgs .and.ifirstpg.le.1) iskip=0 (070717) -c if (ndeltskip.eq.isteppgs .and.ifirstpg.lt.1) iskip=0 (071207) - -c --- Make sure that if reading next M3D file, the future timestep -c --- is read in and not the current timestep. This could happen -c --- when successive M3D files were overlapping and caused dtinc=1 -c --- throughout the rest of the simulation and dtinc=2 at the end (080709) - if(ndeltskip.eq.0.and.nfm3d.gt.1) then - iskip=1 - if(i.eq.1.and.j.eq.1)then - write(io6,*)'WARNING: M3D files overlap in time' - write(io6,*)'CALMET used duplicate times from the earlier file' - write(io6,*)'and skipped those same times in the later file' - endif - endif - -c --- Read data levels - if(iskip.EQ.0) then - -c frr (09/01) -c --- fill in previous time step for time interpolation - do 6 k=1,nz - udat1(i,j,k) = udat2(i,j,k) - vdat1(i,j,k) = vdat2(i,j,k) -6 continue - -c --- M3DMEt.MEt variables (051113) - sstp1(i,j) = sstp2(i,j) - tairp1(i,j) = tairp2(i,j) - rhp1(i,j)=rhp2(i,j) - z1p1(i,j)=z1p2(i,j) - - index=1 - indpx=1 - -c --- Want to use these data levels - do 35 n=1,nlev -c --- read in CALMM5 fields (depends on parameter ioutmm5) - if (ioutmm5.eq.81) then - read(io20,81) ipress,iz,t(n),iwd,ws(n) -81 format (i4,i6,f6.1,i4,f5.1) - else if (ioutmm5.eq.82) then - read(io20,82) ipress,iz,t(n),iwd,ws(n), - : irh,q -82 format (i4,i6,f6.1,i4,f5.1,i3,f5.2) - else if (ioutmm5.eq.83) then -c --- v6.4.0, Level 121203 - if(TRIM(cver3d).EQ.'2.1' .OR. - & TRIM(cver3d).EQ.'2.11' .OR. - & TRIM(cver3d).EQ.'2.12' .OR. - & TRIM(cver3d).EQ.'2.13' .OR. - & TRIM(cver3d).EQ.'3.1' ) then - read(io20,830) ipress,iz,t(n),iwd,ws(n), - : irh,q,qc,qr - elseif(TRIM(cver3d).EQ.'2.0' .OR. - & TRIM(cver3d).EQ.'3.0') then - read(io20,83) ipress,iz,t(n),iwd,ws(n), - : irh,q,qc,qr - else -c --- Unknown dataset version - write(io6,*)'RDMM5: Unknown 3D.DAT dataset: ',cver3d - stop 'HALTED in RDMM5 --- see list file' - endif - -830 format (i4,i6,f6.1,i4,f5.1,i3,f5.2,2(f6.3)) -83 format (i4,i6,f6.1,i4,f5.1,i3,3(f5.2)) - else if (ioutmm5.eq.84) then -c --- v6.4.0, Level 121203 - if(TRIM(cver3d).EQ.'2.1' .OR. - & TRIM(cver3d).EQ.'2.11' .OR. - & TRIM(cver3d).EQ.'2.12' .OR. - & TRIM(cver3d).EQ.'2.13' .OR. - & TRIM(cver3d).EQ.'3.1' ) then - read(io20,840) ipress,iz,t(n),iwd,ws(n), - : irh,q,qc,qr,qi,qs - elseif(TRIM(cver3d).EQ.'2.0' .OR. - & TRIM(cver3d).EQ.'3.0') then - read(io20,84) ipress,iz,t(n),iwd,ws(n), - : irh,q,qc,qr,qi,qs - else -c --- Unknown dataset version - write(io6,*)'RDMM5: Unknown 3D.DAT dataset: ',cver3d - stop 'HALTED in RDMM5 --- see list file' - endif -840 format (i4,i6,f6.1,i4,f5.1,i3,f5.2,4(f6.3)) -84 format (i4,i6,f6.1,i4,f5.1,i3,5(f5.2)) - else if (ioutmm5.eq.85) then -c --- v6.4.0, Level 121203 - if(TRIM(cver3d).EQ.'2.1' .OR. - & TRIM(cver3d).EQ.'2.11' .OR. - & TRIM(cver3d).EQ.'2.12' .OR. - & TRIM(cver3d).EQ.'2.13' .OR. - & TRIM(cver3d).EQ.'3.1' ) then - read(io20,850) ipress,iz,t(n),iwd,ws(n), - : irh,q,qc,qr,qi,qs,qg - elseif(TRIM(cver3d).EQ.'2.0' .OR. - & TRIM(cver3d).EQ.'3.0') then - read(io20,85) ipress,iz,t(n),iwd,ws(n), - : irh,q,qc,qr,qi,qs,qg - else -c --- Unknown dataset version - write(io6,*)'RDMM5: Unknown 3D.DAT dataset: ',cver3d - stop 'HALTED in RDMM5 --- see list file' - endif -850 format (i4,i6,f6.1,i4,f5.1,i3,f5.2,5(f6.3)) -85 format (i4,i6,f6.1,i4,f5.1,i3,6(f5.2)) - else if (ioutmm5.eq.91) then - read(io20,91) ipress,iz,t(n),iwd,ws(n),w -91 format (i4,i6,f6.1,i4,f5.1,f6.2) - else if (ioutmm5.eq.92) then - read(io20,92) ipress,iz,t(n),iwd,ws(n),w, - : irh,q -92 format (i4,i6,f6.1,i4,f5.1,f6.2,i3,f5.2) -c Compressed output - else if (ioutmm5.ge.93) then - read(io20,'(a)')buff -c Read common parts and compression flag -c --- v6.4.0, Level 121203 - if(TRIM(cver3d).EQ.'2.1' .OR. - & TRIM(cver3d).EQ.'2.11' .OR. - & TRIM(cver3d).EQ.'2.12' .OR. - & TRIM(cver3d).EQ.'2.13' .OR. - & TRIM(cver3d).EQ.'3.1' ) then - read(buff,930) ipress,iz,t(n),iwd,ws(n),w, - : irh,q,fcomp - elseif(TRIM(cver3d).EQ.'2.0' .OR. - & TRIM(cver3d).EQ.'3.0') then - read(buff,93) ipress,iz,t(n),iwd,ws(n),w, - : irh,q,fcomp - else -c --- Unknown dataset version - write(io6,*)'RDMM5: Unknown 3D.DAT dataset: ',cver3d - stop 'HALTED in RDMM5 --- see list file' - endif -93 format (i4,i6,f6.1,i4,f5.1,f6.2,i3,3(f5.2)) -930 format (i4,i6,f6.1,i4,f5.1,f6.2,i3,f5.2,2(f6.3)) - -c Un-compression from - if(fcomp.gt.-0.0001) then - if(ioutmm5.eq.93) then -c --- v6.4.0, Level 121203 - if(TRIM(cver3d).EQ.'2.1' .OR. - & TRIM(cver3d).EQ.'2.11' .OR. - & TRIM(cver3d).EQ.'2.12' .OR. - & TRIM(cver3d).EQ.'2.13' .OR. - & TRIM(cver3d).EQ.'3.1' ) then - read(buff,930)ipress,iz,t(n),iwd,ws(n),w, - : irh,q,qc,qr - elseif(TRIM(cver3d).EQ.'2.0' .OR. - & TRIM(cver3d).EQ.'3.0') then - read(buff,93)ipress,iz,t(n),iwd,ws(n),w, - : irh,q,qc,qr - else -c --- Unknown dataset version - write(io6,*)'RDMM5: Unknown 3D.DAT dataset: ', - & cver3d - stop 'HALTED in RDMM5 --- see list file' - endif - else if (ioutmm5.eq.94) then -c --- v6.4.0, Level 121203 - if(TRIM(cver3d).EQ.'2.1' .OR. - & TRIM(cver3d).EQ.'2.11' .OR. - & TRIM(cver3d).EQ.'2.12' .OR. - & TRIM(cver3d).EQ.'2.13' .OR. - & TRIM(cver3d).EQ.'3.1' ) then - read(buff,940)ipress,iz,t(n),iwd,ws(n),w, - : irh,q,qc,qr,qi,qs - elseif(TRIM(cver3d).EQ.'2.0' .OR. - & TRIM(cver3d).EQ.'3.0') then - read(buff,94)ipress,iz,t(n),iwd,ws(n),w, - : irh,q,qc,qr,qi,qs - else -c --- Unknown dataset version - write(io6,*)'RDMM5: Unknown 3D.DAT dataset: ', - & cver3d - stop 'HALTED in RDMM5 --- see list file' - endif -940 format (i4,i6,f6.1,i4,f5.1,f6.2,i3,f5.2,4(f6.3)) -94 format (i4,i6,f6.1,i4,f5.1,f6.2,i3,5(f5.2)) - else if (ioutmm5.eq.95) then -c --- v6.4.0, Level 121203 - if(TRIM(cver3d).EQ.'2.1' .OR. - & TRIM(cver3d).EQ.'2.11' .OR. - & TRIM(cver3d).EQ.'2.12' .OR. - & TRIM(cver3d).EQ.'2.13' .OR. - & TRIM(cver3d).EQ.'3.1' ) then -c --- new moisture format (6.3 instead of 5.2)(050504) - read(buff,950) ipress,iz,t(n),iwd,ws(n),w, - : irh,q,qc,qr,qi,qs,qg - elseif(TRIM(cver3d).EQ.'2.0' .OR. - & TRIM(cver3d).EQ.'3.0') then - read(buff,95) ipress,iz,t(n),iwd,ws(n),w, - : irh,q,qc,qr,qi,qs,qg - else -c --- Unknown dataset version - write(io6,*)'RDMM5: Unknown 3D.DAT dataset: ', - & cver3d - stop 'HALTED in RDMM5 --- see list file' - endif -95 format (i4,i6,f6.1,i4,f5.1,f6.2,i3,6(f5.2)) -950 format (i4,i6,f6.1,i4,f5.1,f6.2,i3,f5.2,5(f6.3)) - endif -c Compressed form - else - if(ioutmm5.eq.93) then - qc=0. - qr=0. - else if (ioutmm5.eq.94) then - qc=0. - qr=0. - qi=0. - qs=0. - else if (ioutmm5.eq.95) then - qc=0. - qr=0. - qi=0. - qs=0. - qq=0. - endif - endif - - endif - - -c --- Convert to real variables: - wd(n)=iwd - -c --- Convert mixing ratio from g/kg to g/g - q=q/1000. - -c --- Calculate potential temperature -c pt1 = t(n) * ((1000./ipress) ** 0.286) -c frr 030106 - pt(n) = t(n) * ((1000./ipress) ** 0.286) - ip(n) = ipress - -c --- compute specific humidity - qw = q / (1 + q) - -c --- compute virtual potential temperature - vpt1(n) = pt(n) * (1. + 0.61 * qw) - -c --- Adjust heights from msl to ht above local ground - z(n) = iz - ielev4(i,j) - - -c --- find cloud ceiling (in meters) - if ( ceil(i,j).eq.0. .and. qc.gt.1.e-09 ) - : ceil(i,j)=z(n) - - -c frr (09 /01) -c --- integrate cloud water content over vertical (in g/kg) - qctot (i,j)= qctot(i,j) + qc - - -c --- v6.4.0, Level 121203 -c --- Store cloud LWC profile - qcpzp(n)=qc - - -c --- Compute air density at lowest level above ground -c --- constant 0.3484321 = 100 kg / (m * sec**2) per mb divided by -c --- (287 m**2 / (deg K * sec**2)) -c -c frr 030106 make sure to use lowest level above ground (not necessarily -c the case if M3D data (e.g. from synoptic model not MM5) -c --- Take surface density (not necessarily the highest - 070327) - if ( z(n).ge.0. .and. irho.eq.0) then - rhop(i,j)= 0.3484321*ipress/t(n) - irho=1 - endif - -c frr (09/01) -c --- 3D array of relative humidity - rh(i,j,n)= float(irh) -c --- 3D array of pressure - pp(i,j,n)=float(ipress) - -c frr (021105) -c find RH at (near) 850mb level for Cloud subroutine - if (ipress.lt.850 .and. i850.eq.0) then - if (n.ne.1) then - k850=n-1 - else - k850=1 - endif - i850=1 - rh850(i,j)=rh(i,j,k850) - endif - -c --- Fill in arrays needed for prognostic offshore delta Method -c --- Values at first level above ground - if(z(n).lt.0) indpx=n+1 - if (n.eq.indpx) then - z1p2(i,j)=z(n) - tairp2(i,j)=t(n) - rhp2(i,j)=rh(i,j,n) - endif - - -35 continue - -c --- v6.4.0, Level 121203 - ldbaux=.false. - if(qctot(i,j).GT.0.0) then -c --- Set face heights for this profile - call Z2FACE(io6,ldbaux,nlev,z,zfacep) -c --- Process cloud water profile to CALMET layers - if(ldbaux) then - write(io6,*)'PRFVAR cell i3D,j3D = ',i,j - write(io6,*)'M3D Time in LST = ',mdathr - endif - call PRFVAR(io6,ldbaux,nlev,nz,qcpzp,zfacep,zface, - & threshqc,qcpz,zupbotp(i,j), - & zuptopp(i,j),qcavgp(i,j)) -c --- Place vertical profile into 3D array - do kk=1,mxnz - qcijpz(i,j,kk)=qcpz(kk) - enddo - else - zupbotp(i,j)=0.0 - zuptopp(i,j)=0.0 - qcavgp(i,j)=0.0 - do kk=1,mxnz - qcijpz(i,j,kk)=0.0 - enddo - endif - -c -c --- Sort arrays by ascending height (useless with CALMM5) -c --- Note: qcksrt3 takes 7 variables since 061231 b -c *** call qcksrt3(nlev,z,wd,ws,t,vpt1) - -c --- Convert wd,ws to u,v components and store in grid arrays -c --- Store temperature in grid array - nlevag=0 - do 45 k=1,nlev - nlevag = nlevag + 1 - -c --- v6.4.0, Level 121203 - if(LLCC .OR. LPS) then - -c --- Convert wd from true north (south) to Lambert Conformal -c --- map north (south) -c --- MM4 west longitudes are negative but RLON0 is positive - dlong = rlon0 + xlong4(i,j) -c --- Cod e to handle 180 degree longitude straddle - if (dlong .gt. 180.) dlong = dlong - 360. - if (dlong .lt. -180.) dlong = dlong + 360. - if (xlat1 .lt. 0.) then -c --- Sou thern Hemisphere - wdmap = wd(k) + (conec*dlong) - else -c --- Nor thern Hemisphere - wdmap = wd(k) - (conec*dlong) - end if - if(wdmap.LT.0.) wdmap = wdmap + 360. - if(wdmap.GT.360.) wdmap = wdmap - 360. - wd(k) = wdmap - endif -c --- Convert ws from knots to m/s - remove JSS 12/98 -c ******* **** ws(k) = ws(k) * 0.51444 - wdrad = deg2rad*wd(k) - up(i,j,nlevag) = -ws(k) * sin(wdrad) - vp(i,j,nlevag) = -ws(k) * cos(wdrad) - tp(i,j,nlevag) = t(k) - vptp(i,j,nlevag) =vpt1(k) - zp(i,j,nlevag) = z(k) - - - -c frr 030106 : sometimes more than 1 levels below ground (e.g. with synoptic -c models such as ETA in M3D format ) -c --- INDEX is the height of the lowest "MM5" level above ground - if(zp(i,j,k).lt.0.0) index=k+1 - -45 continue - -c --- keep track of previous step number of vertical layers -c --- frr 040225 (for previous hour temperature profile) - nlevag0 = nlevag1 - - nlevag1=nlevag+1 - -c --- SOLAR ANGLE: -c --- Explicit MM5 time is interpreted as hour-ending time. Therefore -c --- use sinalp at (mhr-1/2) i.e. sinalp(i,j,mhr+1) (in MOD6 sinalp has -c --- 26 values ranging from 23:30 previous day to 0:30 on next day ) -c --- (i,j, loop is on MM5 grid, not on CALMET grid where sinalp -c --- is defined) - Sina computation moved outside of k loop -c -c --- NOTE (F.Robe 060215) -c --- Around 11PM-midnight CALMET time, MM5 record #2 is on the next day therefore -c --- strictly speaking, one should use sinalp (hour) on the next day (which is not yet computed) -c --- However from one day to the next, sinalp(hour) does not change much. Besides, -c --- this occurs in the middle of the night anyway and not close to sunrise, so it won't affect -c --- sunrise time in most cases. Although that might not be quite true for large isteppg, -c --- or at very high lat during the summer - sina=sinalp(inearg(i,j),jnearg(i,j),mhr+1) - -c frr 030106 -c initialize pot.temp history for temp extrapolation - if (ifirstpg.le.1 )then -c --- Make sure not to pass duplicate levels to subroutine (050113-frr) - if (z(index).ne.z(index+1))then - index1=index+1 - else - index1=index+2 - endif - call stull0(pt(index),z(index),pt(index1),z(index1), - : pt20(i,j),pt30(i,j)) - - endif - -C --- INTERPOLATE PROGNOSTIC SOUNDINGS VERTICALLY TO DIAGNOSTIC -C --- MODEL LEVELS - DO 75 K = 1,NZ -c -c --- Persist data below bottom level -c frr 010306 : use lowest MM5 level above ground -c IF(CELLZC(K).LT.zp(i,j,1))then - IF(CELLZC(K).LT.zp(i,j,index))then -c frr (09/01) U,V at future time -c UDAT(I,J,K)=UP(I,J,1) -c VDAT(I,J,K)=VP(I,J,1) -c UDAT2(I,J,K)=UP(I,J,1) -c VDAT2(I,J,K)=VP(I,J,1) -c TMM4(I,J,K)=TP(I,J,1) -c VPTDAT(I,J,K)=VPTP(I,J,1) - UDAT2(I,J,K)=UP(I,J,index) - VDAT2(I,J,K)=VP(I,J,index) - TMM4(I,J,K)=TP(I,J,index) - VPTDAT(I,J,K)=VPTP(I,J,index) -c -c --- Persist data above top MM4 level - else if(CELLZC(K).GE.zp(i,j,nlevag))then -c frr (09/01) U,V at future time -c UDAT(I,J,K)=UP(I,J,nlevag) -c VDAT(I,J,K)=VP(I,J,nlevag) - UDAT2(I,J,K)=UP(I,J,nlevag) - VDAT2(I,J,K)=VP(I,J,nlevag) - TMM4(I,J,K)=TP(I,J,nlevag) - VPTDAT(I,J,K)=VPTP(I,J,nlevag) -c -c --- Interpolate to CALMET level from surrounding MM5 levels - else -c frr 030106 :only use above ground MM5 levels -c DO KP = 2,nlevag - DO KP = index+1,nlevag - KPM1 = KP - 1 - IF(zp(i,j,KPM1).LE.CELLZC(K).AND. - 1 zp(i,j,KP).GT.CELLZC(K))THEN - ratio1=(CELLZC(K)-zp(i,j,KPM1))/ - 1 (zp(i,j,KP)-zp(i,j,KPM1)) -c frr (09/01) -c UDAT(I,J,K)=UP(I,J,KPM1)+(UP(I,J,KP)-UP(I,J,KPM1)) -c 1 *ratio1 -c VDAT(I,J,K)=VP(I,J,KPM1)+(VP(I,J,KP)-VP(I,J,KPM1)) -c 1 *ratio1 - UDAT2(I,J,K)=UP(I,J,KPM1)+(UP(I,J,KP)-UP(I,J,KPM1)) - 1 *ratio1 - VDAT2(I,J,K)=VP(I,J,KPM1)+(VP(I,J,KP)-VP(I,J,KPM1)) - 1 *ratio1 - TMM4(I,J,K)=TP(I,J,KPM1)+(TP(I,J,KP)-TP(I,J,KPM1)) - 1 *ratio1 - - VPTDAT(I,J,K)=VPTP(I,J,KPM1)+(VPTP(I,J,KP)- - 1 VPTP(I,J,KPM1))*ratio1 - go to 77 - endif - enddo -77 continue - endif -c -c --- Replace winds below first MM5 half-sigma level with -c --- extrapolated logarithmic profile winds. Ignore MM5 surface -c --- (Z=0) winds, -c -c --- Use a logarithmic profile to extrapolate winds down toward -c --- the surface - if(cellzc(k).lt.zp(i,j,index))then -c --- Assume a typical roughness length for extrapolation -c --- purposes - zoave=0.5 - xlnzo=alog(zoave) -c --- ZP(i,j,index) is the lowest true MM5 half-sigma level - xlnz2=alog(zp(i,j,index)) -c --- CELLZC(k) is the CALMET grid point height - xlnz1=alog(cellzc(k)) -c --- Logarithmic profile scaling factor - ratio2=(xlnz1-xlnzo)/(xlnz2-xlnzo) -c frr (09/01) -c UDAT(I,J,K)=ratio2*UP(I,J,index) -c VDAT(I,J,K)=ratio2*VP(I,J,index) - UDAT2(I,J,K)=ratio2*UP(I,J,index) - VDAT2(I,J,K)=ratio2*VP(I,J,index) - endif -c frr 030106 -c Replace temperature below first MM5 half-sigma level with -c extrapolated temperature. -c During day: assume constant theta -c At night: follow Stull (1983, Tellus 35Am p 219-230) -c day/time determined by sinalp (passed on via gen.met) - - -c First record pot.temp before sunset for extrapolation at night -c record even if cellzc(k) not below lowest MM5 level at that -c time because this may change during the night (MM5 levels -c are usually not fixed in Z (but in sigma or p) -c 060318: update only (not for every k) - if (sina.gt.0.and.k.eq.1)then - pt20(i,j) = pt(index) - pt30(i,j) = pt(index+1) - endif - -c Extrapolate if CALMET level below lowest MM5 level - if(cellzc(k).lt.zp(i,j,index))then - if (sina .le. 0.) then -c --- nighttime -c --- Make sure not to pass duplicate levels to subroutine (050113-frr) - if (zp(i,j,index).ne.zp(i,j,index+1))then - index1=index+1 - else - index1=index+2 - endif - -c --- Differentiate between land and water (060322-FRR) - if (ilu4(i,j).eq.iluoc3d) then -c --- ocean - - if(itwprog.eq.2) then -c --- SSTP available: linearly interpolate -c --- between 1st level and SST - zx=cellzc(k)/zp(i,j,index) - ptmm4=sstp2(i,j)*(1.-zx) - : +pt(index) *zx - else -c --- SSTP not available - extrapolate 1st-2nd MM5 levels - zx=(cellzc(k)-zp(i,j,index))/ - : (zp(i,j,index1)-zp(i,j,index)) - ptmm4=pt(index) - : +zx*(pt(index1)-pt(index)) - endif - else -c --- land - surface cooling parameterized by Stull - call stull(zp(i,j,index) ,pt(index), - : pt20(i,j),zp(i,j,index1), - : pt(index1),pt30(i,j),cellzc(k) - : ,ptmm4) - endif - - -c compute temp from pot.temp. and pressure level -c pressure at CALMET level (assume p decreases exp with height) -c make sure no duplicate levels (050113) - if (zp(i,j,2).ne.zp(i,j,1)) then - denz= zp(i,j,2)-zp(i,j,1) - beta= log(ip(1)*1.0/ip(2))/denz - else - denz= zp(i,j,3)-zp(i,j,1) - beta= log(ip(1)*1.0/ip(3))/denz - endif - pc=exp( -beta* (cellzc(k)-zp(i,j,1))) - pc=ip(1)* pc - - tmm4(i,j,k)= ptmm4 * ((pc/1000.)** 0.286) - -c virt. pot. temp.~ pot temp - vptdat(i,j,k)=ptmm4 - - else -c daytime: assume constant Tetha virt. and "dry" adiabat -c except overwater if SSTP is available (060315-frr) - if (itwprog.eq.2.and.ilu4(i,j).eq.iluoc3d) then -c Interpolate Temp. between SST and lowest M3D level (080512) - zx=cellzc(k)/zp(i,j,index) - tmm4(i,j,k)=sstp2(i,j)*(1.-zx) - : +tp(i,j,index) *zx - - else - TMM4(I,J,K)= tp(i,j,index)+ - : 0.0098*(zp(i,j,index)-cellzc(k)) - endif - vptdat(i,j,k)=vptdat(i,j,index) - endif - endif - - -75 CONTINUE - - -c frr 030106 Extrapolate temperature to the surface (Z=0) - if (sina .le. 0.) then -c nighttime -c --- Make sure not to pass duplicate levels to subroutine (050113-frr) - if (zp(i,j,index).ne.zp(i,j,index+1))then - index1=index+1 - else - index1=index+2 - endif -c --- Differentiate between land and water (060322-FRR) - if (ilu4(i,j).eq.iluoc3d) then -c --- ocean - - if(itwprog.eq.2) then -c --- SSTP available: - ptsurf=sstp2(i,j) - else -c --- SSTP not available - extrapolate 1st-2nd levels - zx=-zp(i,j,index)/ - : (zp(i,j,index1)-zp(i,j,index)) - ptsurf=pt(index) - : +zx*(pt(index1)-pt(index)) - endif - else -c --- land - surface cooling parameterized by Stull - call stull(zp(i,j,index) ,pt(index),pt20(i,j), - : zp(i,j,index1),pt(index1), - : pt30(i,j),0.,ptsurf) - endif - -c compute temp from pot.temp. and pressure level -c pressure at CALMET level (assume p decreases exp with height) -c make sure no duplicate levels (050113) - if (zp(i,j,2).ne.zp(i,j,1)) then - denz= zp(i,j,2)-zp(i,j,1) - beta= log(ip(1)*1.0/ip(2))/denz - else - denz= zp(i,j,3)-zp(i,j,1) - beta= log(ip(1)*1.0/ip(3))/denz - endif - pc=exp( -beta* (0.-zp(i,j,1))) - pc=ip(1)* pc - - tsurf(i,j)= ptsurf * ((pc/1000.)** 0.286) - - else -c daytime: assume "dry" adiab (constant Tetha virt) -c frr 030709: bug vptdat(i,j,k)=vptdat(i,j,index) - Tsurf(I,J)= tp(i,j,index)+ - : 0.0098*zp(i,j,index) -c --- except overwater if sstp available: - if (itwprog.eq.2.and.ilu4(i,j).eq.iluoc3d) - : Tsurf(I,J)=sstp2(i,j) - endif - -c --- frr (030106) (only for valid records (not for skipping 070702) -c store first level above ground for each MM5 gridpoint - indx(i,j)=index - - - else - - do 65 n=1,nlev -c --- "Read" (skip) data - read(io20,*) idum,idum -65 continue - endif - - - -c end of loop on nxp,nyp -5 continue - - -c --- Move call to cloud 4 to after check on iskip (080709) - -c frr (09/01) -c --- update time stamps for linear interpolation -c --- Will also have to update seconds when sub-hourly progn.timestep -c --- isec1=isec2; isec2=msec but as of 060215: fixed isec1=isec2=0) - it1 = it2 - it2 = mdathr -c --- seconds (080205) - isec1=isec2 - isec2=msec - if (ifirstpg.eq.0) ifirstpg = 1 - -c --- Do another iteration through the i,j loop if current time not yet reached - if (iskip .eq. 1) goto 1 - -c --- Compute cloud cover on MM5 grid if icloud=4 -c --- Method 4 (MM5toGrads): cloud cover from prognostic relative humidity -c --- at all levels -c --- Call to cloud4 moved after check on iskip to avoid calling when -c --- no new valid data has been read in (080709) -ccec101006 if (icloud.eq.4) call cloud4(nxp,nyp,nlev,rh,pp,zp,ccp,ceil4) - if (mcloud.eq.4) call cloud4(nxp,nyp,nlev,rh,pp,zp,ccp,ceil4) - -c - goto 997 -c -c --- ran out of data, at least in the current file -999 continue -c --- Multiple MM5.DAT: open next MM5.DAT file (if available) -c --- and resume loop (at point where overlapping hours can be skipped) -c --- 071207: keep searching for first valid record in subsequent files - if (nfm3d.lt.nm3d) then - nfm3d=nfm3d+1 - if (imm53d.eq.0) call rdhd51(nfm3d) - if (imm53d.eq.1) call rdhd52(nfm3d) - if (imm53d.eq.2.or.imm53d.eq.3) - : call rdhd53(nfm3d,itwprog,npsta) - goto 1 - else - if (iskip .eq. 1) then - write(io6,*) ' ran out of MM5 data before start!' - else - write(io6,*) 'ran out of MM5 data during run...' -c write(io6,*) 'On (yyyyjulhr): ',ndathr - write(io6,*) 'On (yyyyjulhr-sec): ',ndathre,'- ',nsece - endif - stop - end if - - - 997 continue -C -C INTERPOLATE PROGNOSTIC SOUNDINGS HORIZONTALLY TO DIAGNOSTIC MODEL -C GRID -C -c --- Convert diagnostic grid spacing from m to km - dxk = dx * 0.001 - dyk = dy * 0.001 -c -c --- Compute cell center x,y of diagnostic grid cell (1,1) -c *** xorigcc = utmxor + (0.5*dxk) -c *** yorigcc = utmyor + (0.5*dyk) -c --- Compute diagnostic grid coordinates in real space - xorigcc = xmap0 + (0.5 * dxk) - yorigcc = ymap0 + (0.5 * dyk) -c -c --- Loop over diagnostic grid - do 125 j = 1,ny -c --- Compute Y of cell center - y = yorigcc + (j - 1) * dyk - do 125 i = 1,nx -c --- Compute X of cell center - x = xorigcc + (i - 1) * dxk -c -c frr (09/01) -c --- Store previous time step for interpolation in time FRR (09/2001) - do 121 k = 1,nz - uprog1(i,j,k) = uprog2(i,j,k) - vprog1(i,j,k) = vprog2(i,j,k) - tprog1(i,j,k) = tprog2(i,j,k) - vptprog1(i,j,k) = vptprog2(i,j,k) - -c --- Interpolate horizontally from prognostic grid to diagnostic -c --- grid x,y using inverse distance squared at four nearest points. -c - call r2interp(i,j,x,y,udat2,k,uprog2(i,j,k)) - call r2interp(i,j,x,y,vdat2,k,vprog2(i,j,k)) - call r2interp(i,j,x,y,tmm4,k,tprog2(i,j,k)) - call r2interp(i,j,x,y,vptdat,k,vptprog2(i,j,k)) - 121 continue - -c frr (09/01) -c --- Get temperature vertical profile at closest MM5 gridpoint -c --- (to compute mixing heights in mixht2 - noobs mode) -c frr 030106 : only use above ground MM5 levels and extrapolate to surface - - index=indx(igrab(i,j,1),jgrab(i,j,1)) - - do 122 k = 2,nlevag1+1-index - tz1(i,j,k) = tz2(i,j,k) - zl1(i,j,k) = zl2(i,j,k) - tz2(i,j,k) = tp(igrab(i,j,1),jgrab(i,j,1),index+k-2) - zl2(i,j,k) = zp(igrab(i,j,1),jgrab(i,j,1),index+k-2) - 122 continue - -c persistence aloft - do 123 k=nlevag1+2-index,nlevag1 - tz1(i,j,k) = tz2(i,j,k) - zl1(i,j,k) = zl2(i,j,k) - tz2(i,j,k) = tz2(i,j,k-1) - zl2(i,j,k) = zl2(i,j,k-1)+1. - 123 continue - -c extrapolation at surface (if MM5 levels below surface, ensure all tz levels -c are just above surface - tz1(i,j,1) = tz2(i,j,1) - zl1(i,j,1) = 0. - zl2(i,j,1) = 0. - tz2(i,j,1)=tsurf(igrab(i,j,1),jgrab(i,j,1)) - -c frr (09/01) 2D array of surface density -c --- Surface air density on CALMET grid - rho1(i,j)=rho2(i,j) - call r2interp2(i,j,x,y,rhop,rho2(i,j)) - -c --- v6.4.0, Level 121203 -c --- Swap previous future LWC into current - qcup1(i,j)=qcup2(i,j) - zuptop1(i,j)=zuptop2(i,j) - zupbot1(i,j)=zupbot2(i,j) - do kz=1,nz - qc3d1(i,j,kz)=qc3d2(i,j,kz) - enddo -c --- Transfer cloud LWC from M3D grid to CALMET grid -c --- Method 1: Use nearest cell to preserve M3D cloud pattern - qcup2(i,j)=qcavgp(igrab(i,j,1),jgrab(i,j,1)) - zuptop2(i,j)=zuptopp(igrab(i,j,1),jgrab(i,j,1)) - zupbot2(i,j)=zupbotp(igrab(i,j,1),jgrab(i,j,1)) - do kz=1,nz - qc3d2(i,j,kz)=qcijpz(igrab(i,j,1),jgrab(i,j,1),kz) - enddo - -cc --- Method 2: Interpolate using 1/R2 (needs refinement!) -cc --- Use CINTERP where a zero should not be in average -c call CINTERP(i,j,x,y,qcavgp,qcup2(i,j)) -c call CINTERP(i,j,x,y,zuptopp,zuptop2(i,j)) -c call CINTERP(i,j,x,y,zupbotp,zupbot2(i,j)) -c do kz=1,nz -c call R2INTERP(i,j,x,y,qcijpz,kz,qc3d2(i,j,kz)) -c enddo - - if(ldbaux) then - if(qctot(igrab(i,j,1),jgrab(i,j,1)).GT.0.0) then - write(io6,*)'LWC transferred to CALMET grid' - write(io6,*)'i,j,i3D,j3D = ',i,j, - & igrab(i,j,1),jgrab(i,j,1) - write(io6,*)'LWC = ',(qc3d2(i,j,kz),kz=1,nz) - endif - endif - - -c frr (09/01) 2D array of surface relative humidity on CALMET grid - irhprog1(i,j) = irhprog2(i,j) - call r2interp(i,j,x,y,rh,1,rhprog(i,j)) - irhprog2(i,j) = int(rhprog(i,j)) - - -c frr (021105) 2D array of relative humidity at 850 mb on CALMET grid - rh850pg1(i,j) = rh850pg2(i,j) -c --- 070702: use r2interp2 for 2D array -c --- (and r2interp for a slice of a 3D array) -c call r2interp(i,j,x,y,rh850,1,rh850pg2(i,j)) - call r2interp2(i,j,x,y,rh850,rh850pg2(i,j)) - -c --- cloud cover (061231) - ccgrid1(i,j) = ccgrid2(i,j) -c --- 070702: use r2interp2 for 2D array -c --- (and r2interp for a slice of a 3D array) -c call r2interp(i,j,x,y,ccp,1,ccgrid2(i,j)) -ccec101006 if (icloud.eq.4) call r2interp2(i,j,x,y,ccp,ccgrid2(i,j)) - if (mcloud.eq.4) call r2interp2(i,j,x,y,ccp,ccgrid2(i,j)) - - - 125 continue - -c --- if qc data available, compute ceiling height and accumulated -c --- cloud water content -ccec101006 if (icloud.ge.3) then - if (mcloud.ge.3) then - if ( ( (ioutmm5.ge.83).and.(ioutmm5.le.85) ).OR. - & ( (ioutmm5.ge.93).and.(ioutmm5.le.95) ) ) then - do 127 j=1,ny -c --- Compute Y of cell center - y = yorigcc + (j - 1) * dyk - do 127 i=1,nx -c --- Compute X of cell center - x = xorigcc + (i - 1) * dxk -c --- interpolate ceiling height based on qc to calmet grid -c call cinterp(i,j,x,y,ceil,1,ceilprog) - call cinterp(i,j,x,y,ceil,ceilprog) -c --- convert ceiling height from meters to hundreds of feet - iceilg1(i,j)=iceilg2(i,j) - iceilg2(i,j)= int ( ceilprog/30.28 ) -c --- Vertically integrated cloud water - qcprog1(i,j)=qcprog2(i,j) -c --- bug (070702: use r2interp2 for 2D array -c call r2interp(i,j,x,y,qctot,1,qcprog2(i,j)) - call r2interp2(i,j,x,y,qctot,qcprog2(i,j)) -127 continue -ccec101006 else if (icloud.eq.4) then - else if (mcloud.eq.4) then - do 1277 j=1,ny - y = yorigcc + (j - 1) * dyk - do 1277 i=1,nx - x = xorigcc + (i - 1) * dxk - iceilg1(i,j)=iceilg2(i,j) -c --- interpolate ceiling height based on cloud cover level to calmet grid -c --- 070702: use cinterp for ceiling height (r2interp is not ok anyway -c for 2D arrays, should have used r2interp2 if not cinterp) -c call r2interp(i,j,x,y,ceil4,1,ceilprog) - call cinterp(i,j,x,y,ceil4,ceilprog) - iceilg2(i,j)=int(ceilprog/30.28 ) -1277 continue - endif - endif - -c frr (09/01) -c --- Interpolate precipitation rate onto CALMET grid -c Using an interpolation technique similar to that in GRIDE - if (npsta.eq.-1) then -c --- cec (03/02/14) -c --- add rmm1 = rmm2 to have rmm1.ne.0 when prognostic time step - do j=1,ny - do i=1,nx - rmm1(i,j)=rmm2(i,j) - enddo - enddo - call interpqr(rain,rmm2) - endif -c frr (09/01) -c --- QA check prognostic timestep - if (ifirstpg.eq.2) then -c -- Simplify: Use deltsec function (no special cases) -c --- With actual seconds (080205) -c call deltsec(it1,0,it2,0,istepmm5) - call deltsec(it1,isec1,it2,isec2,istepmm5) - if (istepmm5.ne.isteppgs) then - write(io6,9010)isteppg,it2,isec2,it1,isec1 -9010 format(//1x,'WARNING- Possible error ', - & /1x,'Check actual prognostic time step in MM5.DAT ', - & /1x,' User input is: ISTEPPG = ',i7, - & /1x,'it1=',i10,' and seconds: ',i5, - & /1x,'it2=',i10,' and seconds: ',i5) - - stop - endif - ifirstpg = 3 - endif - -c --- Read next record if start of run to allow interpolation in time - if (ifirstpg.eq.1) then - ifirstpg=2 - - do 128 k = 1,nz - do 126 j = 1,ny - do 126 i = 1,nx - uprog1(i,j,k) = uprog2(i,j,k) - vprog1(i,j,k) = vprog2(i,j,k) - tprog1(i,j,k) = tprog2(i,j,k) - vptprog1(i,j,k) = vptprog2(i,j,k) -126 continue - do 227 j = 1,nyp - do 227 i = 1,nxp - udat1(i,j,k) = udat2(i,j,k) - vdat1(i,j,k) = vdat2(i,j,k) -227 continue -128 continue - -c --- M3DMEt.MEt variables (051113) - do 2227 j = 1,nyp - do 2227 i = 1,nxp - sstp1(i,j) = sstp2(i,j) - tairp1(i,j) = tairp2(i,j) - rhp1(i,j)=rhp2(i,j) - z1p1(i,j)=z1p2(i,j) -2227 continue - - do 228 j = 1,ny - do 228 i = 1,nx - iceilg1(i,j)=iceilg2(i,j) - qcprog1(i,j)=qcprog2(i,j) - rmm1(i,j) = rmm2(i,j) - rho1(i,j) = rho2(i,j) - irhprog1(i,j)=irhprog2(i,j) - rh850pg1(i,j)=rh850pg2(i,j) - ccgrid1(i,j)=ccgrid2(i,j) -228 continue - -c --- v6.4.0, Level 121203 - do j=1,ny - do i=1,nx - qcup1(i,j)=qcup2(i,j) - zuptop1(i,j)=zuptop2(i,j) - zupbot1(i,j)=zupbot2(i,j) - do k=1,nz - qc3d1(i,j,k)=qc3d2(i,j,k) - enddo - enddo - enddo - -c set up temperature profile for use in MIXDT2 (Mix.H. growth) - nlevag0= nlevag1 - do 1321 i = 1,nx - do 1321 j = 1,ny - do 1322 k = 1,mxnzp+1 - tz0(i,j,k) = tz2(i,j,k) - zl0(i,j,k) = zl2(i,j,k) -1322 continue -1321 continue - - goto 1 - endif - - endif - -c frr (09/01) landing point if interpolating in time (no new read) -555 continue - -c --- Interpolate in time -c --- dtinc: 0.<=real<1 during run; dtinc possibly =1 in last step of run) -c --- Sub-hourly timesteps - use seconds (060215) - call deltsec(it1,isec1,ndathre,nsece,ndeltinc) - dtinc = (1.*ndeltinc)/isteppgs - - if (dtinc.lt.0.or.dtinc.gt.1.) then - write(6,*)'STOP in RDMM5- DTINC out of bounds' - write(io6,*)'STOP in RDMM5- DTINC out of bounds' - write(io6,*)'Current Time (YYYYJJJHH) (LST): ',ndathre - write(io6,*)'Current ending seconds (LST): ',nsece - write(io6,*)'Current M3D times in memory (LST): ',it1,it2 - write(io6,*)'Current M3D seconds in memory : ',isec1,isec2 - write(io6,*)'Value of dtinc: ',dtinc - STOP - endif - -c --- not need for following test anylonger with seconds - Always integer (060215) -c allow dtinc should be <= 1 but allow round-off errors=> 1.001 -c if (dtinc.gt.1.001) dtinc = 1.*(ndathr-100+24-it1)/isteppg - - do 115 j = 1,nyp - do 115 i = 1,nxp - do 1115 k = 1,nz - udat(i,j,k)= udat1(i,j,k)+dtinc*(udat2(i,j,k)-udat1(i,j,k)) - vdat(i,j,k)= vdat1(i,j,k)+dtinc*(vdat2(i,j,k)-vdat1(i,j,k)) - 1115 continue - -c --- M3DMET.MET variables (051113) - sstp(i,j) = sstp1(i,j)+dtinc*(sstp2(i,j)-sstp1(i,j)) - tairp(i,j)= tairp1(i,j)+dtinc*(tairp2(i,j)-tairp1(i,j)) - rhp(i,j)=rhp1(i,j)+dtinc*(rhp2(i,j)-rhp1(i,j)) - z1p(i,j)=z1p1(i,j)+dtinc*(z1p2(i,j)-z1p1(i,j)) - - 115 continue - -c --- v6.4.0, Level 121203 - do j=1,ny - do i=1,nx - qcup(i,j)=qcup1(i,j)+dtinc*(qcup2(i,j)-qcup1(i,j)) - zuptop(i,j)=zuptop1(i,j)+dtinc*(zuptop2(i,j)-zuptop1(i,j)) - zupbot(i,j)=zupbot1(i,j)+dtinc*(zupbot2(i,j)-zupbot1(i,j)) - do k=1,nz - qc3d(i,j,k)=qc3d1(i,j,k)+dtinc*(qc3d2(i,j,k)-qc3d1(i,j,k)) - enddo - enddo - enddo - - do 15 j = 1,ny - do 15 i = 1,nx - - do 215 k = 1,nz - uprog(i,j,k)= uprog1(i,j,k)+dtinc*(uprog2(i,j,k)-uprog1(i,j,k)) - vprog(i,j,k)= vprog1(i,j,k)+dtinc*(vprog2(i,j,k)-vprog1(i,j,k)) - tprog(i,j,k)= tprog1(i,j,k)+dtinc*(tprog2(i,j,k)-tprog1(i,j,k)) - vptprog(i,j,k)= vptprog1(i,j,k) - & +dtinc*(vptprog2(i,j,k)-vptprog1(i,j,k)) - -215 continue - rmm(i,j)= rmm1(i,j)+dtinc*(rmm2(i,j)-rmm1(i,j)) - rho(i,j)= rho1(i,j)+dtinc*(rho2(i,j)-rho1(i,j)) - irhpg(i,j)= irhprog1(i,j)+dtinc*(irhprog2(i,j)-irhprog1(i,j)) -c --- frr 021105 - rh850pg(i,j)= rh850pg1(i,j)+dtinc*(rh850pg2(i,j)-rh850pg1(i,j)) - -c --- frr 061231 - Cloud cover from all RH data (MM5toGrads) -ccec101006 if (icloud.eq.4)then - if (mcloud.eq.4)then - ccgrid(i,j)= ccgrid1(i,j)+dtinc*(ccgrid2(i,j)-ccgrid1(i,j)) - endif -15 continue -c -c frr (09/01) precip code - 030119: also frozen based on temperature - if (npsta.eq.-1) then - do 135 i=1,nx - do 135 j=1,ny - if (rmm(i,j).gt.0.)then - if (tprog(i,j,1).lt.273.15) then - ipcodepg(i,j)=20 - else - ipcodepg(i,j)=10 - endif - else - ipcodepg(i,j)=0 - endif -135 continue - endif - -c frr(09/01) -ccec101006 if (icloud.eq.3) then - if (mcloud.eq.3) then -c --- cloud cover from prognostic relative humidity at 850 MB - call cloud3(nx,ny,rh850pg,ccgrid) - endif - -ccec101006 if (icloud.ge.3) then - if (mcloud.ge.3) then -c --- if qc data available, compute ceiling height otherwise use default - - if ( ( (ioutmm5.ge.83).and.(ioutmm5.le.85) ).OR. - & ( (ioutmm5.ge.93).and.(ioutmm5.le.95) ) ) then - - do 137 j=1,ny - do 137 i=1,nx -c --- linearly interpolate ceiling height if non zero values at t1 and t2 -c --- otherwise pick the non zero value -c --- Test for t1 and t2 (080411) -c if ( iceilg1(i,j).ne.0 .and. iceilg1(i,j).ne.0 )then - if ( iceilg1(i,j).ne.0 .and. iceilg2(i,j).ne.0 )then - iceilg(i,j)= iceilg1(i,j)+dtinc*(iceilg2(i,j)-iceilg1(i,j)) - else - iceilg(i,j)= max(iceilg1(i,j),iceilg2(i,j)) - endif -c --- impose zero cloud cover and zero ceiling height if qc=0 - qcprog(i,j)= qcprog1(i,j)+dtinc*(qcprog2(i,j)-qcprog1(i,j)) - if ( qcprog(i,j).lt.1.e-6 ) then - ccgrid(i,j)= 0. - iceilg(i,j)=0 - endif -137 continue -c --- !!! Important: in RDMM5, the lowest actual cloud ceiling height -c --- is the lowest MM5 level height, not the ground (0) even for -c --- fog. If this ever changed, the logic of using 0 for clear sky -c --- should be reviewed (F. Robe - 080411) - - else - - do 138 j=1,ny - do 138 i=1,nx -ccec101006 if (icloud.eq.3)iceilg(i,j) = 80 - if (mcloud.eq.3)iceilg(i,j) = 80 -ccec101006 if (icloud.eq.4) then - if (mcloud.eq.4) then -c --- Test for t1 and t2 (080411) -c if ( iceilg1(i,j).ne.0 .and. iceilg1(i,j).ne.0 )then - if ( iceilg1(i,j).ne.0 .and. iceilg2(i,j).ne.0 )then - iceilg(i,j)= iceilg1(i,j)+dtinc*(iceilg2(i,j)-iceilg1(i,j)) - else - iceilg(i,j)= max(iceilg1(i,j),iceilg2(i,j)) - endif - endif - -138 continue - - endif - - endif - - return - end -c---------------------------------------------------------------------- - subroutine STULL (z2,t2,t20,z3,t3,t30,z1,t1) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 110324 STULL -c --- F.Robe, SRC -c -c --- PURPOSE: extrapolation of prog temperature down to surface CALMET -c level during the night, based on Stull (1983) -c Assumptions: initial profile is a dry adiabatic (cst Theta) -c Therefore, the fact that z2 and z3 change with time does not -c matter (theta2=~theta3, indpt of z2,z3 at sunset -c This assumption is also necessary to compute theta1 -c -c --- UPDATES: -c --- V5.545 Level 040612 to V5.633 Level 110324 (F.Robe) -c During a nightime warming (e.g. warm front) allow the same -c warming at lower CALMET levels as warming at the lowest 3D.DAT -c level. -c V5.544 Level 030106 to V5.545 Level 040612 -c Bound H to avoid exponential overflow -c -c -c --- INPUT: T2 - real - MM5 potential temperature at MM5 level Z2 -c -c Z2 - real - altitude above ground of lowest above ground MM5 -c level -c -c T20- real - T2 at t =0 , usually t=0 just before sunset (except -c during first night if run starts at night) -c -c T3 - real - MM5 potential temperature at MM5 level Z3 -c -c Z3 - real - altitude above ground of second lowest above -c ground MM5 level (Z3>Z2>Z1>0) -c -c T30- real - T2 at t =0 , usually t=0 just before sunset -c -c -c -c -c --- OUTPUT: T1 - real - extrapolated potentila temp. at CALMET level Z1 -c Z1 - real - altitude above ground of near surface calmet level -c - -c --------------------------------------------------------------------- - -c -c empirical constant in Stull exponential profile - alpha= 0.77 - -c temperature drop since sunset at Z2 and Z3 - dt2=t2-t20 - dt3=t3-t30 - - -c If lowest 2 MM5 gridpoints are below the inversion -c => retrieve curve parameters and extrapolate downward -c - -c Compute scale height (make sure H>0 and non singular) - - if ( (t3.gt.t2). and. - : (dt3.lt.0.) .and. (dt2.lt.0) .and. (dt2.lt.dt3)) then - - H=alpha*(z3-z2)/log(dt2/dt3) - -c if Z2 and Z3 straddle the inversion, make assumption on inversion height: -c assume H=z3/5 (empirical, based on inversion height~5H and z3~h) -c Make this assumption also if dt2 or dt3 not "well-behaved" - - else - H=z3/5. - endif - -c Bound H to avoid exponential overflow - H=max(H,z2/10.) - - - - -c surface temperature drop since sunset - dts=min(0.,dt2*exp(alpha*z2/H)) - -c Bound surface cooling (arbitrary but prevents pb when T2< t1=dt1+t10=dt1+t20 - t1= dt1+t20 - - -c Note: if no cooling at z2: no cooling at z1 either but usually -c cooling starts close to surface (pb especially if Z2 is >> ) -c in that case, no way of knowing what happens at the surface... - - return - - end -c --------------------------------------------------------------------- - subroutine STULL0 (t2,z2,t3,z3,t20,t30) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 030106 STULL0 -c --- F.Robe, SRC -c -c --- PURPOSE: Initialize Stull's temperature profile at night -c based on Stull (1983) -c Useful as CALMET runs must start between 0-5AM (i.e. after sunset) -c -c --- INPUT: T2 - real - MM5 potential temperature at MM5 level Z2 -c -c Z2 - real - altitude above ground of lowest above ground MM5 -c level -c -c -c T3 - real - MM5 potential temperature at MM5 level Z3 -c -c Z3 - real - altitude above ground of second lowest above -c ground MM5 level (Z3>Z2>Z1>0) -c -c -c -c -c --- OUTPUT: T20 - real - T2 at sunset -c T30 - real - T3 at sunset -c - -c --------------------------------------------------------------------- -c -c empirical constant in Stull exponential profile - alpha= 0.77 - -c Stull: -c t3=t30+dts * exp(-alpha*z3/H) -c t2=t20+dts * exp(-alpha*z2/H) - -c assume z3~inversion height(h) and h~5H - H=z3/5. - -c assume t30=t20 (dry adiabatic profile at sunset) -c => t3-t2=dts * [ exp(-alpha*z3/H) - exp(-alpha*z2/H) ] - - dts= (t3-t2)/ ( exp(-alpha*z3/H) - exp(-alpha*z2/H) ) - dts=min (dts,0.) - -c Bound surface cooling (arbitrary but prevents pb when T2<0 only) -c - Reworded output comments describing values selected for -c ISURFT,IUPT, IDIOPT1,IDIOPT2,IDIOPT3, IUPWND and ZUPWND -c - Added a QA check on ITPROG (must be 0,1 or 2) -c -c --- v6.215 (061020) to v6.217 (061231) (FRR) -c - Allow ICLOUD=4 -c -c --- v6.212 (060519) to v6.215 (061020) (DGS) -c - Allow MESOPAC output only with 1-hour timestep -c -c --- v6.210 (060408) to v6.212 (060519) (DGS) -c - Place starting date QA tests inside IF-blocks related -c to control file version (MOD5 input file failed test) -c (irhprog,iprog,noobs) -c - Reset character*4 CTIME array from (1,4) to (70) to -c match character*70 ABTZ declaration -c -c --- v6.209 (060331) to v6.210 (060408)(F. Robe) -c - Add user-input parameter irhprog and related QA checks -c (irhprog,iprog,noobs) -c -c --- v6.2 (060215) to v6.209 (060331) (DGS) -c - Report problem with a late starting-time with the -c explicit begin time for the starting period (not -c hour-ending) -c -c --- V5.711 (060106) to v6.2 (060215) (F.Robe) -c - First line in CALMET.INP flags new input format (2.1) -c - Additional parameters in CALMET.INP version 2.1 -c (beginning seconds, and ending dates +UTC time zone) -c - IRLG and IBTZ are no longer an input but are computed -c internally . They remain in the dictionary so old input -c files can still be read in -c - New input parameter:NSECDT (timestep in seconds) in -c Input Group #1 - Default value - NSECDT= 3600 seconds -c - Compute isteppgs (prognostic timestep in seconds) -c and make sure it is a multiple of CALMET timestep -c -c --- v5.7 (051230) to V5.711 (060106) (F.Robe) -c - Read new input parameters related to IGF based -c on coarse CALMET.dAT files :NIGF,IGFMET,IGFDAT(nigf) -c -c --- V5.614 (051228) to v5.7 (051230) (J. Scire) -c - Change default value for IWARM and ICOOL options -c in COARE to OFF -c -c --- V5.61 (051109) to v5.611 (051113)(F.Robe) -c - Add ILUOC3D to input group 6 -c - Add QA test for new possible value for ITWPROG = 2 -c -c --- v5.6g (051109) to v5.61 (051111)(DGS) -c - Reset defaults as follows: -c ICOARE = 10 (not 0) -c IMXHT = 1 (not -1) -c -c --- V5.6c (050419) to v5.6g (051109)(DGS) -c - Correct QA test for IEXTRP=1 that requires BIAS(2+)=1 -c so that no warning is made if the bias is already set -c properly. -c - Skip BIAS/IEXTRP checks if surface obs are not used -c -c --- 5.6a (050331) to V5.6c (050419): -c - Add COARE input variables (IWARM,ICOOL) -c - Move ICOARE and DSHELF from input group 5 to input -c group 6 -c -c --- V5.6 (050328) to V5.6a (050331): -c - Correct QA test for IEXTRP<0 that requires BIAS(1)=-1 -c so that no warning is made if the bias is already set -c properly. -c -c --- V5.551 (050310) to V5.6 (050328): -c - Add mixing height input variables (IMIXH,ITWPROG,TRESHW) -c - Additional parameter ICOARE to select the overwater -c boundary layer method (DeltaT or COARE).Input Group #5 -c default value icoare =0 (for backward compatibility) -c - Additional parameter dshelf = coastal/shallow water -c length scale (for COARE parameterization) -c in Input Group #5- Default: 0km -c - Additional parameters ldbcst, dcst.grd to write out -c gridded field of distance to the coast -c -c --- V5.549 050128 to V5.551 050310 (DGS) -c - Modify output format statements to allow surface -c station IDs to be at least 6 digits long -c -c --- V5.548a (050101) to V5.549 050128 (DGS) -c - Add call to COORDSVER and write info to list file -c -c --- V5.548(041101) to V5.548a (050101) -c - Include d3.met (as variables kbar,nbar,xybar are moved from -c common wparm.met to common d3.met -c -c --- V5.547 (041016) to V5.548(041101) (FRR) -c - Additional parameter KBAR indicating the level up to which -c barriers apply -c -c --- V5.546 (040924) to V5.547 (FRR) -c - Additional parameters to read in several MM4-MM5 files -c (number of files nm3d and filenames m3ddat) -c -c --- V5.541 (031106) to V5.546 (040924) (DGS) -c - Add QA check for datum = UNKNOWN -c -c -c --- V5.54 (031017) to V5.541 (031106) (KAM) -c - Correction to the variable type definitions -c of IAVET and TGDEFA -c -c --- V5.51 (030515) to V5.54 (031017) (DGS) -c - Allow location data for surface, upper, and precip -c stations to be missing from control file if they are -c provided in the corresponding data files -c -c --- V5.5 (030402) to V5.51 (030515) (J. Scire) -c - Correction to the variable type definition of IAVET -c -c --- V5.4 (020211) to V5.5 (030402) (DGS) -c - Add list-file unit to JULDAY call -c - rdate changed to include YYYY format for year -c (MM-DD-YYYY) -c - New map projection and datum specification -c - Lat/Lon of SW corner computed from input (x,y) -c - QA checks repositioned -c - Explicitly reset met station number to zero if NOOBS -c selection indicates type of met data not used -c - Do not close control file after use -c -c --- V5.3 020211 (FRR): allow input of prognostic temperature -c and noobs option from control file -c --- allow input of non hourly MM5 data -c from control file -c --- V5.2 000602b (JSS): allow input of radiation parameters -c from control file -c --- V5.0-V5.1 991104 (DGS): enforce YYYY format for year -c --- V5.0-V5.1 991104 (DGS): include MM5.DAT choices for IPROG in -c QA output to list file -c -c --- INPUTS: -c Common block /QA/ -c ver, level, rdate, rtime -c Common block /FLAGS/ -c iomesg, lmesg -c Parameters: -c IO5, IO6, MVER, MLEVEL -c -c --- OUTPUT: -c TITLE(3) - Char*80 array - Three line run title -c IDIOP2(5) - Integer array - Flags for diagnostic wind field -c options -c IPROG2 - integer - Control variable determining use of -c prognostic data (1=CSUMM as Step 1 -c field; 2=CSUMM as initial guess field; -c 3=MM4 as Step 1 field; 4=MM4 as initial -c guess field, 5=MM4 as "observations") -c 13=MM5 as Step 1 field; 14=MM5 as initial -c guess field, 15=MM5 as "observations") -c ITEST - integer - Flag indicating if execution is to -c include COMPUTATIONAL phase -c (ITEST = 1 to STOP program after -c SETUP phase, -c ITEST = 2 to CONTINUE execution to -c include computations) -c -c n3d - integer - Number of MM4/MM5 data files -c -c nig - integer - Number of IGF-CALMET data files -c igfflag -integer - Flag to use coarse CALMET as IGF -c -c -c -c Variables from common blocks: -c /GEN/, /GRID/, /MET1/, /ZIPARM/, /OVRWAT/, OUTPT/, /WPARM/, /TMP/ -c /LON/, /HFLUX/, /MAP/, /IGF/ -c -c --- READCF called by: SETUP -c --- READCF calls: READFN, READIN, JULDAY, QAYR4, YR4C, -c GLOBE1, GLOBE, NIMADATE, COORDSVER -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.met' - include 'params.cal' -c -c - character*16 inputset,inputver - character*64 inputmod - character*70 abtz - - real zbuf(mxnz) - integer ivleng(mxvar,mxsg),ivtype(mxvar,mxsg) - integer idiop2(5),metbxid(mxbxwnd) - character*12 cvdic(mxvar,mxsg) - logical lecho, lerrcf, lwarncf -c *** - character*132 ctemp - character*80 title(3) - character*50 verdoc - dimension xbbar(mxbar),ybbar(mxbar),xebar(mxbar),yebar(mxbar) -c *** - character*4 clatlon(16,4) - character*4 ctime(70) - character*4 cpmap(8),cdatum(8) - -c --- For coordinate transformations - character*8 cmapi,cmapo - character*12 caction - character*4 c4hem - real*8 vecti(9),vecto(9) -c -c --- Include common blocks - include 'gen.met' - include 'grid.met' - include 'hflux.met' - include 'met1.met' - include 'ziparm.met' - include 'ovrwat.met' - include 'outpt.met' - include 'wparm.met' - include 'qa.met' - include 'breez.met' - include 'lon.met' - include 'map.met' - include 'tmp.met' - include 'filnam.met' - include 'flags.met' - include 'mm4hdo.met' - include 'd3.met' - include 'igf.met' -c - data lecho/.true./, lerrcf/.false./, lwarncf/.false./ -c -c - data cvdic/'IBYR','IBMO','IBDY','IBHR','IBSEC', - 1 'IEYR','IEMO','IEDY','IEHR','IESEC','ABTZ','IBTZ','IRLG', - 1 'NSECDT','IRTYPE','LCALGRD','ITEST','MREG',42*' ', - 2 'PMAP','DATUM','FEAST','FNORTH','IUTMZN','UTMHEM', - 2 'RLAT0','RLON0','XLAT1','XLAT2','NX','NY','DGRIDKM', - 2 'XORIGKM','YORIGKM','NZ','ZFACE', 43*' ', - 3 'LSAVE','LPRINT','IPRINF','IUVOUT','IWOUT','ITOUT','STABILITY', - 3 'USTAR','MONIN','MIXHT','WSTAR','PRECIP','SENSHEAT','CONVZI', - 3 'LDB','NN1','NN2','LDBCST','IOUTD','NZPRN2','IPR0','IPR1', - 3 'IPR2','IPR3','IPR4','IPR5','IPR6','IPR7','IPR8','IFORMO',30*' ', - 4 'NOOBS','NSSTA','NPSTA','IFORMS','IFORMP', - 4 'ICLOUD','ICLDOUT','MCLOUD','IFORMC',51*' ', - 5 'IWFCOD','IFRADJ','IKINE','IOBR','IEXTRP','RMIN2', - 5 'FEXTR2','IPROG','ISTEPPG','ISTEPPGS','IGFMET', - 5 'LVARY','RMAX1','RMAX2','RMAX3', - 5 'RMIN','TERRAD','R1','R2','RPROG','DIVLIM','NITER','NSMTH', - 5 'NINTR2','CRITFN','ALPHA','NBAR','XBBAR','YBBAR', - 5 'XEBAR','YEBAR','KBAR', - 5 'IDIOPT1','IDIOPT2','IDIOPT3','IDIOPT4','IDIOPT5','ISURFT', - 5 'IUPT','ZUPT','IUPWND','ZUPWND','LLBREZE','NBOX','XG1','XG2', - 5 'YG1','YG2','XBCST', 'YBCST','XECST','YECST','NLB','METBXID', - 5 'BIAS','ISLOPE','ICALM',3*' ', - 6 'CONSTB','CONSTE','CONSTN','DPTMIN','DZZI','ZIMIN', - 6 'ZIMAX','ZIMINW','ZIMAXW','IAVEZI','MNMDAV','HAFANG','ILEVZI', - 6 'FCORIOL','CONSTW','ITPROG','ITWPROG','ILUOC3D','IRAD','IAVET', - 6 'TGDEFB','TGDEFA','JWAT1','JWAT2','TRADKM','NUMTS','NFLAGP', - 6 'SIGMAP','CUTP','HA1','HA2','HB1','HB2','HC1','HC2','HC3', - 6 'IMIXH','THRESHL','THRESHW','ICOARE','DSHELF','IWARM','ICOOL', - 6 'IRHPROG','IZICRLX','TZICRLX',14*' ', - 7 60*' ',60*' ',60*' '/ -c - -c --- Variable dimension (1: scalar) - data ivleng/10*1,70,7*1, 42*0, - 2 2*8,4*1,4*16,6*1,mxnzp1, 43*0, - 3 3*1, 3*mxnz, 24*1, 30*0, - 4 9*1, 51*0, - 5 6*1, mxnz, 15*1, 2*mxnz, 3*1, 4*mxbar, 10*1, 2, - 5 2*1, 9*mxbox, mxbxwnd, mxnz, 2*1,3*0, - 6 22*1, 2*mxwb, 22*1, 14*0, - 7 60*0, - 8 60*0, - 9 60*0/ -c -c -c --- Variable types (ivtype) are coded as: -c 0 = null -c 1 = real -c 2 = integer -c 3 = logical -c 4 = character - data ivtype/10*2,4,4*2,3,2*2,42*0, - 2 2*4,2*1,2,5*4,2*2,3*1,2,1, 43*0, - 3 2*3, 12*2, 3,2*2,3,12*2, 30*0, - 4 9*2, 51*0, - 5 5*2, 2*1, 4*2, 3, 9*1, 3*2, 2*1, 2, 4*1,8*2, 1, 2, 1, 3, 2, - 5 8*1, 2*2, 1, 2*2, 3*0, - 6 9*1, 2*2, 1, 2, 2*1, 5*2, 2*1, 2*2, 1, 2*2, 9*1, 1*2, - 6 2*1, 2, 1, 4*2, 1, 14*0, - 7 60*0, 60*0, 60*0/ - -c --- Scale factor for Tangential TM projection - tmsone=1.00000 -c -c - if(lmesg)write(iomesg,*)'ENTERING SETUP PHASE' -c ------------------ -c --- Input format -c ------------------- -c --- New format: first line includes dataset types, version number -c --- and description (starts at 2.1) (060215) - read(io5,'(2a16,a64)') inputset,inputver,inputmod - -C -c ------------------ -c --- Read title (First 3 lines of the control file) -c ------------------- - read(io5,102)title -102 format(a80/a80/a80) - -c ------------------------------------------------- -c --- Read file names from control file - IG # 0(a) -c ------------------------------------------------- - - call readfn(1,nusta,nowsta,nm3d,nigf) -c --- set other variable name to pass through calling list - n3d=nm3d - nig=nigf -c -c --- Open the output LIST file - open(io6,file=metlst,status='unknown') -c -c --- Write page header - write(io6,1400)ver,level - -c --- v6.4.0, Level 121203 -1400 format(40x,'CALMET',3x,'Version: ',a12,3x,'Level: ',a8/ - - 1 1x,13('**********')/) -c -c --- Write clock date/time of run - write(io6,1402)rtime,rdate -1402 format(//2x,'Clock time: ',a8/ - 1 2x,' Date: ',a10) -c -c --- Check that the version and level number in the parameter -c --- file matches those in the code itself - if(ver.ne.mver.or.level.ne.mlevel)then - write(io6,8)ver,level,mver,mlevel -8 format(/1x,'ERROR in SUBR. SETUP -- The CALMET version ', - 1 'and level numbers do not match those in the parameter file'/ - -c --- v6.4.0, Level 121203 - 2 5x,' Model Code - Version: ',a12,' Level: ',a8/ - 3 5x,'Parameter File - Version: ',a12,' Level: ',a8) - - stop - endif -c -c --- Obtain COORDS version information - call COORDSVER(io6,verdoc) - write(io6,*) - write(io6,*) - write(io6,*)'Internal Coordinate Transformations by ',verdoc - write(io6,*) -c - write(io6,1410)title -1410 format(//2x,'Run Title:'/ - 1 3(5x,a80/)) - -c --------------------------------------------------------------------- -c --- Read upper air, overwater, MM5 and misc. files - IG # 0(b,c,d,e) -c --------------------------------------------------------------------- - - call readfn(2,nusta,nowsta,nm3d,nigf) - -c -------------------------------------------- -c --- General run control parameters -- IG # 1 -c -------------------------------------------- -c --- Initialize the temporary array for the time zone - do j=1,70 - ctime(j)(1:1)=' ' - abtz(j:j)=' ' - enddo - -c --- initialize input parameters to check input file version consistency - ibsec=-9999 - iesec=-9999 - iehr =-9999 - ibtz =-9999 - - call readin(cvdic(1,1),ivleng(1,1),ivtype(1,1),io5,io6,lecho, - 1 IBYR,IBMO,IBDY,IBHR,IBSEC,IEYR,IEMO,IEDY,IEHR,IESEC,CTIME(1), - 2 IBTZ,IRLG,NSECDT,IRTYPE,LCALGRD,ITEST,MREG,idum,idum,idum,idum, - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum) - - -c --- transfer the char*4 data into the char*70 variable - do j=1,70 - if(ctime(j)(1:1).ne.' ')abtz(j:j)=ctime(j)(1:1) - enddo - -c --- Convert UTC time zone to/from integer base sf time zone - if (inputver.EQ.'2.1'.or.inputver.EQ.'2.2') then -c --- CALMEt.INP version 2.1 or 2.2 -c --- Strip charct time zone from blanks and take 8 characters - ij=0 - do j=1,70 - if (abtz(j:j).ne.' ') then - ij=ij+1 - if (ij.gt.8) then - write(io6,*)'wrong format for UTC time zone ABTZ' - STOP 'wrong format for input UTC time zone - STOP' - endif - axtz(ij:ij)=abtz(j:j) - endif - end do -c --- transform Char*8 UTC time zone to real time zone - call utcbasr(axtz,xbtz) -c --- Integer time zone - ibtz=int(xbtz) - else -c --- old format (pre 2.1) - convert ibtz time zone to UTC for output - xbtz=ibtz*1. - call basrutc(xbtz,axtz) - endif - -c --- Check consistency of input parameters and input file version number -c --- Expect explicit begining/ending times and UTC time zone if version 2.1 -c --- stop if inconsistent - if (inputver.EQ.'2.1'.or.inputver.EQ.'2.2') then - if ((ibsec.eq.-9999).or.(iesec.eq.-9999).or. - : (iehr.eq.-9999)) then - write(io6,*)' INCONSISTENT Input format and parameters' - write(io6,*)' Input file format: ', inputver - write(io6,*)'IBSEC=',ibsec,'IESEC=',iesec,'IEHR=',iehr - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - else if (axtz(1:3).ne.'UTC') then - write(io6,*)' INCONSISTENT Input format and parameters' - write(io6,*)' Input file format: ', inputver - write(io6,*)'ABTZ=',AXTZ, ' - Must follow: UTC+HHMM ' - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - else - if ((ibsec.ne.-9999).or.(iesec.ne.-9999).or. - : (iehr.ne.-9999))then - write(io6,*)'INCONSISTENT Input format and parameters' - write(io6,*)'Explicit beginning/ending times for V2.1 or higher' - write(io6,*)'CALMET.INP V2.1 requires first header line' - write(io6,*)'or CALMET.INP V2.2 requires first header line' - write(io6,*)'Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - endif - -c -------------------------------------------------------- -c --- Map Projection and Grid control parameters -- IG # 2 -c -------------------------------------------------------- - -c --- Initialize the temporary arrays for the character lat/lon fields - do i=1,4 - do j=1,16 - clatlon(j,i)(1:1)=' ' - enddo - enddo - do j=1,16 - clat0(j:j)=' ' - clon0(j:j)=' ' - clat1(j:j)=' ' - clat2(j:j)=' ' - enddo - -c --- Initialize the temporary array for the Datum-Region name and -c --- map projection - do j=1,8 - cpmap(j)(1:1)=' ' - cdatum(j)(1:1)=' ' - enddo - - call readin(cvdic(1,2),ivleng(1,2),ivtype(1,2),io5,io6,lecho, - 1 CPMAP,CDATUM,FEAST,FNORTH,IUTMZN,UTMHEM, - 2 CLATLON(1,1),CLATLON(1,2),CLATLON(1,3),CLATLON(1,4), - 2 NX,NY,DGRIDKM,XORIGKM,YORIGKM,NZ,ZFACE, - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum) - - -c --- Pad the char*4 UTM Hemisphere - utmhem(2:4)=' ' - -c --- Transfer the char*4 data into the char*16 variables - do j=1,16 - if(clatlon(j,1)(1:1).ne.' ')clat0(j:j)=clatlon(j,1)(1:1) - if(clatlon(j,2)(1:1).ne.' ')clon0(j:j)=clatlon(j,2)(1:1) - if(clatlon(j,3)(1:1).ne.' ')clat1(j:j)=clatlon(j,3)(1:1) - if(clatlon(j,4)(1:1).ne.' ')clat2(j:j)=clatlon(j,4)(1:1) - enddo - -c --- Transfer the char*4 data into the char*8 variables - if(cpmap(1)(1:1).ne.' ') then - do j=1,8 - pmap(j:j)=cpmap(j)(1:1) - enddo - endif - if(cdatum(1)(1:1).ne.' ') then - do j=1,8 - datum(j:j)=cdatum(j)(1:1) - enddo - endif - -c --- Translate character lat/lon to real NLat/ELon - if(clat0(1:1).NE.' ') call XTRACTLL(io6,'LAT ',clat0,rnlat0) - if(clon0(1:1).NE.' ') call XTRACTLL(io6,'LON ',clon0,relon0) - if(clat1(1:1).NE.' ') call XTRACTLL(io6,'LAT ',clat1,xlat1) - if(clat2(1:1).NE.' ') call XTRACTLL(io6,'LAT ',clat2,xlat2) - -c --- Set logicals for map projection PMAP - if(pmap.EQ.'UTM ') lutm =.TRUE. - if(pmap.EQ.'LCC ') llcc =.TRUE. - if(pmap.EQ.'PS ') lps =.TRUE. - if(pmap.EQ.'EM ') lem =.TRUE. - if(pmap.EQ.'LAZA ') llaza=.TRUE. - if(pmap.EQ.'TTM ') lttm =.TRUE. - -c --- Adjust projection information if needed - if(LEM) then -c --- Equatorial Mercator projection matches at 0.0N, -c --- and places the northing origin at 0.0N - rnlat0=0.0 - xlat1=0.0 - xlat2=0.0 - endif - -c ---------------------------- -c --- Output options -- IG # 3 -c ---------------------------- - - call readin(cvdic(1,3),ivleng(1,3),ivtype(1,3),io5,io6,lecho, - 1 LSAVE,LPRINT,IPRINF,IUVOUT,IWOUT,ITOUT,IMTOUT(1),IMTOUT(2), - 2 IMTOUT(3),IMTOUT(4),IMTOUT(5),IMTOUT(6),IMTOUT(7),IMTOUT(8), - 3 LDB,NN1,NN2,LDBCST,IOUTD,NZPRN2,IPR0,IPR1,IPR2,IPR3, - 4 IPR4,IPR5,IPR6,IPR7,IPR8,IFORMO, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 7 idum,idum,idum,idum,idum,idum) - -c ----------------------------------------- -c --- Meteorological data options -- IG # 4 -c ----------------------------------------- - - call readin(cvdic(1,4),ivleng(1,4),ivtype(1,4),io5,io6,lecho, -ccec101006 1 noobs,NSSTA,NPSTA,IFORMS,IFORMP,ICLOUD,IFORMC, - 1 noobs,NSSTA,NPSTA,IFORMS,IFORMP,ICLOUD,ICLDOUT,MCLOUD,IFORMC, -cfrr 1 NSSTA,NPSTA,IFORMS,IFORMP,noobs,ICLOUD,IFORMC, - 2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum) -c - if (icloud.eq.999.and.inputver.ne.'2.2')then - write(io6,*)' ICLOUD should be equal to 0,1,2,3 or 4' - write(io6,*)' ICLOUD =',icloud - write(io6,*)' Check a CALMET.INP V2.1 format or before' - write(io6,*)' or change ' - write(io6,*)' to CALMET.INP V2.2 in the first header line' - write(io6,*)' if MCLOUD and ICLDOUT are used instead of ICLOUD' - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - if ((mcloud.eq.999.or.icldout.eq.999).and.inputver.eq.'2.2')then - write(io6,*)' INCONSISTENT Input format and parameters' - write(io6,*)' ICLOUD should be replaced by MCLOUD and ICLOUD' - write(io6,*)' Check a CALMET.INP V2.2 format' - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - -c --- Check NOOBS selection and reset NSSTA,NOWSTA,NUSTA if needed - if(noobs.EQ.1) then - if(nusta.GT.0) then - write(io6,*) - write(io6,*) 'READCF: Warning in Input Group 4' - write(io6,*) 'No upper air needed for NOOBS = ',noobs - write(io6,*) 'NUSTA reset to 0 from ',nusta - lwarncf=.TRUE. - nusta=0 - endif - elseif(noobs.EQ.2) then - if(nusta.GT.0 .OR. nssta.GT.0 .OR. nowsta.GT.0) then - write(io6,*) - write(io6,*) 'READCF: Warning in Input Group 4' - write(io6,*) 'No observations for NOOBS = ',noobs - write(io6,*) 'NSSTA reset to 0 from ',nssta - write(io6,*) 'NUSTA reset to 0 from ',nusta -c --- SEa.DAT files are allowed in NOOBS=2 mode (041001- CEC) -c write(io6,*) 'NOWSTA reset to 0 from ',nowsta - lwarncf=.TRUE. - nssta=0 -c nowsta=0 - nusta=0 - endif - endif -c -c --- Match CLOUD PARAMETERS between CALMET.INP version 2.2 and before -c - if(inputver.ne.'2.2') then - if (ICLOUD.eq.0) then - ICLDOUT=0 - MCLOUD=1 - elseif(ICLOUD.eq.1) then - ICLDOUT=1 - MCLOUD=1 - elseif (ICLOUD.eq.2) then - ICLDOUT=0 - MCLOUD=2 - elseif (ICLOUD.eq.3) then - ICLDOUT=0 - MCLOUD=3 - elseif (ICLOUD.eq.4) then - ICLDOUT=0 - MCLOUD=4 - else - write(io6,*)' ERROR in READCF:ICLOUD is equal to 0,1,2,3or4' - write(io6,*)' Please choose one of these options' - write(io6,*)' Current Value of ICLOUD = ',ICLOUD - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - else - if(ICLDOUT.gt.1) then - write(io6,*)' ERROR in READCF:ICLDOUT is equal to 0 or 1' - write(io6,*)' Please choose one of these options' - write(io6,*)' Current Value of ICLDOUT = ',ICLDOUT - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - if(MCLOUD.gt.4.or.MCLOUD.le.0) then - write(io6,*)' ERROR in READCF:MCLOUD is equal to 1,2,3 or 4' - write(io6,*)' Please choose one of these options' - write(io6,*)' Current Value of MCLOUD = ',MCLOUD - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - if(MCLOUD.eq.2.and.ICLDOUT.eq.1) then - write(io6,*)' ERROR in READCF: if MCLOUD =2, no gridded' - write(io6,*)' CLOUD.DAT needs to be output' - write(io6,*)' since gridded data come from CLOUD.DAT' - write(io6,*)' ICLDOUT needs to be switched to 0' - write(io6,*)' Check input file - STOP ' - STOP ' STOP - Check list file for error' - endif - endif -c -c ----------------------------------------------- -c --- Wind field options and parameters -- IG # 5 -c ----------------------------------------------- -c --- Initialize kbar - nbar initialized in block data (050101) - kbar=nz - -c --- initialize igfmet (compatibility with old files) - igfmet=0 - -c --- Initialize isteppg and isteppgs (080205) - isteppg=0 - isteppgs=0 - - call readin(cvdic(1,5),ivleng(1,5),ivtype(1,5),io5,io6,lecho, - 1 IWFCOD,IFRADJ,IKINE,IOBR,IEXTRP,RMIN2,FEXTR2,IPROG,ISTEPPG, - 2 ISTEPPGS, - 2 IGFMET,LVARY,RMAX1,RMAX2,RMAX3,RMIN,TERRAD,R1,R2,RPROG,DIVLIM, - 3 NITER,NSMTH,NINTR2,CRITFN,ALPHA,NBAR,XBBAR,YBBAR,XEBAR,YEBAR, - 4 KBAR,IDIOPT(1),IDIOPT(2),IDIOPT(3),IDIOPT(4),IDIOPT(5), - 5 ISURFT,IUPT,ZUPT,IUPWND,ZUPWND,LLBREZE,NBOX,XG1,XG2,YG1,YG2, - 5 XBCST,YBCST,XECST,YECST,NLB,METBXID,BIAS,ISLOPE,ICALM, - 6 idum,idum,idum) - -c --- set other variable name to pass through calling list - igfflag=igfmet - -c --- Prognostic timestep in seconds (if not in the input file) - if (isteppgs.eq.0) ISTEPPGS= isteppg*3600 - -c ------------------------------------------------------ -c --- Mixing height and temperature parameters -- IG # 6 -c ------------------------------------------------------ -c --- 050328 - Default value for icoare such that backward compatible -c --- icoare=0 (deltaT method) -c --- 051111 - Reset default - icoare=10 -c --- 050328 - Default value for dshelf (deep sea everywhere) - dshelf=0. -c --- 050419 - Default value for iwarm-icool (on) changed to -c --- off (051230) - iwarm=0 - icool=0 - -c --- 050328 - Initialize new mixing height parameters such that -c the old CALMET.INP files can be used -c imixh=-1 -c --- 051111 - Reset default - imixh=1 - itwprog=0 - threshw=0.05 -c threshl=0.05 - value reset (070702) - threshl=0.0 - -c --- 110212 - read in izicrlx and tzicrlx (default set in block data) - call readin(cvdic(1,6),ivleng(1,6),ivtype(1,6),io5,io6,lecho, - 1 CONSTB,CONSTE,CONSTN,DPTMIN,DZZI,ZIMIN,ZIMAX,ZIMINW,ZIMAXW, - 2 IAVEZI,MNMDAV,HAFANG,ILEVZI,FCORIOL,CONSTW,ITPROG,ITWPROG, - 2 ILUOC3D,IRAD,IAVET,TGDEFB, - 3 TGDEFA,JWAT1,JWAT2,TRADKM,NUMTS,NFLAGP,SIGMAP,CUTP,HA1,HA2, - 4 HB1,HB2,HC1,HC2,HC3,IMIXH,THRESHL,THRESHW,ICOARE,DSHELF, - 5 IWARM,ICOOL,IRHPROG,IZICRLX,TZICRLX,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum) -c - -c --- Compute temperature radius of influence (in grid units) - trad=tradkm/dgridkm - -c --- Set directives for choice of surface temperatures and wind -c --- speed profile stability functions PSIU based on ICOARE - if(icoare.EQ.0) then -c --- Use model formulations prior to COARE module implementation - isfcmet=1 - ipsifcn=1 - else -c --- Use formulation consistent with COARE module - isfcmet=0 - ipsifcn=0 - endif -c ------------------------------------------------------------------ -c --- Remainder of control file is read using free-reads, and -c --- key strings are searched to locate the beginning of station -c --- assignments (control file delimiters are not interpreted) -c ------------------------------------------------------------------ - -c --- Met station information may be provided in the met files. If -c --- information is not presented in control file, set a flag to make -c --- sure that it is found in the met files. Any information found in -c --- the met files will replace that provided in the control file. - lcfsfc=.FALSE. - lcfupr=.FALSE. - lcfprc=.FALSE. - -c ----------------------------------------- -c --- Surface meteorological data -- IG # 7 -c ----------------------------------------- - -c *** Use free read until control file reader is enhanced to -c *** accomodate character inputs -c FRR (01/09) accept no surface station if noobs=2 -c if (nssta.eq.0 .and. noobs.eq.2) goto 666 - if (nssta.eq.0) goto 666 - -112 continue - read(io5,113,end=666)ctemp -113 format(a132) - if(ctemp(3:5).eq.'US1')go to 213 - if(ctemp(3:5).eq.'PS1')go to 313 - if(ctemp(3:5).ne.'SS1')go to 112 -c -c --- Do not let array index exceed max dimension here - read -c --- all stations in control file, but clamp array index at -c --- the max value. Later QA test will stop execution if -c --- too many stations are provided. -c - do 114 j=1,nssta - i=MIN(j,mxss) -c *** read(ctemp(9:132),*)csnam(i),idssta(i),xssta(i),yssta(i), -c ***1 xslat(i),xslon(i),xstz(i),zanem(i) -c -c --- Replace internal free-formatted read with write/read -c --- to a scratch file - open(io98,status='scratch') - write(io98,'(a)')ctemp(9:132) - rewind(io98) - read(io98,*)csnam(i),idssta(i),xssta(i),yssta(i), - 1 xstz(i),zanem(i) -c ***1 xslat(i),xslon(i),xstz(i),zanem(i) - close(io98) -c *** - read(io5,113)ctemp -114 continue - lcfsfc=.TRUE. - -666 continue - -c ------------------------------------ -c --- Upper air station data -- IG # 8 -c ------------------------------------ - -c *** Use free read until control file reader is enhanced to -c *** accomodate character inputs -c if (noobs .gt. 0 ) goto 667 - if (nusta .eq. 0 ) goto 667 - -212 continue - read(io5,113,end=667)ctemp - if(ctemp(3:5).eq.'PS1')go to 313 - if(ctemp(3:5).ne.'US1')go to 212 -c -c --- Do not let array index exceed max dimension here - read -c --- all stations in control file, but clamp array index at -c --- the max value. Later QA test will stop execution if -c --- too many stations are provided. -c -213 do 214 j=1,nusta - i=MIN(j,mxus) -c *** read(ctemp(9:132),*)cunam(i),idusta(i),xusta(i),yusta(i), -c ***1 xulat(i),xulon(i),xutz(i) -c -c --- Replace internal free-formatted read with write/read -c --- to a scratch file - open(io98,status='scratch') - write(io98,'(a)')ctemp(9:132) - rewind(io98) - read(io98,*)cunam(i),idusta(i),xusta(i),yusta(i), - 1 xutz(i) -c ***1 xulat(i),xulon(i),xutz(i) - close(io98) -c *** - read(io5,113)ctemp -214 continue - lcfupr=.TRUE. - -667 continue - -c ---------------------------------------- -c --- Precipitation station data -- IG # 9 -c ---------------------------------------- - -c *** Use free read until control file reader is enhanced to -c *** accomodate character inputs - if (npsta .eq. 0 ) goto 668 -312 continue - read(io5,113,end=668)ctemp - if(ctemp(3:5).ne.'PS1')go to 312 -c -c --- Do not let array index exceed max dimension here - read -c --- all stations in control file, but clamp array index at -c --- the max value. Later QA test will stop execution if -c --- too many stations are provided. -c -313 do j=1,npsta - i=MIN(j,mxps) -c *** read(ctemp(9:132),*)cpnam(i),idpsta(i),xpsta(i),ypsta(i) -c -c --- Replace internal free-formatted read with write/read -c --- to a scratch file - open(io98,status='scratch') - write(io98,'(a)')ctemp(9:132) - rewind(io98) - read(io98,*)cpnam(i),idpsta(i),xpsta(i),ypsta(i) - close(io98) -c *** - read(io5,113)ctemp - enddo - lcfprc=.TRUE. - -668 continue - - -c ----------------------------------------------------------- -c --- Perform QA checks -c ----------------------------------------------------------- - -c --- IG #1 -c --------- -c - -c --- Check that the timestep is a fraction of an hour - if (mod(3600,nsecdt).ne.0) then - write(io6,*)'NSECDT must be a fraction of 1 hour (in seconds)' - stop 'STOP in READCF - NSECDT must be a fraction of 1 hour' - endif - - if (inputver.EQ.'2.1'.or.inputver.EQ.'2.2') then -c --- QA on starting/ending year of simulation - call QAYR4(io6,ibyr,0,ierr) - if(ierr.NE.0) lerrcf=.TRUE. - call QAYR4(io6,ieyr,0,ierr) - if(ierr.NE.0) lerrcf=.TRUE. - call JULDAY(io6,ibyr,ibmo,ibdy,ibjul) - call JULDAY(io6,ieyr,iemo,iedy,iejul) - -c --- Make sure hours are between 0-24 - if ((ibhr.gt.24) . or. (iehr.gt.24)) then - write(io6,*)'IBHR-IEHR must be between 0 and 23' - stop 'STOP in READCF - IBHR-IEHR must be between 0 and 23' - else if (ibhr.eq.24) then - ibhr=0 - call INCR(io6,ibyr,ibjul,ibhr,24) - call GRDAY(io6,ibyr,ibjul,ibmo,ibdy) - else if (iehr.eq.24) then - iehr=0 - call INCR(io6,ieyr,iejul,iehr,24) - call GRDAY(io6,ieyr,iejul,iemo,iedy) - endif - -c --- If explicit times, convert to hour-ending times for internal -c --- computations (041207) - -c --- Only accept multiple of the timestep - if((mod(ibsec,nsecdt).ne.0).or.(mod(iesec,nsecdt).ne.0)) then - write(io6,*)'Beg/ending seconds must be a multiple ', - : 'of the timestep' - write(io6,*)'Timestep NSECDT=',nsecdt - write(io6,*)'IBSEC =',ibsec - write(io6,*)'IESEC =',iesec - write(io6,*)' STOP in READCF' - STOP 'Beginning/ending seconds must be a multiple of NSECDT' - endif - -c --- Convert seconds to hours - if(ibsec.GE.3600) then - nhrinc=ibsec/3600 - ibsec=ibsec-nhrinc*3600 - call INCR(io6,ibyr,ibjul,ibhr,nhrinc) - call GRDAY(io6,ibyr,ibjul,ibmo,ibdy) - endif - if(iesec.GE.3600) then - nhrinc=iesec/3600 - iesec=iesec-nhrinc*3600 - call INCR(io6,ieyr,iejul,iehr,nhrinc) - call GRDAY(io6,ieyr,iejul,iemo,iedy) - endif - -c --- output variables in explicit times - ibyrn=ibyr - ibmon=ibmo - ibdyn=ibdy - ibjuln=ibjul - ibhrn=ibhr - ibsecn=ibsec - ieyrn=ieyr - iemon=iemo - iedyn=iedy - iejuln=iejul - iehrn=iehr - iesecn=iesec - -c --- Compute run length in hours - call deltt(ibyr,ibjul,ibhr,ieyr,iejul,iehr,irlg) - - -c --- Beginning/ending dates - nbegdat=ibyrn*100000+ibjuln*100+ibhrn - nenddat=ieyrn*100000+iejuln*100+iehrn - -c --- Total number of seconds in the run - call deltsec (nbegdat,ibsecn,nenddat,iesecn,ntotsec) - -c --- Stop if ending date is earlier than beginning date - if (ntotsec.le.0) then - write(io6,130)ibyr,ibjul,ibhr,ibsec,ieyr,iejul,iehr,iesec -130 format(//2x,'STOP in READCF -- End date is earlier ', - 1 'than beginning date'/ - 2 5x,'Run Beg date/hr/sec: ieyr, iejul, iehr, iesec = ',4i10/ - 3 5x,'Run end date/hr/sec: jeyr, jejul, jehr ,jesec = ',4i10) - STOP 'End date is earlier than beginning date' - endif - -c --- compute run length in sub-hourly steps (stored in GEN.MET): - irsublg=ntotsec/nsecdt - -c --- Convert explicit beginning time to hour-ending beg. times -c --- as hour-ending times are used in the computational part of CALMET -c --- Explicit ending time is the same as hour-ending ending time -c --- because only hourly data are dealt with at this stage (041207) - call INCR(io6,ibyr,ibjul,ibhr,+1) - call GRDAY(io6,ibyr,ibjul,ibmo,ibdy) - - else -c --- QA on starting year of simulation - call QAYR4(io6,ibyr,0,ierr) - if(ierr.NE.0) lerrcf=.TRUE. - call JULDAY(io6,ibyr,ibmo,ibdy,ibjul) - -c --- Make sure hours are between 0-24 - if ((ibhr.gt.24)) then - write(io6,*)'IBHR must be between 0 and 24' - stop 'STOP in READCF - IBHR must be between 0 and 24' - else if (ibhr.eq.24) then - ibhr=0 - call INCR(io6,ibyr,ibjul,ibhr,24) - call GRDAY(io6,ibyr,ibjul,ibmo,ibdy) - endif - -c --- Input format with hour-ending times and length of run -c --- Convert to explict beginning/ending times for output purposes - ibyrn=ibyr - ibmon=ibmo - ibdyn=ibdy - ibjuln=ibjul - ibhrn=ibhr - ibsecn=0 - call INCR(io6,ibyrn,ibjuln,ibhrn,-1) - call GRDAY(io6,ibyrn,ibjuln,ibmon,ibdyn) - -c Compute ending hour: (fixed 070717) - ieyrn=ibyr - iejuln=ibjul - iehrn=ibhr - call incr(io,ieyrn,iejuln,iehrn,irlg-1) - call GRDAY(io6,ieyrn,iejuln,iemon,iedyn) - iesecn=0 - - -c --- Beginning/ending dates (070717) - nbegdat=ibyrn*100000+ibjuln*100+ibhrn - nenddat=ieyrn*100000+iejuln*100+iehrn - -c --- Total number of seconds in the run (070717) - call deltsec (nbegdat,ibsecn,nenddat,iesecn,ntotsec) - -c --- compute run length in sub-hourly steps (stored in GEN.MET): -c -- 070717 - irsublg=ntotsec/nsecdt - - endif - -c --- Test for valid starting hour -c --- Run must start before sunrise because mixing height algorithm -c --- uses a prognostic equation depending on heat flux - if(irtype.ne.0.and.ibhr.gt.5)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 1' -c DGS Report time at the start of the first period - write(io6,'(1x,a34,i2.2,1x,i4.4)') - & 'Invalid beginning time (HH SSSS): ',ibhrn,ibsecn - write(io6,*) 'Run must start before 5 am (LST)' - lerrcf=.TRUE. - endif -c --- Check base time zone - if(ibtz.GT.12 .OR. ibtz.LT.-12) then -c --- Time zone outside valid range - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 1' - write(io6,*) 'Invalid base time zone: IBTZ = ',ibtz - write(io6,*) 'Expected -12 <= IBTZ <= 12' - lerrcf=.TRUE. - endif -c --- Test for valid regulatory check selection - if(mreg.LT.-1 .OR. mreg.GT.1)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 1' - write(io6,*) 'Invalid Regulatory Option: MREG = ',mreg - write(io6,*) 'Expected 0 <= MREG <= 1' - write(io6,*) 'MREG is a mandatory input to the control file' - lerrcf=.TRUE. - endif -c --- Test for missing regulatory check selection - if(mreg.EQ.-1)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 1' - write(io6,*) 'No Regulatory Option (MREG) specified ' - write(io6,*) 'MREG is a mandatory input to the control file' - lerrcf=.TRUE. - endif - -c --- IG #2 -c --------- -c -c --- Test for valid PMAP (restricted set until wind rotation -c --- and map factor codes are implemented) - if(lutm.OR.llcc.OR.lttm) then -c OK - -c --- v6.4.0, Level 121203 - elseif(LPS) then -c --- Added PS rotation - - else - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'Unacceptable PMAP = ',pmap - write(io6,*) 'PMAP must be UTM,LCC,TTM' - write(io6,*) ' or PS' - lerrcf=.TRUE. - endif -cc --- Test for valid PMAP -c if(lutm.OR.llcc.OR.lps.OR.lem.OR.llaza.OR.lttm) then -cc OK -c else -c write(io6,*) -c write(io6,*) 'READCF: Error in Input Group 2' -c write(io6,*) 'Unknown PMAP = ',pmap -c write(io6,*) 'PMAP must be UTM,LCC,PS,EM,LAZA,TTM' -c lerrcf=.TRUE. -c endif -c -c --- Test for valid IUTMZN - if((iutmzn.LT.1 .OR. iutmzn.GT.60) .AND. LUTM) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'IUTMZN out of range = ',iutmzn - write(io6,*) 'IUTMZN should be 1 to 60' - lerrcf=.TRUE. - endif -c -c --- Test for valid UTMHEM - if((utmhem.NE.'N '.AND.utmhem.NE.'S ') .AND. LUTM) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'UTMHEM out of range = ',utmhem - write(io6,*) 'UTMHEM should be N or S' - lerrcf=.TRUE. - endif -c -c --- Test for lat/lon of origin for LCC/PS/EM/LAZA/TTM map projection - if(LLCC .or. LPS .or. LEM .or. LLAZA .or. LTTM) then - if(rnlat0 .LT. -900.0 .OR. relon0 .LT. -900.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'Missing lat/lon of origin for ',pmap - lerrcf=.TRUE. - elseif(rnlat0 .LT. -90.0 .OR. rnlat0 .GT. 90.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'RLAT0 (as N) out of range = ',rnlat0 - write(io6,*) '|RLAT0| should be 0 to 90 degrees' - lerrcf=.TRUE. - elseif(relon0 .LT. -180.0 .OR. relon0 .GT. 180.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'RLON0 (as E) out of range = ',relon0 - write(io6,*) '|RLON0| should be 0 to 180 degrees' - lerrcf=.TRUE. - endif - endif -c -c --- Test for matching latitudes for LCC map projection - if(LLCC) then - if(xlat1 .LT. -900.0 .OR. xlat2 .LT. -900.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'Missing matching lats for ',pmap - lerrcf=.TRUE. - elseif(xlat1 .LT. -90.0 .OR. xlat1 .GT. 90.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'XLAT1 (as N) out of range = ',xlat1 - write(io6,*) '|XLAT1| should be 0 to 90 degrees' - lerrcf=.TRUE. - elseif(xlat2 .LT. -90.0 .OR. xlat2 .GT. 90.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'XLAT2 (as N) out of range = ',xlat2 - write(io6,*) '|XLAT2| should be 0 to 90 degrees' - lerrcf=.TRUE. - endif - endif -c -c --- Test for matching latitudes for PS/EM map projection - if(LPS .or. LEM) then - if(xlat1 .LT. -900.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'Missing matching lats for ',pmap - lerrcf=.TRUE. - elseif(xlat1 .LT. -90.0 .OR. xlat1 .GT. 90.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'XLAT1 (as N) out of range = ',xlat1 - write(io6,*) '|XLAT1| should be 0 to 90 degrees' - lerrcf=.TRUE. - endif - endif -c -c --- Test for grid size - if(nx.GT.mxnx .OR. nx.LE.0 .OR. ny.GT.mxny .OR. ny.LE.0)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'NX,NY out of range = ',nx,ny - write(io6,*) 'Expected >0 and <= MXNX, MXNY = ',mxnx,mxny - lerrcf=.TRUE. - endif -c -c --- Test for number of vertical layers - if(nz.GT.mxnz .OR. nz.LE.0)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'NZ out of range = ',nz - write(io6,*) 'Expected >0 and <= MXNZ = ',mxnz - lerrcf=.TRUE. - endif -c --- Test for invalid DATUM (040924) - if(datum.EQ.'UNKNOWN ') then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 2' - write(io6,*) 'DATUM cannot be UNKNOWN' - lerrcf=.TRUE. - endif - -c --- IG #4 -c --------- -c -c --- Test for max number of stations - if(nssta.gt.mxss.or.nusta.gt.mxus.or.npsta.gt.mxps.or. - 1 nowsta.gt.mxows)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'Number of met stations exceeds parameter limit' - write(io6,*) 'Surface Stations: NSSTA, MXSS = ',nssta,mxss - write(io6,*) 'Upper Stations: NUSTA, MXUS = ',nusta,mxus - write(io6,*) 'Precip Stations: NPSTA, MXPS = ',npsta,mxps - write(io6,*) 'Sea Stations: NOWSTA, MXOWS = ',nowsta,mxows - lerrcf=.TRUE. - endif -c -c --- Test for NOOBS - if(noobs.LT.0 .OR. noobs.GT.2)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'NOOBS out of range = ',noobs - write(io6,*) 'Expected 0,1,2 ' - lerrcf=.TRUE. - endif -c -c 030119 - NPSTA=-1 option only with MM4 or MM5 data - if(NPSTA.eq.-1 .AND. iprog.lt.3)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Groups 4 and 5' - write(io6,*) 'NPSTA=-1 only possible with MM4 or MM5 data' - write(io6,*) 'NPSTA=',npsta,' IPROG=',iprog - lerrcf=.TRUE. - endif -c -c --- Test for too few surface met stations - if (nssta.eq.0 .and. noobs.lt.2) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'Surface stations are needed if NOOBS<2' - write(io6,*) 'NSSTA=',nssta,' NOOBS=',noobs - lerrcf=.TRUE. - endif -c -c --- Test for too few upper air stations - if (nusta.eq.0 .and. noobs.eq.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'Upper air stations are needed if NOOBS=0' - write(io6,*) 'NUSTA=',nusta,' NOOBS=',noobs - lerrcf=.TRUE. - endif -c - if(inputver.eq.'2.2') then - if(mcloud.lt.1.or.mcloud.gt.4)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'Invalid cloud option, MCLOUD = ',mcloud - write(io6,*) 'MCLOUD must be 1, 2, 3 or 4' - lerrcf=.TRUE. - endif -c frr (09/01) ICLOUD must be = 2, 3 or 4 if NOOBS = 2 (no surface observations) - if(mcloud.lt.2 .and. noobs.eq.2)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'Invalid cloud option, MCLOUD = ',mcloud - write(io6,*) 'MCLOUD must be 2, 3 or 4 if NOOBS = 2' - lerrcf=.TRUE. - endif - else -c --- Test for ICLOUD option -c frr (09/01) additional option icloud=3 (gridded cloud cover from MM5 data) - if(icloud.lt.0.or.icloud.gt.4)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'Invalid cloud option, ICLOUD = ',icloud - write(io6,*) 'ICLOUD must be 0, 1, 2, 3 or 4' - lerrcf=.TRUE. - endif -c frr (09/01) ICLOUD must be = 2, 3 or 4 if NOOBS = 2 (no surface observations) - if(icloud.lt.2 .and. noobs.eq.2)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 4' - write(io6,*) 'Invalid cloud option, ICLOUD = ',icloud - write(io6,*) 'ICLOUD must be 2, 3 or 4 if NOOBS = 2' - lerrcf=.TRUE. - endif - endif - -c - if(iformo.lt.1.or.iformo.gt.2 .OR. - & iforms.lt.1.or.iforms.gt.2 .OR. - & iformp.lt.1.or.iformp.gt.2 .OR. - & iformc.lt.1.or.iformc.gt.2)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 3 or 4' - write(io6,*) 'Format codes must be either 1 or 2' - write(io6,*) 'IFORMO, IFORMC = ',iformo,iformc - write(io6,*) 'IFORMS, IFORMP = ',iforms,iformp - lerrcf=.TRUE. - endif - -c --- Do not allow MESOPAC output if the timestep is not 1 hour - if(iformo.EQ.2 .AND. nsecdt.NE.3600) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 3' - write(io6,*) 'MESOPAC output requires 1-hour timestep' - write(io6,*) 'IFORMO, NSECDT = ',iformo,nsecdt - lerrcf=.TRUE. - endif - -c --- Test for NOOBS interaction with other selections -c ---------------------------------------------------- -c -c --- NOOBS mode only with MM5 data or , since 030119, MM4 data - if(noobs .ge. 1 .and. iprog.ne.13 .and. iprog.ne.14 - & .and. iprog .ne.15 .and. iprog.ne.3 .and. iprog.ne.4 - & .and. iprog .ne.5)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Groups 4 and 5' - write(io6,*) 'Incorrect value of IPROG for NOOBS mode' - write(io6,*) 'NOOBS = ',noobs,' IPROG = ',iprog - write(io6,*) 'Expected IPROG = 3,4,5,13,14,15 ' - lerrcf=.TRUE. - endif -c -c --- NOOBS mode with MM4 and DIAG.DAT - if (idiopt(3).eq.0 .and. iprog.eq.5 .and. iwfcod.eq.1 - & .and. noobs .ge. 1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Groups 4 and 5' - write(io6,*)'If using diagnostic wind module and MM4 only ', - 1 'as observations then must use DIAG.DAT to input ' , - 2 'domain-averaged wind components:' - write(io6,*) 'IPROG=5,IWFCOD=1,NOOBS=1or2 ==> IDIOPT(3)=1' - lerrcf=.TRUE. - endif -c -c --- NOOBS mode with MM5 and DIAG.DAT - if (idiopt(3).eq.0 .and. iprog.eq.15 .and. iwfcod.eq.1 - & .and. noobs .ge. 1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Groups 4 and 5' - write(io6,*)'If using diagnostic wind module and MM5 only ', - 1 'as observations then must use DIAG.DAT to input ' , - 2 'domain-averaged wind components:' - write(io6,*) 'IPROG=15,IWFCOD=1,NOOBS=1or2 ==> IDIOPT(3)=1' - lerrcf=.TRUE. - endif - -c --- Parameter for prognostic temp (ITPROG) - if (itprog.ne.0 .and. itprog.ne.1 .and. itprog.ne.2) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of ITPROG = ',itprog - write(io6,*) 'ITPROG must be 0, 1, or 2' - lerrcf=.TRUE. - endif - - if (itprog.ge.1 .and. iprog.lt.3)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of ITPROG = ',itprog - write(io6,*) 'Expected ITPROG=0 with IPROG = ',iprog - lerrcf=.TRUE. - endif -c - if (irhprog.ge.1 .and. iprog.lt.3)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of IRHPROG = ',irhprog - write(io6,*) 'Expected IRHPROG=0 with IPROG = ',iprog - lerrcf=.TRUE. - endif -c - if (itprog.eq.0 .and. noobs.ge.1)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of ITPROG = ',itprog - write(io6,*) 'Expected ITPROG>0 with NOOBS = ',noobs - write(io6,*)'3D Temperature must be computed from', - 1 ' prognostic data if no observation ' - lerrcf=.TRUE. - endif - - if (itprog.ne.2 .and. noobs.eq.2)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of ITPROG = ',itprog - write(io6,*) 'Expected ITPROG=2 with NOOBS = ',noobs - write(io6,*)'3D Temperature must be computed from', - 1 ' prognostic data in no-observation mode ' - lerrcf=.TRUE. - endif - -c --- Automatically reset irhprog=1 if noobs=2 (for compatibility with older versions) - if (irhprog.ne.1 .and. noobs.eq.2)then - irhprog=1 - write(io6,*) - write(io6,*) 'READCF: Warning in Input Group 6' - write(io6,*) 'Value of IRHPROG reset to 1 ' - write(io6,*) 'Because Surface RH must be computed from', - 1 ' prognostic data in no-observation mode (NOOBS=2)' - endif - -c --- IG #5 -c --------- -c -c --- TEst IGFMET value and compatibility with other options - if (igfmet.eq.1) then - if(iprog.eq.1 .or. iprog.eq.3 .or. iprog.eq.13) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Coarse CALMET used as IGF - IGFMET=',igfmet - write(io6,*) 'Incompatible with IPROG=',iprog - lerrcf=.TRUE. - endif - else if (igfmet.ne.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IGFMET must be 0 or 1 -IGFMET=',igfmet - lerrcf=.TRUE. - endif - -c --- Test Prognostic model timestep -c frr (02/10/22) allow maximum MM5 timestep of 12 hours only -c if (isteppg.gt.12) then - if (isteppgs.gt.43200) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Prognostic model timestep = ',isteppg - write(io6,*) 'Maximum timestep allowed is 12 hours' - lerrcf=.TRUE. - endif -c frr 030119: Non hourly prognostic data only possible for MM5 - if (isteppgs.ne.3600 .and. iprog.lt.13 ) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Prognostic timestep (seconds) = ',isteppgs - write(io6,*) 'Only timestep allowed for MM4 is 1 hour' - lerrcf=.TRUE. - endif - -c --- Prognostic timestep must be a multiple of CALMET timestep - if (mod(isteppgs,nsecdt).ne.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Prognostic timestep must be a multiple of', - : ' CALMET timestep' - write(io6,*) 'Prognostic timestep in seconds (ISTEPPGS) = ', - : isteppgs - write(io6,*) 'CALMET timestep in seconds (NSECDT) = ', - : nsecdt - lerrcf=.TRUE. - endif - -c --- Enforce compatibility between iextrp and bias options: -c --- ONLY when surface obs are used (check NOOBS) (051109) -c - if iextrp<0: first guess sfc winds only depend on obs. at sfc -c stations -c --- QA test incomplete: add test for bias(1) also -c if (iextrp.lt.0)then - if (iextrp.lt.0 .AND. bias(1).NE.-1. .AND. NOOBS.NE.2)then - write(io6,*) - write(io6,*) 'READCF: Warning in Input Group 5' - write(io6,*) 'BIAS(1) reset to -1. to be consistent with' - write(io6,*) 'IEXTRP' - write(io6,*) '(i.e., upper air data not used in Layer 1)' - bias(1)=-1. - LWARNCF=.TRUE. - endif -c - if no vertical extrapolation of sfc obs. no influence aloft -c --- QA test incomplete: check for biases not=1 before warning (051109) - if (iabs(iextrp).eq.1 .AND. NOOBS.NE.2) then - kreset=0 - do k=2,nz - if(bias(k).NE.1.) then - bias(k)=1. - kreset=kreset+1 - endif - end do - if(kreset.GT.0) then -c --- Report bias not equal to 1 - write(io6,*) - write(io6,*) 'READCF: Warning in Input Group 5' - write(io6,*) 'BIAS(2)...(NZ) reset to +1. to be consistent', - 1 ' with IEXTRP' - write(io6,*) '(i.e., sfc data not extrapolated vertically)' - LWARNCF=.TRUE. - endif - endif -c -c -c --- Test number of barriers - if(nbar.gt.mxbar)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Number of barriers exceeds parameter limit' - write(io6,*) 'NBAR, MXBAR = ',nbar,mxbar - lerrcf=.TRUE. - endif -c -c --- Check number of lake breeze boxes - if (nbox.gt.mxbox) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Number of lake breeze boxes exceeds limit' - write(io6,*) 'NBOX, MXBOX = ',nbox,mxbox - lerrcf=.TRUE. - endif - -c --- Check prognostic wind field options -c frr (09/01) - if( (iprog.eq.1 .or. iprog.eq.3 .or. iprog.eq.13 ) - & .AND. rprog.eq.0. ) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IPROG=',IPROG,' RPROG=',rprog - write(io6,*) 'RPROG must be non-zero if IPROG=1,3 or 13' - lerrcf=.TRUE. - endif - if(iprog.eq.1 .and. iwfcod.eq.1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IPROG=',IPROG,' IWFCOD=',iwfcod - write(io6,*) 'The Objective Analysis option must be selected' - write(io6,*) 'if CSUMM model results are used as the' - write(io6,*) 'Step 1 Field' - lerrcf=.TRUE. - else if(iprog.eq.2 .and. iwfcod.eq.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IPROG=',IPROG,' IWFCOD=',iwfcod - write(io6,*) 'The Diagnostic Wind module must be selected if ' - write(io6,*) 'CSUMM model results are used as the Initial ', - 1 'Guess Field' - lerrcf=.TRUE. - else if(iprog.eq.3 .and. iwfcod.eq.1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IPROG=',IPROG,' IWFCOD=',iwfcod - write(io6,*) 'The Objective Analysis option must be selected' - write(io6,*) 'if MM4 model results are used as the' - write(io6,*) 'Step 1 Field' - lerrcf=.TRUE. - else if(iprog.eq.4 .and. iwfcod.eq.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IPROG=',IPROG,' IWFCOD=',iwfcod - write(io6,*) 'The Diagnostic Wind module must be selected if ' - write(io6,*) 'MM4 model results are used as the Initial ', - 1 'Guess Field' - lerrcf=.TRUE. - else if(iprog.eq.13 .and. iwfcod.eq.1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IPROG=',IPROG,' IWFCOD=',iwfcod - write(io6,*) 'The Objective Analysis option must be selected' - write(io6,*) 'if MM5 model results are used as the' - write(io6,*) 'Step 1 Field' - lerrcf=.TRUE. - else if(iprog.eq.14 .and. iwfcod.eq.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'IPROG=',IPROG,' IWFCOD=',iwfcod - write(io6,*) 'The Diagnostic Wind module must be selected if ' - write(io6,*) 'MM5 model results are used as the Initial ', - 1 'Guess Field' - lerrcf=.TRUE. - endif -c -c frr (09/01) - if(noobs.ne.2 .AND. idiopt(1).eq.0 .AND. - & (isurft.eq.0.or.isurft.gt.nssta.or.isurft.lt.-2)) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid sfc station ISURFT =',isurft - write(io6,*) 'Number must be -1 or 1 to ',nssta - lerrcf=.TRUE. - endif - - if(idiopt(1).ne.0 .AND. isurft.eq.-1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'ISURFT=-1 not compatible with IDIOPT1=1' - lerrcf=.TRUE. - endif - - if(ITPROG.EQ.2 .AND. isurft.ne.-1 .and. isurft.ne.-2) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid ISURFT =',isurft - write(io6,*) 'ISURFT must be -1 or -2 with ITPROG=2' - lerrcf=.TRUE. - endif -c - -c --- New IUPT options in NOOBS mode - if (itprog.gt.0 .and. iupt.ne.-2.and.iupt.ne.-1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid IUPT =',iupt - write(io6,*) 'IUPT must be -2 or -1 with ITPROG>0' - lerrcf=.TRUE. - else if ( idiopt(2).eq.0 .AND. itprog.eq.0 .and. - : (iupt.lt.-1.or.iupt.eq.0 .or. iupt.gt.nusta) )then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid upper station IUPT =',iupt - write(io6,*) 'IUPT must be 1 to ',nusta - write(io6,*) 'or IUPT=-1 for 2-D spatial interpolation' - lerrcf=.TRUE. - endif - - -c frr (09/01) perform QA checks only if matters (i.e. not in noobs mode) - if(noobs .eq. 0) then - - if(iextrp .eq. 0 .or. iextrp .gt. 4 .or. iextrp .lt. -4) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid extrapolation IEXTRP =',iextrp - write(io6,*) 'Expected |IEXTRP| = 1,2,3,4' - lerrcf=.TRUE. - endif -c -c *** JC modifications of 8/23/93 for non-uniform first-guess field. *** - if(idiopt(3).eq.0 .AND. iupwnd.ne.-1 .AND. - & (iupwnd.lt.1.or.iupwnd.gt.nusta) ) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid upper station IUPWND =',iupwnd - write(io6,*) 'Number must be -1 or 1 to ',nusta - lerrcf=.TRUE. - endif - - endif -c - if(idiopt(4).eq.1.and.irtype.ne.0)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid wind option IDIOPT4 =',idiopt(4) - write(io6,*) 'Preprocessed wind input option is not allowed' - write(io6,*) 'when computing full meteorological fields ' - write(io6,*) '(i.e., IRTYPE = 1)' - lerrcf=.TRUE. - endif -c - if(idiopt(5).eq.1.and.irtype.ne.0)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Invalid wind option IDIOPT5 =',idiopt(5) - write(io6,*) 'Preprocessed wind input option is not allowed' - write(io6,*) 'when computing full meteorological fields ' - write(io6,*) '(i.e., IRTYPE = 1)' - lerrcf=.TRUE. - endif -c -c --- Check compatibility between iextrp and noobs -c frr (021105: ok to extrapolate if noobs=1) - if(noobs.gt.1 .and. abs(iextrp).ne.1) then - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Incorrect value of IEXTRP = ',iextrp - write(io6,*) 'Expected |IEXTRP|=1 with NOOBS= ',noobs - write(io6,*) 'Full Noobs mode (no surface observations)' - write(io6,*) 'Surface observations cannot be extrapolated' - lerrcf=.TRUE. - endif - - -c --- IG #6 -c --------- -c -c --- Implement regulatory checks on Group 6 if requested - if(mreg.EQ.1) then -c --- ICOARE must be 0 - if(icoare.NE.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of ICOARE = ',icoare - write(io6,*) 'FAILS Regulatory Check' - write(io6,*) 'ICOARE must be 0 when MREG = ',mreg - lerrcf=.TRUE. - endif -c --- THRESHL must be 0.0 - if(threshl.NE.0.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of THRESHL = ',threshl - write(io6,*) 'FAILS Regulatory Check' - write(io6,*) 'THRESHL must be 0.0 when MREG = ',mreg - lerrcf=.TRUE. - endif -c --- IMIXH must be -1 - if(imixh.NE.-1) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of IMIXH = ',imixh - write(io6,*) 'FAILS Regulatory Check' - write(io6,*) 'IMIXH must be -1 when MREG = ',mreg - lerrcf=.TRUE. - endif -c --- ISURFT must be -2 in NOOBS mode - if(itprog.eq.2 .and. isurft.NE.-2) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Incorrect value of ISURFT = ',isurft - write(io6,*) 'FAILS Regulatory Check' - write(io6,*) 'ISURFT must be -2 if ITPROG = 2 when ', - : 'MREG = ',mreg - lerrcf=.TRUE. - endif -c --- IUPT must be -2 in NOOBS mode - if(itprog.gt.0 .and. iupt.NE.-2) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 5' - write(io6,*) 'Incorrect value of IUPT = ',iupt - write(io6,*) 'FAILS Regulatory Check' - write(io6,*) 'IUPT must be -2 if ITPROG>0 when ', - : 'MREG = ',mreg - lerrcf=.TRUE. - endif -c --- IZICRLX must be 0 - if(izicrlx.NE.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of IZICRLX = ',izicrlx - write(io6,*) 'FAILS Regulatory Check' - write(io6,*) 'IZICRLX must be 0 when MREG = ',mreg - lerrcf=.TRUE. - endif - endif - - -c --- New mixing height parameters (frr 050328) -c --- Mixing Height parameterization - if (abs(imixh).ne.1 .and. abs(imixh).ne.2 )then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of IMXIH = ',imixh - write(io6,*) 'IMIXH must be 1,-1,2 or -2' - lerrcf=.TRUE. - endif - -c --- Overwater lapse rates (050328) - if (itwprog.ne.0 .and. itwprog.ne.1 .and. itwprog.ne.2 ) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Incorrect value of ITWPROG = ',itwprog - write(io6,*) 'ITWPROG must be 0, 1 or 2' - lerrcf=.TRUE. - else if (itwprog.eq.1 .and. iprog.lt.3)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Expected ITWPROG=0 with IPROG = ',iprog - lerrcf=.TRUE. - else if (itwprog.eq.2 .and. iprog.lt.13)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'ITWPROG=2 not possible with IPROG = ',iprog - lerrcf=.TRUE. - endif - -c --- Buoyancy energy flux thresholds - if (threshw.lt.0.) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'THRESHW must be >= 0 ' - lerrcf=.TRUE. - endif - if (threshl.lt.0.) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'THRESHL must be >= 0 ' - lerrcf=.TRUE. - endif - -c --- Check convective mixing height relaxation flag and time (110212) - if ((izicrlx.ne.1).and.(izicrlx.ne.0)) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'IZICRLX flag must be 1 (on) or 0 (off) ' - lerrcf=.TRUE. - endif - if (tzicrlx.lt.1.) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'TZICRLX must be greater than 1 second ' - write(io6,*) 'Default value is 800 seconds ' - lerrcf=.TRUE. - endif - - -c --- Check overwater boundary layer method - if ((icoare.ne.0).and.(icoare.ne.10).and. (abs(icoare).ne.11).and. - : (abs(icoare).ne.12)) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Unacceptable Overwater boundary layer option' - write(io6,*)'ICOARE must be 0,10,11,-11,12 or-12 but ICOARE=', - : icoare - lerrcf=.TRUE. - else -c --- set COARE wave method - jwave=max(0,abs(icoare)-10) - endif - -c --- Check coastal/shallow water length scale - if (dshelf.lt.0.) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'dshelf must be > 0 ' - lerrcf=.TRUE. - endif - -c --- Check warm layer/cool skin (050419) - if (iwarm.ne.1 .and. iwarm.ne.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'IWARM must be =0 or 1 ' - lerrcf=.TRUE. - endif - if (icool.ne.1 .and. icool.ne.0) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'ICOOL must be =0 or 1 ' - lerrcf=.TRUE. - endif - - -c --- Precipitation Option - if (nflagp .lt. 1 .or. nflagp .gt. 3) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Invalid precip option, NFLAGP = ',nflagp - write(io6,*) 'NFLAGP must be 1, 2, or 3' - lerrcf=.TRUE. - end if -c -c --- Check MXWB from PARAMETER file - if(mxwb .ne. 1)then - write(io6,*) - write(io6,*) 'READCF: Error in PARAMETER file' - write(io6,*) 'MXWB must be 1; found MXWB = ',mxwb - lerrcf=.TRUE. - endif -c -c --- Check temperature interpolation - if(irad .ne. 1 .and. irad .ne. 2) then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Invalid temp interp IRAD = ',irad - write(io6,*) 'IRAD must be 1 or 2' - lerrcf=.TRUE. - endif -c -c --- Check level for upwind averaging - if(iavezi.eq.1)then - if(ilevzi.le.0.or.ilevzi.gt.nz)then - write(io6,*) - write(io6,*) 'READCF: Error in Input Group 6' - write(io6,*) 'Invalid level ILEVZI =',ilevzi - write(io6,*) 'Number must be 1 to ',nz - lerrcf=.TRUE. - endif - endif - -c --- Write warning message to screen -c ----------------------------------- - if(LWARNCF) then - write(*,*)'WARNINGS are found in the CONTROL file' - write(*,*)'Review messages written to the LIST file' - endif - -c --- STOP now if error exists in the control file -c ------------------------------------------------ - if(LERRCF) then - write(*,*)'ERRORS are found in the CONTROL file' - write(*,*)'Review messages written to the LIST file' - stop - endif - -c ----------------------------------------- -c --- Coordinate Conversions & Translations -c ----------------------------------------- -c --- Get NIMA date for the transformation parameters - call NIMADATE(daten) - -c --- Assign lat/lon of projection origin to internal Nlat/Wlon variables - rlat0=rnlat0 - rlon0=-relon0 -c -c --- Calculate cone constant for LCC (used to adjust winds) - conec=0.0 - if(LLCC) then - d2r = 0.0174533 -c --- Use absolute value of latitudes, then adjust y coordinate -c --- later if in Southern Hemisphere - conec = log(cos(abs(xlat1) * d2r) / cos(abs(xlat2) * d2r)) - conec = conec / (log(tan(d2r * (45. - abs(xlat1) / 2.)) / - & tan(d2r * (45. - abs(xlat2) / 2.)))) - endif - -c --- v6.4.0, Level 121203 - if(LPS) then -c --- Conefactor is one for the polar stereograpic projection - conec = 1.0 - endif - -c --- Set translation vectors going from projection(x,y)km -c --- to N.lat/E.lon - iutmi=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmi=-iutmi - cmapi=pmap - if(cmapi.EQ.'TTM ') cmapi='TM ' - cmapo='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,iutmi,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & cmapo,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & caction,vecti,vecto) - -c --- Compute the N.lat/W.lon of the SW corner of the grid - call GLOBE(io6,caction,datum,vecti,datum,vecto, - & xorigkm,yorigkm,xelon0,xnlat0,izone,c4hem) - xlat0=xnlat0 - xlon0=-xelon0 - -c --- Compute N.latitude/W.longitude of each surface station - if(LCFSFC) then - do i=1,nssta - call GLOBE(io6,caction,datum,vecti,datum,vecto, - & xssta(i),yssta(i),xelon,xnlat,izone,c4hem) - xslat(i)=xnlat - xslon(i)=-xelon - enddo - endif - -c --- Compute N.latitude/W.longitude of each upper air station - if(LCFUPR) then - do i=1,nusta - call GLOBE(io6,caction,datum,vecti,datum,vecto, - & xusta(i),yusta(i),xelon,xnlat,izone,c4hem) - xulat(i)=xnlat - xulon(i)=-xelon - enddo - endif - -c --- Convert horizontal grid definition from km to m - dgrid = 1000. * dgridkm - xorigr = 1000. * xorigkm - yorigr = 1000. * yorigkm - -c --- Assign grid reference corner to 'MAP0' variables (km) - xmap0 = xorigkm - ymap0 = yorigkm - -c --- Assign overwater reference corner (km) - xor2 = xorigkm - yor2 = yorigkm - -c --- Convert Barriers to relative coordinates in km -c --- 050101: barxy loaded in common block D3.MET in km -c --- (no longer in wparm.met and no longer in meters) - do ibar = 1, nbar - barxy(1,ibar) = xbbar(ibar) - xorigkm - barxy(2,ibar) = ybbar(ibar) - yorigkm - barxy(3,ibar) = xebar(ibar) - xorigkm - barxy(4,ibar) = yebar(ibar) - yorigkm - enddo - -c --- Write grid origin latitude/longitude and cartesian coordinates - write(io6,*) - write(io6,*) - write(io6,*) - write(io6,*)'Grid origin coordinates: (SW corner of cell 1,1)' - write(io6,*)' XMAP0 = ',xmap0,' (km)' - write(io6,*)' YMAP0 = ',ymap0,' (km)' - write(io6,*)' N.Lat0 = ',xlat0,' (deg)' - write(io6,*)' E.Lon0 = ',xelon0,' (deg)' - write(io6,*)' W.Lon0 = ',xlon0,' (deg)' - -c --- Convert and Write SURFACE station parameters -c - if(nssta .eq. 0) then - write(io6,*) - write(io6,*)' NO SURFACE STATIONS - noobs MUST BE = 2 ' - elseif(.not.LCFSFC) then - write(io6,*) - write(io6,*)' NO SURFACE STATION DATA in control file ' - write(io6,*)' These data must be provided in SURF.DAT ' - else - write(io6,1485) - endif -1485 format(//30x,'SURFACE STATIONS'/69x,'Time',3x,'Anemometer',5x, - 1 'Grid Coordinates'/1x,'Name',5x,'ID',8x,' X ',8x,' Y ',6x, - 2 'NLatitude',4x,'WLongitude',2x,'Zone',4x,'Height',11x,'X',9x,'Y'/ - 3 20x,'(km)',9x,'(km)',9x,'(Deg)',8x,'(Deg)',14x,'(m)',10x, - 4 '(Origin = (0,0))'/) - - if(LCFSFC) then - do 1500 i=1,nssta - -c --- Convert from km to m, and into relative coordinates - xkm=xssta(i) - ykm=yssta(i) - - xssta(i)=1000.*xkm-xorigr - yssta(i)=1000.*ykm-yorigr - -c --- Compute grid coordinates for printing - xgrdc=xssta(i)/dgrid - ygrdc=yssta(i)/dgrid - - write(io6,1490)csnam(i),idssta(i),xkm,ykm,xslat(i),xslon(i), - 1 xstz(i),zanem(i),xgrdc,ygrdc -1490 format(1x,a4,1x,i8,3x,f10.1,3x,f10.1,3x,f10.3,3x,f10.3,2x, - 1 f5.1,3x,f5.1,7x,f10.3,f10.3) -1500 continue - -c --- compute delta longitudes -c --- (assumes Western Hemisphere longitudes are input -c --- as positive values) - EMI 07/28/92 - -c --- v6.4.0, Level 121203 - if(LLCC .OR. LPS) then - - do 1501 i=1,nssta - dlongs(i) = rlon0 - xslon(i) -c --- Code to handle 180 degree longitude straddle - if (dlongs(i) .gt. 180.) dlongs(i) = dlongs(i) - 360. - if (dlongs(i) .lt. -180.) dlongs(i) = dlongs(i) + 360. -1501 continue - endif - endif - -1502 continue - -c --- Convert and Write UPPER AIR station parameters - if(nusta .eq. 0) then - write(io6,*) - write(io6,*)' NO UPPER AIR STATIONS - noobs MUST BE >= 1' - elseif(.not.LCFUPR) then - write(io6,*) - write(io6,*)' NO UPPER AIR STATION DATA in control file ' - write(io6,*)' These data must be provided in UP.DATs ' - else - write(io6,1505) - endif -1505 format(//30x,'UPPER AIR STATIONS'/69x,'Time',5x, - 1 'Grid Coordinates'/1x,'Name',5x,'ID',8x,' X ',8x,' Y ', - 2 6x,'NLatitude',4x,'WLongitude',2x,'Zone',8x,'X',9x,'Y'/ - 3 20x,'(km)',9x,'(km)',9x,'(Deg)',8x,'(Deg)',14x, - 4 '(Origin = (0,0))'/) - - if(LCFUPR) then - do 1510 i=1,nusta - -c --- convert from km to m, and into relative coordinates - xkm=xusta(i) - ykm=yusta(i) - - xusta(i)=1000.*xkm-xorigr - yusta(i)=1000.*ykm-yorigr - -c --- compute grid coordinates for printing - xgrdc=xusta(i)/dgrid - ygrdc=yusta(i)/dgrid - - write(io6,1492)cunam(i),idusta(i),xkm,ykm,xulat(i),xulon(i), - 1 xutz(i),xgrdc,ygrdc -1492 format(1x,a4,3x,i5,4x,f10.1,3x,f10.1,3x,f10.3,3x,f10.3,2x, - 1 f5.1,2x,f10.3,f10.3) - -1510 continue - -c --- compute delta longitudes (assume Western Hemisphere is -c --- positive - EMI 07/28/92 - -c --- v6.4.0, Level 121203 - if(LLCC .OR. LPS) then - - do 1511 i=1,nusta -c --- Corrected for west longitudes which are defined as positive - dlongu(i) = rlon0 - xulon(i) -c --- Code to handle 180 degree longitude straddle - if (dlongu(i) .gt. 180.) dlongu(i) = dlongu(i) - 360. - if (dlongu(i) .lt. -180.) dlongu(i) = dlongu(i) + 360. -1511 continue - endif - endif -1512 continue - -c --- Write PRECIPITATION station data - if(npsta.le.0)then - write(io6,*) - write(io6,*)' NO PRECIPITATION STATIONS' - elseif(.not.LCFPRC) then - write(io6,*) - write(io6,*)' NO PRECIPITATION STATION DATA in control file ' - write(io6,*)' These data must be provided in PRECIP.DAT ' - else - write(io6,1605) - endif -1605 format(//30x,'PRECIPITATION STATIONS'// - 1 1x,'Name',5x,'ID',8x,' X ',8x,' Y ',7x,'Grid Coordinates'/ - 2 20x,'(km)',9x,'(km)',11x,'X',9x,'Y'/45x,'(Origin = (0,0))') -c -c --- MCB-E (071207) - Check should be on precipitation not upper air stations -c if(LCFUPR) then - if(LCFPRC) then - do 1610 i=1,npsta -c -c --- convert from km to m, and into relative coordinates - xkm=xpsta(i) - ykm=ypsta(i) -c - xpsta(i)=1000.*xkm-xorigr - ypsta(i)=1000.*ykm-yorigr -c -c --- compute grid coordinates for printing - xgrdc=xpsta(i)/dgrid - ygrdc=ypsta(i)/dgrid -c - write(io6,1609)cpnam(i),idpsta(i),xkm,ykm,xgrdc,ygrdc -1609 format(1x,a4,3x,i6,3x,f10.3,3x,f10.3,2x,f10.3,f10.3) -1610 continue - endif - -1611 continue - -c --- duplicate iprog variable for passing back to calling subr. - iprog2 = iprog -c --- duplicate option array for passing back to calling subr. - do 1573 i=1,5 - idiop2(i)=idiopt(i) -1573 continue -c - isl = 1 - istl = 0 -c convert to meters - do 5045 kl=1,nbox - xbcst(kl)=xbcst(kl)*1000.-xorigr - ybcst(kl)=ybcst(kl)*1000.-yorigr - xecst(kl)=xecst(kl)*1000.-xorigr - yecst(kl)=yecst(kl)*1000.-yorigr - istl=istl+nlb(kl) - do 5043 jk=isl,istl - ijk=jk-isl+1 - iboxid(kl,ijk)=metbxid(jk) -5043 continue - isl=isl + nlb(kl) -5045 continue - - - -c ------------------------------------------------ -c --- Print out Plot files with Met grid boundary -c --- [BNA format] (090511) -c ------------------------------------------------ - open(io4,file='QAMETG.bna',status='REPLACE') - -c --- Set Upper Right met grid corner (km) -c --- (Lower Left is xmap0,ymap0) - xUR=xmap0+FLOAT(nx)*dgridkm - yUR=ymap0+FLOAT(ny)*dgridkm - - write(io4,'(a15)') '" Met","grid",5' - write(io4,'(f12.4,a1,f12.4)') xmap0,',',ymap0 - write(io4,'(f12.4,a1,f12.4)') xmap0,',',yUR - write(io4,'(f12.4,a1,f12.4)') xUR, ',',yUR - write(io4,'(f12.4,a1,f12.4)') xUR, ',',ymap0 - write(io4,'(f12.4,a1,f12.4)') xmap0,',',ymap0 - close(io4) - - - -c ----------------------------------------------------------- -c ----------------- Print input parameters ------------------ -c ----------------------------------------------------------- - - write(io6,1420)ibyrn,ibmon,ibdyn,ibjuln,ibhrn,ibsecn, - : ieyrn,iemon,iedyn,iejuln,iehrn,iesecn,axtz, - : irlg,irtype,lcalgrd,itest,mreg - -1420 format(//2x,'Input group no. 1 -- General run parameters'/ - 1 5x,' Run starting date -- year: ',i4/ - 2 5x,' month: ',i4/ - 3 5x,' day: ',i4/ - 4 5x,' Julian day: ',i4/ - 5 5x,' hour: ',i4/ - 6 5x,' second: ',i4/ - 1 5x,' Run ending date -- year: ',i4/ - 2 5x,' month: ',i4/ - 3 5x,' day: ',i4/ - 4 5x,' Julian day: ',i4/ - 5 5x,' hour: ',i4/ - 6 5x,' second: ',i4/ - 6 5x,' UTC time zone: ',a8// - 7 5x,' Run length (hours): ',i4// - 8 5x,' Run type: ',i4,' (0=winds only, ', - 8 '1=winds + other met. variables)'/ - 9 5x,'Complete met fields computed: ',3x,l1// - a 5x,' TEST mode run: ',i4,' (1=yes, 2=no)'/ - 1 5x,' Regulatory check: ',i4,' (0=none, 1=USEPA)') -c - write(io6,1430)nx,ny,dgrid,xorigr,yorigr,xlat0,xlon0, - & pmap,datum,daten -1430 format(//2x,'Input group no. 2 -- Grid parameters'/ - 1 5x,' No. horizontal grid cells: ',4x,i4,' x ',i4/ - 2 5x,' Horizontal grid size (m): ',f9.0/ - 3 5x,' Reference coordinates of '/ - 4 5x,' SW corner of grid cell (1,1): (',f8.0,',',f8.0,')'/ - 5 5x,' N.Latitude SW corner of (1,1): ',f7.2/ - 6 5x,' W.Longitude SW corner of (1,1): ',f7.2/ - 7 5x,' Map Projection: ',a8/ - 8 5x,' NIMA Datum ID: ',a8/ - 9 5x,' NIMA Date: ',a12) - - if(LLCC.or.LLAZA.or.LTTM) then - write(io6,1431) feast,fnorth - endif - if(LUTM) then - write(io6,1432) utmhem,iutmzn - endif - if(LLCC.or.LPS.or.LEM.or.LLAZA.or.LTTM) then - write(io6,1433) rlat0,rlon0 - if(LLCC.or.LPS) write(io6,1434) xlat1 - if(LLCC) write(io6,1435) xlat2 - endif - -1431 format(5x,' False Easting at proj. origin: ',f12.3/ - & 5x,' False Northing at proj. origin: ',f12.3) -1432 format(5x,' UTM Hemisphere: ',a4/ - & 5x,' UTM Zone: ',i4) -1433 format(5x,' N.Latitude at proj. origin: ',f7.2/ - & 5x,' W.Longitude at proj. origin: ',f7.2) -1434 format(5x,' Standard N.Latitude #1: ',f7.2) -1435 format(5x,' Standard N.Latitude #2: ',f7.2) - - nzp1=nz+1 - write(io6,1436)nz,(zface(n),n=1,nzp1) -1436 format(/5x,' No. vertical grid cells: ',i8/ - 1 5x,'Vertical cell face heights (m): ',12f8.1/ - 2 (37x,12f8.1)) - -c --- Compute cell center heights for printing - do i=1,nz - zbuf(i)=0.5*(zface(i)+zface(i+1)) - enddo - write(io6,1437)(zbuf(n),n=1,nz) -1437 format(5x,' Cell center heights (m): ',12f8.1/ - 2 (37x,12f8.1)) - - write(io6,1445)lsave,iformo,lprint,iprinf,ldb,nn1,nn2,ldbcst -1445 format(//2x,'Input group no. 3 -- Output options'/ - 1 11x,'Meteorological fields save in disk file ? (LSAVE) = ',l5/ - 2 11x,' Format of output file (IFORMO) = ',i5, - 2 3x,'(1=CALMET, 2=MESOPAC II)'/ - 3 11x,' Meteorological fields printed ? (LPRINT) = ',l5/ - 4 11x,' Print interval (IPRINF) = ',i5/ - 5 5x,'Input met. data and internal parameters printed ? (LDB) = ', - 5 l5/ - 6 5x,' Time steps for which LDB parameters printed (NN1, NN2) = ', - 6 i5,' to ',i5,/ - 7 5x,'Distance to the coast printed in grd file? (LDBCST) = ', - 7 l5/) -c - write(io6,1446) -1446 format(/11x,'Control variables for printing of 3-D fields'/ - 1 20x,'(used only if LPRINT = .TRUE.)'/ - 2 25x,'(0=not printed, 1=printed)'/ - 3 21x,'LEVEL',3x,'U,V',4x,'W',4x,'TEMP'/) - do 3446 i=1,nz - write(io6,2446)i,iuvout(i),iwout(i),itout(i) -2446 format(21x,i3,6x,i1,5x,i1,5x,i1) -3446 continue -c - write(io6,1447)imtout -1447 format(/11x,'Control variables for printing of other met. fields' - 1 /20x,'(used only if LPRINT = .TRUE.)'/23x,'VARIABLE',21x, - 2 'PRINTED (0=no, 1=yes)'/ - 3 23x,'PGT stability class ',i1/ - 4 23x,'Friction velocity (u*) ',i1/ - 5 23x,'Monin-Obukhov length (L) ',i1/ - 6 23x,'Mixing height (zi) ',i1/ - 7 23x,'Convective velocity scale (w*) ',i1/ - 8 23x,'Precipitation rate ',i1// - 9 23x,'Sensible heat flux (Qh) ',i1/ - a 23x,'Convective mixing ht ',i1) -c - if(inputver.eq.'2.2') then - write(io6,1450)noobs,nssta,iforms,nusta,npsta,iformp,nowsta, - 1 icldout,mcloud -1451 format(//2x,'Input group no. 4 -- Meteorological data options'/ - 1 5x,' MM4/5 only flag (NOOBS): ',i4/ - 2 5x,' No. surface stations: ',i4,5x,'Format type: ',i4/ - 3 5x,' No. rawinsonde stations: ',i4/ - 4 5x,'No. precipitation stations: ',i4,5x,'Format type: ',i4/ - 5 5x,'(if NPSTA = -1: precipitation read from MM5)',/ - 6 5x,' No. overwater stations: ',i4/ - 7 5x,37x,'(Format type 1=unformatted, 2=formatted)'// - 8 5x,' Output of clouds data in a CLOUD.DAT file: ',i4/ - 9 5x,' (ICLDOUT=0, no output; ICLDOUT=1, output created) '/ - 1 5x,' Gridded cloud data option: ',i4/ - 2 5x,38x,'1=CLOUD from Observations in SURF.DAT,'/ - 3 5x,38x,'2=CLOUD.DAT read as INPUT and used,'/ - 4 5x,38x,'3=CLOUD computed from progn. RH at 850mb (Teixera),'/ - 5 5x,38x,'4=CLOUD computed from progn. RH at all levels', - 6 '(MM5toGrads)') - else - write(io6,1450)noobs,nssta,iforms,nusta,npsta,iformp,nowsta, - 1 icloud -1450 format(//2x,'Input group no. 4 -- Meteorological data options'/ - 1 5x,' MM4/5 only flag (NOOBS): ',i4/ - 2 5x,' No. surface stations: ',i4,5x,'Format type: ',i4/ - 3 5x,' No. rawinsonde stations: ',i4/ - 4 5x,'No. precipitation stations: ',i4,5x,'Format type: ',i4/ - 5 5x,'(if NPSTA = -1: precipitation read from MM5)',/ - 6 5x,' No. overwater stations: ',i4/ - 7 5x,37x,'(Format type 1=unformatted, 2=formatted)'// - 8 5x,' Gridded cloud data option: ',i4,5x,'(0=CLOUD.DAT not used,'/ - 9 5x,38x,'1=CLOUD.DAT created as OUTPUT,'/ - 1 5x,38x,'2=CLOUD.DAT read as INPUT,'/ - 2 5x,38x,'3=CLOUD computed from progn. RH at 850mb (Teixera),'/ - 3 5x,38x,'4=CLOUD computed from progn. RH at all levels', - 4 '(MM5toGrads)') - endif -c frr 030119 (new cloud option) -c - if(nbar.gt.0)then - write(io6,1460) -1460 format(//1x,5('-'),' BARRIER PARAMETERS',5('-')) - write(io6,1461)kbar -1461 format(//1x,5x,' Barriers extending to layer kbar= ',i2) - - write(io6,1462) -1462 format(//1x,5('-'),' Beginning ',5('-'),5x,6('-'),' Ending ', - 1 7('-'),6x,'Beginning',9x,'Ending'/6x,'X',11x,'Y',13x,'X',11x, - 2 'Y',10x,'I',6x,'J',8x,'I',6x,'J'/) -c - do 1465 j=1,nbar -c -c --- convert back to original km (from relative coord. in m) -c --- for printing -c --- Use original barrier input coordinate (why recompute??) (050101) -c x1km=0.001*xybar(1,j)+xorigkm -c y2km=0.001*xybar(2,j)+yorigkm -c x3km=0.001*xybar(3,j)+xorigkm -c y4km=0.001*xybar(4,j)+yorigkm -c - i1=barxy(1,j)/dgridkm - j1=barxy(2,j)/dgridkm - i2=barxy(3,j)/dgridkm - j2=barxy(4,j)/dgridkm - -c write(io6,1463)x1km,y2km,x3km,y4km,i1,j1,i2,j2 - write(io6,1463)xbbar(j),ybbar(j),xebar(j),yebar(j),i1,j1,i2,j2 -1463 format(1x,2(f9.1,3x,f9.1,5x),2(i4,3x,i4,5x)) -1465 continue - - endif -c - write(io6,1470)iwfcod,lvary,rmax1,rmax2,rmax3,rmin,terrad,r1,r2 - write(io6,1472)(nintr2(n),n=1,nz) - write(io6,1476)iprog,rprog -1470 format(//2x,'Input group no. 5 -- Wind field parameters'/ - 1 5x,' Wind field code = ',i8, - 1 ' (0 = objective analysis, 1 = diagnostic)'/ - 1 5x,'Varying radius of influence (LVARY) = ',9x,L1,/ - 2 5x,'Radius of influence - land - surface (rmax1) = ',f10.1, - 2 ' (km)'/ - 3 5x,'Radius of influence - land - aloft (rmax2) = ',f10.1, - 3 ' (km)'/ - 4 5x,'Radius of influence - water (rmax3) = ',f10.1, - 4 ' (km)'/ - 5 5x,'Radius of influence - minimum (rmin) = ',f10.1, - 5 ' (km)'/ - 6 5x,'Radius of influence - terrain (terrad) = ',f10.1, - 6 ' (km)'/ - 7 5x,'Weighting parameter - surface (r1) = ',f10.1/ - 8 5x,'Weighting parameter - aloft (r2) = ',f10.1) -1472 format(/5x,'Maximum no. stations used in interpolation at one ', - 1 'grid point in each level (nintr2):'/(10x,20i4/)) -1476 format(/5x,'Gridded prognostic model results used as input = ',i2/ - 1 7x,'0 = no',/ - 2 7x,'1 = Use CSUMM model winds as Step 1 inputs'/ - 3 7x,'2 = Use CSUMM model winds as initial guess field'/ - 4 7x,'3 = Use MM4.DAT file winds as Step 1 inputs',/ - 5 7x,'4 = Use MM4.DAT file winds as initial guess field'/ - 6 7x,'5 = Use MM4.DAT file winds as "observations"'/ - 7 6x,'13 = Use MM5.DAT file winds as Step 1 inputs',/ - 8 6x,'14 = Use MM5.DAT file winds as initial guess field'/ - 9 6x,'15 = Use MM5.DAT file winds as "observations"'/ - 1 5x,'Weighting parameter for prognostic ', - 2 'data (rprog) = ',f10.1,' (km)'/) -c - if (iprog.gt.0) write(io6,1477)isteppgs -1477 format(/5x,'Prognostic model output timestep (seconds):',i5) - - write(io6,1478)igfmet -1478 format(/5x,'Use coarse CALMET fields as IGF:',i4,/ - 1 7x,'0 = no',/ - 2 7x,'1 = yes'/) - - - write(io6,1497)llbreze,nbox - do 3456 jk=1,nbox - write (io6,1498)jk,xg1(jk),xg2(jk),yg1(jk),yg2(jk), - 1 xbcst(jk),ybcst(jk),xecst(jk),yecst(jk),nlb(jk), - 2 (iboxid(jk,kk),kk=1,nlb(jk)) -3456 continue -1497 format(/2x,'LAKE BREEZE parameters'/ - 2 5x,'Utilize the Lake Breeze Module of CALMET (LLBREZE) = ',L1,/ - 2 5x,'Number of regions (NBOX) = ',i10,/) -1498 format(/3x,'Inputs for BOX # ',i10,/ - 2 5x,'Four grid lines will determine the region of influence',/ - 3 5x,' X-GRID 1 : ',f10.1,/ - 3 5x,' X-GRID 2 : ',f10.1,/ - 3 5x,' Y-GRID 1 : ',f10.1,/ - 3 5x,' Y-GRID 2 : ',f10.1,/ - 4 5x,'Beginning of coastline = ',2f10.1,'(M)',/ - 5 5x,'End of coastline =',2f10.1,'(M)',/ - 6 5x,'Number of Met Stations within the region = ',i10,/ - 7 5x,'Met Station Id numbers :',/(10x,20i6/)) -c - write(io6,*) - write(io6,*)'divlim,niter = ',divlim,niter - write(io6,*)'nsmth ',(nsmth(n),n=1,nz) - write(io6,*)'iextrp = ',iextrp,' rmin2 = ',rmin2, - 1 ' fextr2 = ',fextr2 - write(io6,*)'bias = ',(bias(n),n=1,nz) - write(io6,*)'critfn,terrad,ifradj,ikine,alpha,iobr = ', - 1 critfn,terrad,ifradj,ikine,alpha,iobr - write(io6,*)'islope,icalm',islope,icalm - write(io6,*)'nzprn2,ipr0,ipr1,ipr2,ipr3,ipr4,ipr5,ipr6,ipr7,', - 1 'ipr8,ioutd = ',nzprn2,ipr0,ipr1,ipr2,ipr3,ipr4,ipr5,ipr6,ipr7, - 2 ipr8,ioutd -c - write(io6,1575)idiopt -1575 format(/5x,'Specification for diagnostic wind module data input' - 1 //10x,' Surface temperature: ',i1, - 1 ' (0=computed internally, 1=preprocessed values input)' - 2 /10x,'Domain-averaged temp. lapse rate: ',i1, - 2 ' (0=computed internally, 1=preprocessed values input)' - 3 /10x,' Domain-averaged wind components: ',i1, - 3 ' (0=computed internally, 1=preprocessed values input)' - 4 /10x,' Surface wind components: ',i1, - 4 ' (0=computed internally, 1=preprocessed values input)', - 5 /10x,' Upper air wind components: ',i1, - 5 ' (0=computed internally, 1=preprocessed values input)') -c -c --- if computing surface temp., write surface station no. to use -c FRR (noobs option) -c if(idiopt(1).eq.0)then - if(idiopt(1).eq.0 .and. itprog.lt.2 )then - write(io6,*) - write(io6,*)' Surface station no. used for surf. temp. ', - 1 'in diagnostic wind field module (-1 is 2D array): ',isurft - endif -c -c --- if computing domain-ave temp. lapse rate, write upper air station -c --- no. to use, and depth through which to average - - if(idiopt(2).eq.0)then -c - write(io6,*) - - if (iupt.eq.-1) then - write(io6,*)' 2-D varying temperature lapse rate (IUPT=-1)' - if (noobs.eq.0) then - write(io6,*)' Interpolating between all upper air', - 1 ' stations' - else - write(io6,*)' Interpolating prognostic data' - endif - else - write(io6,*)' Domain averaged lapse rate ' - if (noobs.eq.0) then - write(io6,*)' Upper air station no. used for ', - 1 'domain-averaged temp. lapse rate (IUPT): ',iupt - else - write(io6,*)' Prognostic data used for domain-', - 1 'averaged temp. lapse rate ' - endif - endif - write(io6,*)' Depth through which temp.lapse rate ', - 1 'is computed (ZUPT): ',zupt - - endif -c -c --- if computing domain-ave wind components, read upper air station -c --- no. to use, and depth through which to average - if(idiopt(3).eq.0.and.IUPWND.GT.0.and.NOOBS.EQ.0)then -c - write(io6,*) - write(io6,*)' Upper air station no. used for domain-', - 1 'averaged wind components (IUPWND): ',iupwnd - write(io6,*)' (IUPWND = -1 to use all stations -- i.e., ', - 1 'spatially-variable initial ' - write(io6,*)' guess field)' - write(io6,*)' Depth through which domain-averaged wind ', - 1 'components are computed: ',zupwnd(1),' TO ',zupwnd(2) - endif -c -c --- write message if preprocessed surface and upper air components -c --- are used (allowed only if met. fields other than winds are not -c --- being computed) - if(idiopt(4).eq.1)then - write(io6,*) - write(io6,*)' Preprocessed surface winds are read ', - 1 'from an input file' - endif - if(idiopt(5).eq.1)then - write(io6,*) - write(io6,*)' Preprocessed upper air winds are read ', - 1 'from an input file' - endif -c - write(io6,1578)constb,conste,constn,constw,fcoriol,dptmin, - & dzzi,nflagp,sigmap,cutp -1578 format(//2x,'Input group no. 6 -- Mixing height, temperature,', - 1 ' radiation and precipitation parameters'/ - 1 5x,' Neutral mechanical mix. ht. constant (constb) = ',f10.4/ - 2 5x,' Convective mixing height constant (conste) = ',f10.4/ - 3 5x,' Stable mixing height constant (constn) = ',f10.4/ - 3 5x,' Overwater mixing height constant (constw) = ',f10.4/ - 4 5x,'Absolute value of Coriolis parameter (fcoriol) = ',1pe10.3, - 4 ' (1/s)'// - 5 5x,' Minimum pot. temp. lapse rate in layer above',/ - 5 5x,' current mixing height (dptmin) = ',0pf10.4, - 5 ' (deg. K/m)'/ - 6 5x,' Depth of layer above mixing height used to '/ - 6 5x,' compute lapse rate (dzzi) = ',f10.4, - 6 ' (m)'/ - 6 5x,' Precip interp. option: ',i4/ - 7 5x,' Rad. Inf. for Precip (km): ',f10.4/ - 8 5x,' Min. Prec. cutoff (mm/hr): ',f10.4) - - - write(io6,1479)imixh, threshl,threshw,itwprog -1479 format(/5('-'),'Convective Mixing Height options',5('-'),/ - 1 5x,' Method used to compute mixing height (imixh)',i4,/ - 2 7x,' 1 = Maul-Carson for land and water cells'/ - 3 7x,'-1 = Maul-Carson for land cells only; OCD overwater'/ - 4 7x,' 2 = Batchvarova and Gryning for land and water cells'/ - 5 7x,'-2 = Batchvarova and Gryning for land cells only;', - 5 'OCD overwater'// - 6 5x,' Threshold buoyancy fluxes required to sustain convective'/ - 6 5x,' mixing height growth (in W/m3):'/ - 7 7x,' Overland (THRESHL) = ',f6.3,/ - 7 7x,' Overwater (THRESHW) = ',f6.3,/ - 8 5x,' Overwater lapse rates used in conv. mix.hgt growth:',i3/ - 9 7x,' 0 : SEA.DAT lapse rates and deltaT (neutral if missing)'/ - 9 7x,' 1 : progn. lapse rates & SEA.DAT deltaT (neutral if mis.)'/ - 9 7x,' 2 : progn.lapse rates and progn. deltaT' ) - - if (iprog.gt.2) write(io6,1579)iluoc3d -1579 format(/5x,' LU category in progn. datasets (ILUOC3d):',i4) -c - - write(io6,1580)icoare -1580 format(/5('-'),'Overwater surface fluxes',5('-'),/ - 1 5x,' Method used to compute overwater fluxes (icoare)',i4,/ - 2 7x,' 0 = original deltaT method (OCD)'/ - 3 7x,' 10 = COARE with no wave parameterization'/ - 4 7x,' 11 = COARE with wave option jwave=1 (Oost et al.)'/ - 5 7x,'-11 = COARE with wave option jwave=1 and obs. wave prop.'/ - 6 7x,' 12 = COARE with wave option jwave=2 (Taylor and Yelland)'/ - 7 7x,'-11 = COARE with wave option jwave=2 and obs. wave prop.'/) - -c --- Echo internal switches set by ICOARE: - write(io6,*)' (internal ipsifcn set to ',ipsifcn,')' - write(io6,*)' (internal isfcmet set to ',isfcmet,')' - - if(icoare.gt.0) write (io6,1581)dshelf,iwarm,icool -1581 format(/ - 1 5x,'Coastal/Shallow water length scale (DSHELF in km)',f6.1,/ - 2 5x,'COARE warm layer computation (IWARM)(1:on-0:off):',i3,/ - 3 5x,'COARE cool skin computation (ICOOL)(1:on-0:off):',i3,/) - - - - -c - write(io6,1480)zimax,zimin,ziminw,zimaxw -1480 format(//, - : 5('-'),' Other Mixing Height Parameters',5('-'),/ - 1 5x,' Maximum overland mixing height (zimax) = ',f10.4, - 1 ' (m)'/ - 2 5x,' Minimum overland mixing height (zimin) = ',f10.4, - 2 ' (m)'/ - 3 5x,' Minimum computed overwater mixing ht (ziminw) = ',f10.4, - 3 ' (m)'/ - 4 5x,' Maximum computed overwater mixing ht (zimaxw) = ',f10.4, - 4 ' (m)') -c - write(io6,1482)iavezi,mnmdav,hafang,ilevzi -1482 format(/ - 1 5x,' Spatial averaging of mixing hts. ? (iavezi) = ',i10, - 1 ' (0=no, 1=yes)'/ - 2 5x,' Max. search radius in mixing ht ave. (mnmdav) = ',i10, - 2 ' (grid cells)'/ - 3 5x,' Half-angle of upwind cone (hafang) = ',f10.4, - 3 ' (deg.)'/ - 4 5x,' Level of winds used in upwind ave. (ilevzi) = ',i10) -c - write(io6,1483)irad - 1483 format(/ - & 5x,'Temperature interpolation type (1=1/R;2=1/R**2)= ',i10) -c - write(io6,2484)tradkm - 2484 format(/5x,'Radius of influence - temperature ', - 1 'interpolation= ',f10.1,' (km)') -c - write(io6,2483)itprog - 2483 format(/5x,'3-D temperature option- ITPROG =',i2,/ - 1 5x,'0= Temperature from surface and upper air observations'/ - 2 5x,'1= Temperature from surface obs. and prognostic data '/ - 3 5x,'2= Temperature from prognostic data only') - -c write(io6,2485)numts - 2485 format(/ - & 5x,'Maximum # stations, temperature interpolation = ',i10) -c - write(io6,1486)iavet - 1486 format(/ - & 5x,'Spatial averaging of temperature ? (iavet) = ',i10, - & ' (0=no, 1=yes)') -c - write(io6,1495)tgdefb - 1495 format(/ - & 5x,'Default T gradient below mix. ht. over water = ',f10.4, - & ' (K/m)') -c - write(io6,1496)tgdefa - 1496 format(/ - & 5x,'Default T gradient above mix. ht. over water = ',f10.4, - & ' (K/m)') -c - write(io6,1484) -1484 format(//1x,' Beginning land use ',5x,' Ending ', - 1 'land use for water interpolation '/) - write(io6,1489) jwat1(1),jwat2(1) -1489 format(1x,8x,i5,16x,i5) -c -c --- Heat flux parameters - write(io6,1491)ha1,ha2,hb1,hb2,hc1,hc2,hc3 -1491 format(//1x,'Radiation parameters'/ - 1 5x,'Turbidity coefficient 1 (ha1) = ',f10.2,' (W/m**2)'/ - 2 5x,'Turbidity coefficient 2 (ha2) = ',f10.2,' (W/m**2)'/ - 3 5x,'Cloudiness coefficient 1 (hb1) = ',f10.4/ - 4 5x,'Cloudiness coefficient 2 (hb2) = ',f10.4/ - 5 5x,'Net radiation coefficient 1 (hc1) = ',1pe12.4, - 5 ' (W/m**2/K**6)'/ - 6 5x,'Net radiation coefficient 2 (hc2) = ',0pf10.2,'(W/m**2)'/ - 7 5x,'Net radiation coefficient 3 (hc3) = ',f10.4) - -c - - - - return - end -c---------------------------------------------------------------------- - subroutine readge(ldb) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 030515 READGE -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Read geophysical data from data file (GEO.DAT) -c -c land use (ILANDU), terrain elevations (ELEV), -c surface roughness (Z0), albedo (ALBEDO), -c Bowen ratio (BOWEN), soil heat flux parameter (HCG), -c anthropogenic heat flux (QF), leaf area index (XLAI) -c -c --- UPDATE -c Ver 5.51, Level 030515 from Ver 5.5 Level 030402 D. Strimaitis -c - Add read for false easting/northing for LCC,LAZA,TTM -c - Fix reference lat/lon variable names for QA tests -c Ver 5.5, Level 030402 from Ver 5.4 Level 000602d D. Strimaitis -c - New header for GEO.DAT file -c - LLCONF replaced with LLCC -c - /MAP/ replaces /LON/ -c - Transfer header comments to scratch file -c -c --- INPUTS: -c LDB - logical - Control variable determining -c the printing of internal arrays -c (useful for testing) -c Common block /QA/ variables: -c NCOMMOUT -c Common block /GEO/ variables: -c IOGEO -c Common block /GRID/ variables: -c NX, NY, DGRID, XORIGR, YORIGR -c Common block /MAP/ variables: -c iutmzn,feast,fnorth, -c rnlat0,relon0,xlat1,xlat2, -c pmap,utmhem,datum -c Parameters: MXNX, MXNY, MXNZ, MXNZP1, MXLU, IO6, IOX -c -c --- OUTPUT: -c Common block /QA/ variables: -c NCOMMOUT -c Common block /GEO/ variables: -c ILANDU(mxnx,mxny), ELEV(mxnx,mxny), Z0(mxnx,mxny), -c XLAI(mxnx,mxny), -c NLU, ILUCAT(mxlu), IWAT1, IWAT2 (if IOPT(1) = 1) -c Common block /HFLUX/ variables: -c ALBEDO(mxnx,mxny),BOWEN(mxnx,mxny),HCG(mxnx,mxny), -c QF(mxnx,mxny) -c -c --- READGE called by: SETUP -c --- READGE calls: FILLGEO, OUT, ALLCAP, LRSAME, XTRACTLL -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - - include 'qa.met' - include 'geo.met' - include 'grid.met' - include 'hflux.met' - include 'map.met' - - integer iopt(7) - logical ldb,ldate - character*70 messag - character*80 titlege - -c --- Local Variables for GEO.DAT - character*16 dataset,dataver,blank16 - character*64 datamod - character*4 xyunitin - character*8 pmapin,utmhemin,datumin - character*12 datenin - character*16 clat0in,clon0in,clat1in,clat2in - character*33 blank33,break33 - character*132 blank,break - - logical lutmin,llccin,lpsin,lemin,llazain,lttmin - logical LRSAME - logical lerror - - data ldate/.false./ - data nlim/1/ - data blank16/' '/ - - data blank33/' '/ - data break33/'.................................'/ - -c --- Set blank (132 characters) - blank(1:33)=blank33 - blank(34:66)=blank33 - blank(67:99)=blank33 - blank(100:132)=blank33 - -c --- Set break (132 characters) - break(1:33)=break33 - break(34:66)=break33 - break(67:99)=break33 - break(100:132)=break33 - - lutmin =.FALSE. - llccin =.FALSE. - lpsin =.FALSE. - lemin =.FALSE. - llazain=.FALSE. - lttmin =.FALSE. - - lerror=.FALSE. - - clat0in=blank16 - clon0in=blank16 - clat1in=blank16 - clat2in=blank16 - - write(io6,*) - write(io6,*) - write(io6,*) - write(io6,'(a30,50x)')'GEO.DAT File Header ----------' - write(io6,*) - -c --- Dataset, Version, Modifier - read(iogeo,'(2a16,a64)') dataset,dataver,datamod - write(io6,'(2a16,a64)') dataset,dataver,datamod -c --- Convert Dataset to upper case - do i=1,16 - call ALLCAP(dataset(i:i),nlim) - enddo - if(dataset.NE.'GEO.DAT') then -c --- FATAL ERROR - write(io6,*) - write(io6,*)'READGE: Invalid input file DATASET: ',dataset - write(io6,*)' Expected GEO.DAT' - lerror=.TRUE. - goto 999 - endif -c --- To scratch file - write(iox,'(a132)') blank - write(iox,'(a132)') break - write(iox,'(a132)') blank - write(iox,'(2a16,a64)') dataset,dataver,datamod - ncommout=ncommout+4 - -c --- Number of comment records - read(iogeo,'(i4)') ncomment - write(io6,'(i4)') ncomment - -c --- Comment (optional/repeatable) - do i=1,ncomment - read(iogeo,'(a80)') titlege - write(io6,'(a80)') titlege -c --- To scratch file - write(iox,'(a80)') titlege - ncommout=ncommout+1 - enddo - -c --- Map projection - read(iogeo,'(a8)') pmapin - write(io6,'(a8)') pmapin - do i=1,8 - call ALLCAP(pmapin(i:i),nlim) - enddo - - if(pmapin.EQ.'UTM ') lutmin =.TRUE. - if(pmapin.EQ.'LCC ') llccin =.TRUE. - if(pmapin.EQ.'PS ') lpsin =.TRUE. - if(pmapin.EQ.'EM ') lemin =.TRUE. - if(pmapin.EQ.'LAZA ') llazain=.TRUE. - if(pmapin.EQ.'TTM ') lttmin =.TRUE. - -c --- Map projection parameters - if(LUTMIN) then - read(iogeo,'(i4,a4)') izonein,utmhemin - write(io6,'(i4,a4)') izonein,utmhemin - elseif(LLCCIN) then - read(iogeo,'(4a16)') clat0in,clon0in,clat1in,clat2in - write(io6,'(4a16)') clat0in,clon0in,clat1in,clat2in - elseif(LPSIN) then - read(iogeo,'(3a16)') clat0in,clon0in,clat1in - write(io6,'(3a16)') clat0in,clon0in,clat1in - elseif(LEMIN.or.LLAZAIN.or.LTTMIN) then - read(iogeo,'(2a16)') clat0in,clon0in - write(io6,'(2a16)') clat0in,clon0in - endif -c --- Map false Easting/Northing - if(LLCCIN.or.LLAZAIN.or.LTTMIN) then - read(iogeo,*) feastin,fnorthin - write(io6,*) feastin,fnorthin - else - feastin=feast - fnorthin=fnorth - endif -c --- Map DATUM - read(iogeo,'(a8,a12)') datumin,datenin - write(io6,'(a8,a12)') datumin,datenin - do i=1,8 - call ALLCAP(datumin(i:i),nlim) - enddo -c --- Grid - read(iogeo,'(2i8,4f12.3)') nxin,nyin,xorin,yorin,dgridin,dgridin - write(io6,'(2i8,4f12.3)') nxin,nyin,xorin,yorin,dgridin,dgridin -c --- XYUNIT - read(iogeo,'(a4)') xyunitin - write(io6,'(a4)') xyunitin - write(io6,*) - write(io6,*) - - -c --- QA header information -c ------------------------- - -c --- Units - do i=1,4 - call ALLCAP(xyunitin(i:i),nlim) - enddo - if(xyunitin.NE.'KM ') then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' XY units must be KM' - write(io6,*)' Input file: ',xyunitin - lerror=.TRUE. - endif - -c --- Grid information -c --- Convert from km to m - dgridm=1000.*dgridin - xorm=1000.*xorin - yorm=1000.*yorin - if(nx.NE.nxin.OR.ny.NE.nyin) then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' Number of grid cells does not match' - write(io6,*)' Input file NX,NY : ',nxin,nyin - write(io6,*)' Control file NX,NY: ',nx,ny - lerror=.TRUE. - endif - if(.not.LRSAME(0.0001,dgridm,dgrid))then - write(io6,*) - write(io6,*)'READGE: Problem in input file type: ',dataset - write(io6,*)' Grid cell size does not match' - write(io6,*)' Input file : ',dgridm - write(io6,*)' Control file: ',dgrid - lerror=.TRUE. - endif - if((.not.LRSAME(0.0001,xorm,xorigr)).or. - 1 (.not.LRSAME(0.0001,yorm,yorigr)))then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' SW corner coordinates do not match' - write(io6,*)' Input file xm,ym : ',xorm,yorm - write(io6,*)' Control file xm,ym: ',xorigr,yorigr - lerror=.TRUE. - endif - -c --- Projection checks - if(pmap.NE.pmapin) then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' Map projection PMAP does not match' - write(io6,*)' Input file : ',pmapin - write(io6,*)' Control file: ',pmap - lerror=.TRUE. - endif - if(LUTMIN .AND. LUTM) then - if(izonein.NE.iutmzn)then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' UTM zone does not match' - write(io6,*)' Input file : ',izonein - write(io6,*)' Control file: ',iutmzn - lerror=.TRUE. - endif - if(utmhemin.NE.utmhem)then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' UTM Hemisphere does not match' - write(io6,*)' Input file : ',utmhemin - write(io6,*)' Control file: ',utmhem - lerror=.TRUE. - endif - endif - -c --- False Easting/Northing checks - if(.not.LRSAME(0.0001,feastin,feast))then - write(io6,*) - write(io6,*)'RDHEAD: Problem in input file type: ',dataset - write(io6,*)' False Easting does not match' - write(io6,*)' Input file : ',feastin - write(io6,*)' Control file: ',feast - lerror=.TRUE. - endif - if(.not.LRSAME(0.0001,fnorthin,fnorth))then - write(io6,*) - write(io6,*)'RDHEAD: Problem in input file type: ',dataset - write(io6,*)' False Northing does not match' - write(io6,*)' Input file : ',fnorthin - write(io6,*)' Control file: ',fnorth - lerror=.TRUE. - endif - -c --- Check lat/lon variables - if(clat0in(1:1).NE.' ') then - call XTRACTLL(io6,'LAT ',clat0in,reflatin) - if(.not.LRSAME(0.0001,reflatin,rnlat0))then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' REFLAT does not match' - write(io6,*)' Input file : ',reflatin - write(io6,*)' Control file: ',rnlat0 - lerror=.TRUE. - endif - endif - if(clon0in(1:1).NE.' ') then - call XTRACTLL(io6,'LON ',clon0in,reflonin) - if(.not.LRSAME(0.0001,reflonin,relon0))then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' REFLON does not match' - write(io6,*)' Input file : ',reflonin - write(io6,*)' Control file: ',relon0 - lerror=.TRUE. - endif - endif - if(clat1in(1:1).NE.' ') then - call XTRACTLL(io6,'LAT ',clat1in,xlat1in) - if(.not.LRSAME(0.0001,xlat1in,xlat1))then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' XLAT1 does not match' - write(io6,*)' Input file : ',xlat1in - write(io6,*)' Control file: ',xlat1 - lerror=.TRUE. - endif - endif - if(clat2in(1:1).NE.' ') then - call XTRACTLL(io6,'LAT ',clat2in,xlat2in) - if(.not.LRSAME(0.0001,xlat2in,xlat2))then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' XLAT2 does not match' - write(io6,*)' Input file : ',xlat2in - write(io6,*)' Control file: ',xlat2 - lerror=.TRUE. - endif - endif - -c --- DATUM - if(datumin.NE.datum)then - write(io6,*) - write(io6,*)'READGE: Problem in input file: ',dataset - write(io6,*)' DATUM does not match' - write(io6,*)' Input file : ',datumin - write(io6,*)' Control file: ',datum - lerror=.TRUE. - endif - -c --- STOP now if error exists in the header -999 if(LERROR) then - write(*,*)'ERRORS are found in the input GEO.DAT file' - write(*,*)'Review messages written to the LIST file' - stop - endif - -c -c --- ********** LAND USE DATA - read(iogeo,*)iopt(1) - if(iopt(1).eq.0)then - write(io6,14) -14 format(/1x,'Default land use categories used') - else if(iopt(1).eq.1)then -c -c --- read new land use categories - read(iogeo,*)nlu,iwat1,iwat2 - if(nlu.le.0.or.nlu.gt.mxlu)then - write(io6,11)nlu,mxlu -11 format(//2x,'ERROR IN SUBR. READGE -- invalid value of ', - 1 'NLU -- NLU = ',i5,2x,'MXLU = ',i5) - stop - endif -c - read(iogeo,*)(ilucat(n),n=1,nlu) - write(io6,12)nlu,iwat1,iwat2,(ilucat(n),n=1,nlu) -12 format(//1x,'New land use categories entered' - 1 /5x,'No. categories (nlu) = ',i5 - 2 /5x,'Range of land use categories corresponding to WATER = ', - 3 i5,' to ',i5/5x,'New land use categories: ',20i5, - 4 (/30x,20i5)) - endif -c -c --- read and print gridded land use data - do 20 j=ny,1,-1 - read(iogeo,*)(ilandu(n,j),n=1,nx) -20 continue - messag='Land use categories' - call out(xdum,ilandu,2,5,ldate,messag,nx,ny) -c -c --- ********** TERRAIN ELEVATIONS -c -c --- read factor for conversion to meters - read(iogeo,*)htfac -c - do 30 j=ny,1,-1 - read(iogeo,*)(elev(n,j),n=1,nx) -30 continue -c -c --- print terrain data in user units - write(io6,32)htfac -32 format(//1x,'Factor to convert user TERRAIN HEIGHT units ', - 1 'to meters (HTFAC) = ',f10.4) - messag='Terrain heights (user units)' - call out(elev,idum,1,5,ldate,messag,nx,ny) -c -c --- if necessary, convert user units to m - if(htfac.ne.1.0)then - do 40 i=1,nx - do 40 j=1,ny - elev(i,j)=htfac*elev(i,j) -40 continue - endif -c -c --- ********** SURFACE ROUGHNESS - read(iogeo,*)iopt(2) -c -c --- read Z0 data or compute from land use categories - call fillgeo(iogeo,iopt(2),ilucat,nlu,z0lu,ilandu,nx,ny,z0) - if(iopt(2).eq.0)then -c -c --- print DEFAULT z0-land use table - write(io6,121) -121 format(//2x,'Surface roughness (z0) computed from default ', - 1 'z0-land use table') - write(io6,122) -122 format(//2x,'Land Use',6x,'Roughness'/2x,'Category',8x, - 1 'Length'/19x,'(m)'/) - do 128 i=1,nlu - write(io6,125)ilucat(i),z0lu(i) -125 format(3x,i4,6x,f10.4) -128 continue - else if(iopt(2).eq.1)then -c -c --- print USER-INPUT z0-land use table - write(io6,131) -131 format(//2x,'Surface roughness (z0) computed from USER-INPUT ', - 1 'z0-land use table') - write(io6,122) - do 138 i=1,nlu - write(io6,125)ilucat(i),z0lu(i) -138 continue - else -c -c --- user-input gridded z0 field - messag='Gridded surface roughness length field (m)' - call out(z0,idum,1,5,ldate,messag,nx,ny) - endif -c -c --- ********** ALBEDO - read(iogeo,*)iopt(3) -c -c --- read ALBEDO data or compute from land use categories - call fillgeo(iogeo,iopt(3),ilucat,nlu,alblu,ilandu,nx,ny,albedo) - if(iopt(3).eq.0)then -c -c --- DEFAULT albedo-land use table used - write(io6,141) -141 format(//2x,'Albedo computed from default ', - 1 'albedo-land use table') - else if(iopt(3).eq.1)then -c -c --- print USER-INPUT albedo-land use table - write(io6,142) -142 format(//2x,'Albedo computed from USER-INPUT ', - 1 'albedo-land use table') - write(io6,143) -143 format(//2x,'Land Use',5x,' Albedo '/2x,'Category'/) - do 148 i=1,nlu - write(io6,125)ilucat(i),alblu(i) -148 continue - else -c -c --- user-input gridded albedo field - messag='USER-INPUT albedo field' - call out(albedo,idum,1,5,ldate,messag,nx,ny) - endif -c -c --- ********** BOWEN RATIO - read(iogeo,*)iopt(4) -c -c --- read BOWEN RATIO data or compute from land use categories - call fillgeo(iogeo,iopt(4),ilucat,nlu,bowlu,ilandu,nx,ny,bowen) - if(iopt(4).eq.0)then -c -c --- DEFAULT Bowen ratio-land use table used - write(io6,151) -151 format(//2x,'Bowen ratio computed from default ', - 1 'Bowen ratio-land use table') - else if(iopt(4).eq.1)then -c -c --- print USER-INPUT Bowen ratio-land use table - write(io6,152) -152 format(//2x,'Bowen ratio computed from USER-INPUT ', - 1 'Bowen ratio-land use table') - write(io6,153) -153 format(//2x,'Land Use',4x,'Bowen ratio'/2x,'Category'/) - do 158 i=1,nlu - write(io6,125)ilucat(i),bowlu(i) -158 continue - else -c -c --- user-input gridded Bowen ratio field - messag='USER-INPUT Bowen ratio field' - call out(bowen,idum,1,5,ldate,messag,nx,ny) - endif -c -c --- ********** SOIL HEAT FLUX PARAMETER - read(iogeo,*)iopt(5) -c -c --- read soil heat flux parameter data or compute from -c --- land use categories - call fillgeo(iogeo,iopt(5),ilucat,nlu,hcglu,ilandu,nx,ny,hcg) - if(iopt(5).eq.0)then -c -c --- DEFAULT soil heat flux parameter-land use table used - write(io6,161) -161 format(//2x,'Soil heat flux parameter computed from default ', - 1 'Soil parameter-land use table') - else if(iopt(5).eq.1)then -c -c --- print USER-INPUT soil heat flux parameter-land use table - write(io6,162) -162 format(//2x,'Soil heat flux parameter computed from ', - 1 'USER-INPUT soil parameter-land use table') - write(io6,163) -163 format(//2x,'Land Use',5x,'Soil heat'/2x,'Category',5x, - 1 'flux parameter'/) - do 168 i=1,nlu - write(io6,125)ilucat(i),hcglu(i) -168 continue - else -c -c --- user-input gridded soil heat flux parameter field - messag='USER-INPUT soil heat flux parameter field' - call out(hcg,idum,1,5,ldate,messag,nx,ny) - endif -c -c --- ********** ANTHROPOGENIC HEAT FLUX - read(iogeo,*)iopt(6) -c -c --- read anthropogenic heat flux parameter data or compute from -c --- land use categories - call fillgeo(iogeo,iopt(6),ilucat,nlu,qflu,ilandu,nx,ny,qf) - if(iopt(6).eq.0)then -c -c --- DEFAULT anthropogenic heat flux-land use table used - write(io6,171) -171 format(//2x,'Anthropogenic heat flux computed from default ', - 1 'Heat flux-land use table') - else if(iopt(6).eq.1)then -c -c --- print USER-INPUT anthropogenic heat flux-land use table - write(io6,172) -172 format(//2x,'Anthropogenic heat flux computed from ', - 1 'USER-INPUT heat flux-land use table') - write(io6,173) -173 format(//2x,'Land Use',5x,'heat flux'/2x,'Category'/) - do 178 i=1,nlu - write(io6,125)ilucat(i),qflu(i) -178 continue - else -c -c --- user-input gridded anthropogenic heat flux field - messag='USER-INPUT anthropogenic heat flux field' - call out(qf,idum,1,5,ldate,messag,nx,ny) - endif -c -c --- ********** LEAF AREA INDEX - read(iogeo,*)iopt(7) -c -c --- read leaf area index data or compute from land use categories - call fillgeo(iogeo,iopt(7),ilucat,nlu,xlailu,ilandu,nx,ny,xlai) - if(iopt(7).eq.0)then -c -c --- DEFAULT Leaf area index-land use table used - write(io6,181) -181 format(//2x,'Leaf area index computed from default ', - 1 'Leaf area index-land use table') - else if(iopt(7).eq.1)then -c -c --- print USER-INPUT Leaf area index-land use table - write(io6,182) -182 format(//2x,'Leaf area index computed from ', - 1 'USER-INPUT Leaf area index-land use table') - write(io6,183) -183 format(//2x,'Land Use',5x,' LAI '/2x,'Category'/) - do 188 i=1,nlu - write(io6,125)ilucat(i),xlailu(i) -188 continue - else -c -c --- user-input gridded leaf area index flux field - messag='USER-INPUT Leaf area index field' - call out(xlai,idum,1,5,ldate,messag,nx,ny) - endif -c -c --- write final gridded arrays if "debug write" option is on -c --- (arrays written above are not repeated) - if(ldb)then - if(iopt(2).ne.2)then - messag='Gridded surface roughness length field (m)' - call out(z0,idum,1,5,ldate,messag,nx,ny) - endif -c - if(iopt(3).ne.2)then - messag='Gridded albedo field' - call out(albedo,idum,1,5,ldate,messag,nx,ny) - endif -c - if(iopt(4).ne.2)then - messag='Gridded Bowen ratio field' - call out(bowen,idum,1,5,ldate,messag,nx,ny) - endif -c - if(iopt(5).ne.2)then - messag='Gridded soil heat flux parameter field' - call out(hcg,idum,1,5,ldate,messag,nx,ny) - endif -c - if(iopt(6).ne.2)then - messag='Gridded anthropogenic heat flux field' - call out(qf,idum,1,5,ldate,messag,nx,ny) - endif -c - if(iopt(7).ne.2)then - messag='Gridded leaf area index field' - call out(xlai,idum,1,5,ldate,messag,nx,ny) - endif - endif -c - return - end -c---------------------------------------------------------------------- - logical function lrsame(r0,r1,r2) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 030402 LRSAME -c D. Strimaitis, Earth Tech, Inc. -c --- From CALPOST V5.2, L991104c -c -c --- PURPOSE: Compare 2 real numbers (r1,r2) to determine if their -c fractional difference exceeds r0 -c -c --- INPUTS: -c r0 - real - Fractional difference allowed -c r1 - real - Real value 1 -c r2 - real - Real value 2 -c -c -c --- OUTPUT: -c lrsame - logical - Key indicating result of test -c .TRUE. -- values are 'same' -c .FALSE. -- values are NOT 'same' -c -c -c --- LRSAME called by: (utility) -c --- LRSAME calls: none -c---------------------------------------------------------------------- -c - data half/0.5/ - - lrsame=.TRUE. - -c --- Direct comparison - if(r1.EQ.r2) return - - rdif=ABS(r1-r2) - ravg=half*ABS(r1+r2) - - if(rdif.GE.ravg) then -c --- Fractional difference greater than one! - lrsame=.FALSE. - else - ftest=rdif/ravg - if(ftest.GT.r0) lrsame=.FALSE. - endif - - return - end -c----------------------------------------------------------------------- - subroutine readhd(ibyr,ibjul,ibhr,ibsec,ieyr,iejul,iehr,iesec, - : ibtz,nsecdt,ldb,idiopt,iprog,igfmet) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 121203 READHD -c --- J. Scire, M. Fernau, Earth Tech, Inc. -c -c --- PURPOSE: Read header records from meteorological data files -c and perform QA checks -c -c --- UPDATES -c -c --- v6.334 (110421) to v6.4.0 (121203) -c - Add wind dir. rotation for Polar Stereographic -c projection -c -c --- v6.330 (101006) to v6.334 (110421) (F.Robe) -c - check that value of SIGMAP just includes 4 -c nearest progn. gridpoints when NPSTA=-1 and reset -c if necessary -c -c --- v6.327 (090511) to v6.330 (101006) (CEC) -c - Change ICLOUD into MCLOUD and ICLDOUT -c -c --- v6.326 (080325) to v6.327 (090511) -c - Revised write Formats 75,76 to add more information -c and add write statement at stop (JSS) -c -c --- v6.32 (080205) to V6.321 (080325) -c - Correct warning write statement to reflect precipitation -c dataset name rather than sf data filename -c - Correct list file statement (introduce character return -c to make sure values are lined up with correct text in lst -c file -c - Check precip. station IDs based on LFCPRC not LFCSFC -c -c --- v6.302(070929) to v6.32 (080205) -c - Initialize prognostic record beginning/end seconds -c - 3D.DAT beginning time test includes seconds -c - Add npsta to RDHD5 calling list -c -c --- v6.301 (070927) to v6.302 (070929)(JSS) -c - Update documentation on routines being called -c - Update documentation on parameters required -c --- v6.207 (060328) to v6.215 (061020)(DGS) -c - Test of time span for UP.DAT files did not fully -c account for time shift between base time zone and -c UTC, causing an unnecessary halt -c -c --- v6.205 (060309) to v6.207 (060328)(DGS) -c - change test on beginning times MM4/CALMET -c -c --- v6.2 (060215)to v6.205 (060309)(F.Robe) -c - change test on beginning times MM5/CALMET -c -c --- v5.711 (060106) to v6.2 (060215)(F.Robe) -c - Switch from hour-ending times to explicit beg/ending times -c and allow sub-hourly timesteps -c - Get SURF.DAT, PRECIP.DAT and UP.DAT dataset version numbers -c from respective rdhd(u) subroutines and store them -c in MET1.MET -c - Remove irlg from calling list (no longer needed) and add -c nsecdt -c - Initialize ifirstpg for all types of prognostic data -c (stored in internal common: progstep) -c -c --- v6.513 (051227) to v5.711 (060106)(F.Robe) -c - Add flag igfmet to calling list and read IGF.DAT -c header -c -c --- v5.611 (051113) to v6.513 (051227) (F.Robe) -c - Add ibtz to calling list to rdhdow -c --- v5.6e(050520) to v5.611 (051113) (F.Robe) -c - Add itwprog to calling list to rdhd5 -c --- v5.6d(050428) to v5.6e(050520) (DGS) -c - Restore IPROG constraints before call to RDHD5 -c --- V5.542 (031126) to v5.6d(050428) (F.Robe) -c - Remove npsta from calling list to rdhd5 -c --- V5.541 (031017) to V5.542 (031126) (J. Scire) -c - Correct calls to RDHD to include CLATS/CLONS and -c CLATP/CLONP arrays in the argument list, and -c dimension these arrays in the calling routine -c (READHD). -c --- V5.5 (030402) to V5.54 (031017) (DGS) -c - Add processing code for station location data in -c updated met data files (lat/lon only) -c --- V5.4 (991104) to V5.5 (030402) (DGS) -c - Add list-file unit to INDECR, RDHDU calls -c - Add arrays for call to RDHD for new format -c - Add scratch file io unit to RDHDU arg list -c - Add subroutine RDHDOW for new SEA.DAT header -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- Modified by F. Robe (1/98) to read MM5 data -c --- Modified by J. Scire (2/98) to allow comma-delimited upper air -c data format -c --- Modified by M. Fernau to disable MM4/MM5 record skipping, -c i.e., read header but don't position pointer -c --- Modified by J. Scire to eliminate conversion of precip. data -c --- from ending hour to beginning hour -c -c -c --- INPUTS: -c IBYR - integer - Year of beginning of run -c IBJUL - integer - Julian day of beginning of run -c IBHR - integer - Hour of beginning of run -c IBSEC - integer - Second of beginning of run (explicit) -c IEYR - integer - Year of end of run (explicit) -c IEJUL - integer - Julian day of end of run (explicit) -c IEHR - integer - Hour of end of run (explicit) -c IESEC - integer - Second of end of run (explicit) -c IBTZ - integer - Base time zone -c NSECDT - integer - Timestep in seconds -c LDB - logical - Control variable determining -c the printing of internal arrays -c (useful for testing) -c IDIOPT(5) - int. array - Diagnostic wind module input -c flags (Element 4 -- surf. data -c Element 5 -- upper air data) -- -c (0=compute internally, 1=use -c preprocessed values) -c IPROG - integer - Control variable determining use -c of prognostic data (1=CSUMM as Step 1 -c field; 2=CSUMM as initial guess field; -c 3=MM4 as Step 1 field; 4=MM4 as initial -c guess field; 5=MM4 as observations) -c 13=MM5 as Step 1 field; 14=MM5 as initial -c guess field; 15=MM5 as observations) -c IGFMET - integer - Control variable determining use -c of IGF CALMET.dAT -c -c Common block /GRID/ variables: -c dgrid,xorigr,yorigr -c Common block /LON/ variables: -c dlongs(mxss),dlongu(mxus) -c Common block /MAP/ variables: -c llcc, -c lps, -c iutmzn,conec,feast,fnorth, -c rnlat0,relon0,xlat1,xlat2, -c pmap,utmhem,datum -c Common block /MET1/ variables: -c IOS, NSSTA, IFORMS, IDSSTA(mxss) -c IOP, NPSTA, IFORMP, IDPSTA(mxps), noobs -c IOS, NUSTA, IDUSTA(mxus), CUNAM(mxus) -c LCFSFC,LCFUPR,LCFPRC, -c DATAVERS,DATAVERP,DATAVERU, SIGMAP -c Common block /OVRWAT/ variables: -c IOOW,NOWSTA -c Parameters: MXSS, MXUS, MXLEV, MXPS, MXOWS, IO6, -c MXNX, MXNY, MXNZ, MXNZP1, -c MXNXP, MXNYP, MXNZP, -c MXNXI, MXNYI, MXNZI -c -c --- OUTPUT: -c Common block /MET1/ variables: -c IPPACK, ISPACK, ZANEM,DATAVERS,DATAVERP,DATAVERU, ... -c Common block /OVRWAT/ variables: -c CHOWSTA,IDOWSTA -c Common block /IGF/nfigf -c Common block /UPMET/ isnap(mxus) -c -c --- READHD called by: SETUP -c --- READHD calls: RDHD, DELTT, RDS, RDP, RDHDU, RDUP, RDHD4, -c INDECR, RDHD5, RDHDOW, GLOBE1, GLOBE, -c DELTSEC, RDHDMET, GRDAY -c------------------------------------------------------------------------------ -c -c --- include parameters - include 'params.met' - - include 'grid.met' - include 'lon.met' - include 'map.met' - include 'met1.met' - include 'met2.met' - include 'met3.met' - include 'upmet.met' - include 'ovrwat.met' - include 'mm4hdo.met' - include 'igf.met' -c -c Internal common (also in RDHD4,RDHD5,RDMM4,RDMM5,PROGRD) - COMMON /PROGSTEP/ ifirstpg,nfm3d - - integer idsurf(mxss),idprec(mxps),idiopt(5) - integer ishift(3) - logical ldb, lstnloc, lfatal - logical lht,ltemp,lwd,lws - -c --- Declare local arrays for reading new station data format - real dumprec(mxps) - character*8 datumu(mxus) - character*16 clats(mxss),clons(mxss) - character*16 clatp(mxps),clonp(mxps) - -c --- For coordinate transformations - character*8 cmapi,cmapo,datumi - character*12 caction - character*4 c4hem - real*8 vecti(9),vecto(9) - -c --- Set translation vectors going from N.lat,E.lon to map(x,y)km -c --- for station locations provided in files -c --- Scale factor for Tangential TM projection - tmsone=1.00000 - iutmo=iutmzn - if(utmhem.EQ.'S ' .AND. iutmzn.LT.900) iutmo=-iutmo - cmapo=pmap - if(cmapo.EQ.'TTM ') cmapo='TM ' - cmapi='LL ' - idum=0 - rdum=0.0 - call GLOBE1(cmapi,idum,rdum,rdum,rdum,rdum,rdum, - & rdum,rdum, - & cmapo,iutmo,tmsone,xlat1,xlat2,rnlat0,relon0, - & feast,fnorth, - & caction,vecti,vecto) -c -c --- Read surface met. header records -c ------------------------------------ -c frr (noobs option 2: no surface obs) - if(idiopt(4).eq.1 .or. noobs.eq.2 )go to 151 -c - call RDHD(iforms,ios,jbyr,jbjul,jbhr,jbsec, - 1 jeyr,jejul,jehr,jesec,jbtz,jssta, - 1 ispack,datavers,idsurf,zanem,csnam,xslat,xslon,mxss, - 2 clats,clons,datumi,lstnloc) -c -c --- Write SURFACE station parameters - write(io6,110)iforms,ispack,jbtz,jssta,jbyr,jbjul,jbhr, - 1 jeyr,jejul,jehr -110 format(///2x,'Data from Surface met. file header records'// - 1 5x,' Format code: ',i5/ - 2 5x,' Packing code: ',i5/ - 3 5x,' Time zone: ',i5/ - 4 5x,' No. stations: ',i5// - 5 5x,' Beginning year: ',i5/ - 6 5x,' Julian day: ',i5/ - 7 5x,' hour: ',i5// - 8 5x,' Ending year: ',i5/ - 9 5x,' Julian day: ',i5/ - a 5x,' hour: ',i5) - - if(LSTNLOC) then -c --- Process station location data from file - write(io6,1485) -1485 format(//30x,'SURFACE STATIONS'/69x,2x,'Anemometer',5x, - 1 'Grid Coordinates'/1x,'Name',5x,'ID',8x,'X-UTM',8x,'Y-UTM',6x, - 2 'NLatitude',4x,'WLongitude',5x,'Height',11x,'X',9x,'Y'/ - 3 20x,'(km)',9x,'(km)',9x,'(Deg)',8x,'(Deg)',9x,'(m)',10x, - 4 '(Origin = (0,0))'/) - - do i=1,jssta -c -c --- Pass source IDs into common - idssta(i)=idsurf(i) -c -c --- Compute map coordinates (km) - call GLOBE(io6,caction,datumi,vecti,datum,vecto, - & xslon(i),xslat(i),xssta(i),yssta(i),idum,c4hem) -c -c --- Convert E.Lon to W.Lon - xslon(i)=-xslon(i) -c - -c --- v6.4.0, Level 121203 - if(LLCC .OR. LPS) then - -c --- Compute delta longitudes (West Lon.) - dlongs(i) = rlon0 - xslon(i) -c --- Code to handle 180 degree longitude straddle - if (dlongs(i) .gt. 180.) dlongs(i) = dlongs(i) - 360. - if (dlongs(i) .lt. -180.) dlongs(i) = dlongs(i) + 360. - endif -c -c --- Convert from km to m, and into relative coordinates - xkm=xssta(i) - ykm=yssta(i) - xssta(i)=1000.*xkm-xorigr - yssta(i)=1000.*ykm-yorigr -c -c --- Compute grid coordinates for printing - xgrdc=xssta(i)/dgrid - ygrdc=yssta(i)/dgrid -c - write(io6,1490)csnam(i),idssta(i),xkm,ykm,xslat(i),xslon(i), - 1 zanem(i),xgrdc,ygrdc -1490 format(1x,a4,1x,i8,3x,f10.1,3x,f10.1,3x,f10.3,3x,f10.3,6x, - 1 f5.1,6x,f10.3,f10.3) -c - enddo -c - else -c --- No station location data from file: report IDs -c --- set variables for proper columns -c --- j4 is no. rows in a "short" column -c --- j5 is no. rows in a "long" column -c --- j6 is the number of "long" columns - j4=jssta/4 - j6=mod(jssta,4) - if(j6.eq.0)then - j5=j4 - else - j5=j4+1 - endif - ishift(1)=j5 - do i=2,3 - if(i.le.j6)then - ishift(i)=ishift(i-1)+j5 - else - ishift(i)=ishift(i-1)+j4 - endif - enddo -c -c --- Write surface station IDs - ncol=min0(jssta,4) - write(io6,112)(' ',n=1,ncol) -112 format(//2x,'Surface met. station ID numbers: '// - 1 3x,4(a1,'No.',6x,'ID',9x)/) -c - do i=1,j4 - i2=i+ishift(1) - i3=i+ishift(2) - i4=i+ishift(3) - write(io6,14)i,idsurf(i),i2,idsurf(i2),i3,idsurf(i3),i4, - 1 idsurf(i4) - enddo - if(j6.gt.0)then - n1=j5 - n2=n1+(j6-1)*j5 - write(io6,14)(n,idsurf(n),n=n1,n2,j5) - endif -c - endif - -119 continue -c -c --- QA checks on surface met. data - lfatal=.FALSE. - if(ibtz.ne.jbtz.or.nssta.ne.jssta)then - write(io6,120)ibtz,jbtz,nssta,jssta -120 format(//2x,'ERROR IN SUBR. READHD -- Surface met. header ', - 1 'data does not match control file inputs'/5x,'ibtz = ',i10,5x, - 2 'jbtz = ',i10/5x,'nssta = ',i10,5x,'jssta = ',i10) - lfatal=.TRUE. - endif -c - if(LCFSFC) then -c --- surface station IDs from surface file must match those in -c --- control file - nmatch=0 - do 122 i=1,nssta - if(idsurf(i).eq.idssta(i))then - nmatch=nmatch+1 - else - write(io6,121)i,idsurf(i),idssta(i) -121 format(/1x,'ERROR IN SUBR. READHD -- Surface station ID ', - 1 'does not match value entered by user in control file'/5x, - 2 'I = ',i5,5x,'Station ID -- FILE: ',i10,5x,'USER INPUT: ', - 3 i10) - endif -122 continue - if(nmatch.ne.nssta) lfatal=.TRUE. - endif -c -c --- check that surface met. file begin. time <= run begin. time -c --- determine number of records to skip - call deltt(jbyr,jbjul,jbhr,ibyr,ibjul,ibhr,nskip) - if((nskip.lt.0).or.(nskip.eq.0 .and. ibsec.lt.jbsec))then - write(io6,125)ibyr,ibjul,ibhr,ibsec,jbyr,jbjul,jbhr,jbsec -125 format(//2x,'ERROR IN SUBR. READHD -- Surface data does not ', - 1 'cover time period in run'/5x,/ - 2 5x,'Run starting date/hr/sec: ibyr, ibjul, ibhr, ibsec = ', - 2 i10.4,i10.3,i10.2,i10.4/ - 3 5x,' Date/hr/sec in file: jbyr, jbjul, jbhr ,jbsec = ', - 3 i10.4,i10.3,i10.2,i10.4) - lfatal=.TRUE. - endif -c -c --- check that surface met. file end time >= run end time - call deltt(ieyr,iejul,iehr,jeyr,jejul,jehr,jleng) - if((jleng.lt.0).or.(jleng.eq.0 .and. iesec.gt.jesec)) then - write(io6,130)ieyr,iejul,iehr,iesec,jeyr,jejul,jehr,jesec -130 format(//2x,'ERROR IN SUBR. READHD -- Surface data does not ', - 1 'cover time period in run'/ - 2 5x,'Run Ending date/hr/sec: ieyr, iejul, iehr, iesec = ', - 2 i10.4,i10.3,i10.2,i10.4/ - 3 5x,'End Date/hr/sec in file: jeyr, jejul, jehr ,jesec = ', - 3 i10.4,i10.3,i10.2,i10.4) - lfatal=.TRUE. - endif - -c --- Make sure that 1 set of station locations is provided - if(LCFSFC .AND. LSTNLOC) then - write(io6,*) - write(io6,*) - write(io6,*)' ERROR IN SUBR. READHD -- station locations are' - write(io6,*)' provided in control file and SURF.DAT file.' - write(io6,*)' Use one or the other.' - lfatal=.TRUE. - elseif(.not.LCFSFC .AND. .not.LSTNLOC) then - write(io6,*) - write(io6,*) - write(io6,*)' ERROR IN SUBR. READHD -- station locations are' - write(io6,*)' missing from both control file and SURF.DAT' - lfatal=.TRUE. - endif - -c --- Check for QA failure - if(LFATAL) stop 'Halted in READHD --- See list file' -c -c -c --- Beginning date/hr of run -c idathr=ibyr*100000+ibjul*100+ibhr - -c --- Skip to proper starting point in surface data file if old format - if (datavers.eq.'2.1') then -c --- explicit beg/ending time with seconds - Sub-hourly records/timesteps -c--- No need to skip if sub-hourly timestep as done anyway in normal call to rdsn -c --- in subroutine comp - else -c --- hour-ending time format - hourly record only - so skip to beginning hour - iskip=1 - do i=1,nskip - call rds(iforms,nssta,ispack,ios,0,ibuf,iyr,ijul,ihr, - 1 ws,wd,iceil,icc,tempk,irh,pres,ipcode) - enddo - endif - -151 continue -c -c --- Read precip. header records -c -------------------------------- -c frr (09/01) if npsta =-1, use MM5 precip data -c if(npsta.eq.0)go to 51 - if(npsta.le.0)go to 51 -c - call RDHD(iformp,iop,jbyr,jbjul,jbhr,jbsec,jeyr,jejul,jehr, - 1 jesec,jbtz,jpsta, - 1 ippack,dataverp,idprec,dumprec,cpnam,xplat,xplon,mxps, - 2 clatp,clonp,datumi,lstnloc) -c -c --- write data from precipitation header records -c --- write data from precipitation header records - write(io6,10)iformp,ippack,jbtz,jpsta,jbyr,jbjul,jbhr,jbsec, - 1 jeyr,jejul,jehr,jesec -10 format(///2x,'Data from Precipitation file header records'// - 1 5x,' Format code: ',i5/ - 2 5x,' Packing code: ',i5/ - 3 5x,' Time zone: ',i5/ - 4 5x,' No. stations: ',i5// - 5 5x,' Beginning year: ',i5/ - 6 5x,' Julian day: ',i5/ - 7 5x,' hour: ',i5/ - 7 5x,' second: ',i5// - 8 5x,' Ending year: ',i5/ - 9 5x,' Julian day: ',i5/ - a 5x,' hour: ',i5/ - b 5x,' second: ',i5) -c - if(LSTNLOC) then -c --- Process station location data from file - write(io6,1605) -1605 format(//30x,'PRECIPITATION STATIONS'// - 1 1x,'Name',5x,'ID',8x,' X ',8x,' Y ',7x,'Grid Coordinates'/ - 2 20x,'(km)',9x,'(km)',11x,'X',9x,'Y'/45x,'(Origin = (0,0))') - - do i=1,jpsta -c -c --- Pass source IDs into common - idpsta(i)=idprec(i) -c -c --- Compute map coordinates (km) - call GLOBE(io6,caction,datumi,vecti,datum,vecto, - & xplon(i),xplat(i),xpsta(i),ypsta(i),idum,c4hem) -c -c --- Convert E.Lon to W.Lon - xplon(i)=-xplon(i) -c -c --- Convert from km to m, and into relative coordinates - xkm=xpsta(i) - ykm=ypsta(i) - xpsta(i)=1000.*xkm-xorigr - ypsta(i)=1000.*ykm-yorigr -c -c --- Compute grid coordinates for printing - xgrdc=xpsta(i)/dgrid - ygrdc=ypsta(i)/dgrid -c - write(io6,1609)cpnam(i),idpsta(i),xkm,ykm,xgrdc,ygrdc -1609 format(1x,a4,3x,i6,3x,f10.3,3x,f10.3,2x,f10.3,f10.3) -c - enddo -c - else -c --- No station location data from file: report IDs -c --- set variables for proper columns -c --- j4 is no. rows in a "short" column -c --- j5 is no. rows in a "long" column -c --- j6 is the number of "long" columns - j4=jpsta/4 - j6=mod(jpsta,4) - if(j6.eq.0)then - j5=j4 - else - j5=j4+1 - endif - ishift(1)=j5 - do 11 i=2,3 - if(i.le.j6)then - ishift(i)=ishift(i-1)+j5 - else - ishift(i)=ishift(i-1)+j4 - endif -11 continue -c -c --- write precip. station IDs - ncol=min0(jpsta,4) - write(io6,12)(' ',n=1,ncol) -12 format(//2x,'Precipitation station ID numbers: '// - 1 3x,4(a1,'No.',6x,'ID',9x)/) -c - do i=1,j4 - i2=i+ishift(1) - i3=i+ishift(2) - i4=i+ishift(3) - write(io6,14)i,idprec(i),i2,idprec(i2),i3,idprec(i3),i4, - 1 idprec(i4) -14 format(3x,4(i3,5x,i6,7x)) - enddo -c - if(j6.gt.0)then - n1=j5 - n2=n1+(j6-1)*j5 - write(io6,14)(n,idprec(n),n=n1,n2,j5) - endif -c - endif - -19 continue -c -c --- QA checks on precipitation data - lfatal=.FALSE. - if(ibtz.ne.jbtz.or.npsta.ne.jpsta)then - write(io6,20)ibtz,jbtz,npsta,jpsta -20 format(//2x,'ERROR IN SUBR. READHD -- Precip. header ', - 1 'data does not match control file inputs'/5x,'ibtz = ',i10,5x, - 2 'jbtz = ',i10/5x,'npsta = ',i10,5x,'jpsta = ',i10) - lfatal=.TRUE. - endif -c -c if(LCFSFC) then - Not ok (080325) - if(LCFPRC) then -c --- precip. station IDs from precip. file must match those in -c --- control file - nmatch=0 - do 22 i=1,npsta - if(idprec(i).eq.idpsta(i))then - nmatch=nmatch+1 - else - write(io6,21)i,idprec(i),idpsta(i) -21 format(/1x,'ERROR IN SUBR. READHD -- Precip. station ID ', - 1 'does not match value entered by user in control file'/5x, - 2 'I = ',i5,5x,'Station ID -- FILE: ',i10,5x,'USER INPUT: ', - 3 i10) - endif -22 continue - if(nmatch.ne.npsta) lfatal=.TRUE. - endif -c -c --- check that precipitation file begin. time <= run begin. time -c --- determine number of records to skip - call deltt(jbyr,jbjul,jbhr,ibyr,ibjul,ibhr,nskip) - if((nskip.lt.0).or.(nskip.eq.0 .and. ibsec.lt.jbsec))then - write(io6,25)ibyr,ibjul,ibhr,ibsec,jbyr,jbjul,jbhr,jbsec -25 format(//2x,'ERROR IN SUBR. READHD -- Precipitation data does', - 1 ' not cover time period in run'/5x,/ - 2 5x,'Run starting date/hr/sec: ibyr, ibjul, ibhr, ibsec = ', - 2 i10.4,i10.3,i10.2,i10.4/ - 3 5x,' Date/hr/sec in file: jbyr, jbjul, jbhr ,jbsec = ', - 3 i10.4,i10.3,i10.2,i10.4) - lfatal=.TRUE. - endif -c - -c --- check that precipitation file end time >= run end time - call deltt(ieyr,iejul,iehr,jeyr,jejul,jehr,jleng) - if((jleng.lt.0).or.(jleng.eq.0 .and. iesec.gt.jesec)) then - write(io6,30)ieyr,iejul,iehr,iesec,jeyr,jejul,jehr,jesec -30 format(//2x,'ERROR IN SUBR. READHD -- Precip data does not ', - 1 'cover time period in run'/ - 2 5x,'Run Ending date/hr/sec: ieyr, iejul, iehr, iesec = ', - 2 i10.4,i10.3,i10.2,i10.4/ - 3 5x,'End Date/hr/sec in file: jeyr, jejul, jehr ,jesec = ', - 3 i10.4,i10.3,i10.2,i10.4) - lfatal=.TRUE. - endif -c -c --- Make sure that 1 set of station locations is provided - if(LCFPRC .AND. LSTNLOC) then - write(io6,*) - write(io6,*) - write(io6,*)' ERROR IN SUBR. READHD -- station locations are' - write(io6,*)' provided in control file and PRECIP.DAT file.' - write(io6,*)' Use one or the other.' - lfatal=.TRUE. - elseif(.not.LCFPRC .AND. .not.LSTNLOC) then - write(io6,*) - write(io6,*) - write(io6,*)' ERROR IN SUBR. READHD -- station locations are' - write(io6,*)' missing from both control file and PRECIP.DAT' - lfatal=.TRUE. - endif - -c --- Check for QA failure - if(LFATAL) stop 'Halted in READHD --- See list file' -c -c --- skip to proper starting point in precip. data file - iskip=1 - do i=1,nskip - if (dataverp.eq.'2.1')then -c --- 2.1 time format with explicit beg/ending times with seconds -c--- No need to skip here (done in rdpn when called by comp) - else - call rdp(iformp,npsta,ippack,iop,iskip,iyr,ijul,ihr,xprecp) - endif - enddo - -51 continue -c -c --- Loop over upper air data files -c ---------------------------------- -c FRR (09/2001) additional option for noobs -c if(idiopt(5).eq.1 .or. noobs .eq. 1) go to 101 - if(idiopt(5).eq.1 .or. noobs .ge. 1) go to 101 -c - io=iou-1 - do 100 i=1,nusta -c *** rjy added initialization of new arrays on 1/25/90. - justa(i) = 0 - jusdt(i) = 0 - ntzaa(i) = 0 - ntzbb(i) = 0 -c --- All soundings are instantaneous in UP.DAT versions 2.1 and older -c --- In UP.DAT v2.2, time-averaged soundings are defined by ISNAP=0 -c --- in subroutine RDUPN2 (080205) - isnap(i) = 1 -c -c --- read header records -- upper air data - io=io+1 - call RDHDU(io,io6,iox,ibyru,ibjulu,ibhru,ibsecu,ieyru,iejulu, - 1 iehru,iesecu,ptop,jdat,dataveru,ifmtu(i),lht,ltemp, - 2 lwd,lws,idusta(i),cunam(i),xulat(i),xulon(i), - 3 uelev(i),datumu(i),lstnloc) -c -c --- write data from upper air header records - write(io6,52)i,io -52 format(///2x,'Data from Upper Air data file -- no.: ',i5,3x, - 1 'unit no.: ',i5) -c - write(io6,54)ibyru,ieyru,ibjulu,iejulu,ibhru,iehru -54 format(//6x,'Starting date:',16x,'Ending date:'/6x,9x,'Year = ', - 1 i4,17x,'Year = ',i4/10x,'Julian day = ',i3,12x,'Julian day = ', - 2 i3/16x,'Hour = ',i3,18x,'Hour = ',i3) - write(io6,56)ptop,jdat,ifmtu(i) -56 format(//6x,'Pressure levels extracted:'//6x,20x,'Surface', - 1 ' to ',F5.0,' mb'//6x,'Data type (JDAT): ',i2,' (1=TD6201, ', - 2 '2=NCDC CD, 3=other/unknown)'/6x,'Data format (IFMT): ',i2, - 3 ' (1=slash-delimited, 2=comma-delimited)') - write(io6,58)lht,ltemp,lwd,lws -58 format(//6x,'Data level eliminated if height missing ? ',8x,L1/ - 1 /6x,'Data level eliminated if temperature missing ? ',3x,L1/ - 2 /6x,'Data level eliminated if wind direction missing ? ',L1/ - 3 /6x,'Data level eliminated if wind speed missing ? ',4x,L1) - -c --- check that upper air file begin time <= run begin time -c --- ndiff = run begin - UA begin (hours) - call DELTT(ibyru,ibjulu,ibhru,ibyr,ibjul,ibhr,ndiff) - ndiff=ndiff+ibtz - if((ndiff.LT.0).or. - & (ndiff.EQ.0 .and. ibsec.lt.ibsecu))then -c --- Compute Gregorian day for output purposes - call grday(io6,ibyr,ibjul,ipmo,ipday) - call grday(io6,ibyru,ibjulu,ipmou,ipdayu) -c --- Compute Model start time in UTC for output purposes -c --- Initialize UTC variables & compute in subr. INDECR - ibyrUTC=ibyr - ibjulUTC=ibjul - ibhrUTC=ibhr - call indecr(io6,ibyrUTC,ibjulUTC,ibhrUTC,ibtz,0,23) - call grday(io6,ibyrUTC,ibjulUTC,ipmoUTC,ipdayUTC) - write(io6,75)i,ibyr,ibjul,ipmo,ipday,ibhr,ibsec, - 1 ibyrUTC,ibjulUTC,ipmoUTC,ipdayUTC,ibhrUTC,ibsec, - 2 ibyru,ibjulu,ipmou,ipdayu,ibhru,ibsecu -75 format(//2x,'ERROR IN SUBR. READHD -- Upper air data does ', - 1 'not cover time period in run'/,6x,'Station no.: ',i5/ - 2 36x,'Year Julian Day Month Day Hour Seconds '/ -c xxxx xxx xx xx xx xxxx - 3 6x,'Model run starting date/time:', - 3 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,' (LST)'/ - 4 6x,'Model run starting date/time:', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,' (UTC)'/ - 5 3x,'Beg. Date/time in UP.DAT header:', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,' (UTC)') - lfatal=.TRUE. - endif -c -c --- check that upper air file end time >= run end time -c --- ndiff = run end - UA end (hours) - call DELTT(ieyru,iejulu,iehru,ieyr,iejul,iehr,ndiff) - ndiff=ndiff+ibtz - if((ndiff.GT.0).or. - & (ndiff.EQ.0 .and. ibsecu.lt.ibsec))then -c --- Compute Gregorian day for output purposes - call grday(io6,ieyr,iejul,ipmo,ipday) - call grday(io6,ieyru,iejulu,ipmou,ipdayu) -c --- Compute Model start time in UTC for output purposes -c --- Initialize UTC variables & compute in subr. INDECR - ieyrUTC=ieyr - iejulUTC=iejul - iehrUTC=iehr - call indecr(io6,ieyrUTC,iejulUTC,iehrUTC,ibtz,0,23) - call grday(io6,ieyrUTC,iejulUTC,ipmoUTC,ipdayUTC) - write(io6,76)i,ieyr,iejul,ipmo,ipday,iehr,iesec, - 1 ieyrUTC,iejulUTC,ipmoUTC,ipdayUTC,iehrUTC,iesec, - 2 ieyru,iejulu,ipmou,ipdayu,iehru,iesecu -76 format(//2x,'ERROR IN SUBR. READHD -- Upper air data does ', - 1 'not cover time period in run'/5x,'Station no.: ',i5/ - 2 34x,'Year Julian Day Month Day Hour Seconds '/ - 3 3x,' Model run ending date/time: ', - 3 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,' (LST)'/ - 4 3x,' Model run ending date/time: ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,' (UTC)'/ - 5 1x,'End Date/time in UP.DAT header: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,' (UTC)') - lfatal=.TRUE. - endif -c -c --- Make sure that 1 set of station locations is provided - if(LCFUPR .AND. LSTNLOC) then - write(io6,*) - write(io6,*) - write(io6,*)' ERROR IN SUBR. READHD -- station locations are' - write(io6,*)' provided in control file and UP.DAT file.' - write(io6,*)' Use one or the other.' - lfatal=.TRUE. - elseif(.not.LCFUPR .AND. .not.LSTNLOC) then - write(io6,*) - write(io6,*) - write(io6,*)' ERROR IN SUBR. READHD -- station locations are' - write(io6,*)' missing from both control file and UP.DAT' - lfatal=.TRUE. - endif -c -c --- No Need To Skip to Proper Starting Point in Upper Air File Here -c --- It will be taken care of in Subr. RDUP - -100 continue - -c --- Check for QA failure - if(LFATAL)then - write(io6,*) - write(io6,*)'Error in Subr. READHD--See error messages above' - stop 'Halted in READHD --- See list file' - endif -c - if(LSTNLOC) then -c --- Process station location data from files - write(io6,1505) -1505 format(//30x,'UPPER AIR STATIONS'/69x,'Stn.',5x, - 1 'Grid Coordinates'/1x,'Name',5x,'ID',8x,' X ',8x,' Y ', - 2 6x,'NLatitude',4x,'WLongitude',2x,'Elev',8x,'X',9x,'Y'/ - 3 20x,'(km)',9x,'(km)',9x,'(Deg)',8x,'(Deg)',14x, - 4 '(Origin = (0,0))'/) -c - do i=1,nusta -c -c --- Compute map coordinates (km) - call GLOBE(io6,caction,datumu(i),vecti,datum,vecto, - & xulon(i),xulat(i),xusta(i),yusta(i),idum,c4hem) -c -c --- Convert E.Lon to W.Lon - xulon(i)=-xulon(i) -c - -c --- v6.4.0, Level 121203 - if(LLCC .OR. LPS) then - -c --- Compute delta longitudes (West Lon.) - dlongu(i) = rlon0 - xulon(i) -c --- Code to handle 180 degree longitude straddle - if (dlongu(i) .gt. 180.) dlongu(i) = dlongu(i) - 360. - if (dlongu(i) .lt. -180.) dlongu(i) = dlongu(i) + 360. - endif - -c --- convert from km to m, and into relative coordinates - xkm=xusta(i) - ykm=yusta(i) - xusta(i)=1000.*xkm-xorigr - yusta(i)=1000.*ykm-yorigr - -c --- compute grid coordinates for printing - xgrdc=xusta(i)/dgrid - ygrdc=yusta(i)/dgrid - - write(io6,1492)cunam(i),idusta(i),xkm,ykm,xulat(i),xulon(i), - 1 uelev(i),xgrdc,ygrdc -1492 format(1x,a4,3x,i5,4x,f10.1,3x,f10.1,3x,f10.3,3x,f10.3,2x, - 1 f5.0,2x,f10.3,f10.3) - - enddo - endif - -101 continue - -c --- Record first access to prognostic data (if used) - 051128 -c Stored in internal common progstep - ifirstpg=0 -c - -c --- new option: use coarse CALMET.DAT as IGF (060106) - -c --- Read header records from existing CALMET.DAT file -c ----------------------------------------------------- - if(igfmet.EQ.1 )then - -c --- First IGF-CALMET.DAT file - nfigf=1 - call rdhdmet - -c --- No need to skip to starting point in IGF CALMET file here, -c --- it will be done in SUBR. RDMET2 -c - endif - -c -c --- Read header records from MM5 data file -c ------------------------------------------ -c --- Initialize prognostic beginning/end seconds (080205) - ibsecm=0 - iesecm=0 - -c FRR (09/2001) additional option for noobs - if(iprog.EQ.13 .or. iprog.EQ.14 .or. iprog.EQ.15 )then -c & .or. noobs .eq. 1) then -c frr (09/01) precipitation code reset, cloud option -c call rdhd5 -c --- add npsta to calling list (080205) -ccec101006 call rdhd5 (icloud,itwprog,npsta) - call rdhd5 (mcloud,itwprog,npsta,dxmm5) -c -c --- write data from mm5 header records - if(.not.ldb)go to 260 - write(io6,252) -252 format(///2x,'Data from MM5 Prognostic file header records',//) -c - write(io6,154)ibyrm,ieyrm,ibjulm,iejulm,ibhrm,iehrm, - : ibsecm,iesecm - write(io6,256)nzp -256 format(//6x,'Number of layers in the MM5 model grid: ',i2) - write(io6,258)i1,j1,nxp,nyp -258 format(//6x,'Lower-left corner of MM5 extraction subdomain: I = ', - 1 i3/6x,'Lower-left corner of MM5 extraction subdomain: J = ', - 2 i3/6x,'Number of columns in MM5 extraction subdomain: ',i3/ - 3 6x,'Number of rows in MM5 extraction subdomain: ',i3) -260 continue -c -c --- Convert from GMT to LST - idtz = 0 - ibtz - call indecr(io6,ibyrm,ibjulm,ibhrm,idtz,0,23) -c -c --- check that MM5 file begin. time <= run begin. time -c --- if(ibyrm.gt.ibyr)then - -c --- Check with explicit times and subhourly timesteps - -c --- explicit beginning time of simulation: - ndathrbb=ibyr*100000+ibjul*100+ibhr -c --- ending second of beginning time step - nsecbb=ibsec+nsecdt - -c --- time of first MM5 record (note that must be >= ending time of -c first CALMET timestep NOT >= beginning time of simulation - - ndathrbm=ibyrm*100000+ibjulm*100+ibhrm - -c --- Seconds of MM5 first record (080205: sub-hourly in v3.x) - call deltsec(ndathrbb,nsecbb,ndathrbm,ibsecm,ndeltas) - -c if(ndeltas.lt.0)then - if(ndeltas.gt.0)then - write(io6,275) ndathrbb,nsecbb,ndathrbm,ibsecm -275 format(//2x,'ERROR IN SUBR. READHD -- MM5 data does ', - 1 'not cover time period in run'/ - 2 5x,'Run starting date (YYYJJJHH-SEC):',i10,'-',i5, - 2 ' (LST)'/ - 3 5x,'Beginning date in file (YYYJJJHH-SEC):',i10,'-',i5, - 3 ' (LST)') - stop - endif -c --- No need to skip to starting point in MM5 file here, -c --- it will be done in SUBR. RDMM5 -c - endif -c -c FRR (09/2001) - if(iprog.EQ.3 .or. iprog.EQ.4 .or. iprog.EQ.5)then -c & .or. noobs .eq. 1) then - call rdhd4(dxmm5) -c -c --- write data from mm4 header records - if(.not.ldb)go to 160 - write(io6,152) -152 format(///2x,'Data from MM4 Prognostic file header records',//) -c - write(io6,154)ibyrm,ieyrm,ibjulm,iejulm,ibhrm,iehrm, - : ibsecm,iesecm - -154 format(//6x,'Starting date:',16x,'Ending date:'/6x,9x,'Year = ', - 1 i4,17x,'Year = ',i4/10x,'Julian day = ',i3,12x,'Julian day = ', - 2 i3/11x,'Hour(GMT) = ',i3,13x,'Hour(GMT) = ',i3, - 3 /11x,'Seconds = ',i4,13x,'Seconds = ',i4) - write(io6,156)nxmm4,nymm4,nzp,ptopmm4 -156 format(//6x,'Number of columns in MM4 model grid: ',i3,/ - 1 6x,'Number of rows in MM4 model grid: ',i3,/ - 2 6x,'Number of layers in the MM4 model grid: ',i2,/ - 3 6x,'Pressure levels extracted to:' ,f5.0,' mb') - write(io6,158)i1,j1,nxp,nyp -158 format(//6x,'Lower-left corner of MM4 extraction subdomain: I = ', - 1 i3/6x,'Lower-left corner of MM4 extraction subdomain: J = ', - 2 i3/6x,'Number of columns in MM4 extraction subdomain: ',i3/ - 3 6x,'Number of rows in MM4 extraction subdomain: ',i3) -160 continue -c -c --- Convert from GMT to LST - idtz = 0 - ibtz - call indecr(io6,ibyrm,ibjulm,ibhrm,idtz,0,23) -c -c --- check that MM4 file begin. time <= run begin. time -c --- Check with explicit times and subhourly timesteps -c --- beginning explicit time of simulation: - ndathrbb=ibyr*100000+ibjul*100+ibhr -c --- ending second of beginning time step - nsecbb=ibsec+nsecdt -c --- time of first MM4 record (note that must be >= ending time of -c first CALMET timestep NOT >= beginning time of simulation - ndathrbm=ibyrm*100000+ibjulm*100+ibhrm -c --- Seconds of MM4 first record (only hourly MM4) - nsecbm=0 -c DGS call deltsec(ndathrbb,nsecbb,ndathrbm,nsecbm,ndeltas) - call deltsec(ndathrbm,nsecbm,ndathrbb,nsecbb,ndeltas) - if(ndeltas.lt.0)then -c if(ibyrm.gt.ibyr)then - write(io6,175) ibyr,ibjul,ibhr,ibyrm,ibjulm,ibhrm -175 format(//2x,'ERROR IN SUBR. READHD -- MM4 data does ', - 1 'not cover time period in run'/ - 2 5x,'Run starting date/hr: ibyr, ibjul, ibhr = ',3i10, - 2 ' (LST)'/ - 3 5x,' Date/hr in file: ibyrm, ibjulm, ibhrm = ',3i10, - 3 ' (LST)') - stop -c else if(ibyrm.eq.ibyr.and.ibjulm.gt.ibjul)then -c write(io6,175) ibyr,ibjul,ibhr,ibyrm,ibjulm,ibhrm -c stop -c else if(ibyrm.EQ.ibyr.and.ibjulm.EQ.ibjul.and.ibhrm.GT.ibhr)then -c write(io6,175) ibyr,ibjul,ibhr,ibyrm,ibjulm,ibhrm -c stop - endif -c -c --- No need to skip to starting point in MM4 file here, -c --- it will be done in SUBR. RDMM4 -c - endif -c -c --- Get station ID info from overwater files -c -------------------------------------------- -c - if (nowsta .gt. 0) then - do i = 1,nowsta - call RDHDOW(i,ibtz) - end do - end if - - -c --- 110421- Check value of SIGMAP against DXMM5 when NPSTA=-1 -c dxmm5 < sigmap < sqrt(2)* dxmm5 (allow 5% round-off) - if (npsta.eq.-1) then - dxmax= (2**0.5)*dxmm5 *1.05 - if ((sigmap.lt.dxmm5).or.(sigmap.gt.dxmax)) then - write(io6,*) 'WARNING ' - write(io6,*) 'SIGMAP RESET to SQRT(2)* MM5gridsize ' - sigmap=dxmax - endif - endif - - - return - end -c---------------------------------------------------------------------- - subroutine rreplac(dist2,nsta,rarr,rmiss,rdeflt,rvalue) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 RREPLAC -c --- J. Scire, SRC -c -c --- PURPOSE: Replace the missing value of an REAL variable with -c the value from the closest station with valid data -- -c If all values are missing, set variable equal to the -c default value (RDEFLT) -c -c --- INPUTS: -c DIST2(nsta) - real - Distance**2 from each station to the -c current station with missing data -c NSTA - integer - Number of stations -c RARR(nsta) - real - Array of values at each station -c RMISS - real - Missing value indicator -c RDEFLT - real - Default value to be returned if all values -c are missing -c -c --- OUTPUT: -c RVALUE - integer - Value of the variable to be used in -c replacement of the missing value -c NOTE: if all values are missing, -c RVALUE is set equal to RDEFLT -c -c --- RREPLAC called by: MISSFC -c --- RREPLAC calls: none -c---------------------------------------------------------------------- -c - real dist2(nsta),rarr(nsta) -c - data xmax/1.e38/ -c - dmin2=xmax - ista=0 -c -c --- Loop over stations - do 10 i=1,nsta -c -c --- Find the closest non-missing value - if(rarr(i).lt.rmiss)then -c - if(dist2(i).lt.dmin2)then - dmin2=dist2(i) - ista=i - endif - endif -10 continue -c -c --- Return the appropriate value - if(ista.ge.1)then -c -c --- At least one station with non-missing data - rvalue=rarr(ista) - else -c -c --- All values missing -- use default value - rvalue=rdeflt - endif -c - return - end -c---------------------------------------------------------------------- - subroutine rsqwts(ix,jy,rsqwt) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 940930 RSQWTS -c --- DG Strimaitis, SRC -c --- MEF, SRC/ETCO, added separate land/water surface sites -c -c --- PURPOSE: Compute inverse distance squared weights for all sfc. -c and upper air locations (CALMET grid) at (ix,jy) -c -c --- INPUTS: -c -c ix,jy - integer - Grid index for cell at which -c weights are calculated -c -c common/GRID/ --- -c DGRID - real - Horizontal grid size (m) -c -c common/MET1/ --- -c NSSTA - integer - No. surface land wind stations -c NUSTA - integer - No. upper air wind stations -c XSSTA(MXSS) - real array - Surface station relative X -c coordinate (m) (relative to grid -c origin) -c YSSTA(MXSS) - real array - Surface station relative Y -c coordinate (m) (relative to grid -c origin) -c XUSTA(MXUS) - real array - Upper air station relative X -c coordinate (m) (relative to grid -c origin) -c YUSTA(MXUS) - real array - Upper air station relative Y -c coordinate (m) (relative to grid -c origin) -c -c common/OVRWAT/ --- -c NOWSTA - integer - No. over water wind stations -c XOWSTA(MXOWS) - real array - Surface station relative X -c coordinate (m) (relative to grid -c origin) -c YOWSTA(MXOWS) - real array - Surface station relative Y -c coordinate (m) (relative to grid -c origin) -c -c --- OUTPUT: -c -c RSQWT(MXWND) - real array - Inverse distance squared weights -c of met station locations for ONE -c grid-point in CALMET grid -c -c---------------------------------------------------------------------- -c - include 'params.met' - include 'grid.met' - include 'met1.met' - include 'ovrwat.met' - - real rsqwt(mxwnd) - - data zero/0./ - dgridi=1.0/dgrid - -c Initialize array for weights - n=mxwnd - call XMIT(-n,zero,rsqwt) - -c Process grid cell ix,jy -c --- Note,(xusta,yusta) are relative to the SW corner of grid pt (1,1) - xc=FLOAT(ix)-0.5 - yc=FLOAT(jy)-0.5 - -c Compute the 1/r**2 weights for the surface met stations - sumwt = 0.0 - nstat = nssta + nowsta - do is=1,nstat - if (is .le. nssta) then - r2=(xssta(is)*dgridi-xc)**2 + (yssta(is)*dgridi-yc)**2 - else - r2=(xowsta(is - nssta)*dgridi-xc)**2 + - & (yowsta(is - nssta)*dgridi-yc)**2 - end if - if(r2 .LT. 1.0) then - wt=1.0 - else - wt=1.0/r2 - endif - sumwt=sumwt+wt - rsqwt(is)=wt - enddo - -c Normalize the weights. - sumwt=1.0/sumwt - do is=1,nstat - rsqwt(is)=rsqwt(is)*sumwt - enddo - -c Compute the 1/r**2 weights for the upper air stations. - sumwt=0.0 - do iu=1,nusta - k=nstat+iu - r2=(xusta(iu)*dgridi-xc)**2 + (yusta(iu)*dgridi-yc)**2 - if(r2 .LT. 1.0) then - wt=1.0 - else - wt=1.0/r2 - endif - sumwt=sumwt+wt - rsqwt(k)=wt - enddo - -c Normalize the weights. - sumwt=1.0/sumwt - do iu=1,nusta - k=nstat+iu - rsqwt(k)=rsqwt(k)*sumwt - enddo - - return - end -c---------------------------------------------------------------------- - subroutine rtheta(u,v,array) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 RTHETA -c -c --- UPDATES: -c -c --- V5.6 Level 050328 :explicit common replaced by include d6.met -c -c --------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - include 'grid.met' - include 'd6.met' -c COMMON /D6/ IRD,IWR,IFILE,irdp - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*) - DIMENSION ARRAY(mxnx,mxny,*) -C -C RTHETA PRINTS WIND FIELD SPEED AND DIRECTION -C -C INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -c array (r array) - work array to hold gridded wind -c speed (-,-,1) and direction (-,-,2) -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C CONVERSION FACTOR FROM RADIANS TO DEGREES -C - FACTOR=180./3.141592654 - DO 100 K=1,NZPRNT - DO 50 J=1,NY - DO 50 I=1,NX - UU=U(I,J,K) - VV=V(I,J,K) - SUM = UU**2 + VV**2 - ARRAY(I,J,1)=SQRT(SUM) - ARRAY(I,J,2)=0. - IF(SUM.LT.1.0E-10) GO TO 50 - ANGLE=270.-ATAN2(VV,UU)*FACTOR - ARRAY(I,J,2)=AMOD(ANGLE,360.) - if (array(i,j,2) .eq. 0.) array(i,j,2) = 360. - 50 CONTINUE - if(iwr.gt.0)WRITE(IWR,60) K - if(iwr.gt.0)WRITE(IWR,61) - CALL WNDLPT(ARRAY(1,1,1)) - if(iwr.gt.0)WRITE(IWR,70) K - if(iwr.gt.0)WRITE(IWR,71) - CALL WNDLPT(ARRAY(1,1,2)) - 100 CONTINUE - RETURN - 60 FORMAT(//,5X,'WIND SPEED (M/S) AT LEVEL = ',I4) - 61 FORMAT(5X,26('-')) - 70 FORMAT(//,5X,'WIND DIRECTION (DEGREES) AT LEVEL = ',I4) - 71 FORMAT(5X,34('-')) - END -c---------------------------------------------------------------------- - subroutine setcom(ldb) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 SETCOM -c --- J. Scire, SRC -c -c --- PURPOSE: Set general model common block variables -c -c --- INPUTS: -c LDB - logical - Control variable determining -c the printing of internal arrays -c (useful for testing) -c Common block /GEN/ variables: -c irtype -c Common block /GRID/ variables: -c zface(mxnzp1),nx,ny,nz -c Common block /MET1/ variables: -c nssta,xssta(mxss),yssta(mxss),dgrid -c nusta,xusta(mxus),yusta(mxus) -c npsta,xpsta(mxps),ypsta(mxps) -c Parameters: MXNX, MXNY, MXNZ, MXNZP1, MXSS, MXUS, MXPS -c -c --- OUTPUT: -c Common block /GRID/ variables: -c zmid(mxnz),nzp1 -c Common block /MET1/ variables: -c nears(mxnx,mxny) -c nearu(mxnx,mxny) -c nearp(mxnx,mxny) -c -c --- SETCOM called by: SETUP -c --- SETCOM calls: OUT -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - logical ldb,ldate - character*70 messag -c - include 'gen.met' - include 'grid.met' - include 'met1.met' -c - data rmax/1.e37/,ldate/.false./ -c -c --- compute cell midpoint - do 10 i=1,nz - zmid(i)=0.5*(zface(i+1)+zface(i)) -10 continue -c -c --- lowest grid cell midpoint must be at approx. 10 m for the -c --- computation of the micrometeorological parameters -c --- (no restrictions if only computing wind field -- irtype=0) - if(irtype.eq.0)go to 14 - if(zmid(1).lt.9.0.or.zmid(1).gt.11.0)then - write(io6,11)zmid(1),zface(1),zface(2) -11 format(//2x,'ERROR in SUBR. SETCOM -- height of first cell ', - 1 ' midpoint must be approx. 10 m'//2x,'zmid(1) = ',f10.2,3x, - 2 'zface(1) = ',f10.2,3x,'zface(2) = ',f10.2) - stop - endif -14 continue -c - nzp1=nz+1 -c -c --- find nearest surface meteorological station to each grid point -c --- and store station number in array "NEARS" - if(nssta.le.0)go to 21 - do 20 i=1,nx - xgdpt=(float(i)-0.5)*dgrid - do 20 j=1,ny - ygdpt=(float(j)-0.5)*dgrid - dmin2=rmax - ksv=0 -c -c --- loop over surface stations to find closest one to (I,J) - do 12 k=1,nssta - dist2=(xssta(k)-xgdpt)**2+(yssta(k)-ygdpt)**2 - if(dist2.lt.dmin2)then - dmin2=dist2 - ksv=k - endif -12 continue -c - if(ksv.gt.0)then - nears(i,j)=ksv - else - write(io6,18)i,j,ksv,'NEARS' -18 format(//1x,'ERROR IN SUBR. SETCOM -- invalid value of KSV '/ - 1 5x,'I = ',i5,3x,'J = ',i5,3x,'KSV = ',i5,5x,a5) - stop - endif -20 continue -c -c --- write results if "debug write" switch is on - if(ldb)then - messag=' ' - messag(1:45)='Station number of closest surface station to ' - messag(46:60)='each grid point' - call out(xdum,nears,2,5,ldate,messag,nx,ny) - endif -21 continue -c -c --- find nearest upper air station to each grid point -c --- and store station number in array "NEARU" -c --- (skipped if only using MM4 data) - if(nusta.le.0)go to 121 - do 120 i=1,nx - xgdpt=(float(i)-0.5)*dgrid - do 120 j=1,ny - ygdpt=(float(j)-0.5)*dgrid - dmin2=rmax - ksv=0 -c -c --- loop over upper air stations to find closest one to (I,J) - do 112 k=1,nusta - dist2=(xusta(k)-xgdpt)**2+(yusta(k)-ygdpt)**2 - if(dist2.lt.dmin2)then - dmin2=dist2 - ksv=k - endif -112 continue -c - if(ksv.gt.0)then - nearu(i,j)=ksv - else - write(io6,18)i,j,ksv,'NEARU' - stop - endif -120 continue -c -c --- write results if "debug write" switch is on - if(ldb)then - messag=' ' - messag(1:47)='Station number of closest upper air station to ' - messag(48:62)='each grid point' - call out(xdum,nearu,2,5,ldate,messag,nx,ny) - endif -121 continue -c -c --- find nearest precipitation station to each grid point -c --- and store station number in array "NEARP" - if(npsta.le.0)go to 221 - do 220 i=1,nx - xgdpt=(float(i)-0.5)*dgrid - do 220 j=1,ny - ygdpt=(float(j)-0.5)*dgrid - dmin2=rmax - ksv=0 -c -c --- loop over precipitation stations to find closest one to (I,J) - do 212 k=1,npsta - dist2=(xpsta(k)-xgdpt)**2+(ypsta(k)-ygdpt)**2 - if(dist2.lt.dmin2)then - dmin2=dist2 - ksv=k - endif -212 continue -c - if(ksv.gt.0)then - nearp(i,j)=ksv - else - write(io6,18)i,j,ksv,'NEARP' - stop - endif -220 continue -c -c --- write results if "debug write" switch is on - if(ldb)then - messag=' ' - messag(1:45)='Station number of closest precip. station to ' - messag(46:60)='each grid point' - call out(xdum,nearp,2,5,ldate,messag,nx,ny) - endif -221 continue -c - return - end -c---------------------------------------------------------------------- - subroutine setup(itest) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 SETUP -c --- J. Scire, SRC -c --- MEF, SRC/ETCO added separate land/water surface sites -c -c --- PURPOSE: setup phase of CALMET meteorological model -c -c --- UPDATES: -c -c --- v6.4.0 to v6.5.0 (150223) -c - Trap and report error opening files (not found) -c -c --- V6.201 (060218) to v6.4.0 (121203) -c - Add AUX file header output -c -c --- V6.2 (060215) to V6.201 (060218) (DGS) -c - add QA plot file subroutine -c -c --- V5.711 (060106) to v6.2 (060215)(F.Robe) -c - Replace hour-ending times by explicit beg/ending times -c - Remove irlg from calling list to readhd -c - Pass nsecdt to microi -c -c --- V5.6 (050328) to V5.711 (060106) (F.Robe) -c - Add nigf to READCF and WRFIL calling lists -c -c --- V5.547 (041010) to V5.6 (050328) (F.Robe) -c - add Z0 calling list to DIAGI -c - Call to new subroutine SETCOAST to compute distance -c to nearest shore -c - Explicit common replaced by include d1.met -c -c --- V5.543 (031215) to V5.547 (041010) (FRR) -c - Modify calling list to subroutine READCF (nm3d) -c -c --- V5.5 (030402) to V5.543 (031215) (DGS) -c - Place SETCOM after READHD as station locations may -c be read from headers -c --- V5.4 (960521) to V5.5 (030402) (DGS) -c - Add structures to pass control file image and other -c inputs to header of CALMET.DAT -c -c --- INPUTS: -c ITEST - integer - Flag indicating if execution is to -c include COMPUTATIONAL phase -c (ITEST = 1 to STOP program after -c SETUP phase, -c ITEST = 2 to CONTINUE execution to -c include computations) -c -c --- Parameters: -c MXNX, MXNY, MXNZ, MXNZP1, MXSS, MXUS, MXPS, -c MXLU, MXOWS -c Common block /MET1/ variables: -c NUSTA -c Common block /OVRWAT/ variables: -c NOWSTA -c -c --- SETUP called by: Main -c --- SETUP calls: COMLINE, DATETM, READFN, WRFILES, -c READCF, OPENOT, READGE, SETCOM, READHD, MICROI, -c DIAGI, OUTHD, OUTPC1, RDWT, TFERCF, QAPLOT1, -c OUTAUXHD, OPEN_ERR -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - integer idiopt(5) - character*80 title(3) -c - include 'gen.met' - include 'grid.met' - include 'met1.met' - include 'metpac.met' - include 'geo.met' - include 'outpt.met' - include 'qa.met' - include 'filnam.met' - include 'flags.met' - include 'wtgrd.met' - include 'ovrwat.met' -c - include 'd1.met' -c COMMON /D1/ U(mxnx,mxny,mxnz),V(mxnx,mxny,mxnz), -c 1 W(mxnx,mxny,mxnzp1), UB(mxny,2,mxnz), VB(mxnx,2,mxnz), -c 1 USLOPE(mxnx,mxny,mxnz), VSLOPE(mxnx,mxny,mxnz), -c 1 UG(mxnx,mxny,mxnz), VG(mxnx,mxny,mxnz), -c 1 HTOPO(mxnx,mxny), HMAX(mxnx,mxny), -c 1 UTMXST(mxwnd), UTMYST(mxwnd), WT(mxwnd), -c 1 RS(mxwnd), IS(mxwnd), IST(mxwnd), JST(mxwnd), -c 1 US(mxnz,mxwnd), VS(mxnz,mxwnd), -c 1 CELLZB(mxnzp1), CELLZC(mxnz), -c 1 PEXP(7), FEXTRP(mxnz), DIV(mxnx,mxny,mxnz), -c 1 NINTRP(mxnz) -c -c --- Get date and time from system - call datetm(rdate,rtime,rcpu) -c -c --- Get the name of the control file from the command line - call comline(metinp) -c -c --- Open the control file - open(io5,file=metinp,status='old',iostat=ierr) - if(ierr.NE.0) call OPEN_ERR(-1,'SETUP','Control File', - & metinp,io5) -c -c --- Read control file inputs - call readcf(idiopt,title,iprog,itest,nm3d,nigf,igfmet) -c -c --- Pass image of CALMET control file to scratch file - call TFERCF -c -c --- Write the files used in this run to the list file - call wrfiles(nm3d,nigf) -c -c --- Open I/O files other than the control & list files - call openot -c -c --- Read and write QA information to plot files (SEA.DAT locations) - if(iqaplot.EQ.1) call QAPLOT1(ibtz) -c -c --- Read geophysical data - call readge(ldb) - -c --- Read header records of input met. data files & find proper -c --- starting point in each file (surface data file, precip. data -c --- file, upper air data file, over water file) -c call readhd(ibyr,ibjul,ibhr,ibtz,irlg,ldb,idiopt,iprog,igfmet) - call readhd(ibyrn,ibjuln,ibhrn,ibsecn,ieyrn,iejuln,iehrn,iesecn, - : ibtz,nsecdt,ldb,idiopt,iprog,igfmet) - -c -c --- Set general model common block parameters - call setcom(ldb) -c -c --- Set-up computations for micrometeorological module - call microi(nsecdt) -c -c --- Wind field module set-up - call diagi(elev,z0,nowsta) -c -c --- Write header records of output file - if(lsave)then - if(iformo.eq.1)then -c -c --- CALMET-formatted output file - call outhd - -c --- v6.4.0, Level 121203 - if(iauxlwc.EQ.1) call OUTAUXHD -c --- Done with scratch file - close(iox) - - else if(iformo.eq.2)then -c -c --- MESOPAC II-formatted output file - ilwf=2 - iuwf=4 - vk=0.4 -c --- Compute coordinates in MESOPAC II met. grid units - shift=dgrid/2. -c -c frr (09/01)noobs - if (noobs.ne.2) then - do 10 i=1,nssta - xscoor(i)=(xssta(i)-shift)/dgrid+1.0 - yscoor(i)=(yssta(i)-shift)/dgrid+1.0 -10 continue - endif -c - if (nusta .gt.0) then - do 20 i=1,nusta - xucoor(i)=(xusta(i)-shift)/dgrid+1.0 - yucoor(i)=(yusta(i)-shift)/dgrid+1.0 -20 continue - end if -c - call outpc1(ldb,ibyr,ibjul,irlg,nssta,nusta,nx,ny,ibtz, - 1 ilwf,iuwf,dgrid,vk,xscoor,yscoor,xucoor,yucoor,z0,nears, - 2 ilandu) - endif - endif -c -c --- Read sigma weighting factors if using prognostic data (IPROG=3/13 or -c --- 5/15) -- otherwise fill in default values -c frr (09/01) - pass on noobs: no need for weight if no observations -c call rdwt(iprog,cellzc) - call rdwt(noobs,iprog,cellzc) - -c --- frr 050328 -c --- Set coastal variables (compute distance to coast) - call setcoast(ilandu,iwat1,iwat2,ldbcst) -c - return - end -c---------------------------------------------------------------------- - subroutine similt(zzanem,el,z0,zi,ns,ipsifcn,us,vs,zimini) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 140912 SIMILT -c --- M. Fernau, J. Scire EARTH TECH -c -c --- PURPOSE: Extrapolate surface wind speed and direction aloft using -c the method of Van Ulden and Holtslag (J. Climate & Appl. -c Meteor., vol 24, pp. 1196-1207, 1985) -c -c --- UPDATES: -c --- v6.3 (070717) to v6.4.2 (140912) -c - Replace XLAT1 with XSLAT(mxss) array or XOWLAT(mxows) for -c use in assigning the N./S. hemispere when extrapolating -c wind direction at the surface met stations -c (XLAT1 not set for UTM coordinates) -c --- v5.612 (051214) to v6.3 (070717) -c - add new control variable IPSIFCN to select call to PSIU -c functions -c -c - V5.6 (050328) to v5.612 (051214) (DGS-FRR) -c - use double precision argument for psiud -c -c --- V5.5 (030402) to V5.6 (050328) (FRR) -c - Update similarity profiles using COARE consistent stability -c functions (Paulson (1970) and Dyer (1974) for the unstable -c surface layer,coupled with a free convection relation for -c large z/L (Gratchev et al, 2000) and new relations for stable -c atm (Beljaars and Holtslag, 1991) -c => use COARE stabitily functions PSIU and PSIT except for -c Dyer's fit correction (PSIUD/PSITD) -c -c --- V5.4 (970825) to V5.5 (030402) (DGS) -c - /MAP/ replaces /LON/ -c -c --- Changes: F. Robe - 5/97 -c Replace the arbitrary 200m height for extrapolation -c by user-selected minimum mixing height -c -c --- J. Scire, J. Chang (8/97) -c Add restrictions to Monin-Obukhov length < 5 z0 -c -c --- INPUTS: -c ZZANEM - real - station anemometer height (m) -c EL - real - Monin-Obukhov length (m) -c Z0 - real - roughness length (m) -c ZI - real - mixing height (m) -c NS - integer - Index of station in surface array -c stability correction for wind -c profile -c (IPSIFCN=0 use CALMET v5.6; -c IPSIFCN=1 use CALMET v5.53) -c US(MXNZ,MXWND) - real array - U component (m/s) of observed winds -c k=1 corresponds to anemometer height -c VS(MXNZ,MXWND) - real array - V component (m/s) of observed winds -c k=1 corresponds to anemometer height -c ZIMINI - real - Lower bound on mixing height -c -c Common block /GRID/ -c nx,ny,nz,nzp1,dgrid,zface,zmid -c Common block /MET1/ -c nssta, xslat(mxss) -c Common block /OVRWAT/ -c nowsta, xowlat(mxows) -c Parameters: mxnx,mxny,mxnz,mxwnd,mxss,mxows -c -c --- OUTPUT: -c -c US(MXNZ,MXWND) - real array - U component (m/s) of observed winds -c with surface extrapolation -c k=1 corresponds to first CALMET level -c VS(MXNZ,MXWND) - real array - V component (m/s) of observed winds -c with surface extrapolation -c k=1 corresponds to first CALMET level -c -c --- SIMILT called by: ELUSTR2, WATER2, WIND1 -c --- SIMILT calls: function PSIUD, PSIUC -c---------------------------------------------------------------------- -c - include 'params.met' - include 'grid.met' - include 'met1.met' - include 'ovrwat.met' - - dimension us(mxnz,mxwnd),vs(mxnz,mxwnd) - real eltbli(9) - real dhtbl2(9) - real*8 psiud,r8 - - logical ldb - -c --- Factor = 180 degrees / pi - data d1/1.58/,d2/1.0/,factor/57.2957795/ -c --- Values from Table 2, Van Ulden & Holtslag (1985) - data ztbl2 /200./ -c --- Values of L from van Ulden & Holtslag (ELTBL2) -c *** data eltbl2 /-30.,-100.,-370.,10000.,350.,130.,60.,20.,9./ -c --- Values of 1/L (ELTBLI) - data eltbli/-0.03333333,-0.01,-0.0027027,0.0,0.002857,0.007692, - 1 0.0166667,0.05,0.1111111/ - data dhtbl2 /12.,10.,9.,12.,18.,28.,35.,38.,39./ - -c ldb=.TRUE. - ldb=.FALSE. - -c --- Select latitude of the station location - if(ns.LE.nssta) then - idstation=ns - stnlat=xslat(idstation) - else - idstation=ns-nssta - if(idstation.GE.1 .AND. idstation.LE.nowsta) then - stnlat=xowlat(idstation) - else - write(io6,*)'ERROR in SIMILT: invalid NS' - write(io6,*)' Expected NS = 1 to NSSTA+NOWSTA' - write(io6,*)' Found NS,NSSTA,NOWSTA = ',ns,nssta,nowsta - stop 'ERROR in SIMILT -- see list file' - endif - endif -c -c --- Restrict Monin-Obukhov length to be at least 5*z0 - eladj=el - if(abs(eladj).lt.5.*z0)then - if(eladj.lt.0.)then - eladj=-5.0*z0 - else - eladj=5.0*z0 - endif - endif -c -c --- Convert M-O length to 1/L (neutral = 0) - if (abs(eladj) .ge. 10000.) then - elinv = 0. - else - elinv = 1. / eladj - end if -c -c --- Recover anemometer (not surface) wind speed and direction - ws1 = sqrt(us(1,ns) **2 + vs(1,ns) **2) - angle = 270. - atan2(vs(1,ns),us(1,ns)) * factor - wd1 = amod(angle,360.) - if (wd1 .eq. 0.) wd1 = 360. -c --- Calculate ln(z1/z0) and stability function psi-m(z1/L) at -c anenometer height (not at CALMET level 1)050328 -c xlnz1z0 = alog(zmid(1) / z0) - xlnz1z0 = alog(zzanem / z0) - - if (abs(elinv) .lt. .00005) then -c --- Neutral - psim1 = 0. - - else -c stable or unstable - -c 050328: use new profiles (COARE) for stable and unstable atm -c at this point ws is at zzanem (instead of zmid(!)) - -c psim1 = PSIUD(zzanem/eladj) - if(ipsifcn.EQ.0) then - r8=zzanem/eladj - psim1 = PSIUD(r8) - elseif(ipsifcn.EQ.1) then - psim1 = PSIUC(zzanem,eladj,16) - else - write(io6,*)'ERROR in SIMILT: invalid IPSIFCN' - write(io6,*)' Expected IPSIFCN = 0 or 1' - write(io6,*)' Found IPSIFCN = ',ipsifcn - stop 'ERROR in SIMILT -- see list file' - endif - - endif - -c else if (elinv .gt. 0) then -c --- Stable -c psim1 = -17. * (1. - exp(-0.29 * zmid(1) / eladj)) -c else -c --- Unstable -c x = (1. - 16. * zmid(1) / eladj) ** .25 -c psim1 = 2. * alog((1. + x) * .5) + alog((1. + x * x) * .5) -c & - 2. * atan(x) + 1.5707963 -c end if - -c --- Calculate turning angle D(h) using z = 200 m. - if (abs(elinv) .lt. .00005) then -c --- Neutral - dh200 = dhtbl2(4) - else -c --- Interpolate from Table 2 values - do i = 1,9 - if (eltbli(i) .ge. elinv) then - if (i .eq. 1) then - dh200 = dhtbl2(1) - else - dh200 = dhtbl2(i-1) + - & (dhtbl2(i) - dhtbl2(i-1)) * - & (elinv - eltbli(i-1)) / - & (eltbli(i) - eltbli(i-1)) - end if - goto 1 - end if - end do - dh200 = dhtbl2(9) - end if - 1 continue -c --- Calculate turning angle at anemometer height - dzan = dh200 * d1 * (1. - exp(-d2 * zzanem / ztbl2)) -c -c --- Loop over all levels above surface (including level 1 - 050328) -c do k = 3,nzp1 - do k = 2,nzp1 - -c --- FRR (5/97): extrapolate below mixing height (no arbitrary 200m min) -c --- if (zface(k) .le. amax1((zi + .001),200.)) then - if (zface(k) .le. amax1((zi + .001),zimini)) then - - xlnzz0 = alog(zmid(k-1) / z0) - if (abs(elinv) .lt. .00005) then -c --- Neutral - psim = 0. - else -c --- stable or unstable - use COARE-like PSIU functions (050328-frr) -c psim=PSIUD(zmid(k-1)/eladj) - if(ipsifcn.EQ.0) then - r8=zmid(k-1)/eladj - psim = PSIUD(r8) - elseif(ipsifcn.EQ.1) then - psim = PSIUC(zmid(k-1),eladj,16) - else - write(io6,*)'ERROR in SIMILT: invalid IPSIFCN' - write(io6,*)' Expected IPSIFCN = 0 or 1' - write(io6,*)' Found IPSIFCN = ',ipsifcn - stop 'ERROR in SIMILT -- see list file' - endif - endif - -c --- Apply wind speed adjustment, eqn 52 of Van Ulden & Holtslag (1985) - - ws = ws1 * (xlnzz0 - psim) / (xlnz1z0 - psim1) -c --- Turn winds, eqn 51 of Van Ulden & Holtslag (1985) - dwd = dh200 * d1 * (1. - exp(-d2 * zmid(k-1) / ztbl2)) - if (stnlat .gt. 0.) then -c --- Winds veer in Northern Hemisphere -c (Wind direction + shear between level and ground - shear between -c anemometer and ground = WD + shear between level and anemometer) - wd = wd1 + dwd - dzan - if (wd .gt. 360.) wd = wd - 360. - else -c --- Winds back in Southern Hemisphere - wd = wd1 - dwd + dzan - if (wd .le. 0.) wd = 360. + wd - end if - -c --- Retrieve u and v components -c --- NoteL now us(1,) vs(1,) are at zmid(1) and no longer at anemometer height - wdrad = 0.0174533 * wd - us(k-1,ns) = -ws * sin(wdrad) - vs(k-1,ns) = -ws * cos(wdrad) - else -c --> Above mixing height, exit - goto 2 - end if - end do - 2 continue - - -c --- Debug output for station latitude - if(ldb) then - write(io6,*)'SIMILT: ns,idstation,stnlat,wd1,wd(top) = ', - & ns,idstation,stnlat,wd1,wd - endif - - return - end -c---------------------------------------------------------------------- - subroutine slope(uslope,vslope,htopo,isurft,tinf,temp2d,hmax) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070113 SLOPE -c -c THIS SUBROUTINE COMPUTES THE SLOPE FLOWS (U,V) -C ACCORDING TO MAHRT's formula for shooting flows (1982) -c THE SLOPE FLOWS ARE FUNCTION OF THE LOCAL SENSIBLE HEAT FLUX -C AND ARE NOT COMPUTED OVER WATER -C -c --- UPDATES: -c --- V5.6 (050328) to V5.727(060828) - F.Robe -c - Add option to use spatially varying temp2D instead of domain -c repreentative Tinf -c - Remove obsolete common /S1/ -c -c --- V5.6 (050328-FRR) : explicit common replaced by include d6.met -c -c 01/11/97 (FRR) - Slope flow parameterization according to -c Mahrt. Based on the local heat flux -c Requires new include files -c - Slope flow may exist in layers aloft. -c -C INPUT: HTOPO (R ARRAY) - GRIDDED TERRAIN HEIGHTS -c ISURFT (I) - Surface station number where domain -c representative temperature is used from -c or trigger for using 2-D surface temp -c (ISURFT=-1; default); isurft=-2 is for -c domain-averaged prognostic sf temperature -C TINF (R) - DOMAIN REPRESENTATIVE SF TEMPERATURE -C TEMP2D(R ARRAY) - Surface TEMPERATURE -C HMAX (R ARRAY) - MAXIMUM TERRAIN HEIGHTS WITHIN A -C GIVEN RADIUS -c --- include grid.met: -c ZFACE(MXNX.MXNY) - real array - Grid cell face heights -c DISTHMAX(MXNX,MXNY) - real array - Birdwise distance to the -c highest peak within a radius -c terrad -c DISTHMIN(MXNX,MXNY) - real array - Birdwise distance to the -c lowest valley bottom within a radius -c terrad -c HMIN(MXNX,MXNY) - real array - Altitude of the lowest valley -c bottom within a radius TERRAD -c --- include geo.met: -c ILANDU(MXNX,MXNY) -integer array - landuse category -c -c --- include metgrd.met: -c QH (MXNX,MXNY) - real array - sensible heat flux -c -c --- include params.met: -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C --- OUTPUT: USLOPE (R ARRAY) - U-COMPONENTS OF THE SLOPE FLOW -C VSLOPE (R ARRAY) - V-COMPONENTS OF THE SLOPE FLOW -C -c --- SLOPE called by: DIAGNO -c SLOPE calls: none -c ------------------------------------------------------------------------------- - - -c --- include parameters - include 'params.met' - -c --- include GRID common block to get ZFACE and the new variable -c DISTHMAX (birdwise distance to the highest peak) - include 'grid.met' -c --- Include METGRID common block to get HF (sensible heat flux) - include 'metgrd.met' -c --- Include GEO common block to get ILANDU, IWAT1,IWAT2 - include 'geo.met' - - include 'd6.met' - - DIMENSION USLOPE(mxnx,mxny,mxnz), VSLOPE(mxnx,mxny,mxnz), - 1 HTOPO(mxnx,mxny), HMAX(mxnx,mxny),temp2D(mxnx,mxny), - 2 usfc(mxnx,mxny),vsfc(mxnx,mxny) - - DATA ZERO/0./ -C rho*cp using the standard atmosphere density (1.225 kg/m3)& cp=1004J/K/kg - data rhocp/1229.9/ -c cdk=cd+k= drag coefficient + entrainment coefficient - data cdk/8.e-2/ - -C DEFINE CONVERSION FACTORS -C - RPD=0.017453 - DPR=57.296 -C -C INITIALIZE ARRAYS -C - - CALL XMIT(-mxxyz,ZERO,USLOPE) - CALL XMIT(-mxxyz,ZERO,VSLOPE) -C - - DO 100 J=1,NY - DO 100 I=1,NX - -c --- No slope flow over water (iwat1 < ilandu < iwat2) - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2) goto 100 - -c --- Use spatially varying temperature unless specifically requested - if (isurft.gt.0.or.isurft.eq.-2) then - temp=tinf - else - temp=temp2d(i,j) - endif - - - DELU=0. - DELV=0. -C -C CALCULATE THE TOPOGRAPHIC GRADIENTS -C - DXI=0.5/DX - DYI=0.5/DY - HTOIM1=HTOPO(I,J) - HTOJM1=HTOPO(I,J) - IF (I .GT. 1) HTOIM1=HTOPO(I-1,J) - IF (J .GT. 1) HTOJM1=HTOPO(I,J-1) - HTOIP1=HTOPO(I,J) - HTOJP1=HTOPO(I,J) - IF (I .LT. NX) HTOIP1=HTOPO(I+1,J) - IF (J .LT. NY) HTOJP1=HTOPO(I,J+1) - DELHI=(HTOIP1-HTOIM1)*DXI - DELHJ=(HTOJP1-HTOJM1)*DYI -C -C CALCULATE THE SLOPE FLOW -C - - AALPHA=ATAN((DELHI**2+DELHJ**2)**0.5) - IF (ABS(AALPHA) .LT. 0.009) GO TO 100 - SINALF=SIN(ABS(AALPHA)) - SINALT=(DELHI**2+DELHJ**2)**0.5 - IF (SINALT .LT. 0.) SINALT=0. - - -c --- Distance to the crest (downslope) or valley bottom (upslope)(dcrest) - - if (qh(i,j).lt.0.) then - dcrest=sqrt((hmax(i,j)-htopo(i,j))**2+ disthmax(i,j)**2) -c--------- thickness of the slope flow (hd; according to Horst-Doran, 1985) - hd=0.05*(hmax(i,j)-htopo(i,j)) - else -c--------- thickness of the slope flow (hd; according to Horst-Doran, 1985) - hd=0.05*(htopo(i,j)-hmin(i,j)) - dcrest=sqrt((htopo(i,j)-hmin(i,j))**2+ disthmin(i,j)**2) - endif - - if (hd.le.0.05) then - uvally=0. - else -c --- Downslope - if (qh(i,j).lt.0.)then -c ---------- bound on slope - sinalf=min(sinalf,(hmax(i,j)-htopo(i,j))/dcrest) -c - tempmef = -dcrest * cdk / hd - tempmef=amax1(tempmef,-50.) - UVALLY=-(sinalf*(9.81/temp)*abs(qh(i,j))*dcrest/rhocp/cdk) - 1 **(1./3.)*(1-exp(tempmef))**(1./3.) - else -c --- Upslope - UVALLY=((9.81/temp)*abs(qh(i,j))* - 1 (htopo(i,j)-hmin(i,j))/rhocp)**(1./3.) - endif - endif - -c -C SET UP DRAINAGE VECTOR DIRECTIONS -C - IF (DELHI .EQ. 0.) THEN - IF (DELHJ .EQ. 0.) GO TO 100 - IF (DELHJ .LT. 0.) THET=270. - IF (DELHJ .GT. 0.) THET=90. - ELSE - THETP=ATAN(DELHJ/DELHI)*DPR - ENDIF - IF (DELHI .LT. 0.) THET=THETP+180. - IF (DELHI .GT. 0.) THEN - IF (DELHJ .GT. 0.) THEN - THET=THETP - ELSE - THET=THETP+360. - ENDIF - ENDIF - IF (THET .GE. 0. .AND. THET .LE. 90.) THETD=90.-THET - IF (THET .GT. 90. .AND. THET .LE. 360.) THETD=450.-THET -C -C RESOLVE SLOPE FLOW INTO COMPONENTS -C - ANG=(270.-THETD)*RPD - DELU=-COS(ANG)*UVALLY - DELV=-SIN(ANG)*UVALLY -C - -C SET UP USLOPE AND VSLOPE ARRAYS -c Determine the layers affected by the slope flow - do 111 k=1,nz - if (hd.gt.zface(k+1)) then - uslope(i,j,k)=delu - vslope(i,j,k)=delv - else if (hd.gt.zface(k)) then - ratio=(hd-zface(k))/(zface(k+1)-zface(k)) - uslope(i,j,k)=delu*ratio - vslope(i,j,k)=delv*ratio - endif -111 continue - -C - - 100 CONTINUE -C -C PRINT OUT SLOPE WIND COMPONENTS at the surface -C - DO 110 J=1,NY - DO 110 I=1,NX - USFC(I,J)=USLOPE(I,J,1) - VSFC(I,J)=VSLOPE(I,J,1) - 110 CONTINUE -C - if(iwr.gt.0)WRITE(IWR,1010) - if(iwr.gt.0)WRITE(IWR,1020) - CALL WNDLPT(USFC) - if(iwr.gt.0)WRITE(IWR,1030) - if(iwr.gt.0)WRITE(IWR,1020) - CALL WNDLPT(VSFC) -C - 1010 FORMAT(/,5X,'X-COMPONENT OF SLOPE WIND (U) AT THE SURFACE') - 1020 FORMAT(5X,44('-')) - 1030 FORMAT(/,5X,'Y-COMPONENT OF SLOPE WIND (V) AT THE SURFACE') - RETURN - END -c---------------------------------------------------------------------- - subroutine smooth(u,v,ub,vb,nsmth) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 950201 SMOOTH -c --- S. DOUGLAS, SAI -c --- changes by M. Fernau, Earth Tech, to make NSMTH a -c user-defined array -c -c --- include parameters - include 'params.met' - include 'breez.met' - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*), - 1 UB(mxny,2,*),VB(mxnx,2,*),nsmth(mxnz) -c NEW -frr (12/96) D5 replaced by grid.met - include 'grid.met' -c COMMON /D5/ NX,NY,NZ,DX,DY,dz(mxnz),NZPRINT -C -C APPLIES SMOOTHING TO INTERPOLATED FILEDS -C -C INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C UB (R ARRAY) - U-COMPONENT BOUNDARY VALUES -C VB (R ARRAY) - V-COMPONENT BOUNDARY VALUES -C NSMTH (I ARRAY) - NUMBER OF SMOOTHING PASSES FOR ALL -C LAYERS -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C OUTPUTS: U (R ARRAY) - SMOOTHED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - SMOOTHED Y-DIRECTION WIND COMPONENTS -C - DO 10 K=1,NZ - DO 20 N=1,NSMTH(K) -C -C SMOOTH SURFACE LAYER ONLY TWICE -c (deleted by MEF, 950201, block data default for k=1 is 2) -C -c IF (K .EQ. 1 .AND. N .GT. 2) GO TO 10 - DO 30 J=1,NY - DO 30 I=1,NX -c no smoothing inside lake breeze box - if (llbreze) then - if (k.eq.1)then - do 90 ibx=1,nbox - call box(ibx,float(i),float(j),ok) - if (ok.gt.0.00)goto 30 -90 continue - endif - endif - IP1=I+1 - JP1=J+1 - IM1=I-1 - JM1=J-1 - UIM1=UB(J,1,K) - IF (I .GT. 1) UIM1=U(IM1,J,K) - UJM1=U(I,J,K) - IF (J .GT. 1) UJM1=U(I,JM1,K) - VIM1=V(I,J,K) - IF (I .GT. 1) VIM1=V(IM1,J,K) - VJM1=VB(I,1,K) - IF (J .GT. 1) VJM1=V(I,JM1,K) - UIP1=UB(J,2,K) - IF (I .LT. NX) UIP1=U(IP1,J,K) - UJP1=U(I,J,K) - IF (J .LT. NY) UJP1=U(I,JP1,K) - VIP1=V(I,J,K) - IF (I .LT.NX) VIP1=V(IP1,J,K) - VJP1=VB(I,2,K) - IF (J .LT. NY) VJP1=V(I,JP1,K) -C - U(I,J,K)=0.5*U(I,J,K)+0.125*(UIP1+UIM1+UJP1+UJM1) - V(I,J,K)=0.5*V(I,J,K)+0.125*(VIP1+VIM1+VJP1+VJM1) - 30 CONTINUE - 20 CONTINUE - 10 CONTINUE - RETURN - END -c---------------------------------------------------------------------- - subroutine cloud3(nx,ny,rh,ccgrid) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 030119 CLOUD3 -c --- F.Robe, Earth Tech Inc. -c -c --- PURPOSE: Calculate cloud cover based on the prognostic -c relative humidity at ~ 850mb -c After Teixeira (Monthly Weather Review, 2001) -c -c --- INPUTS: -c RH - real array - prognostic rel. humidity -c on calmet grid at 850 mb -c -c --- OUTPUTS: -c CCGRID - real array - gridded cloud fraction - - - -c Common block variables: -c Parameters: - -c -------------------------------------------------------------------- -c - include 'params.met' - - real ccgrid(mxnx,mxny),rh(mxnx,mxny) - -c --- Teixera formula for cloud cover A (for rh < 1) -c --- A = (D/K)*(l/qs)*( -1 + sqrt(1+4*(K/D)*(qs/l)*(1-rh)) ) / (2*(1-rh)) -c --- where D : detrainment rate (4.e-06 s-1) -c --- K : erosion coefficient (1e-06 s-1) -c --- l : liquid water content -c --- qs: saturation specific humidity -c --- Based on observations reported in Teixera, we assume qs/l=100. -c --- Note that A=0.18 even when RH=0 (overestimate light cloud cover) -c --- unless corrected by qc value -c - - do 10 j=1,ny - do 10 i=1,nx - - if (rh(i,j).ge.99.) then - ccgrid(i,j)= 1. - else - rhd = rh(i,j)/100. - ccgrid(i,j)= 0.02*( -1 + sqrt(1.+100.*(1.-rhd)) ) / (1.-rhd) - endif - -10 continue - - return - end -c---------------------------------------------------------------------- - subroutine cloud4 (nxp,nyp,nlev,rh,prs,zp,ccp,ceil4) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070327 CLOUD4 -c --- F.Robe, TRC -c -c --- PURPOSE: Calculate cloud cover based on the prognostic -c relative humidity following MM5toGrads algorithm -c (calcclfr) and ceiling height -c -c --- UPDATES: -c --- V6.220 (070206) to V6.221(070327) (Zhong Wu and F. Robe) -c (1) Initialize cloud fraction arrays and indices in CLOUD4 -c -c --- Version 6.217 Level 061230 to Version 6.220 Level 070206 (F.Robe) -c (1) compute ceiling height index -c -c -c --- INPUTS: -c NXP,NYP,NLEV - integer - number of progn. gridpoints -c -c RH(mxnxp,mxnyp,mxnzp) - real array - prognostic rel. humidity on MM5 grid -c -c pRS(mxnxp,mxnyp,mxnzp) - real array - prognostic pressure on MM5 grid -c -c ZP(mxnxp,mxnyp,mxnzp) - real array - altitude above ground of prognostic -c levels (on MM5 grid) -c -c -c --- OUTPUTS: -c CCP(mxnxp,mxnyp) - real array - total cloud fraction on MM5 grid -c -c CEIL4(mxnxp,mxnyp) - real array - ceiling height(m) -c -c -c -c --- CLOUD4 called by: RDMM4, RDMM5 -c -c --- CLOUD4 calls:none -c -c -------------------------------------------------------------------- -c - include 'params.met' - - real prs(mxnxp,mxnyp,mxnzp),rh(mxnxp,mxnyp,mxnzp) - real clfrlo(mxnxp,mxnyp),clfrmi(mxnxp,mxnyp),clfrhi(mxnxp,mxnyp) - real ccp(mxnxp,mxnyp),ceil4(mxnxp,mxnyp),zp(mxnxp,mxnyp,mxnzp) - -c --- NOTES (F.Robe) -c --- prs: pressure in mb (!! not in Pascals as in original -c MM5tograds algorithm- FActor 100) -c --- k in CALMET increases from surface to upper levels, in MM5, it is -c the other way around => change looping order/ -c --- rh: relative humidity (%) -c - - do i=1,nxp - do j=1,nyp - -C --- Initialize cloud arrays (070327) - clfrlo(i,j)=0. - clfrmi(i,j)=0. - clfrhi(i,j)=0. - -c --- initialize cloud levels (070327) - kclo=nlev+1 - kcmd=nlev+1 - kchi=nlev+1 - - do k=nlev,1,-1 - if(prs(i,j,k).lt. 970.)kclo=k - if(prs(i,j,k).lt. 800.)kcmd=k - if(prs(i,j,k).lt. 450.)kchi=k - enddo - do k=1,nlev - IF(K.GE.KCLO.AND.K.LT.KCMD)clfrlo(i,j)= - & AMAX1(RH(i,j,k),clfrlo(i,j)) - IF(K.GE.KCMD.AND.K.LT.KCHI)clfrmi(i,j)= - & AMAX1(RH(i,j,k),clfrmi(i,j)) - IF(K.GE.KCHI)clfrhi(i,j)= - & AMAX1(RH(i,j,k),clfrhi(i,j)) - enddo - - clfrlo(i,j)=4.0*clfrlo(i,j)/100.-3.0 - clfrmi(i,j)=4.0*clfrmi(i,j)/100.-3.0 - clfrhi(i,j)=2.5*clfrhi(i,j)/100.-1.5 - -c --- Low, medium, high cloud fraction (MM5toGrads) - clfrlo(i,j)=amin1(clfrlo(i,j),1.0) - clfrlo(i,j)=amax1(clfrlo(i,j),0.0) - clfrmi(i,j)=amin1(clfrmi(i,j),1.0) - clfrmi(i,j)=amax1(clfrmi(i,j),0.0) - clfrhi(i,j)=amin1(clfrhi(i,j),1.0) - clfrhi(i,j)=amax1(clfrhi(i,j),0.0) - - -c --- Ceiling height CALMET): mid level of lowest layer with cloud -c fraction >=0.5 (or with the largest cloud fraction <0.5) -c - if (clfrlo(i,j).ge.0.5)then - kceil=kclo +(kcmd-kclo)/2 - else if (clfrmi(i,j).ge.0.5)then - kceil=kcmd+(kchi-kcmd)/2 - else if (clfrhi(i,j).ge.0.5)then - kceil=kchi - else if (clfrlo(i,j).ge.clfrmi(i,j).and. - : clfrlo(i,j).ge.clfrhi(i,j)) then - kceil=kclo+(kcmd-kclo)/2 - else if (clfrmi(i,j).ge.clfrlo(i,j).and. - : clfrmi(i,j).ge.clfrhi(i,j)) then - kceil=kcmd+(kchi-kcmd)/2 - else - kceil=kchi - endif - -c --- Total cloud fraction (CALMET variable, not in MM5toGrads) - ccp(i,j)=max(clfrlo(i,j),clfrmi(i,j),clfrhi(i,j)) - -c --- Ceiling height (0 if clear sky) -c --- (CALMET variable, not in MM5toGrads) - if (ccp(i,j).gt.1.e-09.and.kceil.le.nlev) then - ceil4(i,j)=zp(i,j,kceil) - else - ceil4(i,j)=0. - endif - - - enddo - enddo - - return - end - -c---------------------------------------------------------------------- - subroutine solar(njul,ibtz,sinalp) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060215 SOLAR -c --- J Scire, SRC -c Modified by F.Robe, Earth Tech, Inc. -c -c --- PURPOSE: Calculate sin(solar elevation angle) at all -c gridpoints (in "base time zone" time) -c -c --- UPDATES: -c --- V5.6 (050328) to v6.2 (060215) (FRR) -c - Compute 26 hourly values of sinalp at the 1/2h. -c Sinalp array goes from 1 to 26 , corresponding to LST times -c 23:30 previous day to 0:30 next day. -c - Keep negative values of sinalp for linear interpolation -c -c --- V5.5 (030402) to V5.6 (050328) (FRR) -c (1) Latitudes and longitudes are no longer computed in SOLAR -c but passed via Common GRID (computed in microi at setup) -c Note in COMMON GRID: East longitudes (not West long.) -c -c --- V5.4 (030119) to V5.5 (030402) (DGS) -c - Replace UTM/LLC conversion with COORDS (GLOBE1,GLOBE) -c -c --- INPUTS: -c NJUL - integer - Julian day number -c IBTZ - integer - Base time zone (5=EST, 6=CST, -c 7=MST, 8=PST) -c -c -c --- VIA GRID.MET: gridded N. latitude and E.longitude -c xlat(mxnx,mxny),xlon(mxnx,mxny) -c -c --- OUTPUT: -c SINALP(MXNX,MXNY,26) - real array - Sine of the solar elevation -c angle at all gridpoint for -c each hour of the day -c -c -c --- SOLAR called by: COMP -c --- SOLAR calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'grid.met' - -c --- 050328: variables from met1.met are no longer used in SOLAR -c (nothing new but just clean-up) -c include 'met1.met' -c - -c real sinalp(mxnx,mxny,24) - real sinalp(mxnx,mxny,26) -c --- All mapping variables defined outside of SOLAR - - -c --- constant 0.9856479 = 360./365.242 -c - d = (float(njul) -1.) * 0.9856479 - radd = 0.0174533 * d - xsind = sin(radd) - xcosd = cos(radd) - rad2d = 2. * radd - sin2d = sin(rad2d) - cos2d = cos(rad2d) - em = 12. + 0.12357 * xsind - 0.004289 * xcosd + 0.153809 - & * sin2d + 0.060783 * cos2d - sigma = 279.9348 + d + 1.914827 * xsind - 0.079525 * xcosd - & + 0.019938 * sin2d - 0.00162 * cos2d - sincd = 0.39784989 * sin(0.0174533 * sigma) - capd = asin(sincd) - coscd = cos(capd) -c -c --- calculate sine of solar elevation angles for each gridpoint -c - do 100 j=1,ny - do 100 i=1,nx - radlat = 0.0174533 * xlat(i,j) - sinlat = sin(radlat) - coslat = cos(radlat) -c -c --- constant 3.8197187 = 57.29578/15. -c -c *** Needed only if sunrise/sunset times computed -c *** caph = acos(-sinlat * sincd / (coslat * coscd)) * 3.8197187 -c *** dtemp = xlon(i,j) / 15. + em - ibtz -c !!! if line above even un-commented, change sign of xlon to -xlon as -c !!! since 050328, xlon is E.longitude (no longer W. longitude) -c -c --- sunrise/sunset not currently needed -c -c *** tsr = dtemp - caph -c *** tss = dtemp + caph -c *** write(io6,*) ' sunrise: ',tsr,' sunset: ',tss -c -c --- in GMT calculation: -c --- variable 'ihr' is array subscript variable (1-24) -- actual clock -c --- time is 'ihr-1' (00-23), but want half hour later so 1-24 -c --- actually represent 0:30 through 23:30 current day. -c -c --- zero negative values; these occur before sunrise or after sunset -c -c --- MOD6: compute for 26 hours from 23:30 previous day to 0:30 next day (explicit time) -c do 30 ihr = 1,24 - do 30 ihr = 1,26 - gmt = float(ihr-1) - 0.5 + ibtz -c --- East longitudes since 050328 (no longer W. Longitudes_ -c solha = 15. * (gmt - em) - xlon(i,j) - solha = 15. * (gmt - em) + xlon(i,j) - sinalp(i,j,ihr) = sinlat * sincd + coslat * coscd - & * cos(0.0174533 * solha) -c --- Keep negative values for linear interpolation to mid time step -c if (sinalp(i,j,ihr) .lt. 0.) sinalp(i,j,ihr) = 0. - -30 continue -100 continue - return - end -c---------------------------------------------------------------------- - subroutine stheor(nhrz,zi,ziconv,us,vs,ns,is,js,nsurf,iupt, -ccec101006 1 itwprog,iicloud,ccgrid, rho, temp2d,rmm,qsw,qlw, - 1 itwprog,mmcloud,ccgrid, rho, temp2d,rmm,qsw,qlw, - & ipsifcn,isfcmet) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101006 STHEOR -c --- M. Fernau, Earth Tech -c --- Modified by J. Scire to include gridded clouds -c -c --- PURPOSE: Call routines to extrapolate surface winds aloft -c using similarity theory -c -c --- UPDATES: -c --- V6.3 (070404) to v6.330 (101006) (CEC) -c - Change ICLOUD into MCLOUD and ICLDOUT -c -c --- V6.218 (070113)to v6.3 (070404) -c - Add IPSIFCN to ELUSTR argument list -c - Add IPSIFCN to WATER2 argument list -c - Add IPSIFCN to WATER2P argument list -c - Add ISFCMET to control temperature to use in ELUSTR2 -c - Add IUPT to calling list (to pass to ELUSTR2) -c -c --- v5.612 (051214)to V6.218 (070113)(Frr) -c - Remove iupt from calling list and from ELUSTR2 calling list -c -c V5.611 (051113) to v5.612 (051214)(Frr) -c - Replace call to water2p by call to water2 for surface stations -c -c over water when itwprog<2 (bug) -c (V5.6 Level(050328) to V5.611 (051113)(Frr) -c - Add itwprog to calling list -c - Call to WATER2/WATER2P depending on value of itwprog -c (ITWPROG=2: use 3D.DAT deltaT not SEA.DAT) -c -c (951021) to V5.6 Level(050328) (Frr) -c - Receive and pass on imixh to water2 so that it can compute -c the convective mixing height at the station with the -c user-selected method and extrapolate winds accordingly -c - Use interpolated surface temperature field temp2d -c - Pass on short and long wave fluxes to WATER2 for COARE method -c -c --- INPUTS: -c NRHZ - integer - GMT hour (ending time) -c ZICONV(mxnx,mxny) - real array - Convective mixing heights (m) -c of previous timestep -c ZI(mxnx,mxny) - real array - Previous timestep mixing heights (m) -c US(MXNZ,MXWND) - real array - U component of observed winds -c VS(MXNZ,MXWND) - real array - V component of observed winds -c NS - integer - Location of station in surface -c array -c IS,JS - integer - Coordinates of grid cell in -c which station is located -c NSURF - integer - Total # of surface sites -c MMCLOUD - integer - Flag indicating if gridded -c cloud data are available -c (2=yes, otherwise, no) -c CCGRID(mxnx,mxny) - real array - Gridded cloud fraction -c (Used only if MMCLOUD=2,3) -c RMM(mxnx,mxny) - real array - 2D rainfall rate (at this point is only filled -c if npsta=-1 (prognostic rainfall) -c RHO(mxnx,mxny) - real array - 2D surface density -c TEMP2D(mxnx,mxny) - real array - Surface temperature (on CALMET grid) -c QSW(mxnx,mxny) - real array - net short wave flux at surface -c QLW(mxnx,mxny) - real array - downward long wave flux at surface -c IPSIFCN - integer - Flag controlling choice of PSI -c stability correction for wind -c profile -c (IPSIFCN=0 use CALMET v5.6; -c IPSIFCN=1 use CALMET v5.53) -c ISFCMET - integer - Flag controlling surface -c temperature to use in ELUSTR2 -c (ISFCMET=0 use full 2D; -c ISFCMET=1 use surface stn if -c ITPROG<2) -c -c -c -c Common block /GRID/ -c nx,ny,nz,nzp1,dgrid,zface,zmid -c Common block /MET1/ -c nssta, noobs ,itprog -c Common block /MET2/ -c pres,icc,tempk -c Common block /GEO/ -c ilandu,iwat1,iwat2,z0 -c Common block /ZIPARM/ -c fcoriol -c Common block /HFLUX/ -c imixh -c Parameters: mxnx,mxny,mxnz,mxwnd -c -c --- OUTPUT: -c US(MXNZ,MXWND) - real array - U component of observed winds -c with surface extrapolation -c VS(MXNZ,MXWND) - real array - V component of observed winds -c with surface extrapolation -c -c --- STHEOR called by: DIAGNO -c --- STHEOR calls: ELUSTR2, WATER2 -c---------------------------------------------------------------------- -c - include 'params.met' - include 'met1.met' - include 'met2.met' - include 'geo.met' - include 'ziparm.met' - include 'grid.met' - include 'hflux.met' - - real us(mxnz,mxwnd),vs(mxnz,mxwnd) - real ziconv(mxnx,mxny),zi(mxnx,mxny) - real ccgrid(mxnx,mxny), rmm(mxnx,mxny) - real temp2d(mxnx,mxny),rho(mxnx,mxny) - real qsw(mxnx,mxny),qlw(mxnx,mxny) - -c - - if (ns .gt. nssta) then -c --- Treat SEA#.DAT station as water -c --- frr 050328 (additional parameters passed on to water2 for COARE method) -c actual anenometer height is already in WATER2 (via common) - zzanem=9999. - if (itwprog.eq.2) then - call water2p(us,vs,is,js,ns,zzanem,imixh,fcori(is,js),nsurf, - : zi(is,js),qsw(is,js),qlw(is,js),rmm(is,js),nhrz, - : dcoast(is,js),ipsifcn) - else - call water2(us,vs,is,js,ns,zzanem,imixh,fcori(is,js),nsurf, - : zi(is,js),qsw(is,js),qlw(is,js),rmm(is,js),nhrz, - : dcoast(is,js),ipsifcn) - endif - else if (ilandu(is,js) .ge. iwat1 .and. ilandu(is,js) - & .le. iwat2) then -c --- If SURF.DAT station but cell is water, treat as water -c --- 050328: pass on station anemometer height for proper extrapolation - if (itwprog.eq.2) then - call water2p(us,vs,is,js,ns,zanem(ns),imixh,fcori(is,js), - : nsurf,zi(is,js),qsw(is,js),qlw(is,js),rmm(is,js),nhrz, - : dcoast(is,js),ipsifcn) - else - call water2(us,vs,is,js,ns,zanem(ns),imixh,fcori(is,js), - : nsurf,zi(is,js),qsw(is,js),qlw(is,js),rmm(is,js),nhrz, - : dcoast(is,js),ipsifcn) - endif - else -c --- Treat as land station -c --- frr 021105: allow noobs mode (and also itprog=2) -c --- frr 050328: pass station anemometer height to elustr2 -c --- and use temp2d rather than tempk/tprog -c --- TEMP2D here is either the fully conditioned 2D field -c --- or the 2D field from either the prognostic data or the -c --- nearest surface station - if(isfcmet.EQ.0 .OR. itprog.EQ.2) then - temp=temp2d(is,js) - elseif(isfcmet.EQ.1) then - temp=tempk(ns) - endif - - call elustr2(ziconv,us,vs,ns,zanem(ns),is,js,icc,iupt, -ccec101006 1 iicloud,itprog,ccgrid,zi,temp,rho(is,js),ipsifcn) - 1 mmcloud,itprog,ccgrid,zi,temp,rho(is,js),ipsifcn) - end if - return - end -c---------------------------------------------------------------------- - subroutine temp3d(nyrze,njulze,nhrze,nsece,temp2d,ziconv, - 1 tzgraa,tzgrbb,ztemp,zi,tprog) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 090511 TEMP3D -c --- R. Yamartino, SRC -c --- Modified by J. Scire to allow for missing data (900810) -c --- Modified by M. Fernau to allow for 1/Radius weighting -c --- and different treatment of land vs. water (940912) -c --- Modified for MM4 data only; no UPn.DAT (941101) -c --- Modified to have radius of influence and maximum number -c --- of stations in surface interpolation (950321) -c --- Modified by F.Robe to get 3D temp from prognostic data -c --- at upper levels and/or surface (030119)(param:ITPROG) -c -c --- PURPOSE: Compute a 3-D temperature field -c -c --- NOTE: Currently, if no upper air data exist, then MM4 data are -c used in place of NWS upper air data. If any NWS data -c exist, only NWS data are used. This should be modified -c to allow a weighted use of both. -c FRR (09/2001): if ITPROG=1 upper air temperature from MM5 -c if ITPROG=2 upper air and surface temperature from MM5 -c -c --- UPDATES : -c --- V6.32 Level 080205 to v6.327 Level 090511(FRR) -c - Add more explicit information to 1089-1090 error write -c statements -c -c --- v6.223 Level 070702 to v6.32 (080205)(F.Robe) -c (1) Use end times rather than beginning times -c -c --- V6.222 Level 070404 to v6.223 Level 070702 to (F.Robe) -c (1) initialize ldwat sooner in the code to avoid non-initialization -c if no water stations (with water tempresults depending on default -c value assigned to ldwat by compiler ) -c -c --- v6.2 Level 060215 to V6.222 Level 070404(F.Robe) -c (1) bug fix: in noobs temp mode, adjust temperatures to adiabatic -c profile under convective mixing height (was done under un-defined -c variables i.e. 0 or random number depending on compiler) -c -c --- V5.6 level 050328 to v6.2 Level 060215 (F.Robe) -c - Use explicit beginning times with seconds -c --- 5.6 level 050328 -c - No need to declare U,V anylonger as surface temperature is -c now computed in SURFVAR -c -c --- INPUTS: -c NYRZE - integer - Year of current hour (GMT) -c (explicit end time) -c NJULZE - integer - Day of current hour (GMT) -c (explicit end time) -c NHRZE - integer - Current hour GMT time (0-23) -c (explicit end time) -C NSECE - integer - Current end second -c TEMP2D(mxnx,mxny) - real array - Gridded Surface temp. (deg K) c -c ZICONV(mxnx,mxny) - real array - Convective mixing height (m) -c ZI(mxnx,mxny) - real array - Mixing height (m) -c TZGRaa(mxnzp1,mxus) - real array - Grid face temp. interpolations -c for aa GMT sounding (deg. K) -c TZGRbb(mxnzp1,mxus) - real array - Grid face temp. interpolations -c for bb GMT sounding (deg. K) -c TPROG(mxnx,mxny,mxnz) - real array - MM4 temperature array on CALMET grid -c Common block /GRID/ -c nx,ny,nz,nzp1,dgrid,zface,zmid -c Common block /MET1/ -c nssta,nusta,xssta,yssta,xusta,yusta,noobs,ITPROG -c Common block /UPMET/ -c justa,justd,ntzaa,ntzbb -c Common block /TMP/ -c irad,numwb,tgdefb,tgdefa,jwat1,jwat2,trad,numts,iavet -c Common block /GEO/ -c ilandu,iwat1,iwat2,elev -c Common block /OVRWAT/ -c tairow,nowsta,tgrada,tgradb -c Parameters: mxnx, mxny, mxnz, mxnzp1, mxss, -c mxus, mxps, mxlev, mxtmp -c -c --- OUTPUT: -c ZTEMP(mxnx,mxny,mxnz) - real array - 3-D temperature field (deg. K) -c -c --- TEMP3D called by: COMP -c --- TEMP3D calls: DEDAT,DELTT -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real temp2d(mxnx,mxny) - real zi(mxnx,mxny),ziconv(mxnx,mxny) - real tzgraa(mxnzp1,mxus),tzgrbb(mxnzp1,mxus) - real ztemp(mxnx,mxny,mxnz),tprog(mxnx,mxny,mxnz) -c real u(mxnx,mxny),v(mxnx,mxny) -c --- local arrays - real tzgr(mxnzp1,mxus),tgrdb(mxnx,mxny),tgrda(mxnx,mxny) - real tzua(mxnzp1) - real wtus(mxus) - real tdist(mxtmp) - integer stlist(mxtmp) -c - include 'grid.met' - include 'met1.met' - include 'upmet.met' - include 'tmp.met' - include 'geo.met' - include 'ovrwat.met' -c - data xmiss/9999./ -c -c -c --- If no upper air stations, use default value for ZTEMP -c There are no default values for Ztemp and the combo nusta<=0 and itprog=0 -c is not valid (rejected in READCF - No need for this statement -c frr (050328) -c if(nusta.le.0 .and. itprog.eq.0 ) return -c -c --- Current timestamp (End GMT time) - nowtze = nyrze*100000 + njulze*100 + nhrze - -c --- Compute time interpolated temperatures for each upper air station. -c Note that the aa and bb GMT values at each cell face are -c available in the tzgraa and tzgrbb arrays. -c -c FRR (9/2001) noobs (3 options) -c if (noobs .eq. 1) goto 6 - if (itprog.ge.1) goto 6 - do 10 iu = 1,nusta - jorder = justa(iu) - jdelta = jusdt(iu) - ntzaas = ntzaa(iu) - call dedat(ntzaas,jaayr,jaaday,jaahr) - ntzbbs = ntzbb(iu) - call dedat(ntzbbs,jbbyr,jbbday,jbbhr) - ibbsec=jbbsec(iu) - iaasec=jaasec(iu) - - if (jorder .gt. 0) then -c call deltt(nyrz,njulz,nhrz,jbbyr,jbbday,jbbhr,jtogo) -c call deltt(jaayr,jaaday,jaahr,nyrz,njulz,nhrz,jpast) - call deltsec(nowtze,nsece,ntzbbs,ibbsec,jtogo) - call deltsec(ntzaas,iaasec,nowtze,nsece,jpast) - else -c call deltt(nyrz,njulz,nhrz,jaayr,jaaday,jaahr,jtogo) -c call deltt(jbbyr,jbbday,jbbhr,nyrz,njulz,nhrz,jpast) - call deltsec(nowtze,nsece,ntzaas,iaasec,jtogo) - call deltsec(ntzbbs,ibbsec,nowtze,nsece,jpast) - - end if -c -c --- Check for negative values of jtogo or jpast -c - if (jtogo .LT. 0 .OR. jpast .LT. 0) then - -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1089)iu, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - -1089 format(//1x,'ERROR IN SUBR. TEMP3D -- Upper air ', - 1 'soundings do not straddle current hour'/ - 1 2x,'Station no.: ',i5/, - 2 38x,'Year Julian Day Month Day Hour Seconds '/, -c xxxx xxx xx xx xx xxxx - 4 ' Current model date/time (UTC-GMT): ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 1 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 2 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - - stop - end if -c -c --- Double check for upper air data inconsistencies -c - if ((jpast + jtogo) .ne. jdelta) then - -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1090)iu, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - -1090 format(//1x,'ERROR IN SUBR. TEMP3D -- Inconsistent ', - 1 'upper air times for station ',i3/ - 2 38x,'Year Julian Day Month Day Hour Seconds '/, -c xxxx xxx xx xx xx xxxx - 4 ' Current model date/time (UTC-GMT): ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 1 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 2 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - - stop - end if -c -c --- Interpolate in time to current hour and loop over all levels -c - xfact = float(jtogo) / float(jdelta) - if (jorder .lt. 0) then - do 3 k = 2,nzp1 - 3 tzgr(k,iu) = tzgraa(k,iu) - (tzgraa(k,iu) - tzgrbb(k,iu)) - & * xfact - else - do 5 k = 2,nzp1 - 5 tzgr(k,iu) = tzgrbb(k,iu) - (tzgrbb(k,iu) - tzgraa(k,iu)) - & * xfact - end if - -10 continue - 6 continue -c - dgridi = 1.0 / dgrid -c - -c --- OVERWATER GRADIENTS - -c --- Use Prognostic data if itprog=2 - if (itprog.eq.2) goto 51 - - -c --- Determine whether overwater vs. land interpolation to be used -c (assume mxwb is hardwired to 1) - -c --- must initialize ldwat sooner or can be undefined (070702) - ldwat = 0 - -c --- Skip if no overwater station - if (nowsta.eq.0) goto 51 -c -c --- Find maximum land use category - maxcat = 0 - do lwi = 1,nlu - if (ilucat(lwi) .gt. maxcat) maxcat = ilucat(lwi) - end do -c -c --- If maximum land use category is < jwat1, no overwater T interpolation - ldwat = 1 - if (maxcat .lt. jwat1(mxwb)) then -c --- no overwater temp interpolation - ldwat = 0 - go to 51 - endif - -c --- Total number of station - nstat = nssta + nowsta - -c --- Reduce the missing value indicator by a small amount to allow -c for machine roundoff - xmissm=xmiss-0.01 -c -c --- Loop over grid cells -c - do 50 i = 1,nx -c -c --- Note,(xssta,yssta) are relative to the SW corner of grid pt (1,1) -c - xc = float(i) - 0.5 -c - do 50 j = 1,ny - yc = float(j) - 0.5 - - -c --- If using land/water interpolation, determine whether water -c or land (assume mxwb is hardwired to 1) - lndwat = 0 - if (ilandu(i,j) .ge. jwat1(mxwb) .and. - & ilandu(i,j) .le. jwat2(mxwb)) lndwat = 1 - -c --- skip if not overwater gridpoint - if (lndwat.eq.0) goto 50 -c -c --- Compute distance to all overwater stations - numsta = 0 - do 30 is = nssta+1,nstat - numsta=numsta+1 - xxx = xowsta(is - nssta) - yyy = yowsta(is - nssta) - r2 = (xxx * dgridi - xc)**2 + - & (yyy * dgridi - yc)**2 - - tdist(numsta) = sqrt(r2) - stlist(numsta) = is - 30 continue -c -c --- Sort list of eligible stations -c - if (numsta .gt. 1) then - do ii = 1,numsta-1 - do jj = ii+1,numsta - if (tdist(ii).gt.tdist(jj)) then - tmpvar = tdist(ii) - tdist(ii) = tdist(jj) - tdist(jj) = tmpvar - itmpvar = stlist(ii) - stlist(ii) = stlist(jj) - stlist(jj) = itmpvar - end if - end do - end do - end if - - tgrda(i,j) = 0.0 - tgrdb(i,j) = 0.0 - sumwt2 = 0.0 - sumwt3 = 0.0 -c -c --- Calculate TGRADs -c -c If no station within radius of influence, take nearest one - if (tdist(1) .gt. trad) then - if (tgradb(stlist(1) - nssta) .lt. xmissm) then -c --- Use observed TGRAD - tgrdb(i,j) = tgradb(stlist(1) - nssta) - else -c --- Use default TGRAD - tgrdb(i,j) = tgdefb - end if - - if (tgrada(stlist(1) - nssta) .lt. xmissm) then -c --- Use observed TGRAD - tgrda(i,j) = tgrada(stlist(1) - nssta) - else -c --- Use default TGRAD - tgrda(i,j) = tgdefa - end if - - else -c --- Some stations within radius, use up to NUMTS of them -c - do 888 is = 1,numsta - if (tdist(is) .gt. trad) goto 889 - if (is .gt. numts) goto 889 - if (irad .eq. 2) tdist(is) = tdist(is) * tdist(is) - if (tdist(is) .lt. 1.0) then - wt = 1.0 - else - wt = 1.0 / tdist(is) - endif - - if (tgradb(stlist(is) - nssta) .lt. xmissm) then - sumwt2 = sumwt2 + wt - tgrdb(i,j) = tgrdb(i,j) + - & wt * tgradb(stlist(is) - nssta) - end if - if (tgrada(stlist(is) - nssta) .lt. xmissm) then - sumwt3 = sumwt3 + wt - tgrda(i,j) = tgrda(i,j) + - & wt * tgrada(stlist(is) - nssta) - end if - - 888 continue - 889 continue - - - if (sumwt2 .gt. 0.) then -c --- Use observed TGRAD - tgrdb(i,j) = tgrdb(i,j) / sumwt2 - else -c --- Use default TGRAD - tgrdb(i,j) = tgdefb - end if - if (sumwt3 .gt. 0.) then -c --- Use observed TGRAD - tgrda(i,j) = tgrda(i,j) / sumwt3 - else -c --- Use default TGRAD - tgrda(i,j) = tgdefa - end if - - end if -c - - 50 continue -c -51 continue - - -c --- Load the 3-d temp array: -c - do 150 i = 1,nx -c -c --- Note,(xusta,yusta) are relative to the SW corner of grid pt (1,1) -c - xc = float(i) - 0.5 -c - do 150 j = 1,ny -c -c --- 2D surface temperature already computed in SURFVAR (frr 050328) - ztemp(i,j,1)=temp2d(i,j) - -c --- If using MM4/MM5 only aloft (no observations) just use TPROG as the -c temperature field aloft -c -c FRR(09/2001) - flag itprog for prognostic temperature -c if (noobs .eq. 1) then - if (itprog .ge. 1) then - do k = 2,nz - ztemp(i,j,k) = tprog(i,j,k) -c frr (09/01) -c --- Below convective mixing height, use dry adiabatic lapse rate -c --- this is needed because of the spatial and temporal interpolation -c --- performed on the prognostic data in RDMM5 -c --- bug fix: zic is not defined in noobs, use convective mixing height -c if (zmid(k).le.zic) - if (zmid(k).le.ziconv(i,j)) - & ztemp(i,j,k) = ztemp(i,j,1)-0.0098*(zmid(k)-zmid(1)) - enddo - go to 150 - endif -c - yc = float(j) - 0.5 -c -c --- Compute the weights for the upper air stations -c (irad = 1 = 1/R; irad = 2 = 1/R**2) -c - sumwt = 0.0 - do 115 iu = 1,nusta - wtus(iu) = 0.0 - r2 = (xusta(iu) * dgridi - xc)**2 + - & (yusta(iu) * dgridi - yc)**2 - if (irad .eq. 1) r2 = sqrt(r2) - if (r2 .lt. 1.0) then - wt = 1.0 - else - wt = 1.0 / r2 - endif - sumwt = sumwt + wt - wtus(iu) = wt - 115 continue -c -c --- Normalize the weights -c - sumwt = 1.0 / sumwt - do 117 iu = 1,nusta - 117 wtus(iu) = wtus(iu) * sumwt -c -c --- Load the upper air determined temperatures into tzua -c - do 125 k = 2,nzp1 - tzuas = 0.0 - do 120 iu = 1,nusta - 120 tzuas = tzuas + wtus(iu) * tzgr(k,iu) - tzua(k) = tzuas - 125 continue -c -c --- If using land/water interpolation, determine whether water -c or land (assume mxwb is hardwired to 1) -c - if (ldwat .eq. 1) then - lndwat = 0 - if (ilandu(i,j) .ge. jwat1(mxwb) .and. - & ilandu(i,j) .le. jwat2(mxwb)) lndwat = 1 - end if - if (ldwat .eq. 0 .or. lndwat .eq. 0) then -c -c --- Use convective mixing height, adiabatic lapse rate, upper air -c data method if not using L/W interpolation or if grid cell is -c on land -c -c --- Fetch the convective mixing height -c - zic = ziconv(i,j) -c - do 145 k=2,nz - kp1 = k + 1 - zlow = zface( k ) - tlow = tzua( k ) - zhgh = zface(kp1) - thgh = tzua(kp1) -c -c --- Entire layer above convective mixing height, use average of -c sounding levels -c - if (zlow .gt. zic) ztemp(i,j,k) = 0.5 * (tlow + thgh) -c -c --- Entire layer below convective mixing height, use adiabatic -c lapse rate -c - if (zhgh .le. zic) ztemp(i,j,k) = ztemp(i,j,1) - 0.0098 - & * 0.5 * (zlow + zhgh) - - if (zlow .le. zic .and. zhgh .gt. zic) then -c -c --- Convective mixing height located in layer, use 3-point thickness -c weighted average of temperature at the two cell faces and at -c the CMH -c - tlow = ztemp(i,j,1) - 0.0098 * zlow - tmid = ztemp(i,j,1) - 0.0098 * zic - ztemp(i,j,k) = 0.5 * ((tlow + tmid) * (zic - zlow) + - & (tmid + thgh) * (zhgh - zic)) / (zhgh - zlow) - endif - 145 continue - else -c -c --- Over water use user-determined TGRAD -c -c --- Substitute regular mixing height for convective MH -c - zic = zi(i,j) - do 146 k = 2,nz - kp1 = k + 1 - zlow = zface(k) - zhgh = zface(kp1) - if (zhgh .le. zic) then -c -c --- Entire layer below the mixing height, use tgrad below -c - ztemp(i,j,k) = ztemp(i,j,1) + tgrdb(i,j) * zmid(k) - else if (zlow .gt. zic) then -c -c --- Entire layer above the mixing height, use tgrad above for -c portion above the mixing height -c - ztemp(i,j,k) = ztemp(i,j,1) + tgrdb(i,j) * zic + - & tgrda(i,j) * (zmid(k) - zic) - else if (zlow .le. zic .and. zhgh .gt. zic) then -c -c --- Mixing height is located in layer, use thickness weighted -c 3-point average -c - tlow = ztemp(i,j,1) + tgrdb(i,j) * zlow - tmid = ztemp(i,j,1) + tgrdb(i,j) * zic - thgh = ztemp(i,j,1) + tgrdb(i,j) * zic + - & tgrda(i,j) * (zhgh - zic) - ztemp(i,j,k) = 0.5 * ((tlow + tmid) * (zic - zlow) + - & (tmid + thgh) * (zhgh - zic)) / (zhgh - zlow) - endif - 146 continue - end if - 150 continue - return - end - -c---------------------------------------------------------------------- - subroutine setcoast(ilandu,iwat1,iwat2,ldbcst) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 SETCOAST -c F.Robe, Earth Tech -c -c --- PURPOSE: compute distance to the nearest coast for all -c overwater gridpoints -c -c -c --- INPUT: ILANDU(MXNX,MXNY) - integer - Gridded land use -C IWAT1,IWAT2 - integers - land use category interval -c for water cells -c LDBCST - logical - flag to print out gridded field -c of distance to the coast in -c DCST.GRD file -c -c -C -c --- Input via common: -c /GRID/: DX,DY -c /PARAMS/ nx,ny -C --- OUTPUT via COMMON/GRID/ -c DCOAST(MXNX,MXNY) - real - distance to the nearest coast -c in kilometers -C -C --------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'grid.met' - - integer ilandu(mxnx,mxny) - character*40 fmt - logical ldbcst - - dcstmax=0. - -c --- Grid dimension in Km - dgridkm=dgrid*0.001 - - - do j=1,ny - do i=1,nx - if ((ilandu(i,j).ge.iwat1).and.(ilandu(i,j).le.iwat2))then - distmin=1.e+6 -c --- compute distance to all other gridpoints - do l=1,ny - do k=1,nx - xdist=(k-i)*dgridkm - ydist=(l-j)*dgridkm - dist=sqrt(xdist**2+ydist**2) -c --- skip overwater gridpoints - if ((ilandu(k,l).ge.iwat1).and. - : (ilandu(k,l).le.iwat2)) goto 10 -c --- find minimum distance to land cell - distmin=min(distmin,dist) -10 continue - end do - end do - dcoast(i,j)=distmin -c --- Land cells - else - dcoast(i,j)=0. - endif - dcstmax=max(dcstmax,dcoast(i,j)) - end do - end do - -c --- Create a gridded output file (if LDBCST) - if (ldbcst) then - fmt='(10000(1pe10.4,2x))' -c --- Location of gridpoints (1,1) and (nx,ny) in km - xb=(xorigr+dgrid)/1000. - yb=(yorigr+dgrid)/1000. - xe=xb+(nx-1)*dgrid/1000. - ye=yb+(ny-1)*dgrid/1000. - - write(io27,'(a4)')'DSAA' - write(io27,'(2i12)')nx,ny - write(io27,'(2f12.4)')xb,xe - write(io27,'(2f12.4)')yb,ye - write(io27,'(2e12.4)')0.,dcstmax -c --- Data records - do j=1,ny - write(io27,fmt)(dcoast(i,j),i=1,nx) - enddo - - endif - - RETURN - END - -C --------------------------------------------------------------------- - subroutine terset(htopo,hmax,terrad) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 TERSET -c S.DOUGLAS, SAI -c -c --- include parameters - include 'params.met' -c NEW (frr: 12/18/96): new variable in GRID.MET: disthmax(mxnx,mxny) -c distance to the highest peak within TERRAD -c ("birdwise" i.e. in an horizontal plane) -c NEW (frr: 1/21/97): new variables in GRID.MET: DISTMIN(mxnx,mxny) -c distance to the lowest valley bottom within TERRAD -c ("birdwise" i.e. in an horizontal plane) -c and HMIN(mxnx,mxny):altitude of valley bottom - include 'grid.met' -c D5 replaced by grid.met (frr 12/96) -c COMMON /D5/ NX,NY,NZ,DX,DY,dz(mxnz),NZPRNT - - DIMENSION HTOPO(mxnx,mxny),HMAX(mxnx,mxny) -C -C THIS SUBROUTINE DETERMINES THE HEIGHT (HMAX) OF THE HIGHEST -C TERRAIN WITHIN A RADIUS = TERRAD (KM) OF THE POINT I,J -c and the height (hmin) of the valley bottom with radius=terrad -C -C -C INPUT: HTOPO (R ARRAY) - GRIDDED TERRAIN HEIGHTS -C TERRAD (R) - RADIUS OF SEARCH FOR HIGHEST TERRAIN -C HEIGHTS -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C OUTPUT: HMAX (R ARRAY) - MAXIMUM TERRAIN HEIGHT WITHIN A -C GIVEN RADIUS -C Via grid.met: -c DISTHMAX(mxnx,mxny) -c DISTHMIN(mxnx,mxny) -c HMIN(mxnx,mxny) - - DXK=DX*0.001 - DYK=DY*0.001 - IRANGE=NINT(TERRAD/DXK) - JRANGE=NINT(TERRAD/DYK) - IBNDY=NX-IRANGE - JBNDY=NY-JRANGE -C - DO 5 J=1,NY - DO 5 I=1,NX - HMAX(I,J)=HTOPO(I,J) - HMIN(I,J)=HTOPO(I,J) - 5 CONTINUE -c First crest - DO 10 J=1,NY - L1=1 - IF (J .GT. JRANGE) L1=J-JRANGE - L2=NY - IF (J .LT. JBNDY) L2=J+JRANGE - DO 10 I=1,NX - K1=1 - IF (I .GT. IRANGE) K1=I-IRANGE - K2=NX -c *** IF (I .LT. IBDY) K2=I+IRANGE - IF (I .LT. IBNDY) K2=I+IRANGE - DO 20 L=L1,L2 - DO 20 K=K1,K2 - XDIST=(K-I)*DXK - YDIST=(L-J)*DYK - DIST=SQRT(XDIST**2+YDIST**2) - IF (DIST .GT. TERRAD) GO TO 20 - if(htopo(k,l).gt.hmax(i,j)) disthmax(i,j)=dist*1000. - HMAX(I,J)=AMAX1(HMAX(I,J),HTOPO(K,L)) - 20 CONTINUE - 10 CONTINUE - -c Then valley bottom - DO 11 J=1,NY - L1=1 - IF (J .GT. JRANGE) L1=J-JRANGE - L2=NY - IF (J .LT. JBNDY) L2=J+JRANGE - DO 11 I=1,NX - K1=1 - IF (I .GT. IRANGE) K1=I-IRANGE - K2=NX -c *** IF (I .LT. IBDY) K2=I+IRANGE - IF (I .LT. IBNDY) K2=I+IRANGE - DO 21 L=L1,L2 - DO 21 K=K1,K2 - XDIST=(K-I)*DXK - YDIST=(L-J)*DYK - DIST=SQRT(XDIST**2+YDIST**2) - IF (DIST .GT. TERRAD) GO TO 21 -c distance to valley bottom (birdwise) - if(htopo(k,l).lt.hmin(i,j)) disthmin(i,j)=dist*1000. - HMin(I,J)=AMin1(HMin(I,J),HTOPO(K,L)) - 21 CONTINUE - 11 CONTINUE - RETURN - END -c---------------------------------------------------------------------- - subroutine topof2(u,v,w,htopo,cellzb,gamma,isurft,tinf, - : temp2d,alpha) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070113 TOPOF2 -c S.DOUGLAS, SAI -c -c -c --- PURPOSE: THIS SUBROUTINE IS ADAPTED FROM THE 3-D COMPLEX TERRAIN -C WIND MODEL (YOCKE,1979). THE VERTICAL VELOCITY DUE TO -C TOPOGRAPHIC EFFECTS IS COMPUTED AND TRANSFORMED TO TERRAIN -C FOLLOWING COORDINATES -C -c --- UPDATES: -c --- V5.6 (050328) to V6.218 (070113) (F.Robe) -c (1) Remove obsolete /T1/Common -c (2) Allow the use of 2-D surface temp instead of single -c domain-representative Tinf -c (3) Make former scalar gamma a 2-D array -c -c --- V5.6 (050328- FRR): explicit common replaced by include d6.met -c --- Modified 3/98 by J. Scire to prevent numerical problems -c when WS = 0.0 -c --- Modified by Ed Chang; 8/93; SRC -c - Changed underflow control constant from 100 to 50 at about -c the 88th statement; within loop 120. -c -C --- INPUTS: -c U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C HTOPO (R ARRAY) - GRIDDED TERRAIN HEIGHTS -C CELLZB (R ARRAY) - VERTICAL LEVEL HEIGHTS -C GAMMA (R ARRAY) - TEMPERATURE LAPSE RATES (HOURLY) -c ISURFT (I) - Surface station number where domain -c representative temperature is used from -c or trigger for using 2-D surface temp -c (ISURFT=-1; default); isurft=-2 calls -c for domain-averaged progn.temp. -C TINF (R) - DOMAIN REPRESENTATIVE TEMPERATURE -C TEMP2D (R ARRAY) - 2-D SURFACE TEMPERATURE -C ALPHA (R) - EMPIRICAL COEFFICIENT FOR -C TOPOGRAPHIC EFFECTS -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C --- OUTPUTS: -c W (R ARRAY) - TERRAIN INDUCED VERTICAL VELOCITY -C -c --- TOPOF2 called by: DIAGNO -c --- TOPOF2 calls: none -c -c ------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'grid.met' - include 'd6.met' - - DIMENSION U(mxnx,mxny,*), V(mxnx,mxny,*), - 1 W(mxnx,mxny,*), HTOPO(mxnx,*), CELLZB(mxnzp1), - 2 TEMP2D (mxnx,mxny),w1(mxnx,mxny,mxnzp1), - 3 gamma(mxnx,mxny) -C -C -C CALCULATE THE STABILITY PARAMETER, S -C - TAU=-0.01 -C -C CALCULATE THE VERTICAL VELOCITY -C - DO 100 J=1,NY - DO 100 I=1,NX - - if (isurft.gt.0.or.isurft.eq.-2) then - temp=tinf - else - temp=temp2d(i,j) - endif - - GAMMA2=GAMMA(i,j)-TAU - IF (GAMMA2 .LT. 0.) S=-1.0 - IF (GAMMA2 .GE. 0.) S=(9.8*GAMMA2/TEMP)**0.5 - -C CALCULATE THE WAVENUMBER OF THE ATMOSPHERE -C - HINV = 500. - IF (S .LE. 0.) THEN - BK=2./HINV - ELSE -c -c --- Protect against divide by zero errors -c *** BK = S/((U(I,J,NZ)**2+V(I,J,NZ)**2)**0.5) - xws=(U(I,J,NZ)**2+V(I,J,NZ)**2)**0.5 - xws=amax1(xws,1.e-6) - BK = S/xws - ENDIF -C -C CALCULATE THE TOPOGRAPHIC GRADIENTS -C - DXI=0.5/DX - DYI=0.5/DY - HTOIM1=HTOPO(I,J) - HTOJM1=HTOPO(I,J) - IF (I .GT. 1) HTOIM1=HTOPO(I-1,J) - IF (J .GT. 1) HTOJM1=HTOPO(I,J-1) - HTOIP1=HTOPO(I,J) - HTOJP1=HTOPO(I,J) - IF (I .LT. NX) HTOIP1=HTOPO(I+1,J) - IF (J .LT. NY) HTOJP1=HTOPO(I,J+1) - DELHI=(HTOIP1-HTOIM1)*DXI - DELHJ=(HTOJP1-HTOJM1)*DYI -C -C CALCULATE THE VERTICAL VELOCITY DUE TO TOPOGRAPHIC EFFECTS -C - WTOPO=U(I,J,1)*DELHI+V(I,J,1)*DELHJ -C -C SET THE LOWER BOUNDARY CONDITION -C - W1(I,J,1)=WTOPO - W(I,J,1)=WTOPO -C -C COMPUTE THE EXPONENTIAL DECAY OF VERTICAL VELOCITY -C - DO 120 K=1,NZ - KP1=K+1 - BKZ=BK*CELLZB(KP1) - IF (BKZ .GT. 50.) BKZ=50. - W1(I,J,KP1)=WTOPO*EXP(-BKZ) -C -C CALCULATE DWDZ -C - DZI=1.0/DZ(K) - DWDZ1=(W1(I,J,KP1)-W1(I,J,K))*DZI - DWDZ=ALPHA*DWDZ1 -C -C CALCULATE W FROM DWDZ -C - W(I,J,KP1)=DWDZ/DZI+W(I,J,K) - 120 CONTINUE -C -C -C TRANSFORM TO TERRAIN FOLLOWING COORDINATES -C - W(I,J,1)=W(I,J,1)-U(I,J,1)*DELHI-V(I,J,1)*DELHJ - DO 130 K=1,NZ - KP1=K+1 - W(I,J,KP1)=W(I,J,KP1)-U(I,J,K)*DELHI-V(I,J,K)*DELHJ - 130 CONTINUE - 100 CONTINUE - RETURN - END -c---------------------------------------------------------------------- - function unidot(a,b) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 UNIDOT -C - DIMENSION A(3),B(3) -C -C UNIDOT RETURNS THE DOT PRODUCT OF A UNIT VECTOR -C PARALLEL TO "A" WITH A UNIT VECTOR PARALLEL TO "B" -C -C INPUTS: A (R ARRAY) - VECTOR A -C B (R ARRAY) - VECTOR B -C -C OUTPUTS: UNIDOT (R) - DOT PRODUCT OF VECTORS A AND B -C - DENOM = SQRT((A(1)**2+A(2)**2+A(3)**2)*(B(1)**2+B(2)**2+B(3)**2)) - UNIDOT = 0. - IF(DENOM .EQ. 0.) RETURN - DO 100 I=1,3 - UNIDOT = UNIDOT + A(I)*B(I) - 100 CONTINUE - UNIDOT = UNIDOT/DENOM - RETURN - END -c---------------------------------------------------------------------- - subroutine unpack(nwords,xbuf,nvals,xdata) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 UNPACK -c --- J. Scire, SRC -c -c --- PURPOSE: Unpack a packed array of data -c -c --- INPUTS: -c NWORDS - integer - Number of packed words -c XBUF(NWORDS) - real array - Array of packed data -c NVALS - integer - No. of unpacked values stored in -c packed array -c Parameters: IO6 -c -c --- OUTPUT: -c XDATA(NVALS) - real array - Array of unpacked data -c -c --- UNPACK called by: RDP -c --- UNPACK calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real xbuf(nwords),xdata(nvals) -c - ii=0 - do 100 i=1,nwords -c - if(xbuf(i).ge.0.)then -c -c --- transfer actual value to unpacked array - ii=ii+1 - xdata(ii)=xbuf(i) - else -c -c --- insert "jj" zero values into unpacked array - jj=abs(xbuf(i))+0.1 - do 50 j=1,jj - ii=ii+1 - xdata(ii)=0.0 -50 continue - endif -100 continue -c -c --- check that size of unpacked array matches expected value - if(ii.ne.nvals)then - write(io6,102)ii,nvals -102 format(//5x,'ERROR IN SUBR. UNPACK -- no. values unpacked ', - 1 'does not match expected value'//8x,'ii (no. unpacked) = ', - 2 i10//8x,'nvals (no. expected) = ',i10) - stop - endif -c - return - end -c---------------------------------------------------------------------- - subroutine unpcks(nssta,ibuf,ws,wd,iceil,icc,tempk,irh,pres, - 1 ipcode) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 UNPCKS -c --- J. Scire, SRC -c -c --- PURPOSE: Unpack an array of surface meteorological data using -c integer packing (3 words/station) -c Word 1: TTTTPCRRR -- TTTT = temp. (XXX.X deg, K) -c PC = precipitation code (XX) -c RRR = relative humidity (XXX. %) -c Word 2: pPPPPCCWWW -- pPPPP = station pressure (pXXX.X mb, -c with p = 0 or 1 only) -c CC = opaque sky cover (XX tenths) -c WWW = wind direction (XXX. deg.) -c Word 3: HHHHSSSS -- HHHH = ceiling height (XXXX. hundreds -c of feet) -c SSSS = wind speed (XX.XX m/s) -c -c --- INPUTS: -c NSSTA - integer - Number of surface stations -c IBUF(3,NSSTA) - int. array - Array of packed data -c Parameters: IO6 -c -c --- OUTPUT: -c WS(NSSTA) - real array - Wind speed (m/s) -c WD(NSSTA) - real array - Wind direction (degrees) -c ICEIL(NSSTA) - int. array - Ceiling height (hundreds of ft) -c ICC(NSSTA) - int. array - Opaque sky cover (tenths) -c TEMPK(NSSTA) - real array - Temperature (deg. K) -c IRH(NSSTA) - int. array - Relative humidity (percent) -c PRES(NSSTA) - real array - Surface station pressure (mb) -c IPCODE(NSSTA) - int. array - Precipitation code -c -c --- UNPCKS called by: RDS -c --- UNPCKS calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real ws(nssta),wd(nssta),tempk(nssta),pres(nssta) -c - integer iceil(nssta),icc(nssta),irh(nssta),ipcode(nssta) - integer ibuf(3,nssta) -c - do 100 i=1,nssta -c - iword1=ibuf(1,i) - iword2=ibuf(2,i) - iword3=ibuf(3,i) -c -c --- unpack temperature, precip. code, relative humidity - it=iword1/100000 - ipc=iword1/1000-it*100 - ir=iword1-it*100000-ipc*1000 -c -c --- use a standard missing value indicator of 9999 for all variables - if(it.eq.9999)then - tempk(i)=9999. - else - tempk(i)=float(it)/10. - endif -c - if(ipc.eq.99)then - ipcode(i)=9999 - else - ipcode(i)=ipc - endif -c - if(ir.eq.999)then - irh(i)=9999 - else - irh(i)=ir - endif -c -c --- unpack station pressure, cloud cover, wind direction - ip=iword2/100000 - ic=iword2/1000-ip*100 - iw=iword2-ip*100000-ic*1000 -c --- NOTE: 1XXXX is allowed for station pressure and converts to -c --- 1XXX.X mb - if(ip.eq.9999)then - pres(i)=9999. - else - pres(i)=float(ip)/10. - endif -c - if(ic.eq.99)then - icc(i)=9999 - else - icc(i)=ic - endif -c - if(iw.eq.999)then - wd(i)=9999. - else - wd(i)=iw - endif -c -c --- unpack ceiling height, wind speed - ih=iword3/10000 - is=iword3-ih*10000 -c - iceil(i)=ih - if(is.eq.9999)then - ws(i)=9999. - else - ws(i)=float(is)/100. - endif -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine vertav(iu,uu,vv,zz,nlev,nz,zface,uave,vave) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 VERTAV -c --- J. Scire, SRC -c -c --- PURPOSE: Calculate the layer-averaged U and V wind components -c at one upper station using sounding data. Modified -c to allow missing wind data. -c -c --- INPUTS: -c IU - integer - Upper air station number -c (1, 2, ..., nusta) -c UU(mxus,mxlev) - real array - U wind components (m/s) -c VV(mxus,mxlev) - real array - V wind components (m/s) -c ZZ(mxus,mxlev) - real array - Height (m) of UU, VV (above LGL) -c NLEV - integer - Number of sounding levels -c NZ - integer - Number of vertical grid layers -c ZFACE(mxnzp1) - real array - Height (m) of cell face -c -c --- OUTPUT: -c UAVE(mxnz) - real array - Layer averaged U wind -c component (m/s) -c VAVE(mxnz) - real array - Layer averaged V wind -c component (m/s) -c Parameters: MXUS, MXLEV, MXNZ, MXNZP1, MXADD, IO6 -c -c --- VERTAV called by: COMP, PREPDI -c --- VERTAV calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real uu(mxus,mxlev),vv(mxus,mxlev),zz(mxus,mxlev) - real u(mxadd),v(mxadd),z(mxadd) - real zface(mxnzp1) - real uave(mxnz),vave(mxnz) - integer ibound(mxnzp1) -c - data xmiss/999./ -c -c --- Reduce missing value indicator by a slight amount to allow for -c --- machine roundoff - xmissm=xmiss-0.01 -c -c --- Transfer NON-MISSING U, V components into work arrays -- make -c --- all values positive - nl=0 - do 15 k=1,nlev -c -c --- Skip levels with missing data - if(uu(iu,k).ge.xmissm.or.vv(iu,k).ge.xmissm)go to 15 -c -c --- Count number of non-missing levels - nl=nl+1 - u(nl)=uu(iu,k)+1000. - v(nl)=vv(iu,k)+1000. - z(nl)=zz(iu,k) -15 continue -c -c --- interpolate wind components to cell boundaries - nzp1=nz+1 -c - do 100 k=1,nzp1 -c -c --- find level at or just below cell face - zbound=zface(k) - if(zbound.eq.0.0)go to 100 - do 20 j=2,nl - if(z(j).ge.zbound)then - if(z(j).eq.zbound)go to 100 - nbm=j-1 - nbp=j - go to 22 - endif -20 continue -c -c --- sounding does not go high enough - write(io6,21)zbound,nl,z(nl) -21 format(//1x,'ERROR IN SUBR. VERTAV -- cell face is above top ', - 1 'sounding level'//5x,'cell face height = ',f10.1,5x,'No. ', - 2 'sounding levels = ',i5,5x,'Top sounding height = ',f10.1) - stop -c -c --- interpolate U, V to cell face -22 continue - rat=(z(nbp)-zbound)/(z(nbp)-z(nbm)) - ubound=u(nbp)-(u(nbp)-u(nbm))*rat - vbound=v(nbp)-(v(nbp)-v(nbm))*rat -c -c --- bump all values up in arrays to make room for new level - do 25 kk=nl,nbp,-1 - kkp1=kk+1 - u(kkp1)=u(kk) - v(kkp1)=v(kk) - z(kkp1)=z(kk) -25 continue -c -c --- insert U, V at cell boundary - nl=nl+1 - u(nbp)=ubound - v(nbp)=vbound - z(nbp)=zbound -100 continue -c -c --- find indexes corresponding to each cell face - kkb=1 - do 150 k=1,nzp1 - zbound=zface(k) - do 140 kk=kkb,nl - if(z(kk).eq.zbound)then - ibound(k)=kk - kkb=kk+1 - go to 150 - endif -140 continue -c -c --- cell face height not found in Z array - write(io6,142)zbound,kkb,nl,(z(n),n=kkb,nl) -142 format(//2x,'ERROR IN SUBR. VERTAV -- cell face height ', - 1 'not found in height array'//2x,'cell face height = ',f10.1, - 2 3x,'KKB = ',i5,3x,'NL = ',i5//2x,'heights: ',50(/5x,10f10.1)) - stop -150 continue -c -c --- compute the layer-averaged U, V in each cell - do 200 k=1,nz - sumu=0.0 - sumv=0.0 - ib=ibound(k) - ibp1=ib+1 - it=ibound(k+1) -c - do 180 n=ibp1,it - nm1=n-1 - umin=amin1(u(nm1),u(n)) - vmin=amin1(v(nm1),v(n)) - dz=z(n)-z(nm1) - sumu=sumu+(umin+0.5*abs(u(n)-u(nm1)))*dz - sumv=sumv+(vmin+0.5*abs(v(n)-v(nm1)))*dz -180 continue -c - dzi=1.0/(zface(k+1)-zface(k)) - uave(k)=sumu*dzi-1000. - vave(k)=sumv*dzi-1000. -200 continue -c - return - end -c---------------------------------------------------------------------- - subroutine water(u10,v10,imixh,qsw,qlw,dcoast,zu,ilandu, - : iwat1,iwat2,nx,ny,dgrid,fcori,nhrz,z0) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 WATER -c --- J. Scire, SRC -c -c --- PURPOSE: Compute micrometeorological parameters over water using -c delta temp. method or the COARE algorithm -c -c --- Overwater mixing heights are computed if there are no -c --- specified values in a overwater data file -c -c --- UPDATES: -c -c --- v6.332 (110212) to v6.5.0 (150223) (DGS) -c (1) Fix call to MIXHBG line that exceeds 72 characters. -c Argument list was shortened and convective mixing ht variable -c name was mangled so that ht returned was incorrect. -c -c --- v6.229 (100719) to v6.332(F.Robe) -c (1) Actually pass old ZIC value to MIXHMC not old Zi (bug fix of bug fix) -c -c --- V6.223 (070702) to v6.229 (100719)(F.Robe) -c (1) Save Convective mixing height array and pass on old values to -c MIXHMC and MIXHBG (rather than old values of the mixing height -c be it mechanical or convective). Bug fix -c -c --- V6.222 Level 070404 to V6.223 (070702)(F.Robe) -c (1) assign z0 value sooner in the code so that filled in even -c when no valid overwater stations -c (2) Define ilapse and pass on correct value of ilapse to MIXHMC and -c MIXHBG if itwprog=2 -c (3) wstar overwater strictly based on convective mixing height -c if computed (imixh>0) -c -c --- V6.214 Level 060528 to V6.222 Level 070404(F.Robe) -c (1) Include internal common to pass value of dptt to MIXHMC -c -c --- V6.205 (060318) to V6.214 (060528) (F.Robe): -c (1) Differentiate between the buoyancy flux QB and the sensible heat flux -c Use QB to compute the convective velocity scale (WSTAR). -c In DeltaT subroutine, the old QH was previously mislabelled "sensible -c heat flux" but has always been the buoyancy flux (based on virtual potential -c temperature). In COARE, QH strictly refers to the sensible heat flux -c (2) To keep in line with true purpose of the so-called "sensible heat flux" array -c stored in METGRD, assign QH=QB at end of subroutine. -c (3) Skip definition of qe as never used -c -c --- V5.614 (051228) to V6.205 (060318) (DGS): -c (1) Fixed typo that used the overwater (OW) Tair from -c the last OW station in the list with the Tair-Tsea difference -c from the nearest OW station when computing Tsea for the -c nearest OW station. -c (2) Allow round-off error when checking ZOWSTA for missing values -c (use xmissm rather than xmiss) (FRR) -c (3) Make sure SST passed on to COARE are above -3C (otherwise COARE -c crashes) -c (4) Add a check for missing Tairow before call to COARE and -c replace by default Tair if missing -c -c --- V5.613 (051227)to V5.614 (051228)(F.Robe): -c (1) Pass actual SST sensor depth to COARE or use default 0.6m -c if missing or not available in SEA.DAT -c -c --- V5.611 (051113) to V5.613 (051227)(F.Robe): -c (1) Use actual height of Tair sensor instead of anemometer height -c if available (SEA.DAT version 2.11+) -c -c --- V5.6e (050520)to V5.611 (051113) (F.Robe): -c (1) Pass anemometer height instead of nearow to deltaT -c (2) Assume 10m measurement height if anemometer height is missing -c -c --- V5.6d (050428) to V5.6e (050520) (D. Strimaitis): -c (1) Fix typo: ZIOBS should be IZIOBS -c -c --- V5.6c (050419) to V5.6d (050428) (F.Robe): -c (1) Make sure to compute the initial mechanical mix. hgt -c when there are several OW stations but no valid mixH obs. -c -c --- V5.6a (050331) to V5.6c (050419) (F.Robe): -c (1) Pass iwarm,icool,(i,j) to COARE via calling list -c -c --- V5.6 (050328) to V5.6a (050331) (DGS): -c (1) Update references to Charnock -c -c --- V5.547 (041010) to V5.6 (050328) (F.Robe): -c (1) Compute convective mixing height (Batchvarova and Gryning) and keep -c maximum of the mechanical and convective mixing height -c (2) Add option to use the Coupled OPcean Atmosphere Response Experiment -c (COARE) bulk flux model for computing Zo, u*, L and QH overwater -c (3) Revamp the subroutine to isolate the DELTAT method computations -c in a separate suburoutine (in parallel with COARE) -c (4) Depending on the value of the new ICOARE user-input parameter, -c Compute Zo, u*, L and QH using the DELTAT or COARE methods -c (5) Add option to use observed wave properties -c (dominant period and height) -c (6) Add necessary parameters for COARE method to the calling list -c (zu,qsw,qlw,dcoast,icoare) -c -c --- V5.51 (030515) to V5.547 (041010)(F.Robe) -c (1) Remove noobs from argument list as no longer needed -c -c --- V5.5 (030402) to V5.51 (030515) (J. Scire) -c (1) Eliminate check to prevent mixing height to be computed -c when NOOBS = 1 (no UP.DAT) or NOOBS = 2 (only 3D.DAT data) -c -c --- INPUT: -c U10(mxnx,mxny) - real array - Surface U component wind (m/s) -c at height of ZU -c V10(mxnx,mxny) - real array - Surface V component wind (m/s) -c at height of ZU -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c QSW(mxnx,mxny) - real array - net short wave radiative flux (W/m2) -c at the surface -c QLW(mxnx,mxny) - real array - downward long wave radiative flux (W/m2) -c at the surface -c DCOAST(mxnx,mxny) - real array - Distance from overwater gridpoint to -c nearest shorec -c ZU - real - height of the lowest CALMET gridpoint -c where the surface winds are computed -c (usually 10m) -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c DGRID - real - Grid cell size (m) -c FCORI(mxnx,mxny) - real array - Absolute value of the Coriolis -c parameter (1/s) -c NHRZ - integer - GMT hour (ending time) -c -c -c -c Common block /OVRWAT/ variables: -c NOWSTA, XOWSTA(mxows), YOWSTA(mxows), ZOWSTA(mxows), -c ZTAIR (mxows), ZSST (mxows), -c DTOW(mxows), TAIROW(mxows), RHOW(mxows), -c ZIOW(mxows), TGRADA(mxows),ZIMINW, ZIMAXW, CONSTW, -c ICOARE,JWAVE , dshelf, iwarm,icool -c -c ICOARE - Overwater method -JWAVE: wave method -c - 0: original deltaT method (OCD) -c - 10: COARE with wave option jwave=0 (Charnock) -c - 11: COARE with wave option jwave 1 (Oost et al) -c - 12: COARE with wave option 2 (Taylor and Yelland) -c -c common block /METGRD/ arrays, all dimensioned (mxnx,mxny): -c RMM (rainfall rate in mm/hr) -c -c common block /GEN/itimstep -c common block /TMP/tgdefa -c -c Parameters: MXNX, MXNY, MXOWS, IO6 -c -c -c --- OUTPUT: -c Z0(mxnx,mxny) - real array - Surface roughness lengths (m) -c -c common block /METGRD/ arrays, all dimensioned (mxnx,mxny): -c IPGT, QH, USTAR, ZI, EL, WSTAR, RMM -c -c --- WATER called by: COMP -c --- WATER calls: ESAT (function), DELTAT, COARE, MIXHBG, MIXHMC -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'tmp.met' -c - real u10(mxnx,mxny),v10(mxnx,mxny),z0(mxnx,mxny) - real qsw(mxnx,mxny),qlw(mxnx,mxny) -c real qe(mxnx,mxny) - real tair(mxows),twater(mxows),rh(mxows) - real th(mxows),dthz(mxows) - real dth10(mxows),th10(mxows),q(mxows),zanem(mxows) - integer ilandu(mxnx,mxny) - real dcoast(mxnx,mxny),fcori(mxnx,mxny) -c 100719 - save old convective mixing height - real zicold(mxnx,mxny) - -c --- COARE input/output real variables are real*8 - real*8 rzu,rzt,rws10,rtairc,rtsea,rzi,rrmm,rq,rqsw,rqlw - real*8 rrlong,rz0,rustar,rqh,rqe,rtwave,rhwave - real*8 rtstar,rqstar,rzsst -c - - include 'ovrwat.met' - include 'gen.met' - include 'metgrd.met' -c - data z0min/2.0e-6/,rmax/1.e37/,xmiss/9999./,pres/1000./ - data vk/0.4/,g/9.81/,rhocp/1195.2/ - data r2min/1.e-30/ - data nearow/0/ - data xmissm/9998.99/ - data rtwave/-999./,rhwave/-999./ - - common /tjump/ dptt(mxnx,mxny) - -c 100719 - make sure to retain Zicold values from old timestep - save zicold - -c frr 050328 - do not compute xmissm at every call to subroutine -c instead include them in data statement -c xmissm=xmiss-0.01 -c - -c --- Set lapse rate flag for mixing height subroutine (070702) - if (itwprog.eq.0) then - ilapse=0 - else - ilapse=1 - endif - -c --- Compute internal, station-specific parameters - if(nowsta.le.0)go to 51 - - do 50 k=1,nowsta -c -c --- air-sea temperature difference must be valid to use station - if(dtow(k).ge.xmissm)then - twater(k)=xmiss - tair(k)=xmiss - rh(k)=xmiss - go to 50 - endif - -c -c --- overwater air temp. at measurement ht -- if missing, -c --- assume T=60 F = 288.7 - if(tairow(k).ge.xmissm)then - tair(k)=288.7 - else - tair(k)=tairow(k) - endif -c -c --- water temperature -- computed from air temp + air-sea delta temp - twater(k)=tair(k)-dtow(k) -c -c --- relative humidity -- if missing, assume 100 % - if(rhow(k).ge.xmissm)then - rh(k)=100. - else - rh(k)=rhow(k) - endif -c -c --- compute saturation and actual water vapor pressure (mb) at -c --- measurement height -c --- (NOTE: ESAT function uses temperature in deg. C) -c --- (constant 0.01 converts rh from percent to fraction) - tairc=tair(k)-273.15 - es=esat(tairc) - e=0.01*rh(k)*es -c -c --- compute saturation and actual mixing ratio (g h20/g dry air) at -c --- measurement height - ws=0.622*es/(pres-es) - w=0.622*e/(pres-e) -c --- 050328 specific humidity (g H2O/ KG moist air (!! units)) - q(k)= w/(1+w)*1000. -c -c --- compute virtual temperature (deg. K) at measurement height - tv=tair(k)*(1.+0.61*w) -c -c --- compute virtual potential temperatures (deg. K) at measurement ht -c --- (potential temp. = temp. + 0.01 (deg. K/m) * height) -c --- assume 10m measurement height if zowsta missing (051113) - if (zowsta(k).lt.xmissm) then - zanem(k)=zowsta(k) - else - zanem(k)=10. - endif - dth=0.01*zanem(k) - th(k)=tv+dth -c -c --- compute virtual potential temp. (deg. K) at surface -- assume -c --- surface relative humidity = 100 % - twaterc=twater(k)-273.15 - es=esat(twaterc) - ws=0.622*es/(pres-es) - thsurf=twater(k)*(1.+0.61*ws) - dthz(k)=th(k)-thsurf -c -c --- convert measurement ht. - surface delta potential virtual -c --- temperature to 10 m - surface value -c --- constant 11.512925 = ln(10 m/z0) with z0=1.e-4 m -c --- constant 9.2103404 = -ln(z0) with z0=1.e-4 m - dth10(k)=dthz(k)*11.512925/(alog(zanem(k))+9.2103404) - th10(k)=thsurf+dth10(k) - -50 continue - -51 continue - -c --- loop over grid cells -c - do 500 i=1,nx - do 500 j=1,ny -c - -c --- process only water cells - if(ilandu(i,j).lt.iwat1.or.ilandu(i,j).gt.iwat2)go to 500 -c -c --- wind speed at 10 m - ws10=sqrt(u10(i,j)**2+v10(i,j)**2) - -c --- Roughness length (Hosker method) -c --- (is updated in COARE if COARE method selected but initial value -c --- required in both cases to compute mixing height - if(ws10.gt.0.0)then - z02=2.0e-6*ws10**2.5 - z02=amax1(z0min,z02) - else - z02=z0min - endif - z0(i,j)=z02 - - -c --- if overwater data is missing, assume near-neutral conditions - if (nowsta.eq.0) go to 1200 - -c --- find nearest overwater observation to current grid cell -c --- where valid dt: nearow - if(nowsta.eq.1)then - if(dtow(nowsta).ge.xmissm)then - nearow=0 - go to 1200 - else - nearow=1 - endif - else - xgdpt=(float(i)-0.5)*dgrid - ygdpt=(float(j)-0.5)*dgrid - dmin2=rmax - nearow=0 -c -c --- loop over overwater stations to find closest one to (i,j) - do 12 k=1,nowsta -c -c --- check if data is missing - if(dtow(k).ge.xmissm)go to 12 -c --- station coordinates are relative to origin (i.e., -c --- (xowsta(k),yowsta(k)) of lower left corner of grid = (0.,0.)) - dist2=(xowsta(k)-xgdpt)**2+(yowsta(k)-ygdpt)**2 - if(dist2.lt.dmin2)then - dmin2=dist2 - nearow=k - endif -12 continue - if (nearow.eq.0) go to 1200 - endif - - if(nearow.gt.mxows)then - write(io6,9012)nearow,mxows,i,j -9012 format(//1x,'ERROR in SUBR.WATER-- nearest overwater ', - 1 ' station number is greater than max. array dimension'// - 2 5x,' nearow = ',i5,3x,'mxows = ',i5,3x,' i = ',i5,3x, - 3 ' j = ',i5) - stop - endif -c - -c --- 050328 (F.Robe). -c --- option to use original DeltaT method or COARE algorithm to compute -c Roughness length (zo), Monin-Obukhov Length (el), -c friction velocity (u*),Buoyancy Flux (qb) -c If DeltaT; compute u*,Zo,Qb,el first then mixing height -c if COARE: compute mixing height first (required input to COARE) - -c --- DELTAT METHOD: - if (icoare.eq.0) then -c --- Pass measurement height instead of nearow to deltaT (051113) - call DELTAT(ws10,zanem(nearow),dthz(nearow),dth10(nearow), - : th10(nearow),th(nearow),z02, - : el(i,j),ustar(i,j),qB) - -c --- DeltaT actually computes the buoyancy flux QB -c --- (based on virtual pot. temp.)not the sensible -c heat flux QH (based on temp only) -c : el(i,j),ustar(i,j),qh(i,j)) - - z0(i,j)=z02 - -c --- Buoyancy Flux in terms of - wt=Qb/rhocp - - go to 1300 - endif - -c --- OVERWATER MIXING HEIGHT (m) -C --- 1/r**2 interpolation of observed mixing heights (if available) -c --- Otherwise compute Zi using u* -c -c -- For COARE method, u* is not computed yet so make first guess using -c --- neutral deltaT equations for u* - -1200 continue - -c --- NEUTRAL DELTAT EQUATIONS for u* ,el,wt - ustar2=vk*ws10/alog(10./z02) -c --- prevent numerical problems with zero ustar - ustar(i,j)=amax1(ustar2,1.e-9) - el(i,j)=9.9e9 - wt=0. - -c --- non neutral EL and QH/wt are recomputed in COARE -c --- (if COARE is selected and data available) - - -1300 continue - -c flag for valid Mixing Height observations (0:no - 1:yes) - iziobs=0 - - if( (nowsta.eq.1). and. (ziow(1).lt.xmissm) )then -c --- Only one overwater station -- use value if valid - zi(i,j)=ziow(1) - iziobs=1 - else if (nowsta.gt.1) then -c --- 1./R**2 weighting - xsum=0.0 - ysum=0.0 - xgdpt=(float(i)-0.5)*dgrid - ygdpt=(float(j)-0.5)*dgrid - do 410 k=1,nowsta - if(ziow(k).lt.xmissm)then - r2=(xowsta(k)-xgdpt)**2+(yowsta(k)-ygdpt)**2 -c --- prevent divide by zero errors - r2=amax1(r2,r2min) - xsum=xsum+ziow(k)/r2 - ysum=ysum+1./r2 - endif -410 continue -c - if(xsum.gt.0.)then - zi(i,j)=xsum/ysum - iziobs=1 - endif - endif - if(iziobs.eq.0) then -c --- No overwater MixH observations: -c --- At this point, only compute the mechanical MixHeight to be used -c --- in COARE (not a sensitive parameter but needs a value) -c --- after the COARE computations, compute the convective mix. height -c --- compute mechanical overwater mixing height (default value: const=0.16) - - zimech=constw*ustar(i,j)/fcori(i,j) - endif - -c frr 050328 -C --- COARE method (if data is not missing) -c --- Roughness length (z0), Monin-Obukhov Length (el), -c --- friction velocity (u*),Sensible Heat Flux (qh), buoyancy flux - - if ( (abs(icoare).ge.10).and. (nearow.ne.0) ) then -c --- compute air and sea temp in Celsius and positive -c --- longitude in East. Hem. at nearest overwater station. -c --- in real*8 variables -c --- Use Height of Air temp sensor (not always = anemometer hgt) - if (ztair(nearow).lt.9998) then - rzt=ztair(nearow) - else - rzt=zanem(nearow) - endif - if (tairow(nearow).lt.xmissm) then - rtairc=tairow(nearow)-273.15 - else -c --- assume Tair=288.7 i.e. rtairc=15.55 - rtairc=15.55 - endif - rtsea=rtairc-dtow(nearow) -c --- make sure SST above -3C: - rtsea=max(rtsea,-3.D0) - rrlong =xowlon(nearow) - -c --- Observed dominant wave period and height at nearest station -c --- if requested (icoare=-11,-12). -c --- find nearest station with valid wave data - if (icoare.lt.0) then - now=1 - if(nowsta.gt.1) then - xgdpt=(float(i)-0.5)*dgrid - ygdpt=(float(j)-0.5)*dgrid - dmin2=rmax -c --- loop over overwater stations to find closest one to (i,j) - do 122 k=1,nowsta -c --- check if wave data is missing - if((hwave(k).lt.0.).or.(twave(k).lt.0.))goto 122 -c --- station coordinates are relative to origin (i.e., -c --- (xowsta(k),yowsta(k)) of lower left corner of grid = (0.,0.)) - dist2=(xowsta(k)-xgdpt)**2+(yowsta(k)-ygdpt)**2 - if(dist2.lt.dmin2)then - dmin2=dist2 - now=k - endif -122 continue - endif -c --- note: it is okay if all missing wave data (now=1) - rtwave=twave(now) - rhwave=hwave(now) - endif -c --- depth of SST sensor - Default: moored NDCB buoy value (0.6m) - if (zsst(nearow).lt.9998.) then - rzsst = zsst(nearow) - else - rzsst=0.6 - endif - -c --- map other input variables to real*8 variables - rzu=zu - rws10=ws10 - if (iziobs.eq.1) then - rzi=zi(i,j) - else - rzi=zimech - endif - rrmm=rmm(i,j) - rq=q(nearow) - rqsw=qsw(i,j) - rqlw=qlw(i,j) - - - call COARE(itimstep,i,j,rzu,rzt,rzsst,rws10,rtairc,rtsea, - : rzi,rrmm,rq,rqsW,rqLW,rrlong,jwave,rtwave,rhwave, - : nhrz,dshelf,dcoast(i,j),iwarm,icool,rz0,el(i,j), - : rustar,rtstar,rqstar,rqh,rqe) -c --- map output variables to real*4 variables - z0(i,j)=rz0 - ustar(i,j)=rustar -c --- sensible heat flux - no need to assign to qh at this point because -c QH is really a buoyancy flux array not strictly a sensible heat flux array -c qh(i,j)=rqh -c --- latent heat flux (never used so skip) -c qe(i,j)=rqe - -c --- Surface Buoyancy flux in terms of - wt=-ustar(i,j)*(rtstar+0.61*rqstar*tair(nearow)) - -c --- restrict Monin-Obhukov length near zero (to be consistent with deltaT) - if(abs(el(i,j)).lt.5.0)then - if(el(i,j).lt.0)then - el(i,j)=-5.0 - else - el(i,j)=5.0 - endif - endif - endif - -c --- Update mechanical and compute convective OW mixing height if no MixH obs - if (iziobs.eq.0) then - -c --- Mechanical - zimech=constw*ustar(i,j)/fcori(i,j) - - if (itwprog.eq.0) then -c --- Use constant lapse rate over mixing height (default or from SEA.DAT) -c --- (else it will be extracted from the progn. temp. profiles in mixhbg/mixhmc) - dtdz=tgdefa - if(nowsta.eq.1)then -c --- Only one overwater station -- use value if valid - if(tgrada(1).lt.xmissm) dtdz=tgrada(1) - else if (nowsta.gt.1) then -c --- 1./R**2 weighting - xsum=0.0 - ysum=0.0 - xgdpt=(float(i)-0.5)*dgrid - ygdpt=(float(j)-0.5)*dgrid - do 4410 k=1,nowsta - if(tgrada(k).lt.xmissm)then - r2=(xowsta(k)-xgdpt)**2+(yowsta(k)-ygdpt)**2 -c --- prevent divide by zero errors - r2=amax1(r2,r2min) - xsum=xsum+tgrada(k)/r2 - ysum=ysum+1./r2 - endif -4410 continue - if(xsum.gt.0.)dtdz=xsum/ysum - endif -c --- Potential temperature lapse rate - dthdz=dtdz+0.0098 - - endif -c -c --- make sure initial "old" zi is at least the minimum zi otherwise -c --- crashed in mixdt2 for itwprog=1 (could be a problem at first -c --- timestep) - zi(i,j)=amax1(zi(i,j),ziminw) -c make sure old convective Zi is not greater than old Zi (in case Zicold -c not initialized by computer to 0)(100719) - zicold(i,j)=amin1(zicold(i,j),zi(i,j)) - zicold(i,j)=amax1(zicold(i,j),ziminw) - - if(imixh.eq.2) then -c Batchvarova-Gryning convective mixing height -c 100719 -Pass on old value of Zic not old value of Zi - call MIXHBG(nhrz,I,J,WT,DTHDZ,Tairow(nearow),Ilapse, -c : THRESHW,ZIMAXW,ZIMINW,USTAR(i,j),EL(i,j),ZI(i,j),ZICONV, - : THRESHW,ZIMAXW,ZIMINW,USTAR(i,j),EL(i,j),ZICOLD(i,j), - : ZICONV,THT,THTP) - Zicold(i,j)=ziconv - else if (imixh.eq.1) then -c Carson convective mixing height (similar to MIXHTST/MIXHSTS2) -c Pass on old value of Zic not old value of Zi - call MIXHMC(nhrz,i,j,wt,DTHDZ,ilapse,threshw, -c 110212 - fix typo - use zicold not old zi (as meant to be since v6.229) - : zimaxw,zicold(i,j),ziconv,dptt,THT,THTP) -c : zimaxw,zi(i,j),ziconv,dptt,THT,THTP) - Zicold(i,j)=ziconv - else -c OCD mixing height (mechanical only) - ziconv=0. - Zicold(i,j)=ziconv - endif - - - zi(i,j)=amax1(zimech,ziconv) - zi(i,j)=amax1(ziminw,zi(i,j)) - zi(i,j)=amin1(zimaxw,zi(i,j)) - - - endif - - -1600 continue - -c --- OTHER variables ( independent of method) -c - if (nearow.eq.0) then - theta=288.7 - else - theta=th(nearow) - endif - -c --- convective velocity scale (m/s) -c -- Must be based on Buoyancy flux QB not sensible heat flux QH (060528) -c --- (qb=rhocp * wt) -c if(qh(i,j).gt.0.)then -c wstar(i,j)=(g*qh(i,j)*zi(i,j)/(theta*rhocp))**0.3333333 - - - if(wt.gt.0.)then - if (imixh.lt.0) then - wstar(i,j)=(g*wt*zi(i,j)/theta)**0.3333333 - else -c --- convective velocity scale based on ziconv if computed (070702) - wstar(i,j)=(g*wt*ziconv/theta)**0.3333333 - endif - else - wstar(i,j)=0.0 - endif -c - -c --- So-called "sensible heat flux" output in METGRD.MET (but is truly a buoyancy flux) - qh(i,j)=wt*rhocp - -c --- PGT stability class - if(abs(el(i,j)).gt.25.)then - ipgt(i,j)=4 - else if(el(i,j).lt.-10.)then - ipgt(i,j)=3 - else if(el(i,j).lt.0.)then - ipgt(i,j)=2 - else if(el(i,j).le.10.)then - ipgt(i,j)=6 - else if(el(i,j).le.25.)then - ipgt(i,j)=5 - endif -c -500 continue -c - - return - end - -c---------------------------------------------------------------------- - subroutine waterp(u10,v10,imixh,qsw,qlw,dcoast,zu,ilandu, - : iwat1,iwat2,nx,ny,dgrid,fcori,nhrz,z0) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 150223 WATERP -c --- F. Robe, Earth Tech -c -c --- PURPOSE: Compute micrometeorological parameters over water using -c delta temp. method or the COARE algorithm , and -c prognostic overwater temperature variables -c (note: wave properties can still be from SEA.DAT) -c -c -c --- UPDATES: -c -c --- v6.229 (100719) to v6.5.0 (150223) (DGS) -c (1) Fix call to MIXHBG line that exceeds 72 characters. -c Argument list was shortened and convective mixing ht variable -c name was mangled so that ht returned was incorrect. -c -c --- V6.223 (070702) to v6.229 (100719)(F.Robe) -c (1) Save Convective mixing height array and pass on old values to -c MIXHMC and MIXHBG (rather than old values of the mixing height -c be it mechanical or convective) - Bug fix -c -c --- V6.222 Level 070404 to V6.223 Level 070702 (F.Robe) -c (1) Pass on correct value of ilapse to MIXHMC and MIXHBG -c (was not correct when itwprog=2) -c (2) wstar overwater strictly based on convective mixing height -c if computed (imixh>0) -c -c --- V6.214 Level 060528 to V6.222 Level 070404(F.Robe) -c (1) Include internal common to pass value of dptt to MIXHMC -c -c --- Version v6.205 Level 060318 to Version V6.214 Level 060528 (FRR) -c (1) Convert SST from Kelvins to Celsius to pass to COARE -c (2) Define w* as a function of the buoyancy flux not sensible heat flux -c with COARE option -c (3) Populate QH array stored in METGRD.MET consistently with buoyancy -c heat fluxes offshore (was sensible heat fluxes with COARE, and -c buoyancy fluxes with deltaT) -c (4) Label buoyancy flux QB instead of QH in deltaT method to avoid -c misintrepretation -c (5) Skip definition of qe as never used -c -c -c --- Version 5.614 Level 051228 to V6.205 Level 060318 -c (1) Make sure SST passed to COARE are above -3.C -c -c --- Version 5.611 Level 051113 to Version 5.614 Level 051228 -c (1) Add Depth of SST sensor to COARE calling list -c -c --- INPUT: -c U10(mxnx,mxny) - real array - Surface U component wind (m/s) -c at height of ZU -c V10(mxnx,mxny) - real array - Surface V component wind (m/s) -c at height of ZU -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c QSW(mxnx,mxny) - real array - net short wave radiative flux (W/m2) -c at the surface -c QLW(mxnx,mxny) - real array - downward long wave radiative flux (W/m2) -c at the surface -c DCOAST(mxnx,mxny) - real array - Distance from overwater gridpoint to -c nearest shorec -c ZU - real - height of the lowest CALMET gridpoint -c where the surface winds are computed -c (usually 10m) -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c DGRID - real - Grid cell size (m) -c FCORI(mxnx,mxny) - real array - Absolute value of the Coriolis -c parameter (1/s) -c NHRZ - integer - GMT hour (ending time) -c -c -c -c Common block /OVRWAT/ variables: -c NOWSTA, XOWSTA(mxows), YOWSTA(mxows), ZOWSTA(mxows), -c DTOW(mxows), TAIROW(mxows), RHOW(mxows), -c ZIOW(mxows), TGRADA(mxows),ZIMINW, ZIMAXW, CONSTW, -c ICOARE,JWAVE , dshelf, iwarm,icool -c -c ICOARE - Overwater method -JWAVE: wave method -c - 0: original deltaT method (OCD) -c - 10: COARE with wave option jwave=0 (Charnock) -c - 11: COARE with wave option jwave 1 (Oost et al) -c - 12: COARE with wave option 2 (Taylor and Yelland) -c -c common block /METGRD/ arrays, all dimensioned (mxnx,mxny): -c RMM (rainfall rate in mm/hr) -c -c common block /GEN/itimstep -c -c common block /M3DMET/TAIRP(mxnxp,mxnyp),SSTP(mxnxp,mxnyp), -c RHP(mxnxp,mxnyp),Z1P(mxnxp,mxnyp) -c -c common block /MM4HDO/igrabw(mxnx,mxny),jgrabw(mxnx,mxny), -c XLONG4(mxnxp,mxnyp) -cc -c Parameters: MXNX, MXNY, IO6 -c -c -c --- OUTPUT: -c Z0(mxnx,mxny) - real array - Surface roughness lengths (m) -c -c common block /METGRD/ arrays, all dimensioned (mxnx,mxny): -c IPGT, QH, USTAR, ZI, EL, WSTAR, RMM -c -c --- WATERP called by: COMP -c --- WATERP calls: ESAT (function), DELTAT, COARE, MIXHBG, MIXHMC -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real u10(mxnx,mxny),v10(mxnx,mxny),z0(mxnx,mxny) - real qsw(mxnx,mxny),qlw(mxnx,mxny) -c real qe(mxnx,mxny) - - real th(mxnxp,mxnyp),dthz(mxnxp,mxnyp),q(mxnxp,mxnyp) - real dth10(mxnxp,mxnyp),th10(mxnxp,mxnyp) - - integer ilandu(mxnx,mxny) - real dcoast(mxnx,mxny),fcori(mxnx,mxny) - - real zicold(mxnx,mxny) - -c --- COARE input/output real variables are real*8 - real*8 rzu,rzt,rws10,rtairc,rtsea,rzi,rrmm,rq,rqsw,rqlw - real*8 rrlong,rz0,rustar,rqh,rqe,rtwave,rhwave - real*8 rtstar,rqstar,rzsst -c - - include 'ovrwat.met' - include 'gen.met' - include 'metgrd.met' - include 'm3dmet.met' - include 'mm4hdo.met' -c - data z0min/2.0e-6/,rmax/1.e37/,pres/1000./ - data vk/0.4/,g/9.81/,rhocp/1195.2/ - data nearow/0/ - data rtwave/-999./,rhwave/-999./ - - common /tjump/ dptt(mxnx,mxny) - -c 100719 - make sure to retain Zicold values from old timestep - save zicold - - -c --- Treat prognostic gridpoints as overwater stations and compute -c --- necessary variables -c --- Loop over 3D.DAT gridcells - do 50 jp=1,nyp - do 50 ip=1,nxp -c --- process only water cells - if (ilu4(ip,jp).ne.iluoc3d) goto 50 -c -c --- compute saturation and actual water vapor pressure (mb) at -c --- measurement height -c --- (NOTE: ESAT function uses temperature in deg. C) -c --- (constant 0.01 converts rh from percent to fraction) - tairc=tairp(ip,jp)-273.15 - es=esat(tairc) - e=0.01*rhp(ip,jp)*es -c -c --- compute saturation and actual mixing ratio (g h20/g dry air) at -c --- measurement height - ws=0.622*es/(pres-es) - w=0.622*e/(pres-e) -c --- specific humidity (g H2O/ KG moist air (!! units)) - q(ip,jp)= w/(1+w)*1000. - -c -c --- compute virtual temperature (deg. K) at measurement height - tv=tairp(ip,jp)*(1.+0.61*w) -c -c --- compute virtual potential temperatures (deg. K) at measurement ht -c --- (potential temp. = temp. + 0.01 (deg. K/m) * height) - dth=0.01*z1p(ip,jp) - th(ip,jp)=tv+dth -c -c --- compute virtual potential temp. (deg. K) at surface -- assume -c --- surface relative humidity = 100 % - twaterc=sstp(ip,jp)-273.15 - es=esat(twaterc) - ws=0.622*es/(pres-es) - thsurf=sstp(ip,jp)*(1.+0.61*ws) - dthz(ip,jp)=th(ip,jp)-thsurf -c -c --- convert measurement ht. - surface delta potential virtual -c --- temperature to 10 m - surface value -c --- constant 11.512925 = ln(10 m/z0) with z0=1.e-4 m -c --- constant 9.2103404 = -ln(z0) with z0=1.e-4 m - dth10(ip,jp)=dthz(ip,jp)*11.512925/(alog(z1p(ip,jp))+ - 1 9.2103404) - th10(ip,jp)=thsurf+dth10(ip,jp) -50 continue - - -c --- loop over grid cells -c - do 500 i=1,nx - do 500 j=1,ny -c -c --- process only water cells - if(ilandu(i,j).lt.iwat1.or.ilandu(i,j).gt.iwat2)go to 500 -c -c --- wind speed at 10 m - ws10=sqrt(u10(i,j)**2+v10(i,j)**2) - -c --- Roughness length (Hosker method) -c --- (is updated in COARE if COARE method selected but initial value -c --- required in both cases to compute mixing height - if(ws10.gt.0.0)then - z02=2.0e-6*ws10**2.5 - z02=amax1(z0min,z02) - else - z02=z0min - endif - -c --- 3D.DAT ocean gridpoint nearest to CALMET water cell - inear=igrabw(i,j) - jnear=jgrabw(i,j) - -c --- 050328 (F.Robe). -c --- option to use original DeltaT method or COARE algorithm to compute -c Roughness length (zo), Monin-Obukhov Length (el), -c friction velocity (u*),Buoyancy Flux (qb) -c If DeltaT; compute u*,Zo,Qh,el first then mixing height -c if COARE: compute mixing height first (required input to COARE) - -c --- DELTAT METHOD: - if (icoare.eq.0) then -c --- Pass measurement height instead of nearow to deltaT (051113) - call DELTAT(ws10,z1p(inear,jnear),dthz(inear,jnear), - : dth10(inear,jnear),th10(inear,jnear), - : th(inear,jnear),z02,el(i,j),ustar(i,j),qb) - z0(i,j)=z02 -c --- Buoyancy Flux in terms of - wt=Qb/rhocp - - go to 1300 - endif - -c --- OVERWATER MIXING HEIGHT (m) -C --- Compute Zi using u* -c -c -- For COARE method, u* is not computed yet so make first guess using -c --- neutral deltaT equations for u* - - -c --- NEUTRAL DELTAT EQUATIONS for u* ,el,wt - ustar2=vk*ws10/alog(10./z02) -c --- prevent numerical problems with zero ustar - ustar(i,j)=amax1(ustar2,1.e-9) - el(i,j)=9.9e9 - wt=0. - -c --- non neutral EL and QH are recomputed in COARE -c --- (if COARE is selected and data available) - - -1300 continue - - - -c --- No overwater MixH in 3D.DAT: -c --- At this point, only compute the mechanical MixHeight to be used -c --- in COARE (not a sensitive parameter but needs a value) -c --- after the COARE computations, compute the convective mix. height -c --- compute mechanical overwater mixing height (default value: const=0.16) - - zimech=constw*ustar(i,j)/fcori(i,j) - -c frr 050328 -C --- COARE method -c --- Roughness length (z0), Monin-Obukhov Length (el), -c --- friction velocity (u*),Sensible Heat Flux (qh) - - if ( abs(icoare).ge.10) then -c --- compute air and sea temp in Celsius and positive -c --- longitude (+ in East. Hem. )at nearest 3D.DAT gridpoint -c --- in real*8 variables - - rzt=z1p(inear,jnear) - rtairc=tairp(inear,jnear)-273.15 - rtsea=sstp(inear,jnear)-273.15 -c --- make sure SST above -3C: - rtsea=max(rtsea,-3.D0) - - rrlong =xlong4(inear,jnear) - -c --- Observed dominant wave period and height at nearest station -c --- if requested (icoare=-11,-12). -c --- find nearest station with valid wave data - if (icoare.lt.0) then - now=1 - if(nowsta.gt.1) then - xgdpt=(float(i)-0.5)*dgrid - ygdpt=(float(j)-0.5)*dgrid - dmin2=rmax -c --- loop over overwater stations to find closest one to (i,j) - do 122 k=1,nowsta -c --- check if wave data is missing - if((hwave(k).lt.0.).or.(twave(k).lt.0.))goto 122 -c --- station coordinates are relative to origin (i.e., -c --- (xowsta(k),yowsta(k)) of lower left corner of grid = (0.,0.)) - dist2=(xowsta(k)-xgdpt)**2+(yowsta(k)-ygdpt)**2 - if(dist2.lt.dmin2)then - dmin2=dist2 - now=k - endif -122 continue - endif -c --- note: it is okay if all missing wave data (now=1) - rtwave=twave(now) - rhwave=hwave(now) - endif - -c --- depth of SST sensor - Default: surface (0.05m) - rzsst=0.05 - -c --- map other input variables to real*8 variables - rzu=zu - rws10=ws10 - rzi=zimech - rrmm=rmm(i,j) - rq=q(inear,jnear) - rqsw=qsw(i,j) - rqlw=qlw(i,j) - - call COARE(itimstep,i,j,rzu,rzt,rzsst,rws10,rtairc,rtsea, - : rzi,rrmm,rq,rqsW,rqLW,rrlong,jwave,rtwave,rhwave, - : nhrz,dshelf,dcoast(i,j),iwarm,icool,rz0,el(i,j), - : rustar,rtstar,rqstar,rqh,rqe) - -c --- map output variables to real*4 variables - z0(i,j)=rz0 - ustar(i,j)=rustar -c --- sensible heat flux (050628 - the output array QH mislabelled "sensible heat -c flux", should have buoyancy fluxes in it, not sensible heat flux -c qh(i,j)=rqh -c --- latent heat flux (skip - never used) -c qe(i,j)=rqe - -c --- Surface Buoyancy flux in terms of - wt=-ustar(i,j)*(rtstar+0.61*rqstar*tairp(inear,jnear)) - -c --- restrict Monin-Obhukov length near zero (to be consistent with deltaT) - if(abs(el(i,j)).lt.5.0)then - if(el(i,j).lt.0)then - el(i,j)=-5.0 - else - el(i,j)=5.0 - endif - endif - endif - -c --- Update mechanical and compute convective OW mixing height - -c --- Mechanical - zimech=constw*ustar(i,j)/fcori(i,j) - -c -c --- make sure initial "old" zi is at least the minimum zi otherwise -c --- crashed in mixdt2 for itwprog=1 (could be a problem at first -c --- timestep) - zi(i,j)=amax1(zi(i,j),ziminw) -c make sure old convective Zi is not greater than old Zi (in case Zicold -c not initialized by computer to 0)(100719) - zicold(i,j)=amin1(zicold(i,j),zi(i,j)) - zicold(i,j)=amax1(zicold(i,j),ziminw) - - if(imixh.eq.2) then -c --- Batchvarova-Gryning convective mixing height -c 100719-Pass on old value of Zic not old value of Zi - call MIXHBG(nhrz,I,J,WT,DTHDZ,Tairow(nearow),1, -c : THRESHW,ZIMAXW,ZIMINW,USTAR(i,j),EL(i,j),ZI(i,j),ZICONV, - : THRESHW,ZIMAXW,ZIMINW,USTAR(i,j),EL(i,j),ZIcold(i,j), - : ZICONV,THT,THTP) - zicold(i,j)=ziconv - else if (imixh.eq.1) then -c --- Carson convective mixing height (similar to MIXHTST/MIXHSTS2) -c 100719-Pass on old value of Zic not old value of Zi - call MIXHMC(nhrz,i,j,wt,DTHDZ,1,threshw, -c : zimaxw,zi(i,j),ziconv,dptt,THT,THTP) - : zimaxw,zicold(i,j),ziconv,dptt,THT,THTP) - zicold(i,j)=ziconv - else -c OCD mixing height (mechanical only) - ziconv=0. - zicold(i,j)=ziconv - endif - - zi(i,j)=amax1(zimech,ziconv) - zi(i,j)=amax1(ziminw,zi(i,j)) - zi(i,j)=amin1(zimaxw,zi(i,j)) - - - -1600 continue - -c --- OTHER variables ( independent of method) -c - theta=th(inear,jnear) - -c --- convective velocity scale (m/s) -c --- Must be based on Buoyancy flux QB not sensible heat flux QH (060528) -c --- (Qb=rhocp * wt) -c if(qh(i,j).gt.0.)then -c wstar(i,j)=(g*qh(i,j)*zi(i,j)/(theta*rhocp))**0.3333333 - if(wt.gt.0.)then - if (imixh.lt.0) then -c OCD mixing height - wstar(i,j)=(g*wt*zi(i,j)/theta)**0.3333333 - else -c --- convective mixing height (070702) - wstar(i,j)=(g*wt*ziconv/theta)**0.3333333 - endif - else - wstar(i,j)=0.0 - endif -c -c --- So-called "sensible heat flux" array stored in METGRD.MET (but is truly a buoyancy flux) - qh(i,j)=wt*rhocp - - -c --- PGT stability class - if(abs(el(i,j)).gt.25.)then - ipgt(i,j)=4 - else if(el(i,j).lt.-10.)then - ipgt(i,j)=3 - else if(el(i,j).lt.0.)then - ipgt(i,j)=2 - else if(el(i,j).le.10.)then - ipgt(i,j)=6 - else if(el(i,j).le.25.)then - ipgt(i,j)=5 - endif -c -500 continue -c - return - end - - -c---------------------------------------------------------------------- - subroutine DELTAT(ws10,zanem,dthz,dth10,th10,theta,z02,el2, - : ustar2,qb) -c---------------------------------------------------------------------- -c --- CALMET Version: 6.5.0 Level: 070717 DELTAT -c --- F.Robe (Earth Tech) -c after pre-050328 CALMET WATER subroutine -c -c --- PURPOSE: Compute micrometeorological parameters (El,U*,QH) -c over water using delta temp. method -c -c --- UPDATES -c --- V6.214 Level 060528 to V6.3 (070717) -c - Add precision to the product Vk*g by replacing data -c statement with the explicit product, as done in original -c code lines from WATER -c -c --- v5.611 Level 051113 to V6.214 Level 060528(F.Robe) -c - Rename QH2, QB as the so=called "sensible heat flux" is truly a buoyancy -c flux overwater, not a sensible heat flux. i.e. it takes into account -c moisture as well as temperature through the use of virtual potential -c temperature -c --- V5.6 level 050328 to v5.611 Level 051113 (F.Robe) -c - Add Temp measurement height to calling list so that deltaT is -c independent of ITWPROG (same subroutines whether SEA.DAT -c or 3D.DAT is used) -c - Remove nearow from calling list and "include 'ovrwat.met " -c (no longer needed) -c -c -c --- INPUT: -c WS10 - real - Wind speed at 10 m -c ZANEM - real - Measurement height (or first 3D.DAT level) -c DTHZ - surface delta potential virtual -c temperature to meas.ht - surface value at -c nearest station/3D.DAT gridpoint -c DTH10 - surface delta potential virtual -c temperature to 10 m - surface value at -c nearest station/3D.DAT gridpoint -c TH10 - potential virtual temperature to 10 m at -c nearest station/3D.DAT gridpoint -c THETA - surface potential virtual temp. at -c nearest station/3D.DAT gridpoint -c Z02 -real - roughness length -c - -c --- OUTPUT: -c EL2 - real - Monin-Obukhov length (m) -c USTAR2 - real - Friction velocity (m/s) -c QB - real - Buoyancy Flux (W/m2) -c This quantity used to be labelled "sensible heat flux" -c but has always been the buoyancy flux as it is based -c on the virtual potential temperature -c (i.e. effects of temp and moisture are included) -c -c -c -c --- DELTAT called by: WATER, WATERP -c --- DELTAT calls: none - -c ------------------------------------------------------------------------- - include 'params.met' -c include 'ovrwat.met' - -c data e2/5.096e-3/,vk/0.4/,vkg/3.924/,rhocp/1195.2/ - data e2/5.096e-3/,vk/0.4/,g/9.81/,rhocp/1195.2/ - - vkg=vk*g - -c --- estimate values of theta* and u* using OCD technique -c -c --- neutral drag coefficient (Garratt, 1977) - cun=0.75e-3+0.067e-3*ws10 -c - xln10z0=alog(10./z02) - xlnzz0=alog(zanem/z02) -c -c --- Monin-Obukhov length -- first guess - if(abs(dth10).gt.1.e-6)then -c --- constant e2 is 5.096e-3 (Hanna et al., 1985) - el2=th10*cun**1.5*ws10**2/(e2*dth10) - - -c --- if neutral or near-neutral, skip iteration -- use neutral eqns. - if(abs(el2).gt.9999.)go to 1200 -c -c --- Monin-Obukhov length near zero restricted - if(abs(el2).lt.5.0)then - if(el2.lt.0.)then - el2=-5.0 - else - el2=5.0 - endif - endif - else -c -c --- neutral conditions - go to 1200 - endif -c -c --- iterate to refine u* and L estimates - maxit=3 - elold=el2 - do 200 niter=1,maxit -c -c --- new estimate -- stability correction factors - z10l=10.0/el2 - ztl=zanem/el2 - if(el2.gt.0.0)then -c -c --- Monin-Obukhov length is positive -- stable conditions - psiu=-4.7*z10l - psit=-4.7*ztl - else -c -c --- Monin-Obukhov length is negative -- unstable conditions - x=(1.0-15.0*z10l)**0.25 - psiu=2.0*alog(0.5*(1.+x))+alog(0.5*(1.+x*x))- - 1 2.0*atan(x)+1.5707963 - y=sqrt(1.-9.*ztl) -c --- constant 1.48 = 2. * 0.74 - psit=1.48*alog(0.5*(1.+y)) - endif -c -c --- new estimates -- u* and theta* - ustar2=vk*ws10/(xln10z0-psiu) -c --- prevent numerical problems with zero ustar - ustar2=amax1(ustar2,1.e-9) - thstar=vk*dthz/(0.74*xlnzz0-psit) -c -c --- determine new value of Monin-Obukhov length based on u*, theta* - if(abs(thstar).gt.1.e-6)then - el2=theta*ustar2**2/(vkg*thstar) - if(abs(el2).gt.9999.)go to 1200 - else - go to 1200 - endif - if(abs(el2).lt.5.0)then - if(el2.lt.0)then - el2=-5.0 - else - el2=5.0 - endif - endif -c -c --- check for convergence (5% criterion) - if(abs((el2-elold)/elold).lt.0.05)then -c --- convergence -- skip out of loop - go to 400 - else -c --- perform another iteration (up to maxit) - elold=el2 - endif -c -200 continue - go to 400 -c -c --- neutral conditions -1200 continue - ustar2=vk*ws10/alog(10./z02) -c --- prevent numerical problems with zero ustar - ustar2=amax1(ustar2,1.e-9) - el2=9.9e9 - thstar=0.0 -c -400 continue - -c -c --- Buoyancy flux (watts/m**2) -c --- rhocp=1195.2 kg/(m*s**2*deg K)=(1.2 kg/m**3)(996 m**2/(s**2 deg)) - qb=-rhocp*theta*ustar2**3/(vkg*el2) - - - RETURN - END -c---------------------------------------------------------------------- - subroutine water2(us,vs,is,js,ns,zzanem,imixh,fcori,nsurf,zi, - : qsw,qlw,rmm,nhrz,dcoast,ipsifcn) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070717 WATER2 -c --- M. Fernau, Earth Tech after WATER by J. Scire, SRC -c -c --- PURPOSE: Compute micrometeorological parameters over water using -c delta temp. or COARE methods so that similarity theory -c extrapolation can be done. -c -c --- UPDATES -c --- V6.223 Level 070702 to v6.3 (070717) -c - Add IPSIFCN to SIMILT argument list -c -c --- V6.222 Level 070404 to V6.223 Level 070702(F.Robe) -c (1) Correct array index of tgrada (nwat instead of ns) -c (2) Define ws10 also when buoy anemometer height is 10m -c (3) Define wt(=0) when OW data are missing -c (4) Define ilapse and pass on correct value of ilapse -c to MIXHMC and MIXHBG if itwprog=2 -c -c --- V6.214 Level 060528 to V6.222 Level 070404(F.Robe) -c (1) Include internal common to pass value of dptt to MIXHMC -c -c --- V6.205 Level 060318 to V6.214 Level 060528 (F.Robe) -c (1) Rename qh2 output from deltat qb2 as it is a buoyancy flux not -c a sensible heat flux -c (2) compute the buoyancy flux (wt= )for deltaT method -c so the mixing heights can be correctly computed -c (3) Skip definition of thstar,qh,qe as not used -c -c --- Version 5.614 Level 051228 to V6.205 Level 060318 -c (1) Make sure SST passed to COARE are above -3C -c -c --- V5.613 (051227)to v5.614 (051228)(F.Robe): -c - Add depth of SST sensor to COARE calling list -c --- V5.611 (051113) to v5.613 (051227)(F.Robe): -c - Use actual Tair Sensor height instead of anemometer height -c if available (SEA.DAT version 2.11+) -c --- V5.6f (050824) to V5.611 (051113) (F.Robe): -c - Pass zzanem instead of nwat to deltaT -c --- V5.6d (050428) to V5.6f (050824) (DGS): -c - Check for missing Tair-Tsea before calling COARE -c --- V5.6c (050419) to V5.6d (050428) (F.Robe): -c - Declare rtstar,rqstar as real*8 -c -c --- V5.6 (050328) to V5.6c (050419) (F.Robe): -c - Pass iwarm,icool,(is,js) to COARE via calling list -c - Include gen.met to pass itimstep value to COARE -c -c Level(950201) to V5.6 Level 050328 (F.Robe) -c - Allow use of COARE method -c - Compute convective mixing height (Batchvarova&Gryning or Maul-Carson) -c - Use anemometer height not height of first CALMET level as observed -c surface winds have not been extrapolated yet -c - Ensure that winds at 10m are used for OCD method -c -c --- INPUT: -c US(MXNZ,MXWND) - real array - U component of observed winds (for k=1: -c observation is at anemometer height, not -c at first CALMET level -c VS(MXNZ,MXWND) - real array - V component of observed winds -c (IS,JS) - integers - Coordinates (i,j) of the gridcell where the station is located -c NS - integer - Location of station in surface array -c ZZANEM - real - Surface (land) station anemometer height -c For overwater station, actual value is -c passed on via common OVRWAT.MET -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c ZI - real - previous hour mixing height at gridpoint -c where station is located -c QSW - real array - net short wave radiative flux (W/m2) -c at the surface gridpoint where station -c is located -c QLW - real - downward long wave radiative flux (W/m2) -c at the surface gridpoint where station -c is located -c FCORI - real - Absolute value of the Coriolis -c parameter (1/s) at station gridpoint -c NSURF - integer - Total # of surface sites -c NHRZ - integer - GMT hour (ending time) -c RMM - real - Rainfall rate (mm/hr) where station is located -c DCOAST - real - distance from overwater station to -c coast (in km) -c IPSIFCN - integer - Flag controlling choice of PSI -c stability correction for wind -c profile -c (IPSIFCN=0 use CALMET v5.6; -c IPSIFCN=1 use CALMET v5.53) -c -c Common block /OVRWAT/ variables: -c DTOW(mxows), TAIROW(mxows), RHOW(mxows), -c ZIOW(mxows), ZOWSTA(mxows), ZIMINW, ZIMAXW, CONSTW -c ICOARE,WAVE, dshelf -c Parameters: MXNZ, MXWND -c From TMP.MET: tgdefa -c -c --- OUTPUT: -c US(MXNZ,MXWND) - real array - U component of observed winds -c VS(MXNZ,MXWND) - real array - V component of observed winds -c (extrapolated aloft) -c -c --- WATER2 called by: STHEOR -c --- WATER2 calls: SIMILT, ESAT (function) -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'tmp.met' - include 'gen.met' -c - real us(mxnz,mxwnd),vs(mxnz,mxwnd) - -c --- double precision variables for COARE (050328) - real*8 rzu,rzt,rwsz,rzi,rrmm,rq,rqsw,rqlw,rqh,rqe - real*8 rtairc,rtsea,rrlong,rtwave,rhwave,rz0,rustar - real*8 rqstar,rtstar,rzsst - -c --- Flag for OK SEA.DAT data - logical lsea - - include 'ovrwat.met' -c - data z0min/2.0e-6/,xmissm/990./,pres/1000./ - data vk/0.4/,rhocp/1195.2/ -c - common /tjump/ dptt(mxnx,mxny) - -c --- If surface wind components missing, don't bother to extrapolate - if (us(1,ns) .gt. xmissm .or. vs(1,ns) .gt. xmissm) return -c --- Do not extrapolate calm winds -c --- Note (frr 050328):us(1,n),vs(1,n) are winds measured at anemometer height -c --- not necessarily at 10m - wsz = sqrt(us(1,ns) **2 + vs(1,ns) **2) - if (wsz .lt. 0.0001) return -c - -c --- Set lapse rate flag for mixing height subroutine (070702) - if (itwprog.eq.0) then - ilapse=0 - else - ilapse=1 - endif - -c --- Find location of station in overwater array - nsfc = nsurf - nowsta - nwat = ns - nsfc - - -c --- Anemometer height -c --- 050328: for sf station (not SEA.dAT), zanem passed through calling list - if (nwat.gt.0) then - zzanem = zowsta(nwat) - zztair = ztair(nwat) -c --- Assume 10. m anemometer height if missing - if(zzanem.ge.9998.)zzanem=10. - if(zztair.ge.9998.)zztair=zzanem - end if - - -c --- If station is not a SEA#.DAT station, skip following section -c --- Air-sea temperature difference must be valid to use station - if (nwat .le. 0 .or. dtow(nwat) .ge. xmissm) goto 51 -c -c --- overwater air temp. at measurement ht -- if missing, -c --- assume T=60 F = 288.7 K - if (tairow(nwat) .ge. xmissm) then - tair = 288.7 - else - tair = tairow(nwat) - endif -c -c --- water temperature -- computed from air temp + air-sea delta temp - twater = tair - dtow(nwat) -c -c --- relative humidity -- if missing, assume 100 % - if (rhow(nwat) .ge. xmissm) then - rh = 100. - else - rh = rhow(nwat) - endif -c -c --- compute saturation and actual water vapor pressure (mb) at -c --- measurement height -c --- (NOTE: ESAT function uses temperature in deg. C) -c --- (constant 0.01 converts rh from percent to fraction) - tairc = tair - 273.15 - es = esat(tairc) - e = 0.01 * rh * es -c -c --- compute saturation and actual mixing ratio (g h20/g dry air) at -c --- measurement height - ws = 0.622 * es / (pres - es) - w = 0.622 * e / (pres - e) -c --- frr 050328 specific humidity (g H2O/ KG moist air (!! units)) - q= w/(1+w)*1000. -c -c --- compute virtual temperature (deg. K) at measurement height - tv = tair * (1. + 0.61 * w) -c -c --- compute virtual potential temperatures (deg. K) at measurement ht -c --- (potential temp. = temp. + 0.01 (deg. K/m) * height) - dth = 0.01 * zowsta(nwat) - th = tv + dth -c -c --- compute virtual potential temp. (deg. K) at surface -- assume -c --- surface relative humidity = 100 % - twaterc = twater - 273.15 - es = esat(twaterc) - ws = 0.622 * es / (pres - es) - thsurf = twater * (1. + 0.61 * ws) - dthz = th - thsurf -c -c --- convert measurement ht. - surface delta potential virtual -c --- temperature to 10 m - surface value -c --- constant 11.512925 = ln(10 m/z0) with z0=1.e-4 m -c --- constant 9.2103404 = -ln(z0) with z0=1.e-4 m - dth10 = dthz * 11.512925 / (alog(zowsta(nwat)) + - & 9.2103404) - th10 = thsurf + dth10 -51 continue -c - -c vkg = vk * g -c - -c --- compute overwater surface roughness (Hosker, 1974) -c --- Define ws10 for all cases (070702) - ws10=wsz - if(wsz.gt.0.0)then - zz0 = 2.0e-6 * wsz ** 2.5 - zz0 = amax1(z0min,zz0) -c --- Adjust wind speed to 10m and recompute z0 (050328-frr) - if (int(zzanem).ne.10) then - ws10=wsz*alog(10./zz0)/alog(zzanem/zz0) - zz0 = 2.0e-6 * ws10 ** 2.5 - endif - else - zz0 = z0min - endif -c -c --- Scale winds to 10m (050328) for OCD method and z0,u*neutral - -c --- if overwater data is missing, assume near-neutral conditions - if (nwat .le. 0 .or. dtow(nwat) .ge. xmissm) goto 1200 - -c --- 050328 (F.Robe). -c --- option to use original DeltaT method or COARE algorithm to compute -c Roughness length (zo), Monin-Obukhov Length (el), -c friction velocity (u*),Buoyancy Flux (qb) -c If DeltaT; compute u*,Zo,Qb,el first then mixing height -c if COARE: compute mixing height first (required input to COARE) - -c --- DELTAT METHOD (OCD) - if (icoare.eq.0) then - call DELTAT(ws10,zzanem,dthz,dth10,th10,th,zz0,el2, - : ustar2,qb2) -c --- Surface Buoyancy flux in terms of (060528) - wt=qb2/rhocp - go to 400 - endif - -1200 continue -c --- Neutral conditions - - ustar2 = vk * ws10 / alog(10. / zz0) -c --- prevent numerical problems with zero ustar - ustar2 = amax1(ustar2,1.e-9) - el2 = 9.9e9 - wt=0. -c --- thstar not used so skip definition -c thstar = 0.0 -c -400 continue - -c --- friction velocity (m/s) - ustar = ustar2 -c -c --- Monin-Obukhov length (m) - el = el2 -c -c --- Overwater mixing height (m): observed mixing heights (if available) - if (nwat .le. 0 .or. ziow(nwat) .ge. xmissm) then -c -c --- No overwater data -- compute overwater mixing height -c --- Default values: CONSTW = 0.16, - zii = constw * ustar / fcori - zii = amax1(ziminw,zii) - zii = amin1(zimaxw,zii) - iziobs=0 - else - zii = ziow(nwat) - iziobs=1 - end if - - -c --- Adjustment to minimize mixing heights that are bigger than the -c final gridded mixing height field for current hour - zii = amin1(zii,zi) -c make sure however that they are at least = ziminw (for first step, no -c values yet) (050328) - zii = max(zii,ziminw) - -c frr 050328 -C --- COARE method (if data is not missing) -c --- Roughness length (z0), Monin-Obukhov Length (el), -c --- friction velocity (u*),Sensible Heat Flux (qh) -c --- Buoyancy flux (qb) - - lsea=.TRUE. - if(nwat .LE. 0) then - lsea=.FALSE. - elseif(dtow(nwat) .GE. xmissm) then - lsea=.FALSE. - endif - - if ( (abs(icoare).ge.10).and. lsea ) then -c --- compute air and sea temp in Celsius and positive -c --- longitude in East. Hem. at nearest overwater station. -c --- in real*8 variables - - rzt=zztair - rtairc=tairc - rtsea=rtairc-dtow(nwat) -c --- make sure SST above 0C: - rtsea=max(rtsea,-3.D0) - - rrlong =xowlon(nwat) - -c --- Dominant wave period and height (ok if missing, default in COARE) - rtwave=twave(nwat) - rhwave=hwave(nwat) - -c --- depth of SST sensor - Default: moored NDCB buoy value (0.6m) - if (zsst(nwat).lt.9998.) then - rzsst = zsst(nwat) - else - rzsst=0.6 - endif - - -c --- map other input variables to real*8 variables -c --- winds are at anemometer height (not zmid(1) - 050328 - rzu=zzanem - rwsz=wsz - rzi=zii - rrmm=rmm - rq=q - rqsw=qsw - rqlw=qlw - - call COARE(itimstep,is,js,rzu,rzt,rzsst,rwsz,rtairc,rtsea, - : rzi,rrmm,rq,rqsW,rqLW,rrlong,jwave,rtwave,rhwave, - : nhrz,dshelf,dcoast,iwarm,icool,rz0,el, - : rustar,rtstar,rqstar,rqh,rqe) - - -c --- map output variables to real*4 variables - zz0=rz0 - ustar=rustar -c --- not used so no need to define real*4 var. -c qh=rqh -c qe=rqe - -c --- Surface Buoyancy flux in terms of - wt=-ustar*(rtstar+0.61*rqstar*tair) - -c --- restrict Monin-Obhukov length near zero (to be consistent with deltaT) - if(abs(el).lt.5.0)then - if(el.lt.0)then - el=-5.0 - else - el=5.0 - endif - endif - - endif - -c --- Update mechanical and compute convective OW mixing height if no MixH obs. - if (iziobs.eq.0) then - -c --- Mechanical - zimech=constw*ustar/fcori - - if (itwprog.eq.0) then -c --- Use constant lapse rate over mixing height (default or from SEA.DAT) -c --- (else it will be extracted from the progn. temp. profiles in mixhbg/,mixhmc) -c --- Bug fix (070702): tgrada defined for OW stations only (nwat index) -c if(tgrada(ns).lt.xmissm) then -c dtdz=tgrada(ns) - if (nwat.gt.0) then - if(tgrada(nwat).lt.xmissm) then - dtdz=tgrada(nwat) - else - dtdz=tgdefa - endif - else - dtdz=tgdefa - endif -c --- potential temperature lapse rate - dthdz=dtdz+0.0098 - endif - - if(imixh.eq.2) then -c Batchvarova-Gryning convective mixing height - call MIXHBG (nhrz,Is,Js,WT,dthdz,Tair,Ilapse,THRESHW, - : ZIMAXW,ZIMINW,USTAR,EL,ZIi,ZICONV,THT,THTP) - - else if (imixh.eq.1) then -c Carson convective mixing height (similar to MIXHTST/MIXHSTS2) - call MIXHMC (nhrz,is,js,wt,dthdz,ilapse,threshw, - : ZIMAXW,zii,ziconv,dptt,tht,thtp) - else -c OCD mixing height (mechanical only) - ziconv=0. - endif - - zii=amax1(zimech,ziconv) - zii=amax1(ziminw,zii) - zii=amin1(zimaxw,zii) - - endif - -c -c --- Call extrapolation routine - call similt(zzanem,el,zz0,zii,ns,ipsifcn,us,vs,ziminw) - - return - end -c---------------------------------------------------------------------- - subroutine water2p(us,vs,is,js,ns,zzanem,imixh,fcori,nsurf,zi, - : qsw,qlw,rmm,nhrz,dcoast,ipsifcn) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070717 WATER2P -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Compute micrometeorological parameters over water using -c delta temp. or COARE methods so that similarity theory -c extrapolation can be done, with prognostic temperature -c variables. -c -c --- UPDATES: -c --- V6.223 Level 070702 to v6.3 (070717) -c - Add IPSIFCN to SIMILT argument list -c -c --- V6.222 Level 070404to V6.223 Level 070702(F.Robe) -c (1) Define ws10 also when buoy anemometer (lowest M3d level) -c height is 10m -c (2) Pass on correct value of ilapse to MIXHMC and MIXHBG -c when itwprog=2 -c -c --- V6.214 Level 060528 to V6.222 Level 070404(F.Robe) -c (1) Include internal common to pass value of dptt to MIXHMC -c -c --- V6.205 Level 060318 to V6.214 Level 060528 -c (1) Rename QH2 QB2 with deltaT method as this quantity is -c truly a buoyancy flux, not a sensible heat flux -c (2) Compute wt for DeltaT method -c (3) make sure rtwave and rhwave are set to missing values when -c there are no buoy data (nwat=0) -c (4) Skip definition of thstar,qh,qe as not used -c -c --- Version 5.614 Level 051228 to V6.205 Level 060318 -c (1) Make sure SST passed to COARE are above -3C -c -c --- Version 5.611(051113) to V5.614 (051228) -c - Add SST sensor depth to COARE calling list -c -c --- INPUT: -c US(MXNZ,MXWND) - real array - U component of observed winds (for k=1: -c observation is at anemometer height, not -c at first CALMET level -c VS(MXNZ,MXWND) - real array - V component of observed winds -c (IS,JS) - integers - Coordinates (i,j) of the gridcell where the station is located -c NS - integer - Location of station in surface array -c ZZANEM - real - Surface (land) station anemometer height -c For overwater station, actual value is -c passed on via common OVRWAT.MET -c IMIXH - integer - Method for convective mixing height -c 1: Maul Carson overland and overwater -c 2: Batchvarova-Gryning overland and OW -c -1: MC overland, OCD mechanical OW -c -2: BG overland, OCD mechanical OW -c ZI - real - previous hour mixing height at gridpoint -c where station is located -c QSW - real array - net short wave radiative flux (W/m2) -c at the surface gridpoint where station -c is located -c QLW - real - downward long wave radiative flux (W/m2) -c at the surface gridpoint where station -c is located -c FCORI - real - Absolute value of the Coriolis -c parameter (1/s) at station gridpoint -c NSURF - integer - Total # of surface sites -c NHRZ - integer - GMT hour (ending time) -c RMM - real - Rainfall rate (mm/hr) where station is located -c DCOAST - real - distance from overwater station to -c coast (in km) -c IPSIFCN - integer - Flag controlling choice of PSI -c stability correction for wind -c profile -c (IPSIFCN=0 use CALMET v5.6; -c IPSIFCN=1 use CALMET v5.53) -c -c Common block /OVRWAT/ variables: -c ICOARE,WAVE, dshelf -c common /MM4HDO/ -c xlong4 (mxnxp,mxnyp),igrabw(mxnx,mxny),jgrabw(mxnx,mxny) -c common block /M3DMET/ -c TAIRP(mxnxp,mxnyp),RHP(mxnxp,mxnyp),Z1P(mxnxp,mxnyp),SSTP(mxnxp,mxnyp) -c -c Parameters: MXNZ, MXWND -c -c --- OUTPUT: -c US(MXNZ,MXWND) - real array - U component of observed winds -c VS(MXNZ,MXWND) - real array - V component of observed winds -c (extrapolated aloft) -c -c --- WATER2P called by: STHEOR -c --- WATER2P calls: SIMILT, ESAT (function) -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'gen.met' - include 'm3dmet.met' - include 'mm4hdo.met' -c - real us(mxnz,mxwnd),vs(mxnz,mxwnd) - -c --- double precision variables for COARE (050328) - real*8 rzu,rzt,rwsz,rzi,rrmm,rq,rqsw,rqlw,rqh,rqe - real*8 rtairc,rtsea,rrlong,rtwave,rhwave,rz0,rustar - real*8 rqstar,rtstar ,rzsst - - - include 'ovrwat.met' -c - data z0min/2.0e-6/,xmissm/990./,pres/1000./ - data vk/0.4/,rhocp/1195.2/ -c - common /tjump/ dptt(mxnx,mxny) - -c --- If surface wind components missing, don't bother to extrapolate - if (us(1,ns) .gt. xmissm .or. vs(1,ns) .gt. xmissm) return -c --- Do not extrapolate calm winds -c --- Note (frr 050328):us(1,n),vs(1,n) are winds measured at anemometer height -c --- not necessarily at 10m - wsz = sqrt(us(1,ns) **2 + vs(1,ns) **2) - if (wsz .lt. 0.0001) return -c -c --- Find location of station in overwater array - nsfc = nsurf - nowsta - nwat = ns - nsfc - - -c --- Anemometer height -c --- For sf station (not SEA.dAT), zanem passed through calling list - if (nwat.gt.0) then - zzanem = zowsta(nwat) -c --- Assume 10. m anemometer height if missing - if(zzanem.ge.9998.)zzanem=10. - end if - -c --- Nearest 3D.DAT gridpoint - inear=igrabw(is,js) - jnear=jgrabw(is,js) - -c --- Treat prognostic gridpoints as overwater stations and compute -c --- necessary variables -c -c --- compute saturation and actual water vapor pressure (mb) at -c --- measurement height -c --- (NOTE: ESAT function uses temperature in deg. C) -c --- (constant 0.01 converts rh from percent to fraction) - tairc=tairp(inear,jnear)-273.15 - es=esat(tairc) - e=0.01*rhp(inear,jnear)*es -c -c --- compute saturation and actual mixing ratio (g h20/g dry air) at -c --- measurement height - ws=0.622*es/(pres-es) - w=0.622*e/(pres-e) -c --- specific humidity (g H2O/ KG moist air (!! units)) - q= w/(1+w)*1000. - -c -c --- compute virtual temperature (deg. K) at measurement height - tv=tairp(inear,jnear)*(1.+0.61*w) -c -c --- compute virtual potential temperatures (deg. K) at measurement ht -c --- (potential temp. = temp. + 0.01 (deg. K/m) * height) - dth=0.01*z1p(inear,jnear) - th =tv+dth -c -c --- compute virtual potential temp. (deg. K) at surface -- assume -c --- surface relative humidity = 100 % - twaterc=sstp(inear,jnear)-273.15 - es=esat(twaterc) - ws=0.622*es/(pres-es) - thsurf=sstp(inear,jnear)*(1.+0.61*ws) - dthz=th-thsurf -c -c --- convert measurement ht. - surface delta potential virtual -c --- temperature to 10 m - surface value -c --- constant 11.512925 = ln(10 m/z0) with z0=1.e-4 m -c --- constant 9.2103404 = -ln(z0) with z0=1.e-4 m - dth10=dthz*11.512925/(alog(z1p(inear,jnear))+ - 1 9.2103404) - th10=thsurf+dth10 - - -c vkg = vk * g -c - -c --- compute overwater surface roughness (Hosker, 1974) - ws10=wsz - if(wsz.gt.0.0)then - zz0 = 2.0e-6 * wsz ** 2.5 - zz0 = amax1(z0min,zz0) -c --- Adjust wind speed to 10m and recompute z0 -c --- For wind adjustement, use station anenometer height, -c --- not height of first 3D.DAT level - if (int(zzanem).ne.10) then - ws10=wsz*alog(10./zz0)/alog(zzanem/zz0) - zz0 = 2.0e-6 * ws10 ** 2.5 - endif - else - zz0 = z0min - endif -c -c --- Scale winds to 10m for OCD method and z0,u*neutral - -c --- option to use original DeltaT method or COARE algorithm to compute -c Roughness length (zo), Monin-Obukhov Length (el), -c friction velocity (u*),Buoyancy Heat Flux (qh) -c If DeltaT; compute u*,Zo,Qh,el first then mixing height -c if COARE: compute mixing height first (required input to COARE) - -c --- DELTAT METHOD (OCD) - if (icoare.eq.0) then - call DELTAT(ws10,zzanem,dthz,dth10,th10,th,zz0,el2, - : ustar2,qb2) -c --- Surface Buoyancy flux in terms of (060528) - wt=qb2/rhocp - go to 400 - endif - -1200 continue -c --- Neutral conditions - - ustar2 = vk * ws10 / alog(10. / zz0) -c --- prevent numerical problems with zero ustar - ustar2 = amax1(ustar2,1.e-9) - el2 = 9.9e9 -c thstar not used so skip -c thstar = 0.0 -c -400 continue - -c --- friction velocity (m/s) - ustar = ustar2 -c -c --- Monin-Obukhov length (m) - el = el2 -c -c --- Overwater mixing height (m) -c --- Default values: CONSTW = 0.16, - zii = constw * ustar / fcori - zii = amax1(ziminw,zii) - zii = amin1(zimaxw,zii) - - -c --- Adjustment to minimize mixing heights that are bigger than the -c final gridded mixing height field for current hour - zii = amin1(zii,zi) -c make sure however that they are at least = ziminw (for first step, no -c values yet) (050328) - zii = max(zii,ziminw) - -C --- COARE method -c --- Roughness length (z0), Monin-Obukhov Length (el), -c --- friction velocity (u*),Sensible Heat Flux (qh) - - if ( abs(icoare).ge.10 ) then -c --- compute air and sea temp in Celsius and positive -c --- longitude in East. Hem. at nearest overwater station. -c --- in real*8 variables - -c --- measurement height for temp = 3D.DAT level - rzt=z1p(inear,jnear) - rtairc=tairc - rtsea=twaterc -c --- make sure SST above 0C: - rtsea=max(rtsea,-3.D0) - rrlong=xlong4(inear,jnear) - -c --- Dominant wave period and height (ok if missing, default in COARE) -c --- Problem when nwat=0 with some compilers- 060528 fix - if(nwat.gt.0) then - rtwave=twave(nwat) - rhwave=hwave(nwat) - else - rtwave = -999. - rhwave = -999. - end if - -c --- depth of SST sensor - Default: 0.05m (surface value) - rzsst=0.05 - -c --- map other input variables to real*8 variables -c --- winds are at anemomenter height (not zmid(1) - 050328 -c --- measurement height for wind = anemometer height - rzu=zzanem - rwsz=wsz - rzi=zii - rrmm=rmm - rq=q - rqsw=qsw - rqlw=qlw - - call COARE(itimstep,is,js,rzu,rzt,rzsst,rwsz,rtairc,rtsea, - : rzi,rrmm,rq,rqsW,rqLW,rrlong,jwave,rtwave,rhwave, - : nhrz,dshelf,dcoast,iwarm,icool,rz0,el, - : rustar,rtstar,rqstar,rqh,rqe) - - -c --- map output variables to real*4 variables - zz0=rz0 - ustar=rustar -c --- qh/qe not used so skip -c qh=rqh -c qe=rqe - -c --- Surface Buoyancy flux in terms of - wt=-ustar*(rtstar+0.61*rqstar*tair) - -c --- restrict Monin-Obhukov length near zero (to be consistent with deltaT) - if(abs(el).lt.5.0)then - if(el.lt.0)then - el=-5.0 - else - el=5.0 - endif - endif - - endif - -c --- Update mechanical and compute convective OW mixing height - -c --- Mechanical - zimech=constw*ustar/fcori - - if(imixh.eq.2) then -c Batchvarova-Gryning convective mixing height - call MIXHBG (nhrz,Is,Js,WT,dthdz,Tair,1,THRESHW, - : ZIMAXW,ZIMINW,USTAR,EL,ZIi,ZICONV,THT,THTP) - - else if (imixh.eq.1) then -c Carson convective mixing height (similar to MIXHTST/MIXHSTS2) - call MIXHMC (nhrz,is,js,wt,dthdz,1,threshw, - : ZIMAXW,zii,ziconv,dptt,tht,thtp) - else -c OCD mixing height (mechanical only) - ziconv=0. - endif - - zii=amax1(zimech,ziconv) - zii=amax1(ziminw,zii) - zii=amin1(zimaxw,zii) - - -c -c --- Call extrapolation routine - call similt(zzanem,el,zz0,zii,ns,ipsifcn,us,vs,ziminw) - - return - end -c --------------------------------------------------------------------- - subroutine COARE(itimstep,ix,jx,zu,zt,ts_depth,u,t,ts,zi,rain, - : q,rs,rl,xlon,jwave,twave,hwave,nhrz,dshelfx, - : dcoastx,iwarm,icool,zo,el,ustar,tstar,qstar,qh, - : qe) -c---------------------------------------------------------------------- -c --- CALMET Version: 6.5.0 Level: 051214 COARE -c --- F.Robe after COARE main program -c -c -c --- PURPOSE: Compute roughness length Zo, Friction velocity u* , -c Monin-Obukhov length L and sensible heat flux -c overwater using the COARE model -c -c -c --- UPDATES: -c --- V5.612 (051214)to v5.614 (051228)(F.Robe) -c (1) Add ts_depth (SST measnt depth) to calling list -c -c --- Version 5.6c Level 050419 to V5.612 (051214)(F.Robe) -c (1) Restrict the number nits of iterations in ASL subroutine to 1 -c for all cases because the iteration does not always converge -c -c --- Version 5.6a Level 050331 to Version 5.6c Level 050419 (F.Robe) -c (1) Warm layer option is applied to each overwater gridpoint -c independently => create (mxnx,mxny) arrays of bulk variables -c related to warm layer option (common /OLD/) and include 'params.met' -c (2) Warm layer computation starts at any time (no 6AM deadline -c and first day off anylonger - subroutine bulk_flux) -c -c --- Version 5.6 Level 050328 to Version 5.6a Level 050331 -c (1) Fix typo that causes DSHELF variable to be zero in all calls to -c the COARE module, and correct all references to Charnock -c -C --- NOTES: -c 0) COARE runs the COARE bulk FLux model version 2.6bw -c (Bradley et al, Fairall et al), straight from original model -c except for the calling list, input/output files (none) -c The loop over time is not done internally but as part of the -c overall CALMET time loop. -c Modifications to original COARE program are commented with -c "c frr" or labelled with 'c frr 050328') -c -c 1) Call to gravity in BULK_FLUX is commented out and gravity constant g -c is assumed to be constant (=9.81 m/s2=value used throughout CALMET . -c Saves time (otherwise g is computed at each gridpoint, at each timestep) -c If call to gravity is re-instated, the overwater station latitudes -c xlat must be supplied to COARE. This is the only change made to the -c 6 original COARE subroutines (not including the main COARE pgm) -c -c 2) The longitude of the nearest overwater station is used (XOWLON) -c rather than the longitude of the overwater gridpoint itself for the -c purpose of computing the solar local time. Consider computing the -c longitude of each gridpoint -c -c 3) The air and sea temperatures are also taken at the nearest overwater -c station. No spatial interpolation is done - Consider doing it in -c subroutine WATEr and transmit via argument list -c -c 4) There are more output data available in COARE than those -c used in CALMET (see COARE output list below) -c -c 5) Modification of the original COARE code for shallow waters: -c A shallow water corrective factor of the Charnock -c parameter (charn) is introduced to reflect higher -c values of charn in shallow waters (0.032). A typical -c lengthscale for the coastal region is introduced (dshelf, -c reflecting the coastal shelf extent) such that charn varies between -c the shallow water value and the deep sea values depending -c on the distance to the nearest coast (DCOAST) -c -c 6) Constants in common /const/ are initialized in bulk_flux -c rather than asl. Otherwise crash during warm layer calculations -c -c -c -c--- INPUT: -c ITIMSTEP - integer - CALMET timestep - indicate if first call to -c COARE- common variable index=itimstep -c (Ix,Jx) - integer - CALMET gridpoint (i,j) -c ZU - real - height at which winds are either -c measured or computed -c ZT - real - temperature measurement height at buoy -c TS_DEPTH - real - SST measurement depth -c U - real - Wind speed at zu -c T - real - Air temperature in Deg. Celsius -c TS - real - Sea temperature (deg. Celsius) -c ZI - real - Mixing height (in meters) -c RAIN - real - Rainfall rate in mm/hr -c Q - real - specific humidity (q/kg) -c RS - real - short wave radiation (W/m2) -c RL - real - Long wave radiation (W/m2) -c XLON - real - Longitude (+tive in Eastern Hem.) -c JWAVE - integer - Wave parameterization -c 0: none (Charnock) -c 1: Oost et al -c 2: Taylor and Yelland -c TWAVE - real - Dominant wave period (seconds) -c Missing value (-999.) -c HWAVE - real - Significant wave height (meters) -c Missing value (-999.) -c NHRZ - integer - GMT Time in hours (ending time) -c dshelfX - real - Length scale for the coastal region -c used for variable Charnock parameter -c in shallow waters ( in km). -c Default: 0. i.e. deep sea everywhere -c DCOASTX - real - distance to the nearest coast (in km) -c IWARM - integer - Warm layer option - 1: on - 0: off -c must be off if SST measured with -c IR radiomater -c ICOOL - integer - Cool skin option - 1: on - 0: off -c must be off if SST measured with -c IR radiomater -c -c -c --- OUTPUT: -c ZO - real - Surface roughness length (m) -c EL - real - Monin-Obukhov length (m) -c USTAR - real - Friction velocity (m/s) -c QSTAR - real - turbulent moisture flux scale -c TSTAR - real - turbulent temperature flux scale -c QH - real - Sensible heat flux (W/m2) -c QE - real - Latent heat flux (W/m2) -c -c -c -c --- COARE called by: WATER, WATER2 -c --- COARE calls: BULK_FLUX,ASL,HUMIDITY,ZETA,H_ADJUST -c -c -------------------------------------------------------------------------- - -c input data - converted for subroutine call because of conflict with COMMON: -c xtime (COARE convention yymnddhhmmss.ssss GMT) -c zu (wind measurement height) m --- -c zt (T&rh measurement height) m ---- -c zus (wind standard height) m - changes to different ref. height. -c zts (T&rh standard height) m -c ts_depth (depth of sst instrument) - positive m - for cool skin/warm layer correction -c u (wind speed relative to the sea surface) m/s --ws10 (although at 10m>) -c ts (sea surface temp.) deg. C - TAIROW-DTOW -c t (air temperature) deg. C - TAIROW -c q (specific humidity) g/kg or qq (RH as decimal) - code works internally in kg/kg!! -c rs (shortwave radiation) W/m2 -c rl (downwelling longwave) W/m2 -c rain (average rainrate in timestep) mm/hour - RMM -c p (pressure) mb; use 1008mb if data unavailable -c zi (boundary-layer depth; use 600m if data unavailable) m - GET from WATEr -c jcool (=1 for cool skin calculation; =0 if SST measured by IR radiometer) -c jwarm (=1 for warm layer calculation; =0 if SST measured by IR radiometer) -c xlat (latitude) degrees [latitude north +ve, latitude south -ve] -c xlon (longitude) degrees [Longitude east +ve, longitude west -ve] -c.................................................................... -c AVailable COARE output: -c QH W/m**2 (Sensible heat flux) - turbulent part only -c QE W/m**2 (Latent heat flux) - turbulent part only -c QR W/m**2 (Rainfall heat flux) -c TAU N /m**2 (wind stress) - turbulent part only -c Ustar m/s (velocity scaling parameter - friction velocity) -c Qstar kg/kg (humidity scaling parameter) -c Tstar C (temperature scaling parameter) -c CDN - neutral drag coefficient -c CHN - neutral transfer coefficient for heat -c CEN - neutral transfer coefficient for moisture -c RR - Roughness Reynolds number -c RT - Roughness Reynolds number for temperature -c RQ - Roughness Reynolds number for moisture -c ZL - height/L where L is the Obukhov length -c ZO - roughness length -c zot - roughness length for temperature -c zoq - roughness length for humidity -c dt_wrm - total warm layer temperature difference C -c tk_pwp - thickness of warm layer -c dter - cool skin temperature difference C -c T0 - skin temperature C (T0 = sst - dter + dt_wrm*ts_depth/tk_pwp) -c wg - gustiness factor m/s -c Taur - momentum flux due to rain N/m**2 -c Wbar - Webb mean vertical velocity m/s -c -c frr - get mxnx, mxny to dimension warm layer variables - include 'params.met' - -c frr - program fluxes - real*8 ws_h,Ta_h,qq_h - real*8 zu,zt,zus,zts,u,ts,t,q,p,zi,rain,xlat,xlon - real*8 QH,QE,TAU,Ustar,Qstar,Tstar - real*8 rl,rs,QR,T0,ts_depth,wg - real*8 CDN,CEN,CHN,RR,RT,RQ,ZL - real*8 Zo,zot,zoq,dt_wrm,dter,S - real*8 Wbar,Tau_r,xtime,glat - -c --- COARE called for each gridpoint i.e. keep track of updates at each -c gridpoint => real arrays (050419) -c frr real*8 time_old,qcol_ac,tau_ac,tau_old,rf_old,hf_old,ef_old - real*8 time_old(mxnx,mxny),qcol_ac(mxnx,mxny),tau_ac(mxnx,mxny) - real*8 tau_old(mxnx,mxny),rf_old(mxnx,mxny),hf_old(mxnx,mxny) - real*8 ef_old(mxnx,mxny) - - dimension jamset(mxnx,mxny),jump(mxnx,mxny) - -cfrr real*8 intime,sol_time,tk_pwp,fxp - real*8 intime,sol_time,tk_pwp(mxnx,mxny),fxp(mxnx,mxny) - real*8 hwave,twave - integer hh,yy,dd - character*17 chtime - - - - logical eoftag - data eoftag/.FALSE./ - - COMMON /old/time_old,qcol_ac,tau_ac,tau_old,rf_old,hf_old, - & ef_old,jamset,jump,fxp,tk_pwp,index,i,j -cfrr & ef_old,jamset,jump,fxp,tk_pwp,index - - -c frr 050328 - Length Scale for the coastal region and distance to coast -c Used to compute variable Charnock coefficient -c in shallow waters - COMMON/charnock/dshelfkm,dcoast ! pass to ASL - - dshelfkm=dshelfx - dcoast=dcoastx - i=ix - j=jx - index=itimstep - -c initialize variables at first call to COARE only - if (index.eq.1) then - qcol_ac(i,j)=0. - tau_ac(i,j)=0. - time_old(i,j)=0. - tau_old(i,j)=0. - hf_old(i,j)=0. - ef_old(i,j)=0. - rf_old(i,j)=0. - jamset(i,j)=0 - jump(i,j)=0 - endif - -c - -c frr 050328 _ no in/out in this subroutine (orginal commented by c frr) -c open input/output files and set up fixed instrument levels -c -c frr open(unit=3,file='test2_5b.txt') ! original coare2.5b input data -c frr open(unit=9,file='Oea2_6aw.out') ! output Oost et al wave option -c open(unit=9,file='c:\coare\bulk_alg\Tay2_6aw.out') ! output Taylor wave option -c open(unit=10,file='d:\123\bulk2_6\exch2_6c.out') ! CDN,CHN and CEN from this program -c -c frr write(9,500) -c frr 500 format(1x,'index xtime hsb hlb tub ts HF -c frr 1 EF TAU T0 Wbar RainF rain dt_cool dt_warm tk_pwp') -c -c write(10,501) -c501 format(1x,'index u Cdn Chn Cen') -c - -c frr 050328- The winds and temperatures are available in WATER -c winds are at cellzc and temperature at zowsta -c frr zu=15. !height of wind measurement -c frr zt=15. !height of air temp. and RH - - zus=10. !10m standard levels - zts=10. - -c ts_depth=0.05 !Chris Fairall's floating sensor -c ts_depth=0.45 !from IMET buoy -c ts_depth=6.0 !Hemantha's 6m data -c -c default values for pressure and mixed layer height - p=1008. - -c frr 050328 Mixing height supplied via calling list -c frr zi=600. -c -c initial guesses to the warm layer parameters, these values simulate what is expected -c in early morning: fxp=0.5 implies a shallow heating layer to start the integration; -c tk_pwp=19.0 implies the thickness is a maximum from the day before and is not meant to -c match this timestep's fxp. -c initialize variables at first call to COARE only (frr -050329) - if (index.eq.1) then - fxp(i,j)=0.5 - tk_pwp(i,j)=19.0 - endif - -c if SST sensed by IR radiometer, jwarm=jcool=0 - jwarm=iwarm - jcool=icool - -c frr 050328 WAve option chosen by user in input file -c frr jwave=1 !0=Charnock,1=Oost et al,2=Taylor and Yelland. -c Also choose output file name -c loop through data -c -c frr index=0 -c READ(3,505)ADUM ! skip header line of test data -c READ(4,505)ADUM ! skip header line of test output data -505 FORMAT(A1) -c frr 0404001: no time loop (as COARE is called at each time step. -c frr time loop in CALMET) -c do while (.not. eof(3)) !start of loop -c frr do while (.not. eoftag) !start of loop -c frr index=index+1 !count data records (hours) -c -c read Chris Fairall's Moana Wave data from test file, 116 lines(hours) -c hsb,hlb,tub are bulk fluxes calculated independently by Chris for comparison -c frr 050328: hsb, hlb,tub are useless in CALMET -c HWT=Hemantha's Gregg data at 6m for Ts to demonstrate warm layer calculation -c frr 050328: HWT is useless in CALMET -c ts is Chris' floating temperature sensor at 0.05m depth -c Chris' is used here to compare fluxes with his original HP Basic code -c -c frr 050328 - Input comes from argument list and CALMET common OVRWAT.MET -c (not from external file) -c frr700 READ(3,705,end=910)xtime,u,ts,t,q,hsb,hlb,tub, -c frr 2 rs,rl,rain,xlat,xlon,HWT -c frr705 FORMAT(f12.0,10F6.0,3F9.0) -c -c frr 050328 -c hsb,hlb,tub,HWT are QA variables used by the COARE authors but are -c meaningless in CALMET -c Latitude xlat is not used because call to subroutine gravity is -c commented out (frr 050328) -c frr glat=xlat - -c default values for wave height and period for equilibrium sea -c if known, add to data and to read statement above, then comment next two lines -c frr 050328 - Use observed wave properties if available (missing values: -999.) -c frr otherwise use default equilibrium values - if ((hwave.lt.0).or.(twave.lt.0)) then - hwave=0.018*u*u*(1+.015*u) - twave=0.729*u - endif -c -c check warm layer, cool skin switches -c - if(Jwarm.gt.0) then - if(index.eq.1) then - Jwarm=2 - else - Jwarm=1 - endif - endif -c -c convert time to decimal hours (e.g. yymnddhhmmss.ssss -> hh.hhhh) -c skip this part if intime is in this format already -c -c frr 050328: time in hour GMT through calling list (NHRZ) - intime=float(nhrz) -c frr intime=xtime -c frr if(intime .gt. 1e9) then !eg 921125182900 -c frr write(chtime(1:17),'(f17.4)') intime -c frr read(chtime,12) yy,mn,dd,hh,mm,ss -c frr12 format(5i2,f7.4) -c frr intime=(float(hh)+float(mm)/60.+ss/3600.) !eg 18.4833 -c frr endif -c -c and convert to local solar time in seconds -c -c --- DGS Change for DF compile -c sol_time=mod(xlon/15+intime+24,24)*3600 !eg 17580 - sol_time=mod(xlon/15.D0+intime+24.D0,24.D0)*3600.D0 !eg 17580 -c - -c call bulk flux routine. 16/5/01 pass wave parameters also - call bulk_flux(sol_time,xlat,zu,zt,zus,zts,Jwave,hwave,twave, - & u,ts,t,q,ws_h,Ta_h,qq_h,rs,rl,rain,p,zi,Jcool,Jwarm, - & QH,QE,QR,TAU,Ustar,Tstar,Qstar, - & CDN,CHN,CEN,RR,RT,RQ,ZL,Zo,zot,zoq,S, - & dt_wrm,dter,T0,ts_depth,wg,TAU_r,Wbar) - - -c output results - -c frr 050328 - Monin-Obukhov Length - - If (abs(ZL).Lt.1.e-04) then - EL=10000. - else - EL=zu/ZL - endif -c -c frr write(9,200)index,xtime,hsb,hlb,tub,ts, -c frr & QH,QE,TAU,T0,Wbar,QR,rain,dter,dt_wrm,tk_pwp -c frr200 format(i4,f16.0,2f6.0,f7.3,3f7.2,f8.5,f7.2,f8.5,2f6.0,3f7.2) -c -c the following write is useful to monitor various other outputs of interest -c write(10,202)index,u,cdn,chn,cen !to check with Chris' figures -c202 format(i4,2x,f7.2,3(1pe10.2)) !take care p affects everything following - -c frr write(*,*) index -c -c frr enddo !return to beginning of loop -c frr 910 eoftag=.true. -c -c end of loop -c -c frr stop - end -c -c --------------------------------------------------------------------- - subroutine bulk_flux(sol_time,glat,zux,ztx,zusx,ztsx,Jwave,hwavex, - &twavex,ux,tsx,tx,qx,U_hs,T_hs,Q_hs,rs,rl,rainx,px,zix,Jcool,Jwarm, - & HF,EF,RF,TAU,Ustar,Tstar,Qstar, - & CD,CH,CE,RRx,RTx,RQx,ZLx,ZOx,zotx,zoqx,S, - & dt_wrmx,dterx,T0,ts_depthx,wgx,TAU_r,Wbar) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070404 BULK_FLUX -c -c --- Updates: -c -c --- V5.7 (051230) to V6.222 (070404) -c --- Modified by F. Robe -c (1) Initialize dt_wrm to avoid execution stop with some -c compilers when jwarm=0 -c -c --- V5.614 (051228) to V5.7 (051230) -c --- Modified by J. Scire -c --- (1) Minimum stress term of 0.002 N/m2 added to avoid -c unrealistic skin temperature increases -c (STI recommended change) - -c frr Need mxnx,mxny to dimension common /old/ variables (050419) - include 'params.met' - - real*8 zux,ztx,zusx,ztsx,U_hs,T_hs,Q_hs,ts_depthx - real*8 ZU,ZT,ZQ,ZUs,ZTs,ZQs,glat - real*8 ux,tsx,tx,qx,rainx,px,zix,wgx - real*8 U,TS,QS,T,Q,rl,rs,rain,p,zi,QA,S,DU_Wg,Wg,Wbar - real*8 HF,EF,TAU,RF,Ustar,Qstar,Tstar,TAU_r,ef_webb - real*8 CD,CE,CH,USR,TSR,QSR - real*8 Zox,zotx,zoqx,RRx,RTx,RQx,Zlx - real*8 ZO,zot,zoq,RR,RT,RQ,RI,zL - real*8 T0,ee,rns,rnl -c various constants - real*8 al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK,visa - real*8 visw,von,fdg -c rain heat variables - real*8 alfac,dqs_dt,dwat,dtmp -c warm layer variables -c --- COARE called for each gridpoint i.e. keep track of updates at each -c gridpoint => real arrays -c frr real*8 sol_time,newtime,time_old,ctd1,ctd2,rich - real*8 sol_time,newtime,time_old(mxnx,mxny),ctd1,ctd2,rich -c frr real*8 qcol_ac,tau_ac,tau_old,rf_old,hf_old,ef_old - real*8 qcol_ac(mxnx,mxny),tau_ac(mxnx,mxny) - real*8 tau_old(mxnx,mxny),rf_old(mxnx,mxny),hf_old(mxnx,mxny) - real*8 ef_old(mxnx,mxny) - -c frr real*8 fxp,tk_pwp,dsea,dt_wrmx,dterx,qjoule,qr_out,dtime - real*8 fxp(mxnx,mxny),tk_pwp(mxnx,mxny) - real*8 dsea,dt_wrmx,dterx,qjoule,qr_out,dtime - real*8 dt_wrm,dter,dqer,tkt - real*8 hwave,twave,hwavex,twavex - dimension jump(mxnx,mxny),jamset(mxnx,mxny) -c - COMMON /old/time_old,qcol_ac,tau_ac,tau_old,rf_old,hf_old, - & ef_old,jamset,jump,fxp,tk_pwp,index,i,j -cfrr & ef_old,jamset,jump,fxp,tk_pwp,index - COMMON/PIN/U,T,Q,TS,QS,rns,rnl,ZU,ZT,ZQ,zi,P,ID - COMMON/POUT/USR,TSR,QSR,ZO,zot,zoq,ZL,RR,RT,RQ,RI, - & dter,dqer,tkt,DU_Wg,Wg - COMMON/const/al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK, - & visa,visw,von,fdg - COMMON/wave/hwave,twave ! pass to ASL -c -c convert back variables that appear in COMMON -c - ZU=zux !height of wind measurement - ZT=ztx !height of temperature measurement - ZQ=ztx !height of water vapor measurement - ZUs=zusx !standard height of wind measurement - ZTs=ztsx !standard height of temperature measurement - ZQs=ztsx !standard height of water vapor measurement - U=ux !wind speed m/s - TS=tsx !surface temp. Celsius - T=tx !air temp. Celsius - q=qx - P=px !pressure mb - zi=zix !atmospheric boundary layer depth - hwave=hwavex - twave=twavex -c -c frr 050328 - Initialize constants (not later otherwise too late for -c warm layer calculations) -c Constants - Factors in common /const/ - al=2.1e-5*(ts+3.2)**0.79 !water thermal expansion coefft. - Beta=1.2 !Given as 1.25 in Fairall et al.(1996) - Cpa=1004.67 !J/kg/K specific heat of dry air (Businger 1982) - cpw=4000. !J/kg/K specific heat water - rhow=1022. !kg/m3 density water - Rgas=287.1 !J/kg/K gas const. dry air - toK=273.16 ! Celsius to Kelvin - visw=1.e-6 !m2/s kinematic viscosity water - Von=0.4 ! von Karman's "constant" -c fdg=1.00 ! Fairall's LKB rr to von karman adjustment - fdg=1.00 !based on results from Flux workshop August 1995 - - Rnl= 0.97*(5.67e-8*(TS+toK)**4-rl) !Net longwave (up = +) - Rns=0.945*rs !Net shortwave (into water) - rain=rainx !rainfall - ts_depth=ts_depthx !depth of sst measurement -c -c frr 050328 - no call to gravity - Rather set constant g to be consistent with -c rest of CALMET model (g=9.81 m/s2) - grav= 9.81 -c frr call gravity(glat,grav) -c grav=9.72 ! gravity equatorial value (ref. IGPP-SIO) -c -c Warm Layer -c -c --- initialize dt_wrm (070404) to avoid stop in execution with -c --- some compilers if jwarm=0 (no error in results though) - dt_wrm=0.0 - - if(Jwarm.ne.0) then - newtime=sol_time !run time in secs - if(Jwarm.eq.2) then - jump(i,j)=1 - goto 16 !set time_old and pass thru' ASL -c frr -Never too late to start otherwise, simulation is beginning-time -c dependent (CALMET starts between 0-5AM anyway) -c elseif(newtime.gt.21600.and.jump(i,j).eq.1) then -c goto 16 !6 am too late to start - elseif(newtime.lt.time_old(i,j)) then !reset all var. at midnight - jump(i,j)=0 !test threshold q morning only - jamset(i,j)=0 - fxp(i,j)=0.5 - tk_pwp(i,j)=19.0 - tau_ac(i,j)=0.0 - qcol_ac(i,j)=0.0 - dt_wrm=0.0 - goto 16 - else - rich=.65 !critical Rich. No. - ctd1=sqrt(2*rich*cpw/(al*grav*rhow)) !u*^2 integrated so - ctd2=sqrt(2*al*grav/(rich*rhow))/(cpw**1.5) !has /rhow in both - dtime=newtime-time_old(i,j) !delta time - qr_out=rnl+hf_old(i,j)+ef_old(i,j)+rf !flux out from previous pass - q_pwp=fxp(i,j)*rns-qr_out !effective net warming - if(q_pwp.lt.50.and.jamset(i,j).eq.0) go to 16 !integration threshold - jamset(i,j)=1 -c -c *** JSS - Introduce STI changes into warm layer calculation -c *** Minimum stress to prevent DT_WRM from overflow problems -c *** tau_ac(i,j)=tau_ac(i,j)+tau_old(i,j)*dtime !tau from previous pass - tau_ac(i,j)=tau_ac(i,j)+(dmax1(tau_old(i,j),0.002d0)*dtime) !tau from previous pass -c - if(qcol_ac(i,j)+q_pwp*dtime.gt.0) then - do 10 iter1=1,5 !iterate for warm layer thickness - fxp(i,j)=1.-(0.28*0.014*(1-dexp(-tk_pwp(i,j)/0.014)) - & +0.27*0.357*(1-dexp(-tk_pwp(i,j)/0.357)) - & +.45*12.82*(1-dexp(-tk_pwp(i,j)/12.82)))/tk_pwp(i,j) !solar absorb. prof - qjoule=(fxp(i,j)*rns-qr_out)*dtime -c --- DGS Change for DF compile -c if((qcol_ac(i,j)+qjoule.gt.0.0)) -c & tk_pwp(i,j)=min(19,ctd1*tau_ac(i,j)/sqrt(qcol_ac(i,j)+ -c & qjoule)) - if((qcol_ac(i,j)+qjoule.gt.0.0)) - & tk_pwp(i,j)=min(19.D0,ctd1*tau_ac(i,j)/ - & DSQRT(qcol_ac(i,j)+qjoule)) - 10 continue - else - fxp(i,j)=.76 - tk_pwp(i,j)=19 - qjoule=(fxp(i,j)*rns-qr_out)*dtime - endif -c - qcol_ac(i,j)=qcol_ac(i,j)+qjoule !integrate heat input - if(qcol_ac(i,j).gt.0) then - dt_wrm=ctd2*(qcol_ac(i,j))**1.5/tau_ac(i,j) !pwp model warming - else - dt_wrm=0. - endif - endif - if(tk_pwp(i,j).lt.ts_depth) then !sensor deeper than pwp layer - dsea=dt_wrm !all warming must be added to ts - else !warming deeper than sensor - dsea=dt_wrm*ts_depth/tk_pwp(i,j) !assume linear temperature profile - endif - ts=ts+dsea !add warming above sensor for new ts - 16 time_old(i,j)=newtime - endif -c -c end of warm layer -c - 15 call humidity(T,P,QA) !Teten's formula returns sat. air in mb - if(q.lt.2.) then !checks whether humidity in g/Kg or RH - R=q - ee=QA*R !convert from RH using vapour pressure - Q=.62197*(ee/(P-0.378*ee)) !Spec. humidity kg/kg - else - Q=q/1000. !g/kg to kg/kg - endif - QA=.62197*(QA/(P-0.378*QA)) !convert from mb to spec. humidity kg/kg - call humidity(TS,P,QS) !sea QS returned in mb - QS=QS*0.98 !reduced for salinity Kraus 1972 p. 46 - QS=.62197*(QS/(P-0.378*QS)) !convert from mb to spec. humidity kg/kg - Rnl= 0.97*(5.67e-8*(TS+toK)**4-rl) !Recompute net longwave (up = +) -c -c calculate atmospheric surface layer -c - call ASL(Jcool,Jwave,IER,index) ! pass Jwave option - - if(IER.ge.0) then -c -c compute surface stress (TAU), sensible heat flux (HF), -c latent heat flux (EF) & other parameters -c - S=sqrt(u*u + wg*wg) !velocity incl. gustiness param. - TAU=rhoa*USR*usr*u/S !kinematic units - HF=-cpa*rhoa*USR*TSR - EF=-xlv*rhoa*USR*QSR - tau_old(i,j)=tau - ef_old(i,j)=ef - hf_old(i,j)=hf -c compute heat flux due to rainfall - dwat=2.11e-5*((T+toK)/toK)**1.94 !water vapour diffusivity - dtmp=(1.+3.309e-3*T-1.44e-6*T*T)*0.02411/(rhoa*cpa) !heat diffusivity - dqs_dt=QA*xlv/(rgas*(T+toK)**2) !Clausius-Clapeyron - alfac= 1/(1+0.622*(dqs_dt*xlv*dwat)/(cpa*dtmp)) !wet bulb factor - RF= rain*alfac*cpw*((TS-T-dter*jcool)+(QS-Q-dqer)*xlv/cpa)/3600. -c compute momentum flux due to rainfall - TAU_r=0.85*rain/3600*u -c Webb correction to latent heat flux already in EF via zoq/rr function so return Wbar - Wbar=-1.61*usr*qsr/(1+1.61*q)-usr*tsr/(T+toK) -c compute transfer coefficients -c CD=(USR/S)**2 -c CH=USR*TSR/(S*(T-TS+.0098*zt+dter*jcool)) !revise 2e to 2f to include '+dter' -c CE=USR*QSR/(S*(Q-QS+dqer)) -c compute neutral transfer coefficients and met variables at standard height - CD=(0.4/dlog(zus/zo))**2 - CH=0.4*0.4/(dlog(zus/zo)*dlog(zts/zot)) - CE=0.4*0.4/(dlog(zus/zo)*dlog(zqs/zoq)) - T0=ts-dter*jcool - ihumid=0 -c Bypass attempt to accommodate q as RH. Don't have time to fix it. Bradley -c if(q .lt. 2) ihumid=1 - call h_adjust(ZUs,ZTs,ZQs,U_hs,T_hs,Q_hs,ihumid) -c ws_h=U_hs -c Ta_h=T_hs -c qq_h=Q_hs -c Convert a few things back to pass through parameter list - dterx=dter !cool skin parameters - tktx=tkt - dt_wrmx=dt_wrm !warm layer parameter - Ustar=USR -c --- Invert T*,Q* assignments otherwise tstar takes a e+92 value when -c qstar is assigned. can't find out why (common and declaration apparently -c match everywhere - I don't get it (F.Robe) 050328 -c - Qstar=QSR - Tstar=TSR - RRx=RR - RTx=RT - RQx=RQ - ZLx=ZL - Zox=Zo - zotx=zot - zoqx=zoq - wgx=wg - - else !input parameters out of range - EF=-999. - HF=-999. - TAU=-999. - TAUr=-999. - EF_webb=-999. - Ustar=-999. - Tstar=-999. - Qstar=-999. - RRx=-999. - RTx=-999. - RQx=-999. - ZLx=-999. - ZOx=-999. - ws_h=-999. - Ta_h=-999. - qq_h=-999. - wg=-999. - endif - - return !return to main program - end -c -c --------------------------------------------------------------------- - subroutine ASL(Jcool,Jwave,IER,index) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060304 ASL -c (COARE subroutine) -c (Modified by F. Robe, Earth Tech) -c -c --- Updates: -c -c --- V5.7 Level 051230 to V6.204 Level 060304 (F.Robe) -c - Convert argument of min function from single to double -c precision to avoid compiler warnings in Linux -c -c --- V5.614 (051228) to V5.7 (051230) -c --- Modified by J. Scire -c --- (1) Net absorption coefficient changed from 0.137 to 0.060 -c (STI recommended change) -c --- -c -c TO EVALUATE SURFACE FLUXES, SURFACE ROUGHNESS AND STABILITY OF -c THE ATMOSPHERIC SURFACE LAYER FROM BULK PARAMETERS BASED ON -c LIU ET AL. (79) JAS 36 1722-1735 -c - real*8 U,T,Q,TS,QS,rns,rnl,ZU,ZT,ZQ,zi,P,DU_Wg,Wg - real*8 USR,TSR,QSR,Zo,zot,zoq,ZL,RR,RT,RQ,RI,zetu,L10,L,zet -c constants - real*8 al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK,visa - real*8 visw,von,fdg,charn,psiu,psit -c cool skin quantities - real*8 wetc,bigc,be,cpv,dq,dt,dter,dqer,tkt,Bf,tcw - real*8 hsb,hlb,alq,qcol,qout,dels,xlamx,pr,du,ta -c Grachev and Fairall variables - real*8 u10,zo10,cd10,ch10,ct10,zot10,cd,ct,cc,ribcu,ribu - real*8 hwave,twave,cwave,lwave,twopi -c - COMMON/PIN/U,T,Q,TS,QS,rns,rnl,ZU,ZT,ZQ,zi,P,ID - COMMON/POUT/USR,TSR,QSR,ZO,zot,zoq,ZL,RR,RT,RQ,RI, - & dter,dqer,tkt,DU_Wg,Wg - - COMMON/const/al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK, - & visa,visw,von,fdg - COMMON/wave/hwave,twave -c -c frr 050328 - Length scale for coastal region and distance to the coast -c To compute modified Charnock parameter in shallow water -c Values of dshelf and dcoast are in kilometers. -c 050331 - Replace DSHELF with DSHELFKM - COMMON/charnock/dshelfkm,dcoast -c -c -c frr 050328: some constants and factors must be initialized sooner i.e. in -c bulk_flux -c Factors -c frr Beta=1.2 !Given as 1.25 in Fairall et al.(1996) -c frr Von=0.4 ! von Karman's "constant" -c fdg=1.00 ! Fairall's LKB rr to von karman adjustment -c frr fdg=1.00 !based on results from Flux workshop August 1995 -c frr toK=273.16 ! Celsius to Kelvin - twopi=3.14159*2. - -c Air constants and coefficients -c frr Rgas=287.1 !J/kg/K gas const. dry air - xlv=(2.501-0.00237*TS)*1e+6 !J/kg latent heat of vaporization at TS - Cpa=1004.67 !J/kg/K specific heat of dry air (Businger 1982) - Cpv=Cpa*(1+0.84*Q) !Moist air - currently not used (Businger 1982) - rhoa=P*100./(Rgas*(T+toK)*(1.+.61*Q)) !kg/m3 Moist air density ( " ) - visa=1.326e-5*(1+6.542e-3*T+8.301e-6*T*T-4.84e-9*T*T*T) !m2/s - !Kinematic viscosity of dry air - Andreas (1989) CRREL Rep. 89-11 -c -c Cool skin constants -c frr (050328): some constants are alread initialized in bulk_flux -c frr al=2.1e-5*(ts+3.2)**0.79 !water thermal expansion coefft. - be=0.026 !salinity expansion coefft. -c frr cpw=4000. !J/kg/K specific heat water -c frr rhow=1022. !kg/m3 density water -c frr visw=1.e-6 !m2/s kinematic viscosity water - tcw=0.6 !W/m/K Thermal conductivity water - bigc=16.*grav*cpw*(rhow*visw)**3/(tcw*tcw*rhoa*rhoa) - wetc=0.622*xlv*QS/(rgas*(TS+toK)**2) !correction for dq;slope of sat. vap. -c -c Wave parameters - cwave=grav*twave/twopi - lwave=cwave*twave -c -c Initial guesses -c - IER=0 - Dter=0.3*jcool !cool skin Dt - Dqer=0. !cool skin Dq - Zo=0.0001 - Wg=0.5 !Gustiness factor initial guess - tkt= 0.001 ! Cool skin thickness first guess - DU=U !assumes U is measured rel. to current - DU_Wg=(DU**2.+Wg**2.)**.5 !include gustiness in wind spd. difference - !equivalent to S in definition of fluxes - DT=Ts-T-0.0098*zt !potential temperature diff. Changed sign - DQ=Qs-Q ! from Coar2_5b -c -c **************** neutral coefficients ****************** -c - u10=DU_Wg*dlog(10/Zo)/dlog(zu/Zo) - usr=0.035*u10 - zo10=0.011*usr*usr/grav+0.11*visa/usr - Cd10=(von/dlog(10/zo10))**2 - Ch10=0.00115 - Ct10=Ch10/sqrt(Cd10) - zot10=10/dexp(von/Ct10) - Cd=(von/dlog(zu/zo10))**2 -c -c ************* Grachev and Fairall (JAM, 1997) ********** -c - Ct=von/dlog(zt/zot10) ! Temperature transfer coefficient - CC=von*Ct/Cd ! z/L vs Rib linear coefficient - Ribcu=-zu/(zi*0.004*Beta**3) ! Saturation or plateau Rib - TA=T+toK - Ribu=-grav*zu*((DT-dter)+0.61*TA*DQ)/(TA*DU_Wg**2) - if (Ribu.lt.0.) then - zetu=CC*Ribu/(1+Ribu/Ribcu) ! Unstable G and F - else - zetu=CC*Ribu*(1+27/9*Ribu/CC) ! Stable, Chris forgets origin - endif - L10=zu/zetu ! MO length - thing=psiu(zetu) -c --- frr (051214) only one iteration for all cases because the iterative -c --- process does not always converge -c -c if (zetu.gt.50) then - nits=1 -c else -c nits=3 ! number of iterations -c endif -c -c ****** First guess stability dependent scaling params. ****** -c - usr= DU_Wg*von/(dlog(zu/zo10)-psiu(zu/L10)) - tsr=-(DT-dter)*von*fdg/(dlog(zt/zot10)-psit(zt/L10)) - qsr=-(DQ-wetc*dter)*von*fdg/(dlog(zq/zot10)-psit(zq/L10)) - -c - charn=0.011 !then modify Charnock for high wind speeds Chris' data - if(DU_Wg.gt.10) charn=0.011+(0.018-0.011)*(DU_Wg-10)/(18-10) - if(DU_Wg.gt.18) charn=0.018 -c -c frr 050328 - Adjustment for shallow water - (NOT in original COARE) -c coastal (shallow water) Charnock parameter of 0.032 - if (dshelfkm.lt.0.1) then - falpha=1. - else - falpha=1.-(1.-0.032/charn)*exp(-(dcoast/dshelfkm)**4) - endif - charn=charn*falpha -c -c ******************* bulk loop ************************ -c - do 10 iter=1,nits - zet= von*grav*zu/ta*(tsr+0.61*ta*qsr)/(usr*usr) - ZL=zet - if(Jwave.eq.0) then - zo=charn*USR*USR/grav + 0.11*visa/usr !after Smith 1988 - else if(Jwave.eq.1) then - zo=(50./twopi)*lwave*(usr/cwave)**4.5+0.11*visa/usr !Oost et al. - else if(Jwave.eq.2) then - zo=1200.*hwave*(hwave/lwave)**4.5+0.11*visa/usr !Taylor and Yelland - endif - rr=zo*usr/visa -c -c *** zoq and zot fitted to results from several Chris cruises ************ -c - zoq=min(1.15d-4,5.5d-5/rr**0.6) !was 0.63, changed 15/05/01 - zot=zoq -c - L=zu/zet - psu=psiu(zu/L) - pst=psit(zt/L) - usr=DU_Wg*von/(dlog(zu/zo)-psiu(zu/L)) - tsr=-(DT-dter*jcool)*von*fdg/(dlog(zt/zot)-psit(zt/L)) - qsr=-(DQ-wetc*dter*jcool)*von*fdg/(dlog(zq/zoq)-psit(zq/L)) - - Bf=-grav/ta*usr*(tsr+0.61*ta*qsr) - if (Bf.gt.0) then - Wg=Beta*(Bf*zi)**.333 - else - Wg=0.2 - endif -c -c ********** break into coare2.5b code again ************* -c - DU_Wg=sqrt(DU**2.+Wg**2.) !include gustiness in wind spd. - hsb=-rhoa*cpa*usr*tsr - hlb=-rhoa*xlv*usr*qsr - qout=rnl+hsb+hlb -c -c *** -c *** JSS - Update constant from 0.137 to 0.06 to reflect STI changes -c *** dels=rns*(.137+11*tkt-6.6e-5/tkt*(1-dexp(-tkt/8.0e-4))) ! Eq.16 - dels=rns*(.060+11*tkt-6.6e-5/tkt*(1-dexp(-tkt/8.0e-4))) ! Eq.16 -c *** - qcol=qout-dels - alq=Al*qcol+be*hlb*cpw/xlv !Eq. 7 Buoy flux water - if(alq.gt.0.) then !originally (qcol.gt.0) - xlamx=6/(1+(bigc*alq/usr**4)**.75)**.333 !Eq 13 Saunders coeff. - else - pr=bigc*abs(alq)/usr**4 !new from Chris - if(pr.lt.1) then - xlamx=6/(1-pr**.75)**.333 !Eq 13 Saunders coeff. - else - xlamx=6. !was 30 - caused excessive warm skins - endif - endif - tkt=xlamx*visw/(sqrt(rhoa/rhow)*usr) ! Eq.11 Sublayer thickness - dter=qcol*tkt/tcw ! Eq.12 Cool skin - - - dqer=wetc*dter - 10 continue ! end Chris iterations -c - idum=index ! avoids warning on compilation - - - return !to main subroutine, bulk_flux - end -c -c --------------------------------------------------------------------- - subroutine humidity(T,P,Qsat) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 051230 HUMIDITY -c (COARE subroutine) -c -c Tetens' formula for saturation vp Buck(1981) JAM 20, 1527-1532 -c - real*8 T,P,Qsat -c - Qsat = (1.0007+3.46e-6*P)*6.1121*dexp(17.502*T/(240.97+T)) - return - end -c -c --------------------------------------------------------------------- - function psiu(zL) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 080411 PSIU -c (COARE subroutine) -c -c psiu and psit evaluate stability function for wind speed and scalars -c matching Kansas and free convection forms with weighting f -c convective form follows Fairall et al (1996) with profile constants -c from Grachev et al (2000) BLM -c stable form from Beljaars and Holtslag (1991) -c -c --- UPDATES: -c --- V6.204 Level 060304 to v6.323 Level 080411(F.Robe) -c - Remove extraneous 1. multiplication factor and exponent -c to avoid potential numerical problem -c --- V5.7 Level 051230 to V6.204 Level 060304 (F.Robe) -c - Convert argument of min function from single to double -c precision to avoid compiler warnings in Linux -c ------------------------------------------------------------------- - - real*8 zL,x,y,psik,psic,f,psiu,c - if(zL.lt.0) then - x=(1-15.*zL)**.25 !Kansas unstable - psik=2.*dlog((1.+x)/2.)+dlog((1.+x*x)/2.)-2.*atan(x)+2.*atan(1.) - y=(1.-10.15*zL)**.3333 !Convective - psic=1.5*dlog((1.+y+y*y)/3.)-sqrt(3.)*atan((1.+2.*y)/sqrt(3.)) - & +4.*atan(1.)/sqrt(3.) - f=zL*zL/(1.+zL*zL) - psiu=(1.-f)*psik+f*psic - else - c=min(50.d0,0.35d0*zL) !Stable -c psiu=-((1.+1.*zL)**1.+.6667*(zL-14.28)/dexp(c)+8.525) ---080411 - psiu=-((1.+zL)+.6667*(zL-14.28)/dexp(c)+8.525) - endif - return - end - -c --------------------------------------------------------------------- - function psit(zL) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060304 PSIT -c (COARE subroutine) -c -c --- UPDATES: -c --- V5.7 Level 051230 to V6.204 Level 060304 (F.Robe) -c - Convert argument of min function from single to double -c precision to avoid compiler warnings in Linux -c ------------------------------------------------------------------- - - real*8 zL,x,y,psik,psic,f,psit,c - if(zL.lt.0) then - x=(1-15.*zL)**.5 !Kansas unstable - psik=2.*dlog((1.+x)/2.) - y=(1.-34.15*zL)**.3333 !Convective - psic=1.5*dlog((1.+y+y*y)/3.)-sqrt(3.)*atan((1.+2.*y)/sqrt(3.)) - & +4.*atan(1.)/sqrt(3.) - f=zL*zL/(1.+zL*zL) - psit=(1.-f)*psik+f*psic - else - c=min(50.d0,0.35d0*zL) !Stable - psit=-((1.+2.*zL/3.)**1.5+.6667*(zL-14.28)/dexp(c)+8.525) - endif - return - end - -c --------------------------------------------------------------------- - subroutine ZETA(T,Q,USR,TSR,QSR,Z,ZL) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060304 ZETA -c (COARE subroutine) -C -C TO EVALUATE OBUKHOVS STABILITY PARAMETER Z/L FROM AVERAGE -C TEMP T IN DEG C, AVERAGE HUMIDITY Q IN GM/GM, HEIGHT IN M, -C AND FRICTIONAL VEL,TEMP.,HUM. IN MKS UNITS -C SEE LIU ET AL. (1979) -c -c --- UPDATES: -c --- V5.7 Level 051230 to V6.204 Level 060304 (F.Robe) -c - Convert argument of sign function from single to double -c precision to avoid compiler warnings in Linux -c ------------------------------------------------------------------- -C - real*8 T,Q,OB,TVSR,TV,TA,sgn - real*8 USR,TSR,QSR,Z,ZL - real*8 al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK,visa - real*8 visw,von,fdg - COMMON/const/al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK, - & visa,visw,von,fdg - TA=T+toK - TV=TA*(1.+0.61*Q) - TVSR=TSR*(1.+0.61*Q)+0.61*TA*QSR - sgn=sign(1.d0,tvsr) !added this to avoid program - if(abs(tvsr) .lt. 1.e-3) then !failure when TVSR is very small - tvsr=sgn*tvsr - endif - OB=TV*USR*USR/(grav*VON*TVSR) - ZL=Z/OB -c if(ZL .gt. 1000) ZL=1000. - goto 99 - 10 ZL=0. - 99 return - end - -c---------------------------------------------------------------------- - subroutine H_ADJUST(ZUs,ZTs,ZQs,U_hs,T_hs,Q_hs,IHUMID) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 051230 H_ADJUST -c (COARE subroutine) -c -c This subroutine adjusts the U,T,Q variables to the specified -c standard height (ZUs,ZTs,ZQs) using the loglayer profiles. -c The DELTA correction (adjustment) is relative to the surface -c measurement. Cronin 4/13/94 -c Modified to use new profile relations psiu,psit Bradley 26/10/99 -c - real*8 ZUs,ZTs,ZQs,U_hs,T_hs,Q_hs,ZUsL,ZTsL,ZQsL - real*8 U,T,Q,TS,QS,rns,rnl,ZU,ZT,ZQ,zi,P,PUZs,PTZs,PQZs - real*8 U_wg_hs,Rho_hs,Rho_avg,QA,Rho,P_hs,ee - real*8 USR,TSR,QSR,ZO,zot,zoq,ZL,RR,RT,RQ,RI,dter,dqer,tkt - real*8 al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK,visa - real*8 visw,von,fdg,DU_Wg,Wg,S,D,psit,psiu -c - COMMON/PIN/U,T,Q,TS,QS,rns,rnl,ZU,ZT,ZQ,zi,P,ID - COMMON/POUT/USR,TSR,QSR,ZO,zot,zoq,ZL,RR,RT,RQ,RI, - & dter,dqer,tkt,DU_Wg,Wg - COMMON/const/al,beta,cpa,cpw,grav,xlv,rhoa,rhow,rgas,toK, - & visa,visw,von,fdg -c - call ZETA(T,Q,USR,TSR,QSR,ZUs,ZUsL) - call ZETA(T,Q,USR,TSR,QSR,ZTs,ZTsL) - call ZETA(T,Q,USR,TSR,QSR,ZQs,ZQsL) - PUZs= PSIu(ZUsL) - PTZs= PSIt(ZTsL) - PQZs= PSIt(ZQsL) - - S = (dlog(ZTs/zot)-PTZs)/(von*fdg) - D = (dlog(ZQs/zoq)-PQZs)/(von*fdg) - T_hs =TSR*S +TS - dter -.0098*ZTs - Q_hs =(QSR*D + QS - dqer)*1000 - U_wg_hs = USR*(dlog(ZUs/ZO) - PUZs)/0.4 - if(U_wg_hs.ge.Wg) then - U_hs = SQRT(U_wg_hs**2 - Wg**2) - else - U_hs = U_wg_hs - endif -c - if(IHUMID.eq.1) then ! then need to convert sp hum into rh - Q_hs = Q_hs/1000 ! sh kg/kg - RHO=1./(287.*(T+273.16)*(1.+.61*Q))*P*100. - P_hs = P - (RHO*grav*(ZTs - ZT))/100 !Approx hydrost.Pressure mb - RHO_hs=1./(287.*(T_hs+273.16)*(1.+.61*Q_hs))*P_hs*100 - RHO_avg = (RHO + RHO_hs)/2 - P_hs = P -(RHO_avg*grav*(ZTs - ZT))/100 !hydrostatic Pressure - call humidity(T_hs,P_hs,QA) !Teten's formula for Pvap,sat - ee=Q_hs*P_hs/(.62197 + .378*Q_hs) !to get vapor pressure - Q_hs = ee/QA !to get relative humidity - endif - return - end -c---------------------------------------------------------------------- - Subroutine gravity(lat,g) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 051230 GRAVITY -c (COARE subroutine) -c -c calculates g as a funccton of latitude using the 1980 IUGG formula -c -c Bulletin Geodesique, Vol 62, No 3, 1988 (Geodesist's Handbook) -c p 356, 1980 Gravity Formula (IUGG, H. Moritz) -c units are in m/sec^2 and have a relative precision of 1 part -c in 10^10 (0.1 microGal) -c code by M. Zumberge. -c -c check values are: -c -c g = 9.780326772 at latitude 0.0 -c g = 9.806199203 at latitude 45.0 -c g = 9.832186368 at latitude 90.0 -c - real*8 gamma, c1, c2, c3, c4, phi, lat, g - gamma = 9.7803267715 - c1 = 0.0052790414 - c2 = 0.0000232718 - c3 = 0.0000001262 - c4 = 0.0000000007 - phi = lat * 3.14159265358979 / 180.0 - g = gamma * (1.0 - $ + c1 * ((sin(phi))**2) - $ + c2 * ((sin(phi))**4) - $ + c3 * ((sin(phi))**6) - $ + c4 * ((sin(phi))**8)) -c - return - end - -c---------------------------------------------------------------------- - function psiuD(zL) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 080411 PSIUD -c (COARE subroutine) -c -c PSIUD is similar to COARE PSIU except for a factor 16 instead of 15 -c in the Kansas unstable function x (16 should be more correct according -c to Dyer) -c psiu and psit evaluate stability function for wind speed and scalars -c matching Kansas and free convection forms with weighting f -c convective form follows Fairall et al (1996) with profile constants -c from Grachev et al (2000) BLM -c stable form from Beljaars and Holtslag (1991) -c -c --- UPDATES: -c --- V6.204 Level 060304 to v6.323 Level 080411(F.Robe) -c - Remove extraneous 1. multiplication factor and exponent -c to avoid potential numerical problem -c --- V5.7 Level 051230 to V6.204 Level 060304 (F.Robe) -c - Convert argument of min function from single to double -c precision to avoid compiler warnings in Linux -c ------------------------------------------------------------------- -c -c - real*8 zL,x,y,psik,psic,f,psiud,c - if(zL.lt.0) then -c --- COARE: 15 - Here:16 -c x=(1-15.*zL)**.25 !Kansas unstable (COARE) - x=(1-16.*zL)**.25 !Kansas unstable - psik=2.*dlog((1.+x)/2.)+dlog((1.+x*x)/2.)-2.*atan(x)+2.*atan(1.) - y=(1.-10.15*zL)**.3333 !Convective - psic=1.5*dlog((1.+y+y*y)/3.)-sqrt(3.)*atan((1.+2.*y)/sqrt(3.)) - & +4.*atan(1.)/sqrt(3.) - f=zL*zL/(1.+zL*zL) - psiud=(1.-f)*psik+f*psic - else - c=min(50.d0,0.35d0*zL) !Stable -c psiud=-((1.+1.*zL)**1.+.6667*(zL-14.28)/dexp(c)+8.525) -- 080411 - psiud=-((1.+zL)+.6667*(zL-14.28)/dexp(c)+8.525) - endif - return - end - -c---------------------------------------------------------------------- - function psitD(zL) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060304 PSITD -c (COARE subroutine) -c -c PSITD is similar to COARE PSIT except for a factor 16 instead of 15 -c in the Kansas unstable function x (16 should be more correct according -c to Dyer) -c -c --- UPDATES: -c --- V5.7 Level 051230 to V6.204 Level 060304 (F.Robe) -c - Convert argument of min function from single to double -c precision to avoid compiler warnings in Linux -c ------------------------------------------------------------------- - - - real*8 zL,x,y,psik,psic,f,psitd,c - - if(zL.lt.0) then -c x=(1-15.*zL)**.5 !Kansas unstable (COARE) - x=(1-16.*zL)**.5 !Kansas unstable - psik=2.*dlog((1.+x)/2.) - y=(1.-34.15*zL)**.3333 !Convective - psic=1.5*dlog((1.+y+y*y)/3.)-sqrt(3.)*atan((1.+2.*y)/sqrt(3.)) - & +4.*atan(1.)/sqrt(3.) - f=zL*zL/(1.+zL*zL) - psitd=(1.-f)*psik+f*psic - else - c=min(50.d0,0.35d0*zL) !Stable - psitd=-((1.+2.*zL/3.)**1.5+.6667*(zL-14.28)/dexp(c)+8.525) - endif - return - end - - -c -------------------------------------------------------------------- -ccec101006 subroutine radflx (icloud,iceil,ccgrid,iceilg,tair,irh,qlw) - subroutine radflx (mcloud,iceil,ccgrid,iceilg,tair,irh,qlw) -c -------------------------------------------------------------------- -c --- CALMET Version: 6.5.0 Level: 101006 RADFLX -c --- F.Robe -c -c --- PURPOSE: Compute downward long wave radiative -c fluxes at the surface for input to the COARE subroutine -c -c --- UPDATES: -c --- V6.222 (070404) to V6.330 (101006) (CEC) -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c -c --- V6.216 (061230) to V6.222 (070404)(F. Robe) -c - Supply observed ceiling height (iceil) and use it in -c observation mode (icloud<3) (otherwise ceiling height is -c not defined) -c -c --- V6.213 Level 060525 to V6.216 (061230) (F. Robe) -c - Put lower and upper bounds on precipitable water (wp) to -c ensure that wp is within range of applicability (and remove -c lower bound on RH) -c -c --- Version 5.6 Level 050328 to V6.213 Level 060525 (D. Strimaitis) -c - Impose a minimum RH of 1% when computing the precipitable -c water (wp) in RADFLX. IRH=0 resulted in wp=0.0, which then -c makes LOG10(wp) undefined (error stops run). -c -c --- INPUT: -c ICEIL(mxss) - integer - station ceiling height (in -c 100's ft) -c ICEILG (mxnx,mxny)- integer - ceiling height (in 100's ft) -c CCGRID(mxnx,mxny) - real - Fractional Cloud cover -c ICEILG (mxnx,mxny)- integer - Gridded prognostic ceiling height -c (in 100's ft) -c TAIR (mxnx,mxny) - real - Surface air temperature (K) -c IRH (mxnx,mxny) - integer - Surface relative humidity (%) -c -c -c --- OUTPUT: -c qLW(mxnx,mxny) - real - Downward (not net) long wave -c rad. flux at the surface (W/m2) -c -c -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'grid.met' - - real ccgrid(mxnx,mxny) - real qlw(mxnx,mxny),tair(mxnx,mxny) - integer iceilg(mxnx,mxny),irh(mxnx,mxny) - integer iceil(mxss) -c - -c -c DOWNWARD LONG WAVE RADIATIVE FLUX(qLW) - do j=1,ny - do i=1,nx - -ccec101006 if (icloud.ge.3) then - if (mcloud.ge.3) then - jceil=iceilg(i,j) - else - jceil=iceil(nears(i,j)) - endif - -c --- clear sky: QLW=epsa*sigb*Tair**4, with -c sigb: Stefan Boltzman constant (5.67 e-8) -c epsa: atm. longwave emissivity -c epsa=0.725+0.17log10(wp), -c wp: precipitable water in cm, varies between 0.1 and 5 cm -c see MM5 techincical notes (TN 398-June 1994) -c precipitable water in cm as a function of Rel Hum (decimal=>rh/100) -c and air temp (in K)- http://www.uswcl.ars.ag.gov/exper/relhum.htm - rh=irh(i,j)*0.01 - -c --- 060525 Place a 1% floor on RH here -c rh=AMAX1(.01,rh) -c --- 061230 Put bounds on wp to keep wp within range of applicability -c (0.1< wp < 5cm) rather than putting bound on RH - wp=0.439*rh*exp(26.23-5416/Tair(i,j))/Tair(i,j) - wp = max(wp,0.1) - wp = min(wp,5.) - - qlw(i,j)=(0.725+0.17*log10(wp))*5.67e-8 * Tair(i,j)**4 - -c --- Cloud enhancement factor: Clw -c clw=c1*n1+c2*n2+c3*n3, (MM5 technical note TN-398 - June 1994) -c with ci = enhancement factor for cloud layer i -c ni = cloud fraction of low (below 800mb), -c middle(800-450mb), high level clouds(> 450mb) -c ni=function of RH in that layer - Not available (only surface RH) -c attribute all the cloud cover (ccgrid) to the layer where the -c ceiling height (jceil) is - jceil is in 100's feet -c 800mb ~ 1950m ~ 6400ft (ICAO standard Atmosphere) -c 450mb ~ 6400m ~ 21000ft - rn1=0. - rn2=0. - rn3=0. - if (jceil.lt.64 ) then - rn1=ccgrid(i,j) - else if (jceil.le.210) then - rn2=ccgrid(i,j) - else if (jceil.gt.210 )then - rn3=ccgrid(i,j) - endif - - clw=0.26*rn1+0.22*rn2 + 0.006*rn3 - qlw(i,j)=qlw(i,j)*(1+clw) - end do - end do - - - return - end -c---------------------------------------------------------------------- - subroutine wind1 -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070717 WIND1 -c Earth Tech Inc -c -c -c --- UPDATES: -c -c --- V6.223 Level 070702 to V6.3 (070717) -c - Add IPSIFCN to SIMILT argument list -c -c --- V5.6 Level 050328 to V6.223 Level 070702(Frr): -c - Correct index of xowsta and xusta (results are affected -c only if barriers) -c - only readjust extrapolation weights for valid calm wind data -c (results were correct before because no weight was given -c to unvalid data but ws10 was not defined in that case which -c might cause execution to stop with some compilers) -c - Update roughness legnth and log profile coefficients for surface -c stations located on a water gridcell -c -c -c V5.55 Level 050217 to V5.6 Level 050328 (Frr): -c - Extrapolate surface wind measurements from anemometer height -c to first CALMET level (land and overwater stations) using -c the user defined extrapolation method (iextrp) or a neutral -c log profile if iextrp=1 (no vertical extrapolation) -c -c - Use wind-speed dependent z0 overwater rather than the fixed -c value set in GEO.DAT -c -c --- V5.548a Level 050101 to V5.55 Level 050217 (F.Robe) -c - Skip call to barier if nbar=0 -c -c --- V5.548 Level 041101 to V5.548a Level 050101 (F.Robe) -c - Include D3.MET (kbar no longer in wparm.met) -c -c --- Level 000602 to V5.548 Level 041101 (F.Robe) -c - Implement barriers up to level k=KBAR -c -c --- Previous Updates: -c --- DG Strimaitis, SRC -c --- M. Fernau, SRC/ETCO added separate land/water sites -c J. Chang. -- The first-guess wind field is obtained -c by straight 1/r^2 interpolation. -c profiling is disabled. -c F.Robe--Vertically varying weights for horizontal -c interpolation of vertically extrapolated -c surface observations and upper air observed -c winds -c G. Moore--- made sure simult is not called with missing -c data, added d4 include and use of editl -c F. Robe - Use of temporary arrays for the extrapolated -c surface winds. -c - Option not to extrapolate surface calm winds -c aloft -c - 7/11/97: bug corrected r2 redefined as xr2 to -c avoid conflicts with WPARM -c J. Scire- Modified 8/25/97 to add anem. ht. fix & checks -c F. Robe for missing sounding data -c J. Scire- Corrects power law extrapolation (6/2000) -c -c --- PURPOSE: Creates spatially-varying first-guess wind field -c by interpolating upper air and surface observations -c (both use 1/r^2 weighting). -c -c --- INPUTS: -c -c common/GRID/ --- -c NX - integer - No. X grid cells -c NY - integer - No. Y grid cells -c NZ - integer - No. vertical layers -c ZFACE(MXNZP1) - real array - cell face hts. -c ZMID(MXNZ) - real array - center cell hts. (m) -c -c common/WPARM/ --- -c IEXTRP - integer - Flag for vertical interpolation -c BIAS(mxnz) - real array - Factors modifying weights of -c surface and upper air stations -c (-1 <= BIAS <= +1) -- negative -c BIAS reduces weight of upper air -c stations, zero BIAS leaves -c weights unchanged, positive -c BIAS reduces weights of surface -c stations -c ICALM - integer - Flag to vertically extrapolate -c calm winds or not -c IPSIFCN - integer - Flag controlling choice of PSI -c stability correction for wind -c profile -c (IPSIFCN=0 use CALMET v5.6; -c IPSIFCN=1 use CALMET v5.53) -c common /D3/ -c KBAR - integer - Level up to which barriers are applied -c -c common/MET1/ --- -c NSSTA - integer - No. surface landwind stations -c NUSTA - integer - No. upper air wind stations -c XSSTA(mxss), YSSTA(mxss) - real - Surface station coordinates (m) -c relative to grid origin -c XUSTA(mxss), YUSTA(mxss) - real - Upper air station coordinates (m) -c relative to grid origin -c ZANEM (MXSS) - real array - Anemometer height at sf stations -c XORIGR, YORIGR - real - Reference coordinates (m) -c of grid origin -c - -c common/OVRWAT/ --- -c NOWSTA - integer - No. over water wind stations -c ZOWSTA(MXOWS) - real array - Anemometer height (m) of overwater -c stations -c ZLOGWSTA(MXOWS) - real array - Adjustement coefficient from anenometer -c Height to 1st CALMET level (neutral -c profile used if abs(iextrp)=1) -c Z0OW(MXOWS) - real array - overwater roughness length -c -c common/GEO/ --- -c z0(mxnx,mxny) - real array - Roughness length -c -c common/D1/ --- -c US(MXNZ,MXWND) - real array - U component of observed wind, -c assigned to vertical layers -c VS(MXNZ,MXWND) - real array - V component of observed wind, -c assigned to vertical layers -c HTOPO(MXNX,MXNY) - real array - Gridded terrain hts (m) MSL -c -c FEXTRP(mxnz) - real array - user input multiplicative factors -c (vertical interpolation) -c -c --- OUTPUT: -c -c common/D1/ --- -c UG(MXNX,MXNY,MXNZ) - real array - U component of 1st guess wind, -c assigned to cells -c VG(MXNX,MXNY,MXNZ) - real array - V component of 1st guess wind, -c assigned to cells -c --- TEMPORARY ARRAYS -c USTMP(MXNZ,MXWND) - real array - U component of vertically -c extrapolated surface obs. or -c upper air obs. -c VSTMP(MXNZ,MXWND) - real array - V component of vertically -c extrapolated surface obs -c upper air obs. -c WS10(MXWND) - real array - Surface wind speed -c -c--- CALLS TO SUBROUTINE: -c -c SIMILT - vertical extrapolation of sfc winds using similarity -c theory -c -c---------------------------------------------------------------------- -c - include 'params.met' - include 'grid.met' - include 'wparm.met' - include 'met1.met' - include 'd1.met' - include 'd3.met' - include 'd4.met' - include 'ovrwat.met' - include 'geo.met' - - real rsqwt(mxwnd) - real ws10(mxwnd) - real ustmp(mxnz,mxwnd),vstmp(mxnz,mxwnd) - real zzanem(mxwnd),zlog(mxwnd) - real xst(mxwnd),yst(mxwnd) - -c vertically varying weights - real vvw(mxnz,mxwnd) - - data z0min/2.0e-6/ - - -c VERTICALLY VARYING BIASES -c -1<=bias<0: bias towards vertically extrapolated sfc obs. -c 0 use the first one for first calmet level (050328-frr) -c do k=2,nz - do k=nz,1,-1 - ustmp(k,l)=ustmp(1,l)*fextrp(k) - vstmp(k,l)=vstmp(1,l)*fextrp(k) - end do - endif - -c --similarity theory (assuming neutral conditions -c and infinite mixing length) - if(iabs(iextrp).eq.4)then -c --assumed Monin-Obukov length (neutral) - zmo=10000. -c --assumed mixing length - zml=10000. - - if (l.le.nssta) then -c --- if land station use z0 at gridpoint closest to station - isc=ist(l) - jsc=jst(l) - if(isc.gt.nx)isc=nx - if(isc.lt.1)isc=1 - if(jsc.gt.ny)jsc=ny - if(jsc.lt.1)jsc=1 - zr=z0(isc,jsc) - else -c --- overwater station: use current z0 (function of wind speed) -c --- rather than the fixed constant from GEO.DAT (050328) - zr=z0ow(l-nssta) - endif - - call similt(zzanem(L),zmo,zr,zml,l,ipsifcn, - & ustmp,vstmp,zml) - - endif - -666 continue - -c -- done vertically extrapolating sf station winds - - -c-- Loop over i,j cells in the CALMET grid -c - dgridi=1.0/dgrid - do i=1,nx - do j=1,ny - -c -- compute bulk weights (based on 1/R^2 interpolation) - - xc=FLOAT(i)-0.5 - yc=FLOAT(j)-0.5 - -c ---Compute the combined 1/r**2 weights - sumwt = 0.0 -c --loop over all the stations - do l=1,nstat -c --land surface stations: - if (l.le.nssta) then - xr2=(xssta(l)*dgridi-xc)**2 + - & (yssta(l)*dgridi-yc)**2 -c --water surface stations: - else if (l.le.(nssta+nowsta)) then - xr2=(xowsta(l - nssta)*dgridi-xc)**2 + - & (yowsta(l - nssta)*dgridi-yc)**2 -c --upper air stations: - else - iu=l-nssta-nowsta - xr2=(xusta(iu)*dgridi-xc)**2 + - & (yusta(iu)*dgridi-yc)**2 - endif - if(xr2 .LT. 1.0) then - wgt=1.0 - else - wgt=1.0/xr2 - endif - -c --check for valid data (surface) - if (l.le.(nssta+nowsta))then - if((us(1,L).gt.editl).or.(vs(1,L).gt.editl))wgt=0. - end if - - sumwt=sumwt+wgt - rsqwt(l)=wgt - end do -c --Normalize the weights. - sumwt=1.0/sumwt - do l=1,nstat - rsqwt(l)=rsqwt(l)*sumwt - end do -c --done computing bulk weights - -c VVW -- vertically varying weights: biased towards -c -- vertically interpolated sfc obs. or upper air obs. - -c -- first compute sum of bulk sfc and upper weights - sumwsfold=0. - sumwupold=0. - do l=1,nssta+nowsta - sumwsfold=sumwsfold+rsqwt(l) - end do - do l=nssta+nowsta+1,nstat - sumwupold=sumwupold+rsqwt(l) - end do - -c -- loop over nz levels: - do k=1,nz -c -- either bias towards upper air observations (bias>0) - if(bias(k).ge.0.) then - beta=(1.-bias(k)) - gamma=(bias(k)+(1.-bias(k))*sumwupold)/sumwupold -c -- or bias toward vert. extrapolated sfc obs. (bias<0) - else - beta=(-bias(k)+(1.+bias(k))*sumwsfold)/sumwsfold - gamma=(1.+bias(k)) - endif - -c --compute the vertically varying weights: -c ----surface stations: - do l=1,nssta+nowsta - vvw(k,l)=beta*rsqwt(l) - end do -c ----upper stations: - do l=nssta+nowsta+1,nstat - vvw(k,l)=gamma*rsqwt(l) - end do - end do -c ---end loop over NZ levels -c - -c - If ICALM=0, no weight aloft to vertically extrapolated surface calm winds -c - Readjust the weights for other stations at each level - IF (ICALM.EQ.0) THEN - do l=1,nssta+nowsta -c --- only readjust for valid data (070702) - - if((us(1,L).lt.editl).and.(vs(1,L).lt.editl)) then - if (ws10(l).lt.0.0001)then - do k=2,nz -c --- if only partial weight of station with calm winds - if (vvw(k,l).lt.0.9999) then - do ll=1,nstat - if (ll.ne.l) vvw(k,ll)=vvw(k,ll)/(1.-vvw(k,l)) - end do -c --- if full weight (i.e.only surface station with valid data -c --- interpolate upper air data only (1/R**2) - else - do ll=nssta+nowsta+1,nstat - vvw(k,ll)=rsqwt(ll)/(1.-rsqwt(l)) - end do - endif - vvw(k,l)=0. - end do - endif - endif - end do - ENDIF - -c FRR (8/25/97) -c - If missing value at an upper air station, recompute the weights -c level by level for the other stations accordingly -c (should occur only at the surface and only if same name for surface and -c upper stations, hence do not throw the whole sounding away) - -c - Readjust the weights for other stations at each level - do 222 k=1,nz -c --- only if some weight on upper air stations at that level - if (bias(k).gt.-0.9999) then - do l=nssta+nowsta+1,nstat - if ((ustmp(k,l).gt.editl).or.(vstmp(k,l).gt.editl))then -c --- stop if only data available at that level (should -c --- never happen) - if (vvw(k,l).eq.1.)then - write(io6,*)'ERROR in SUBR. WIND1' - write(io6,*)'No valid observation at level: ', k - stop - endif - do ll=1,nstat - if (ll.ne.l) vvw(k,ll)=vvw(k,ll)/(1.-vvw(k,l)) - end do - vvw(k,l)=0. - endif - end do - endif -222 continue -c FRR -END (8/25/97) - - if(nbar.le.0) goto 91 - -c --- Barriers: recompute weights if station shielded by barrier (041101 -FRR) -c --- Do it for all stations (surface, ovw, upper air) -c ---- First get the gridpoint locations in km, relative to grid origin - x=(float(i)-0.5)*dgrid*0.001 - y=(float(j)-0.5)*dgrid*0.001 - - - do 223 l=1,nstat - ok=1. - call barier (x,y,xst(l),yst(l),ok) - if (ok.le.0) then -c --- barrier in the way - discard the station for all levels below -c and up to kbar (041101) - do k=1,kbar -c --- stop if only data available at that level - if (vvw(k,l).eq.1.)then - write(io6,*)'ERROR in SUBR. WIND1' - write(io6,*)'No valid observation at level: ', k - write(io6,*)'For gridpoint (i,j)=', i,j - write(io6,*)'Check barrier set-up' - stop 'STOP in WIND1 - Check list file' - endif - do ll=1,nstat - if (ll.ne.l) vvw(k,ll)=vvw(k,ll)/(1.-vvw(k,l)) - end do - vvw(k,l)=0. - end do - endif -223 continue - -91 continue - -c -- done computing the vertically varying weights - -c -- Compute first guess winds at all levels -c - do k=1,nz - unext=0.0 - vnext=0.0 - do l=1,nstat - unext=unext+vvw(k,l)*ustmp(k,l) - vnext=vnext+vvw(k,l)*vstmp(k,l) - end do - ug(i,j,k)=unext - vg(i,j,k)=vnext - end do - enddo - enddo - -c-- End loop over i,j cells in the CALMET grid - - return - end -c---------------------------------------------------------------------- - subroutine windbc(u,v,ub,vb,k) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 940304 WINDBC -c -c --- include parameters - include 'params.met' -c -c NEW frr (12/96) D5 replaced by grid.met - include 'grid.met' -c COMMON /D5/ NX,NY,NZ,DX,DY,dz(mxnz),NZPRNT - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*) - DIMENSION UB(mxny,2,*),VB(mxnx,2,*) -C -C SETS BOUNDARY CONDITIONS FOR WIND FIELDS -C NO INFLOW - NO OUTFLOW BOUNDARY CONDITIONS ARE USED -C -C INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C K (I) - VERTICAL LEVEL INDEX -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -C OUTPUTS: UB (R ARRAY) - U-COMPONENT BOUNDARY VALUES -C VB (R ARRAY) - V-COMPONENT BOUNDARY VALUES -C -C -C SET BOUNDARY VELOCITIES -C - DO 100 J=1,NY - UB(J,1,K)=U(1,J,K) - UB(J,2,K)=U(NX,J,K) - 100 CONTINUE - DO 200 I=1,NX - VB(I,1,K)=V(I,1,K) - VB(I,2,K)=V(I,NY,K) - 200 CONTINUE - RETURN - END -c---------------------------------------------------------------------- - subroutine windpr(u,v,w) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 940304 WINDPR -c -C --- PURPOSE: PRINT OUT WIND FIELD AT EACH LAYER . -C -c --- UPDATES: -c --- (940304) to V5.6 (050328) (FRR) -c - explicit common replaced by include d6.met (frr 040630) -c -C INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -C W (R ARRAY) - GRIDDED VERTICAL WIND COMPONENTS -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -C -c --------------------------------------------------------------------- -c --- include parameters - include 'params.met' -c -c NEW frr (12/96) D5 replaced by grid.met - include 'grid.met' - include 'd6.met' -c COMMON /D6/ IRD,IWR,IFILE,irdp - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*) - DIMENSION W(mxnx,mxny,*) -C - - DO 100 K=1,NZ - IF(K.EQ.1) GO TO 50 - KM = K-1 - if(iwr.gt.0)WRITE(IWR,30) KM,K - if(iwr.gt.0)WRITE(IWR,12) - CALL WNDLPT(W(1,1,K)) - 50 if(iwr.gt.0)WRITE(IWR,10) K - if(iwr.gt.0)WRITE(IWR,11) - CALL WNDLPT(U(1,1,K)) - if(iwr.gt.0)WRITE(IWR,20) K - if(iwr.gt.0)WRITE(IWR,11) - CALL WNDLPT(V(1,1,K)) - 100 CONTINUE - RETURN - 10 FORMAT(/,5X,'X-COMPONENT OF WIND (U) AT LEVEL = ',I4,5X,'(M/SEC)') - 11 FORMAT(5X,49('-')) - 12 FORMAT(5X,59('-')) - 20 FORMAT(/,5X,'Y-COMPONENT OF WIND (V) AT LEVEL = ',I4,5X,'(M/SEC)') - 30 FORMAT(/,5X,'Z-COMPONENT OF WIND (W) BETWEEN LEVELS',I4, - 1' & ',I2,5X,'(M/SEC)') - END -c---------------------------------------------------------------------- - subroutine wndlpt(grid) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 WNDLPT -c -c -c --- PURPOSE: CREATE A NUMBER MAP OF THE ARRAY 'GRID' SCALED BY FACTOR -c -c --- UPDATES: -c --- V5.6 (050328 - FRR) :xplicit common replaced by include d6.met -c -C -C --- INPUTS: GRID (R ARRAY) - GRIDDED ARRAY OF SOME VARIABLE -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -c -c ------------------------------------------------------------------------- -c --- include parameters - include 'params.met' -c - CHARACTER*1 V - CHARACTER*3 H - DIMENSION H(100) - DIMENSION GRID(mxnx,*) - COMMON /D2/ MAP(mxnx,mxny), WORK2(3) - include 'grid.met' - include 'd6.met' -c COMMON /D6/ IRD,IWR,IFILE,irdp -C - DATA V/'I'/, ICCM /1/ - DATA H /100*'--+'/ - VMAX = 0.0 - DO 10 J=1,NY - DO 10 I=1,NX - VAL = ABS(GRID(I,J)) - VMAX = AMAX1(VAL,VMAX) - 10 CONTINUE - IF(VMAX.EQ.0..and.iwr.gt.0) WRITE(IWR,995) - IF(VMAX.EQ.0.) RETURN - IF(VMAX.LT.10.) GO TO 30 - IF(VMAX.GE.100.) GO TO 40 - FACTOR = 1.00 - GO TO 50 - 30 DO 35 I = 1,20 - FACTOR = 10.**(I) - IFX = IFIX(FACTOR*VMAX) - IF(IFX.GE.10 ) GO TO 50 - 35 CONTINUE - RETURN - 40 DO 45 I = 1,20 - FACTOR = 10.**(-I) - IFX = IFIX(FACTOR*VMAX) - IF(IFX.LT.100 ) GO TO 50 - 45 CONTINUE - RETURN - 50 CONTINUE - DO 60 I=1,NX - DO 60 J=1,NY - VAL = GRID(I,J)*FACTOR - IF(VAL.GT.0.) MAP(I,J) = IFIX( VAL + 0.50) - IF(VAL.LT.0.) MAP(I,J) = IFIX( VAL - 0.50) - IF(VAL.EQ.0.) MAP(I,J) = 0 - 60 CONTINUE - IL = 1 - IR = MIN0(NX,36) - IR = MAX0(IR,1) - JT = 1 - JB = MIN0(NY,36) - JB = MAX0(JB,1) - IRL = IR*ICCM - if(iwr.gt.0)WRITE(IWR,1000) (I,I=IL,IRL,ICCM) - if(iwr.gt.0)WRITE(IWR,1002) V, (H(I),I=IL,IR) - DO 70 J=JT,JB - K = JB - J + JT - JRM = (K-1)*ICCM + 1 - if(iwr.gt.0)WRITE(IWR,1003) JRM,V,(MAP(I,K),I=IL,IR) - 70 CONTINUE - IF (NX .LE. 36) GO TO 80 - IL=37 - IR=MIN0(NX,72) - JT=1 - JB=MIN0(NY,36) - JB=MAX0(JB,1) - IRL=IR*ICCM - if(iwr.gt.0)WRITE(IWR,1000)(I,I=IL,IRL,ICCM) - if(iwr.gt.0)WRITE(IWR,1002) V,(H(I),I=IL,IR) - DO 90 J=JT,JB - K=JB-J+JT - JRM=(K-1)*ICCM+1 - if(iwr.gt.0)WRITE(IWR,1003) JRM,V,(MAP(I,K),I=IL,IR) - 90 CONTINUE - 80 CONTINUE - if(iwr.gt.0)WRITE(IWR,1004) FACTOR - RETURN - 995 FORMAT(/,9X,'FIELD CONTAINS ALL ZEROS - PRINTING SUPPRESSED') - 1000 FORMAT(/,7X,38I3) - 1002 FORMAT(6X,A1,38A3) - 1003 FORMAT(3X,I2,1X,A1,38I3) - 1004 FORMAT(/,9X,'ARRAY HAS BEEN SCALED BY',E9.1,' FOR PRINTING') - END -c---------------------------------------------------------------------- - subroutine wndpr2(u,v) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 WNDPR2 -c -c -c --- PURPOSE: PRINT OUT U & V WIND FIELD AT EACH LAYER -c -c --- UPDATES: -c --- V5.6 (040630 -FRR) :explicit common replaced by include d6.met -c -C --- INPUTS: U (R ARRAY) - GRIDDED X-DIRECTION WIND COMPONENTS -C V (R ARRAY) - GRIDDED Y-DIRECTION WIND COMPONENTS -c Parameters: MXNX, MXNY, MXNZ, MXNZP1 -c -c--------------------------------------------------------------------- -c --- include parameters - include 'params.met' -c - include 'grid.met' - include 'd6.met' -c COMMON /D6/ IRD,IWR,IFILE,irdp - DIMENSION U(mxnx,mxny,*),V(mxnx,mxny,*) -C - DO 100 K=1,NZ - if(iwr.gt.0)WRITE(IWR,10) K - if(iwr.gt.0)WRITE(IWR,11) - CALL WNDLPT(U(1,1,K)) - if(iwr.gt.0)WRITE(IWR,20) K - if(iwr.gt.0)WRITE(IWR,11) - CALL WNDLPT(V(1,1,K)) - 100 CONTINUE - RETURN - 10 FORMAT(//,5X,'X-COMPONENT OF WIND (U) AT LEVEL = ',I4,5X, - 1 '(M/SEC)') - 11 FORMAT(5X,49('-')) - 12 FORMAT(5X,57('-')) - 20 FORMAT(//,5X,'Y-COMPONENT OF WIND (V) AT LEVEL = ',I4,5X, - 1 '(M/SEC)') - END -c---------------------------------------------------------------------- - subroutine wrt(form1,form2,jj,iout,sign,n,io6) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 WRT -c --- J. Scire, SRC -c -c --- PURPOSE: Write one Y row of gridded data -c -c --- INPUTS: -c FORM1 - Char.*24 - Format field for Y label and data -c to be printed -c FORM2 - Char.*21 - Format field for sign of data -c JJ - Integer - Y grid cell number -c IOUT(N) - Int. array - Array of data to be printed -c (one Y row) -c SIGN(N) - Char.*1 - Array containing sign of data -c ('+' or '-') -c N - Integer - Number of cells in this row -c IO6 - Integer - Fortran unit no. of output -c -c --- OUTPUT: none -c -c --- WRT called by: OUT -c --- WRT calls: none -c---------------------------------------------------------------------- - integer iout(n) -c - character*1 sign(n) - character*24 form1 - character*21 form2 -c - write(io6,form1)jj,iout - write(io6,form2)sign -c - return - end -c---------------------------------------------------------------------- - subroutine wrt2(form,n1,n2,io6) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 901130 WRT2 -c --- J. Scire, SRC -c -c --- PURPOSE: Write a line labeling grid cell numbers -c -c --- INPUTS: -c FORM - Char.*18 - Format field of data to be printed -c N1 - Integer - Starting grid cell number -c N2 - Integer - Ending grid cell number -c IO6 - Integer - Fortran unit no. of output -c -c --- OUTPUT: none -c -c --- WRT2 called by: OUT -c --- WRT2 calls: none -c---------------------------------------------------------------------- - character*18 form -c - write(io6,form)(i,i=n1,n2) - return - end -c---------------------------------------------------------------------- - subroutine wrti1d(iomet,idat,nwords,clabel,ndathrb,ibsec, - : ndathre,iesec) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060215 WRTI1D -c --- J. Scire, SRC -c -c --- PURPOSE: Write "NWORDS" of a one-dimensional integer array -c -c --- UPDATES: -c - 901130 to V6.2 Level 060215 (F.Robe) -c - Replace hour-ending date by explicit beginning/ending times -c with seconds - -c --- INPUTS: -c IOMET - integer - Fortran unit number of output file -c IDAT(nwords) - integer array - Array to output -c NWORDS - integer - Number of words to write -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning Date and time of data -c (YYYYJJJHH) (explicit time) -c IBSEC - integer - Beginning Second of data (SSSS) -c NDATHRE - integer - Ending Date and time of data -c (YYYYJJJHH) (explicit time) -c IESEC - integer - Ending Second of data (SSSS) -c -c --- OUTPUT: none -c -c --- WRTI1D called by: OUTHR -c --- WRTI1D calls: none -c---------------------------------------------------------------------- - integer idat(nwords) - character*8 clabel -c - write(iomet)clabel,ndathrb,ibsec,ndathre,iesec,idat - return - end -c---------------------------------------------------------------------- - subroutine wrti2d(iomet,idat,ibuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,ibsec,ndathre,iesec) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060215 WRTI2D -c --- J. Scire, SRC -c -c --- PURPOSE: Write NX * NY words of a 2-D integer array -c -c --- UPDATES: -c - 901130 to V6.2 Level 060215 (F.Robe) -c - Replace hour-ending date by explicit beginning/ending times -c with seconds -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of output file -c IDAT(mxnx,mxny) - integer array - Array to output -c IBUF(nx,ny) - integer array - Buffer to hold data for output -c MXNX,MXNY - integers - Dimensions of data array -c NX,NY - integers - Actual size of grid to output -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning Date and time of data -c (YYYYJJJHH) (explicit time) -c IBSEC - integer - Beginning Second of data (SSSS) -c NDATHRE - integer - Ending Date and time of data -c (YYYYJJJHH) (explicit time) -c IESEC - integer - Ending Second of data (SSSS) -c -c -c --- OUTPUT: none -c -c --- WRTI2D called by: OUTHD, OUTHR -c --- WRTI2D calls: none -c---------------------------------------------------------------------- - integer idat(mxnx,mxny),ibuf(nx,ny) - character*8 clabel -c - if(nx.eq.mxnx.and.ny.eq.mxny)then -c -c --- entire array is being used -- write full grid - write(iomet)clabel,ndathrb,ibsec,ndathre,iesec,idat - else -c -c --- only a portion of grid being used -- transfer to buffer -c --- and write - do 10 i=1,nx - do 10 j=1,ny - ibuf(i,j)=idat(i,j) -10 continue -c - write(iomet)clabel,ndathrb,ibsec,ndathre,iesec,ibuf - endif -c - return - end -c---------------------------------------------------------------------- - subroutine wrtr1d(iomet,x,nwords,clabel, - : ndathrb,ibsec,ndathre,iesec) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060215 WRTR1D -c --- J. Scire, SRC -c -c --- PURPOSE: Write "NWORDS" of a one-dimensional real array -c -c -c --- UPDATES: -c - 901130 to V6.2 Level 060215 (F.Robe) -c - Replace hour-ending date by explicit beginning/ending times -c with seconds -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of output file -c X(nwords) - real array - Array to output -c NWORDS - integer - Number of words to write -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning Date and time of data -c (YYYYJJJHH) (explicit time) -c IBSEC - integer - Beginning Second of data (SSSS) -c NDATHRE - integer - Ending Date and time of data -c (YYYYJJJHH) (explicit time) -c IESEC - integer - Ending Second of data (SSSS) -c -c --- OUTPUT: none -c -c --- WRTR1D called by: OUTHD, OUTHR -c --- WRTR1D calls: none -c---------------------------------------------------------------------- - real x(nwords) - character*8 clabel -c - write(iomet)clabel,ndathrb,ibsec,ndathre,iesec,x - return - end -c---------------------------------------------------------------------- - subroutine wrtr2d(iomet,x,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,ibsec,ndathre,iesec) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060215 WRTR2D -c --- J. Scire, SRC -c -c --- PURPOSE: Write NX * NY words of a 2-D real array -c -c -c --- UPDATES: -c - 901130 to V6.2 (060215) (F. Robe) -c - Hour-ending dates replaced by explicit beginning/ending -c dates with seconds -c --- INPUTS: -c IOMET - integer - Fortran unit number of output file -c X(mxnx,mxny) - real array - Array to output -c XBUF(nx,ny) - real array - Buffer to hold data for output -c MXNX,MXNY - integers - Dimensions of data array -c NX,NY - integers - Actual size of grid to output -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning Date and time of data -c (YYYYJJJHH) (explicit time) -c IBSEC - integer - Beginning Second of data (SSSS) -c NDATHRE - integer - Ending Date and time of data -c (YYYYJJJHH) (explicit time) -c IESEC - integer - Ending Second of data (SSSS) -c -c --- OUTPUT: none -c -c --- WRTR2D called by: OUTHD, OUTHR -c --- WRTR2D calls: none -c---------------------------------------------------------------------- - real x(mxnx,mxny),xbuf(nx,ny) - character*8 clabel -c - if(nx.eq.mxnx.and.ny.eq.mxny)then -c -c --- entire array is being used -- write full grid - write(iomet)clabel,ndathrb,ibsec,ndathre,iesec,x - else -c -c --- only a portion of grid being used -- transfer to buffer -c --- and write - do 10 i=1,nx - do 10 j=1,ny - xbuf(i,j)=x(i,j) -10 continue -c - write(iomet)clabel,ndathrb,ibsec,ndathre,iesec,xbuf - endif -c - return - end -c---------------------------------------------------------------------- - subroutine wstarr(ziconv,qh,temp2d,rho,ilandu,iwat1,iwat2, - 1 nx,ny,wstar) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 050328 WSTARR -c --- J. Scire, SRC -c Modified by F.Robe, Earth Tech, for 2D array of rho -c and prognostic temp (ITPROG) -c -c --- PURPOSE: Calculate the convective velocity scale, w*, (m/s) -c at each grid point (LAND CELLS ONLY) -c -c --- UPDATES: -c --- Level 901130 to V5.6 Level 050328 (frr) -c - Remove NEARS from calling list -c - Use gridded surface temperature array (temp2d) rather -c than tempk,tprog -c -c --- INPUTS: -c ZICONV(mxnx,mxny) - real array - Convective mixing height (m) -c QH(mxnx,mxny) - real array - Sensible heat flux (W/m**2) -c TEMP2D(mxnx,mxny) - real array - Surface air temperature (deg. K) -c RHO(mxnx,mxny) - real array - Air density (kg/m**3) -c ILANDU(mxnx,mxny) - integer array - Land use category at each -c grid point -c IWAT1, IWAT2 - integers - Range of land use categories -c defining water (IWAT1 to IWAT2) -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c Parameters: MXNX, MXNY, MXSS, MXNZ -c -c --- OUTPUT: -c WSTAR(mxnx,mxny) - real array - Convective velocity scale (m/s) -c -c --- WSTARR called by: COMP -c --- WSTARR calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real ziconv(mxnx,mxny),qh(mxnx,mxny),wstar(mxnx,mxny) - real temp2d(mxnx,mxny),rho(mxnx,mxny) - integer ilandu(mxnx,mxny) -c - data cp/996./,g/9.81/ -c - do 100 i=1,nx - do 100 j=1,ny -c -c --- skip water cells - if(ilandu(i,j).ge.iwat1.and.ilandu(i,j).le.iwat2)go to 100 -c - if(qh(i,j).le.0.0)then -c - wstar(i,j)=0.0 - else - wstar(i,j)=(g*qh(i,j)*ziconv(i,j)/ - : (temp2d(i,j)*rho(i,j)*cp))**0.3333333 - endif -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine xmit(n,a,b) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 940304 XMIT -C - DIMENSION A(*),B(*) -C -C IF N >= 0 XMIT FILLS ARRAY B WITH ARRAY A -C IF N < 0 XMIT FILLS ARRAY B WITH VALUE A -C -C INPUT: A (R ARRAY) - VALUE OR ARRAY OF VALUES USED TO -C INITIALIZE ARRAY B -C OUTPUT: B (R ARRAY) - INITIALIZED ARRAY -C - IF(N) 100,120,120 - 100 K=IABS(N) - DO 110 I=1,K - B(I)=A(1) - 110 CONTINUE - RETURN - 120 DO 130 I=1,N - B(I)=A(I) - 130 CONTINUE - RETURN - END -c---------------------------------------------------------------------- - subroutine outpc1(lecho,nyr,idystr,ihrmax,nssta,nusta,imax,jmax, - 1 ibtz,ilwf,iuwf,dgrid,vk,xscoor,yscoor,xucoor,yucoor, - 2 z0,nears,ilandu) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 941101 OUTPC1 -c J. Scire, SRC -c -c --- PURPOSE: Write the MESOPAC II header records in the REVISED -c format -c -c --- INPUTS: -c LECHO - logical - Control variable for output of -c header record information -c NYR - integer - Year of start of run -c IDYSTR - integer - Julian day of start of run -c IHRMAX - integer - Number of hours in run -c NSSTA - integer - Number of surface met. stations -c NUSTA - integer - Number of upper air met. stations -c IMAX - integer - Number of grid points in X dir. -c JMAX - integer - Number of grid points in Y dir. -c IBTZ - integer - Reference time zone -c ILWF - integer - Lower-level wind field code -c (2=mixed-layer averaged winds) -c IUWF - integer - Upper-level wind field code -c (4=mixed-layer to 700 mb ht. ave.) -c DGRID - real - Grid spacing (m) -c VK - real - von Karman constant (0.40) -c XSCOOR(mxss) - real array - Surface met. station X coordinates -c (met. grid units) -c YSCOOR(mxss) - real array - Surface met. station Y coordinates -c (met. grid units) -c XUCOOR(mxus) - real array - Upper air station X coordinates -c (met. grid units) -c YUCOOR(mxus) - real array - Upper air station Y coordinates -c (met. grid units) -c Z0(mxnx,mxny) - real array - Surface roughness lengths (m) -c NEARS(mxnx,mxny)- real array - Station number of closest surface -c station to each grid point -c ILANDU(mxnx,mxny)-real array - Land use categories -c -c Parameters: -c MXNX, MXNY, IO6, IO7 -c -c --- OUTPUT: None -c -c --- OUTPC1 called by: SETUP -c --- OUTPC1 calls: WPCR2D, WPCI2D, OUT -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - real xscoor(nssta),yscoor(nssta),xucoor(nusta),yucoor(nusta) - real z0(mxnx,mxny),xbuf(mxnx,mxny) -c - integer nears(mxnx,mxny),ilandu(mxnx,mxny) - logical lecho,ldate - character*70 messag -c - write(io7)nyr,idystr,ihrmax,nssta,nusta,imax,jmax,ibtz, - 1 ilwf,iuwf,dgrid,vk - write(io7)xscoor,yscoor - if (nusta .gt. 0) write(io7)xucoor,yucoor - call wpcr2d(io7,z0,xbuf,mxnx,mxny,imax,jmax) - call wpci2d(io7,nears,xbuf,mxnx,mxny,imax,jmax) - call wpci2d(io7,ilandu,xbuf,mxnx,mxny,imax,jmax) -c - if(lecho)then - write(io6,1202) -1202 format(//1x,13('----------')//) - write(io6,*) - write(io6,*)' Data written to PACOUT meteorological data file' - write(io6,*) - write(io6,*)' NYR = ',nyr - write(io6,*)' IDYSTR = ',idystr - write(io6,*)' IHRMAX = ',ihrmax - write(io6,*)' NSSTA = ',nssta - write(io6,*)' NUSTA = ',nusta - write(io6,*)' IMAX = ',imax - write(io6,*)' JMAX = ',jmax - write(io6,*)' IBTZ = ',ibtz - write(io6,*)' ILWF = ',ilwf - write(io6,*)' IUWF = ',iuwf - write(io6,*)' DGRID = ',dgrid - write(io6,*)' VK = ',vk - write(io6,*)' XSCOOR = ',xscoor - write(io6,*)' YSCOOR = ',yscoor - write(io6,*)' XUCOOR = ',xucoor - write(io6,*)' YUCOOR = ',yucoor -c - ldate=.false. - messag='Surface roughness lengths (m)' - messag(63:64)='Z0' - call out(z0,idum,1,5,ldate,messag,imax,jmax) -c - messag='Nearest surface station no. to each grid point' - messag(63:67)='NEARS' - call out(xdum,nears,2,5,ldate,messag,imax,jmax) -c - messag='Land use categories' - messag(63:68)='ILANDU' - call out(xdum,ilandu,2,5,ldate,messag,imax,jmax) - endif -c - return - end -c---------------------------------------------------------------------- - subroutine outpc(lecho,kyr,kjul,khr,ul,vl,uup,vup,htmix,ustar, - 1 wstar,xmonin,ipgt,rmm,avrho,tempk,srad,irh,ipcode, - 2 imax,jmax,nssta) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 030402 OUTPC -c J. Scire, SRC -c -c --- PURPOSE: Write the MESOPAC II data records in the REVISED -c format -c -c --- UPDATE -c --- V5.4 (940419) to V5.5 (030402) (DGS) -c - Add list-file unit to GRDAY call -c -c --- INPUTS: -c LECHO - logical - Control variable for output of -c header record information -c KYR - integer - Year -c KJUL - integer - Julian day -c KHR - integer - Hour -c UL(mxnx,mxny) - real array - Lower-layer U wind components (m/s) -c VL(mxnx,mxny) - real array - Lower-layer V wind components (m/s) -c UUP(mxnx,mxny) - real array - Upper-layer U wind components (m/s) -c VUP(mxnx,mxny) - real array - Upper-layer V wind components (m/s) -c HTMIX(mxnx,mxny) - real array - Mixing heights (m) -c USTAR(mxnx,mxny) - real array - Surface friction velocities (m/s) -c WSTAR(mxnx,mxny) - real array - Convective velocity scale (m/s) -c XMONIN(mxnx,mxny) - real array - Monin-Obukhov lengths (m) -c IPGT(mxnx,mxny) - int. array - Stability class array -c RMM(mxnx,mxny) - real array - Precipitation rates (mm/hr) -c AVRHO - real - Average air density (kg/m**3) -c TEMPK(nssta) - real array - Air temperature (deg. K) -c SRAD(nssta) - real array - Solar radiation (W/m**2) -c IRH(nssta) - int. array - Relative humidity (percent) -c IPCODE(nssta) - int. array - Precipitation codes at surface met. -c stations -c IMAX - integer - Number grid cells in X direction -c JMAX - integer - Number grid cells in Y direction -c NSSTA - integer - Number of surface met. stations -c Parameters: -c MXNX, MXNY, IO6, IO7 -c -c --- OUTPUT: None -c -c --- OUTPC called by: COMP -c --- OUTPC calls: WPCR2D, WPCI2D, GRDAY, OUT -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - real ul(mxnx,mxny),vl(mxnx,mxny),uup(mxnx,mxny),vup(mxnx,mxny) - real htmix(mxnx,mxny),ustar(mxnx,mxny),wstar(mxnx,mxny) - real xmonin(mxnx,mxny),rmm(mxnx,mxny) - real tempk(nssta),srad(nssta) - real xbuf(mxnx,mxny) -c - integer ipgt(mxnx,mxny) - integer irh(nssta),ipcode(nssta) -c - logical lecho,ldate - character*70 messag -c -c --- Write a set of revised MESOPAC II data records for one hour - write(io7)kyr,kjul,khr -c - call wpcr2d(io7,ul,xbuf,mxnx,mxny,imax,jmax) - call wpcr2d(io7,vl,xbuf,mxnx,mxny,imax,jmax) -c - call wpcr2d(io7,uup,xbuf,mxnx,mxny,imax,jmax) - call wpcr2d(io7,vup,xbuf,mxnx,mxny,imax,jmax) -c - call wpcr2d(io7,htmix,xbuf,mxnx,mxny,imax,jmax) - call wpcr2d(io7,ustar,xbuf,mxnx,mxny,imax,jmax) -c - call wpcr2d(io7,wstar,xbuf,mxnx,mxny,imax,jmax) - call wpcr2d(io7,xmonin,xbuf,mxnx,mxny,imax,jmax) -c - call wpci2d(io7,ipgt,xbuf,mxnx,mxny,imax,jmax) -c - call wpcr2d(io7,rmm,xbuf,mxnx,mxny,imax,jmax) -c - write(io7)avrho,tempk,srad,irh,ipcode -c - if(lecho)then - write(io6,1202) -1202 format(//1x,13('----------')//) - write(io6,*) - write(io6,*)' Data written to PACOUT meteorological data file' - write(io6,*) - write(io6,*)' KYR = ',kyr - write(io6,*)' KJUL = ',kjul - write(io6,*)' KHR = ',khr -c - ldate=.true. - call grday(io6,kyr,kjul,kmo,kday) -c - messag='Lower-layer U winds (m/s)' - messag(63:64)='UL' - call out(ul,idum,1,5,ldate,messag,imax,jmax) -c - messag='Lower-layer V winds (m/s)' - messag(63:64)='VL' - call out(vl,idum,1,5,ldate,messag,imax,jmax) -c - messag='Upper-layer U winds (m/s)' - messag(63:65)='UUP' - call out(uup,idum,1,5,ldate,messag,imax,jmax) -c - messag='Upper-layer V winds (m/s)' - messag(63:65)='VUP' - call out(vup,idum,1,5,ldate,messag,imax,jmax) -c - messag='Mixing heights (m)' - messag(63:67)='HTMIX' - call out(htmix,idum,1,5,ldate,messag,imax,jmax) -c - messag='Friction velocity (m/s)' - messag(63:67)='USTAR' - call out(ustar,idum,1,5,ldate,messag,imax,jmax) -c - messag='Convective velocity scale (m/s)' - messag(63:67)='WSTAR' - call out(wstar,idum,1,5,ldate,messag,imax,jmax) -c - messag='Monin-Obukhov length (m)' - messag(63:68)='XMONIN' - call out(xmonin,idum,1,5,ldate,messag,imax,jmax) -c - messag='Stability class' - messag(63:66)='IPGT' - call out(xdum,ipgt,2,2,ldate,messag,imax,jmax) -c - messag='Precipitation rate (mm/hr)' - messag(63:65)='RMM' - call out(rmm,idum,1,5,ldate,messag,imax,jmax) -c - write(io6,*) - write(io6,*)' AVRHO (kg/m**3) = ',avrho - write(io6,*)' TEMPK (deg. K) = ',tempk - write(io6,*)' SRAD (W/m**2) = ',srad - write(io6,*)' IRH (percent) = ',irh - write(io6,*)' IPCODE = ',ipcode - endif -c - return - end -c---------------------------------------------------------------------- - subroutine wpcr2d(iomet,x,xbuf,mxnx,mxny,nx,ny) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 930906 WPCR2D -c J. Scire, SRC -c -c --- PURPOSE: Write NX * NY words of a 2-D real array -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of output file -c X(mxnx,mxny) - real array - Array to output -c XBUF(nx,ny) - real array - Buffer to hold data for output -c MXNX,MXNY - integers - Dimensions of data array -c NX,NY - integers - Actual size of grid to output -c -c --- OUTPUT: none -c -c --- WPCR2D called by: OUTPC1, OUTPC -c --- WPCR2D calls: none -c---------------------------------------------------------------------- - integer mxnx,mxny,nx,ny,iomet - real x(mxnx,mxny),xbuf(nx,ny) -c - if(nx.eq.mxnx.and.ny.eq.mxny)then -c -c --- entire array is being used -- write full grid - write(iomet)x - else -c -c --- only a portion of grid being used -- transfer to buffer -c --- and write - do 10 i=1,nx - do 10 j=1,ny - xbuf(i,j)=x(i,j) -10 continue -c - write(iomet)xbuf - endif -c - return - end -c---------------------------------------------------------------------- - subroutine wpci2d(iomet,idat,ibuf,mxnx,mxny,nx,ny) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 930906 WPCI2D -c J. Scire, SRC -c -c --- PURPOSE: Write NX * NY words of a 2-D integer array -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of output file -c IDAT(mxnx,mxny) - integer array - Array to output -c IBUF(nx,ny) - integer array - Buffer to hold data for output -c MXNX,MXNY - integers - Dimensions of data array -c NX,NY - integers - Actual size of grid to output -c -c --- OUTPUT: none -c -c --- WPCI2D called by: OUTPC1, OUTPC -c --- WPCI2D calls: none -c---------------------------------------------------------------------- - integer idat(mxnx,mxny),ibuf(nx,ny) -c - if(nx.eq.mxnx.and.ny.eq.mxny)then -c -c --- entire array is being used -- write full grid - write(iomet)idat - else -c -c --- only a portion of grid being used -- transfer to buffer -c --- and write - do 10 i=1,nx - do 10 j=1,ny - ibuf(i,j)=idat(i,j) -10 continue -c - write(iomet)ibuf - endif -c - return - end -c---------------------------------------------------------------------- - subroutine pacave(u,v,htmix,zface,nx,ny,nz,ztop,zincr, - 1 ul,vl,uup,vup) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 930906 PACAVE -c --- J. Scire, SRC -c -c --- PURPOSE: Calculate vertically-averaged winds in two layers: -c (1) Ground to mixing height (lower layer) -c (2) mixing height to fixed height "ZTOP", or -c mixing height + ZINCR, whichever is greater -c -c -c --- INPUTS: -c U(mxnx,mxny,mxnz) - real array - U wind components (m/s) -c V(mxnx,mxny,mxnz) - real array - V wind components (m/s) -c HTMIX(mxnx,mxny) - real array - Mixing heights (m) -c ZFACE(mxnzp1) - real array - Heights (m) of cell faces -c NX - integer - Number of X grid points -c NY - integer - Number of Y grid points -c NZ - integer - Number of vertical layers -c ZTOP - real - Top of upper layer (m) -c ZINCR - real - Increment above mixing height -c defining minimum thickness of -c the upper layer (m) -c -c --- OUTPUT: -c UL(mxnx,mxny) - real array - Lower-layer vertically averaged -c U wind components (m/s) -c VL(mxnx,mxny) - real array - Lower-layer vertically averaged -c V wind components (m/s) -c UUP(mxnx,mxny) - real array - Upper-layer vertically averaged -c U wind components (m/s) -c VUP(mxnx,mxny) - real array - Upper-layer vertically averaged -c V wind components (m/s) -c -c Parameters: MXNX, MXNY, MXNZ, MXNZP1, IO6 -c -c --- PACAVE called by: COMP -c --- PACAVE calls: none -c---------------------------------------------------------------------- -c -c --- Include parameters - include 'params.met' -c - real u(mxnx,mxny,mxnz),v(mxnx,mxny,mxnz),htmix(mxnx,mxny) - real zface(mxnzp1),dz(mxnz) - real ul(mxnx,mxny),vl(mxnx,mxny) - real uup(mxnx,mxny),vup(mxnx,mxny) - real worku(mxnz),workv(mxnz) -c - nzp1=nz+1 -c -c --- Compute cell depths - do 5 k=1,nz - dz(k)=(zface(k+1)-zface(k)) -5 continue -c -c --- LOOP OVER GRID CELLS - do 100 i=1,nx - do 100 j=1,ny -c -c --- Define top of lower layer - zi=amax1(htmix(i,j),10.0) -c -c --- Define top of upper layer - zztop=amax1(ztop,20.0,htmix(i,j)+zincr) -c -c --- Check for problems with inputs - if(zztop.gt.zface(nzp1))then - write(io6,902) -902 format(/1x,'ERROR in Subr. PACAVE -- ZZTOP > top cell ', - 1 'face height') - write(io6,*)'ZZTOP = ',zztop - write(io6,*)'ZTOP = ',ztop,' HTMIX = ',htmix(i,j),' I = ',i, - 1 ' J = ',j,' ZINCR = ',zincr - write(io6,*)'ZFACE = ',(zface(n),n=1,nzp1) - stop - endif -c -c --- Transfer data to work arrays, make all values positive - do 10 k=1,nz - worku(k)=u(i,j,k) - workv(k)=v(i,j,k) -10 continue -c -c --- Compute mixed-layer averaged winds -c --- NOTE: It is assumed that the CALMET winds are layer-averages -c --- over the depth of each cell - sumu=0.0 - sumv=0.0 - sumz=0.0 -c - ksav=0 - do 20 k=1,nz -c - if(zface(k+1).lt.zi)then -c -c --- CALMET layer is completely within the mixed-layer - sumu=sumu+dz(k)*worku(k) - sumv=sumv+dz(k)*workv(k) - sumz=sumz+dz(k) - else -c -c --- CALMET layer extends to or above mixed-layer - delz=zi-zface(k) - sumu=sumu+delz*worku(k) - sumv=sumv+delz*workv(k) - sumz=sumz+delz - ksav=k - go to 22 - endif -20 continue -c -c --- This should only be reached if ZI > zface(nz+1) - write(io6,*)'ERROR in Subr. PACAVE -- After 20 continue -- ', - 1 'ZI = ',zi,' ZFACE(nz+1) = ',zface(nz+1),' NZ = ',nz - stop -22 continue -c -c --- LOWER LAYER WINDS - ul(i,j)=sumu/sumz - vl(i,j)=sumv/sumz -c -c --- Compute average winds in layer from mixing height to ZZTOP - sumu=0.0 - sumv=0.0 - sumz=0.0 -c -c --- If mixing ht. > ZZTOP, use CALMET layer above zztop for -c --- upper layer winds - if(zface(ksav+1).gt.zztop)then -c -c --- ZI > ZZTOP -- use CALMET winds in layer above ZI - uup(i,j)=worku(ksav) - vup(i,j)=workv(ksav) - go to 100 - else -c -c --- Average over layers between ZI and ZZTOP - delz=zface(ksav+1)-zi - sumu=delz*worku(ksav) - sumv=delz*workv(ksav) - sumz=delz -c - kk=ksav+1 - if(kk.gt.nz)go to 42 - do 40 k=kk,nz -c - if(zface(k+1).lt.zztop)then -c -c --- CALMET layer is completely within upper layer - sumu=sumu+dz(k)*worku(k) - sumv=sumv+dz(k)*workv(k) - sumz=sumz+dz(k) - else -c -c --- CALMET layer extends to or beyond ZZTOP - delz=zztop-zface(k) - sumu=sumu+delz*worku(k) - sumv=sumv+delz*workv(k) - sumz=sumz+delz - go to 42 - endif -40 continue -c -c --- This section of code should never be reached - write(io6,*)'ERROR in Subr. PACAVE -- After 20 continue -- ', - 1 'ZI = ',zi,' ZFACE(nz+1) = ',zface(nz+1),' NZ = ',nz - stop -42 continue -c -c --- UPPER LAYER WINDS - uup(i,j)=sumu/sumz - vup(i,j)=sumv/sumz - endif -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine readfn(igroup,nusta,nowsta,nm3d,nigf) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 121203 READFN -c J. Scire, SRC -c -c --- PURPOSE: Read one or more groups of file names for the -c input and output files of the run -c -c --- UPDATES -c -c --- v6.205 (060309) to v6.4.0 (121203) -c - Allow 999 M3D files (from 99) -c -c --- v5.711 (060106) to v6.205 (060309) (DGS): -c - change filenames from c*70 to c*132 -c -c --- V5.6 (050328) to v5.711 (060106) (FRR): -c - read IGF-CALMET filenames -c -c --- V5.547(041010) to V5.6 (050328) (FRR): -c - read distance-to-coast filename -c -c --- V5.1(991104) to V5.547 (041010) (FRR): -c - read multiple MM4/MM5 /3D filenames - -c -c --- V5.0-V5.1 991104 (JSS): Error messages written to list file -c in addition to screen -c -c --- INPUTS: -c -c IGROUP - integer - Group of file to be read -- the 1st -c group includes the CALMET.LST file. -c The other groups are read AFTER the -c control file is read, since the number -c of files read depends on the variables -c NUSTA and NOWSTA -c NUSTA - integer - Number of upper air stations (an -c input variable if IGROUP=2) -c NOWSTA - integer - Number of overwater stations (an -c input variable if IGROUP=2) -c nm3d - integer - Number of MM5 files in 3D.DAT format -c input variable if IGROUP=2) -c NIGF - integer - Number of IGF-CALMET files -c (an input variable if IGROUP=2) -c -c Parameters: MXUS, MXOWS, mxm3d, mxigf,IO5, IO6 -c -c --- OUTPUT: -c NUSTA - integer - Number of upper air stations (an -c output variable if IGROUP=1) -c NOWSTA - integer - Number of overwater stations (an -c output variable if IGROUP=1) -c nm3d - integer - Number of MM5 files in 3D.DAT format -c input variable if IGROUP=1) -c nigf - integer - Number ofIGF-CALMET.DAT files -c (an input variable if IGROUP=1) -c -c -c -c --- Common block /FILNAM/ variables: -c metinp,geodat,srfdat,prcdat,diadat,prgdat,mm4dat, -c wtdat,updat,seadat,metlst,metdat,pacdat,tstprt, -c tstout,tstkin,tstfrd,tstslp,lcfiles,clddat,m3ddat,dcstgd -c -c --- READFN called by: SETUP -c --- READFN calls: READIN, FILCASE -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.met' -c - character*4 ctemp(132,11) -c frr 060106 cvdic (15,6) instead of (14,5) for multiple IGFDAT.DAT - character*12 cvdic(15,6) - integer ivleng(15,6),ivtype(15,6) - logical lecho -c -c --- Include common blocks - include 'filnam.met' -c - data lecho/.false./ - data cvdic/'METINP','GEODAT','SRFDAT','PRCDAT','MM4DAT','WTDAT', - 1 'METLST','METDAT','PACDAT','CLDDAT','LCFILES','NUSTA','NOWSTA', - 1 'NM3D','NIGF', - 2 'UPDAT',14*' ', - 3 'SEADAT',14*' ', - 4 'M3DDAT',14*' ', - 5 'IGFDAT',14*' ', - 6 'DIADAT','PRGDAT','TSTPRT','TSTOUT','TSTKIN','TSTFRD', - 6 'TSTSLP','DCSTGD',7*' '/ - data ivleng/10*132,5*1, - 2 132,14*0, - 3 132,14*0, - 4 132,14*0, - 5 132,14*0, - 6 8*132,7*0/ - data ivtype/10*4,3,2,2,2,2, - 2 4,14*0, - 3 4,14*0, - 4 4,14*0, - 5 4,14*0, - 6 8*4,7*0/ -c -c --- Read the file names from the data file -c - if(igroup.eq.1)then -c -c --- Initialize the UPn.DAT , SEAn.DAT , MM5n.DAT and IGFn.DAT filenames - do i=1,mxus - if(i.lt.10)then - updat(i)='up .dat' - write(updat(i)(3:3),'(I1)')i - else if(i.lt.100)then - updat(i)='up .dat' - write(updat(i)(3:4),'(I2)')i - else - write(*,*)'ERROR IN SUBR. READFN -- Too many upper ', - 1 'air data files for open format -- i = ',I - write(io6,*)'ERROR IN SUBR. READFN -- Too many upper ', - 1 'air data files for open format -- i = ',i - stop - endif - enddo -c - do i=1,mxows - if(i.lt.10)then - seadat(i)='sea .dat' - write(seadat(i)(4:4),'(I1)')i - else if(i.lt.100)then - seadat(i)='sea .dat' - write(seadat(i)(4:5),'(I2)')i - else - write(*,*)'ERROR IN SUBR. READFN -- Too many ', - 1 'overwater data files for open format -- i = ',I - write(io6,*)'ERROR IN SUBR. READFN -- Too many ', - 1 'overwater data files for open format -- i = ',i - stop - endif - enddo -c -c --- Multiple MM5 files (041010) - FRR - do i=1,mxm3d - if(i.lt.10)then - m3ddat(i)='mm5 .dat' - write(m3ddat(i)(4:4),'(I1)')i - else if(i.lt.100)then - m3ddat(i)='mm5 .dat' - write(m3ddat(i)(4:5),'(I2)')i -c --- v6.4.0, Level 121203 - else if(i.lt.1000)then - m3ddat(i)='mm5 .dat' - write(m3ddat(i)(4:6),'(I3)')i - else - write(*,*)'ERROR IN SUBR. READFN -- Too many ', - 1 'MM5 files for open format -- i = ',I - write(io6,*)'ERROR IN SUBR. READFN -- Too many ', - 1 'MM5 files for open format -- i = ',i - stop - endif - enddo - -c --- Multiple IGF files (060106) - FRR - do i=1,mxigf - if(i.lt.10)then - igfdat(i)='igf .dat' - write(igfdat(i)(4:4),'(I1)')i - else if(i.lt.100)then - igfdat(i)='igf .dat' - write(igfdat(i)(4:5),'(I2)')i - else - write(*,*)'ERROR IN SUBR. READFN -- Too many ', - 1 'IGF-CALMET files for open format -- i = ',I - write(io6,*)'ERROR IN SUBR. READFN -- Too many ', - 1 'IGF-CALMET files for open format -- i = ',i - stop - endif - enddo - -c --- Initialize the temporary arrays - do i=1,10 - do j=1,132 - ctemp(j,i)(1:1)=' ' - enddo - enddo -c -c --- Initialize number of MM4-5 files to 0 so it has the correct -c value if old CALMET.INP file (pre-multiple MM5.DAT ) -041010 - nm3d=0 -c --- Same for IGF-CALMET fiels - nigf=0 -c --- Read the file names for Group #0(a) - - call readin(cvdic(1,1),ivleng(1,1),ivtype(1,1),io5,io6,lecho, - 1 ctemp(1,1),ctemp(1,2),ctemp(1,3),ctemp(1,4),ctemp(1,5), - 2 ctemp(1,6),ctemp(1,7),ctemp(1,8),ctemp(1,9),ctemp(1,10), - 3 lcfiles,nusta,nowsta,nm3d,nigf, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 7 idum,idum,idum,idum,idum,idum,idum,idum,idum) -c -c --- Prepare filenames that are in I/O file by erasing default -c --- characters set above - if(ctemp(1,1)(1:1).ne.' ')metinp=' ' - if(ctemp(1,2)(1:1).ne.' ')geodat=' ' - if(ctemp(1,3)(1:1).ne.' ')srfdat=' ' - if(ctemp(1,4)(1:1).ne.' ')prcdat=' ' - if(ctemp(1,5)(1:1).ne.' ')mm4dat=' ' - if(ctemp(1,6)(1:1).ne.' ')wtdat =' ' - if(ctemp(1,7)(1:1).ne.' ')metlst=' ' - if(ctemp(1,8)(1:1).ne.' ')metdat=' ' - if(ctemp(1,9)(1:1).ne.' ')pacdat=' ' - if(ctemp(1,10)(1:1).ne.' ')clddat=' ' -c -c --- Transfer the char*4 data into the char*132 variables - do j=1,132 - if(ctemp(j,1)(1:1).ne.' ')metinp(j:j)=ctemp(j,1)(1:1) - if(ctemp(j,2)(1:1).ne.' ')geodat(j:j)=ctemp(j,2)(1:1) - if(ctemp(j,3)(1:1).ne.' ')srfdat(j:j)=ctemp(j,3)(1:1) - if(ctemp(j,4)(1:1).ne.' ')prcdat(j:j)=ctemp(j,4)(1:1) - if(ctemp(j,5)(1:1).ne.' ')mm4dat(j:j)=ctemp(j,5)(1:1) - if(ctemp(j,6)(1:1).ne.' ')wtdat (j:j)=ctemp(j,6)(1:1) - if(ctemp(j,7)(1:1).ne.' ')metlst(j:j)=ctemp(j,7)(1:1) - if(ctemp(j,8)(1:1).ne.' ')metdat(j:j)=ctemp(j,8)(1:1) - if(ctemp(j,9)(1:1).ne.' ')pacdat(j:j)=ctemp(j,9)(1:1) - if(ctemp(j,10)(1:1).ne.' ')clddat(j:j)=ctemp(j,10)(1:1) - enddo -c -c --- Convert the file names to the proper case - call filcase(lcfiles,metinp) - call filcase(lcfiles,geodat) - call filcase(lcfiles,srfdat) - call filcase(lcfiles,prcdat) - call filcase(lcfiles,mm4dat) - call filcase(lcfiles,wtdat) - call filcase(lcfiles,metlst) - call filcase(lcfiles,metdat) - call filcase(lcfiles,pacdat) - call filcase(lcfiles,clddat) - -c - else -c -c --- Read filename Subgroups 0(b),(c), (d) , (e) & (f) -c -c --- Upper air stations - if(nusta.lt.0.or.nusta.gt.mxus)then - write(io6,*)'ERROR in Subr, READFN -- Invalid value of ', - 1 'NUSTA -- NUSTA = ',nusta,' MXUS = ',MXUS - stop - endif -c - do i=1,nusta -c -c --- Initialize the temporary arrays - do j=1,132 - ctemp(j,1)(1:1)=' ' - enddo -c -c --- Read the file names for Upper air Station "i" - call readin(cvdic(1,2),ivleng(1,2),ivtype(1,2),io5,io6, - 1 lecho,ctemp(1,1), - 2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum) -c -c --- Prepare filenames that are in I/O file by erasing default -c --- characters set above - if(ctemp(1,1)(1:1).ne.' ')updat(i)=' ' -c -c --- Transfer the char*4 data into the char*132 variables - do j=1,132 - if(ctemp(j,1)(1:1).ne.' ')updat(i)(j:j)=ctemp(j,1)(1:1) - enddo -c -c --- Convert the file names to the proper case - call filcase(lcfiles,updat(i)) - enddo -c -c --- Overwater stations - if(nowsta.lt.0.or.nowsta.gt.mxows)then - write(io6,*)'ERROR in Subr, READFN -- Invalid value of ', - 1 'NOWSTA -- NOWSTA = ',nowsta,' MXOWS = ',MXOWS - stop - endif -c - do i=1,nowsta -c -c --- Initialize the temporary arrays - do j=1,132 - ctemp(j,1)(1:1)=' ' - enddo -c -c --- Read the file names for Overwater Station "i" - call readin(cvdic(1,3),ivleng(1,3),ivtype(1,3),io5,io6, - 1 lecho,ctemp(1,1), - 2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum) -c -c --- Prepare filenames that are in I/O file by erasing default -c --- characters set above - if(ctemp(1,1)(1:1).ne.' ')seadat(i)=' ' -c -c --- Transfer the char*4 data into the char*132 variables - do j=1,132 - if(ctemp(j,1)(1:1).ne.' ')seadat(i)(j:j)=ctemp(j,1)(1:1) - enddo -c -c --- Convert the file names to the proper case - call filcase(lcfiles,seadat(i)) - enddo -c -c --- Multiple MM4-5 files in 3D.DAT format - if(nm3d.lt.0.or.nm3d.gt.mxm3d)then - write(io6,*)'ERROR in Subr, READFN -- Invalid value of ', - 1 'nm3d -- nm3d = ',nm3d,' mxm3d = ',mxm3d - stop - endif -c - do i=1,nm3d -c -c --- Initialize the temporary arrays - do j=1,132 - ctemp(j,1)(1:1)=' ' - enddo -c -c --- Read the file names for MM5 file "i" - call readin(cvdic(1,4),ivleng(1,4),ivtype(1,4),io5,io6, - 1 lecho,ctemp(1,1), - 2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum) -c -c --- Prepare filenames that are in I/O file by erasing default -c --- characters set above - if(ctemp(1,1)(1:1).ne.' ')m3ddat(i)=' ' -c -c --- Transfer the char*4 data into the char*132 variables - do j=1,132 - if(ctemp(j,1)(1:1).ne.' ')m3ddat(i)(j:j)=ctemp(j,1)(1:1) - enddo -c -c --- Convert the file names to the proper case - call filcase(lcfiles,m3ddat(i)) - enddo -c -c frr 050328- -c --- Transfer MM4DAT to m3ddat(1) if MM4DAT is defined in old CALMET.INP file -c --- (pre-multiple MM5.DAT) - if ((nm3d.eq.0) . and. (mm4dat(1:1).ne.' ')) then - m3ddat(1)=mm4dat - nm3d=1 - endif - -c --- 060106 (IGF-CALMET fiels) -c --- Multiple IGF-CALMET files - if(nigf.lt.0.or.nigf.gt.mxigf)then - write(io6,*)'ERROR in Subr, READFN -- Invalid value of ', - 1 'nigf -- nigf = ',nigf,' mxigf = ',mxigf - stop - endif -c - - do i=1,nigf -c -c --- Initialize the temporary arrays - do j=1,132 - ctemp(j,1)(1:1)=' ' - enddo -c -c --- Read the file names for IGF-CALMET file "i" - call readin(cvdic(1,5),ivleng(1,5),ivtype(1,5),io5,io6, - 1 lecho,ctemp(1,1), - 2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum) -c -c --- Prepare filenames that are in I/O file by erasing default -c --- characters set above - if(ctemp(1,1)(1:1).ne.' ')igfdat(i)=' ' -c -c --- Transfer the char*4 data into the char*132 variables - do j=1,132 - if(ctemp(j,1)(1:1).ne.' ')igfdat(i)(j:j)=ctemp(j,1)(1:1) - enddo -c -c --- Convert the file names to the proper case - call filcase(lcfiles,igfdat(i)) - enddo -c - - -c --- Filename Subgroup (f) -c -c --- Initialize the temporary arrays - do i=1,8 - do j=1,132 - ctemp(j,i)(1:1)=' ' - enddo - enddo -c -c --- Read the file names for Subgroup (f) - call readin(cvdic(1,6),ivleng(1,6),ivtype(1,6),io5,io6,lecho, - 1 ctemp(1,1),ctemp(1,2),ctemp(1,3),ctemp(1,4),ctemp(1,5), - 2 ctemp(1,6),ctemp(1,7),ctemp(1,8), - 3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum, - 7 idum,idum,idum,idum) -c -c --- Prepare filenames that are in I/O file by erasing default -c --- characters set above - - if(ctemp(1,1)(1:1).ne.' ')diadat=' ' - if(ctemp(1,2)(1:1).ne.' ')prgdat=' ' - if(ctemp(1,3)(1:1).ne.' ')tstprt=' ' - if(ctemp(1,4)(1:1).ne.' ')tstout=' ' - if(ctemp(1,5)(1:1).ne.' ')tstkin=' ' - if(ctemp(1,6)(1:1).ne.' ')tstfrd=' ' - if(ctemp(1,7)(1:1).ne.' ')tstslp=' ' - if(ctemp(1,8)(1:1).ne.' ')dcstgd=' ' - -c -c --- Transfer the char*4 data into the char*132 variables - do j=1,132 - if(ctemp(j,1)(1:1).ne.' ')diadat(j:j)=ctemp(j,1)(1:1) - if(ctemp(j,2)(1:1).ne.' ')prgdat(j:j)=ctemp(j,2)(1:1) - if(ctemp(j,3)(1:1).ne.' ')tstprt(j:j)=ctemp(j,3)(1:1) - if(ctemp(j,4)(1:1).ne.' ')tstout(j:j)=ctemp(j,4)(1:1) - if(ctemp(j,5)(1:1).ne.' ')tstkin(j:j)=ctemp(j,5)(1:1) - if(ctemp(j,6)(1:1).ne.' ')tstfrd(j:j)=ctemp(j,6)(1:1) - if(ctemp(j,7)(1:1).ne.' ')tstslp(j:j)=ctemp(j,7)(1:1) - if(ctemp(j,8)(1:1).ne.' ')dcstgd(j:j)=ctemp(j,8)(1:1) - enddo - -c --- Convert the file names to the proper case - call filcase(lcfiles,diadat) - call filcase(lcfiles,prgdat) - call filcase(lcfiles,tstprt) - call filcase(lcfiles,tstout) - call filcase(lcfiles,tstkin) - call filcase(lcfiles,tstfrd) - call filcase(lcfiles,tstslp) - call filcase(lcfiles,dcstgd) - endif - -c - return - end -c---------------------------------------------------------------------- - subroutine wrfiles(nm3d, nigf) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101006 WRFILES -c J. Scire, SRC -c -c --- PURPOSE: Write a table of the input and output file names -c for the current run -c -c --- UPDATES -c --- v6.205 (060309) to v6.330 (101006) (CEC) -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c --- v5.711 (060106) to v6.205 (060309) (DGS) -c - Change filenames from c*70 to c*132 -c --- V5.6 050328 to v5.711 (060106) (F.Robe) -c - Additional filenames for IGF-CALMET files -c --- V5.6 050328 (F.Robe): additional filenames (m3ddat,dcstgd) -c -c --- INPUTS: -c nm3d - integer - Number of MM4/MM5 files -c nigf - integer - Number of IGF-CALMET files -c -cc -c Common block /FILNAM/, /FILLOG/ variables -c metfil,metinp,geodat,srfdat,prcdat,diadat,prgdat,mm4dat, -c wtdat,updat(mxus),seadat(mxows),metlst,metdat,pacdat, -c tstprt,tstout,tstkin,tstfrd,tstslp,lcfiles,clddat, -c m3ddat(mxm3d),igfdat(mxigf),dcstgd -c Common block /OUTPT/ -c lsave, iformo -c Common block /MET1/ -c iforms, iformp, nusta, npsta, noobs, mcloud, icldout -c Common block /OVRWAT/ -c nowsta -c Common block /WPARM/ -c ipr0,ipr1,ipr2,ipr3,ipr4,ipr5,ipr6,ipr7, -c ioutd, idiopt(5), iprog, igfmet -c Parameters: MXNZ, MXSS, MXUS, MXPS, MXOWS, MXWND, MXBAR,mxm3d -c IO2, IO5, IO6, IO8, IO10, IO12, IO18, IO19, -c IO20, IO21, IO22, IO23, IO24, IO25, IO26, -c IO27,IO30, IO80 -c -c --- OUTPUT: none -c -c --- WRFILES called by: SETUP -c --- WRFILES calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.met' -c -c --- Include common blocks - include 'met1.met' - include 'geo.met' - include 'outpt.met' - include 'ovrwat.met' - include 'wparm.met' - include 'filnam.met' -c -c -------------------------------------------------- -c --- Write the list of INPUT files used in this run -c -------------------------------------------------- - write(io6,10) -10 format(//1x,13('----------')/10x,'INPUT FILES'// - 1 1x,'Default Name',5x,'Unit No.',5x,'File Name and Path'/ - 2 1x,'------------',5x,'--------',5x,'------------------') -c --- CALMET.INP - write(io6,12)'CALMET.INP',io5,metinp -12 format(1x,a12,7x,i3,8x,a132) -c --- GEO.DAT - write(io6,12)'GEO.DAT',io8,geodat -c --- SURF.DAT - if(idiopt(4).ne.1)write(io6,12)'SURF.DAT',io10,srfdat -c --- PRECIP.DAT - if(npsta.gt.0)write(io6,12)'PRECIP.DAT',io12,prcdat -c --- CLOUD.DAT - as INPUT -ccec101006 if(icloud.eq.2)write(io6,12)'CLOUD.DAT',io26,clddat - if(mcloud.eq.2.and.icldout.eq.0) - 1 write(io6,12)'CLOUD.DAT',io26,clddat -c --- WT.DAT - if(iprog.EQ.3 .OR. iprog.EQ.5 .OR. - : iprog.EQ.13 .OR. iprog.EQ.15) then - write(io6,12)'WT.DAT',io19,wtdat - endif -c --- MM4n.DAT (one file open at a time => same io number) - if(iprog.eq.3 .or. iprog.eq.4 .or. iprog.eq.5)then - write(io6,*) - do 250 i=1,nm3d - if(i.le.9)then - write(io6,220)i,io20,m3ddat(i) -220 format(1x,4x,'MM4',i1,'.DAT',7x,i3,8x,a132) - else - if(i.ge.10)write(io6,240)i,io20,m3ddat(i) -240 format(1x,3x,'MM4',i2,'.DAT',7x,i3,8x,a132) - endif -250 continue - endif -c --- MM5n.DAT (one file open at a time => same io number) - if(iprog.eq.13 .or. iprog.eq.14 .or. iprog.eq.15)then - write(io6,*) - do 350 i=1,nm3d - if(i.le.9)then - write(io6,320)i,io20,m3ddat(i) -320 format(1x,4x,'MM5',i1,'.DAT',7x,i3,8x,a132) - else - if(i.ge.10)write(io6,340)i,io20,m3ddat(i) -340 format(1x,3x,'MM5',i2,'.DAT',7x,i3,8x,a132) - endif -350 continue - endif - - -c --- MM5n.DAT (one file open at a time => same io number:18) - if(igfmet.eq.1)then - write(io6,*) - do 450 i=1,nigf - if(i.le.9)then - write(io6,420)i,io18,igfdat(i) -420 format(1x,4x,'IGF',i1,'.DAT',7x,i3,8x,a132) - else - if(i.ge.10)write(io6,440)i,io18,igfdat(i) -440 format(1x,3x,'IGF',i2,'.DAT',7x,i3,8x,a132) - endif -450 continue - endif - -c --- PROG.DAT - if(iprog.eq.1 .or. iprog.eq.2)then - write(io6,12)'PROG.DAT',io20,prgdat - endif -c --- DIAG.DAT - do 2 i=1,5 - if(idiopt(i).eq.1)then - write(io6,12)'DIAG.DAT',io2,diadat - go to 3 - endif -2 continue -3 continue -c -c --- Upper air station files (UPn.DAT) -c FRR (09/2001) additional option for mm4only -c if(idiopt(5).eq.1 .or. noobs .eq. 1) go to 29 - if(idiopt(5).eq.1 .or. noobs .ge. 1) go to 29 - write(io6,*) - do 15 i=1,nusta - io=io30+i-1 - if(i.le.9)then - write(io6,14)i,io,updat(i) -14 format(1x,5x,'UP',i1,'.DAT',7x,i3,8x,a132) - else - if(i.ge.10)write(io6,16)i,io,updat(i) -16 format(1x,4x,'UP',i2,'.DAT',7x,i3,8x,a132) - endif -15 continue -29 continue -c -c --- Overwater data files (SEAn.DAT) - if(nowsta.gt.0)then - write(io6,*) - do 25 i=1,nowsta - io=io80+i-1 - if(i.le.9)then - write(io6,22)i,io,seadat(i) -22 format(1x,4x,'SEA',i1,'.DAT',7x,i3,8x,a132) - else - if(i.ge.10)write(io6,24)i,io,seadat(i) -24 format(1x,3x,'SEA',i2,'.DAT',7x,i3,8x,a132) - endif -25 continue - endif -c -c --------------------------------------------------- -c --- Write the list of OUTPUT files used in this run -c --------------------------------------------------- - write(io6,30) -30 format(//1x,13('----------')/10x,'OUTPUT FILES'// - 1 1x,'Default Name',5x,'Unit No.',5x,'File Name and Path'/ - 2 1x,'------------',5x,'--------',5x,'------------------') -c --- CALMET.LST - write(io6,12)'CALMET.LST',io6,metlst - if(lsave)then - if(iformo.eq.1)then -c --- CALMET.DAT - write(io6,12)'CALMET.DAT',io7,metdat - else if(iformo.eq.2)then -c --- PACOUT.DAT - write(io6,12)'PACOUT.DAT',io7,pacdat - endif - endif -c -c --- CLOUD.DAT - as OUTPUT -ccec101006 if(icloud.eq.1)write(io6,12)'CLOUD.DAT',io26,clddat - if(icldout.eq.1.and.mcloud.ne.2)write(io6,12)'CLOUD.DAT',io26, - 1 clddat -c -c --- wind field module -- testing & debugging files - write(io6,*) - i21=ipr0+ipr1+ipr2+ipr3+ipr4+ipr5+ipr6+ipr7+ipr8 - i22=ipr8+ioutd - i23=ipr5+ioutd - i24=ipr6+ioutd - i25=ipr7+ioutd -c --- TEST.PRT - if(i21.ge.1)write(io6,12)'TEST.PRT',io21,tstprt -c --- TEST.OUT - if(i22.eq.2)write(io6,12)'TEST.OUT',io22,tstout -c --- TEST.KIN - if(i23.eq.2)write(io6,12)'TEST.KIN',io23,tstkin -c --- TEST.FRD - if(i24.eq.2)write(io6,12)'TEST.FRD',io24,tstfrd -c --- TEST.SLP - if(i25.eq.2)write(io6,12)'TEST.SLP',io25,tstslp - -c --- Distance to the coast gridded output -c --- DCST.GRD - if(ldbcst)write(io6,12)'DCST.GRD',io27,dcstgd - -c - return - end -c----------------------------------------------------------------------- - subroutine rdcld(iformc,nx,ny,ndathr,ccgrid) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070929 RDCLD -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Read a gridded fractional cloud cover field from -c a CLOUD.DAT ile -c -c --- UPDATES: -c --- V6.301 (070927) to v6.302 (070929): -c - Modify calls to RDR2D to include IO6 in argument list -c - Update documentation on routines called -c --- v5.711 (060106) to v6.301 (070927): -c - added mtver and dummy arguments to rdr2d calling list -c (to make compatible with updated RDR2D for MOD5/MOD6) -c -c --- V5.5 (030402) to v5.711 (060106): add ieof to rdr2d calling list -c --- V5.4 (991104) to V5.5 (030402) (DGS) -c - Add list-file unit to YR4 call -c --- V5.0-V5.1 991104 (DGS): YYYY format for year -c -c --- INPUTS: -c IFORMC - integer - Format of CLOUD.DAT file -c (1=unformatted, 2=formatted) -c NX, NY - integers - No. X, Y grid cells -c NDATHR - integer - Date and hour (YYYYJJJHH) in LST of -c current hour to be read (explicit beg. time) -c Parameters: MXNX, MXNY, IO26, IO6 -c -c --- OUTPUT: -c CCGRID(mxnx,mxny) - real array - Gridded cloud cover (fraction) -c -c --- RDCLD called by: COMP -c --- RDCLD calls: RDR2D, DEDAT, YR4 -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real ccgrid(mxnx,mxny),xbuf(mxnx,mxny) - character*8 clabel -c -c --- Read the 2-D cloud cover field - if(iformc.eq.1)then -c -c ----------------------- -c --- Unformatted file -c ----------------------- -10 continue - call rdr2d(io26,0,io6,ccgrid,xbuf,mxnx,mxny,nx,ny, - 1 clabel,idum,idum,idathr,idum,ieof) - if(clabel.ne.'CLOUDFRA')then - write(io6,*)'ERROR in Subr. RDCLD -- Incorrect variable ', - 1 'label read from cloud file -- CLABEL = ',clabel, - 2 ' label expected: CLOUDFRA' - stop - endif -c --- Enforce YYYY format for year - call dedat(idathr,iyr,iday,ihr) - call YR4(io6,iyr,ierr) - if(ierr.NE.0) stop 'Halted in RDCLD' - idathr=iyr*100000+iday*100+ihr - - if(idathr.lt.ndathr)then -c --- Hour expected not yet reached -- keep reading - go to 10 - else if(idathr.gt.ndathr)then -c --- Hour read is past current hour -- error - write(io6,*)'ERROR in Subr. RDCLD -- Current hour not ', - 1 'found -- current (NDATHR) = ',ndathr,' value read from ', - 2 'cloud file (IDATHR) = ',idathr - stop - endif - else -c -c --------------------------------------- -c --- Formatted or free-formatted file -c --------------------------------------- -20 continue - read(io26,*)clabel,idathr,((ccgrid(i,j),i=1,nx),j=1,ny) - if(clabel.ne.'CLOUDFRA')then - write(io6,*)'ERROR in Subr. RDCLD -- Incorrect variable ', - 1 'label read from cloud file -- CLABEL = ',clabel, - 2 ' label expected: CLOUDFRA' - stop - endif - -c --- Enforce YYYY format for year - call dedat(idathr,iyr,iday,ihr) - call YR4(io6,iyr,ierr) - if(ierr.NE.0) stop 'Halted in RDCLD' - idathr=iyr*100000+iday*100+ihr - - if(idathr.lt.ndathr)then -c --- Hour expected not yet reached -- keep reading - go to 20 - else if(idathr.gt.ndathr)then -c --- Hour read is past current hour -- error - write(io6,*)'ERROR in Subr. RDCLD -- Current hour not ', - 1 'found -- current (NDATHR) = ',ndathr,' value read from ', - 2 'cloud file (IDATHR) = ',idathr - stop - endif - endif -c - return - end -c----------------------------------------------------------------------- - subroutine rdcldn(iformc,nx,ny,ndathrb,nsecb,ndathre,nsece,ccgrid) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101129 RDCLDN -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Read a gridded fractional cloud cover field from -c a CLOUD.DAT file with beginning and ending times -c -c --- UPDATES: -c FRom RDCL v6.302 (070929) to RDCLN V6.331(101206) (F.Robe) -c - Reads in CLOUD.DAT with beginning and end ending time -c - correct argument list in call to rdr2d - -c --- INPUTS: -c IFORMC - integer - Format of CLOUD.DAT file -c (1=unformatted, 2=formatted) -c NX, NY - integers - No. X, Y grid cells -c NDATHRB - integer - Beginning Date and hour(YYYYJJJHH) -c in LST -c NSECB - integer - Beginning Second in LST -c NDATHRE - integer - Ending Date and hour(YYYYJJJHH) in LST -c NSECE - integer - Ending Second in LST -c Parameters: MXNX, MXNY, IO26, IO6 -c -c --- OUTPUT: -c CCGRID(mxnx,mxny) - real array - Gridded cloud cover (fraction) -c -c --- RDCLDN called by: COMP -c --- RDCLDN calls: RDR2D, DEDAT, YR4 -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real ccgrid(mxnx,mxny),xbuf(mxnx,mxny) - character*8 clabel -c -c --- Read the 2-D cloud cover field - if(iformc.eq.1)then -c -c ----------------------- -c --- Unformatted file -c ----------------------- -10 continue -c --- Calling list with explicit beg/ending times (101206) - call rdr2d(io26,1,io6,ccgrid,xbuf,mxnx,mxny,nx,ny, - 1 clabel,idathrb,isecb,idathre,isece,ieof) - if(clabel.ne.'CLOUDFRA')then - write(io6,*)'ERROR in Subr. RDCLD -- Incorrect variable ', - 1 'label read from cloud file -- CLABEL = ',clabel, - 2 ' label expected: CLOUDFRA' - stop - endif - -c --- Enforce YYYY format for year -c --- Both for beg and end times - call dedat(idathre,iyre,idaye,ihre) - call YR4(io6,iyre,ierr) - call dedat(idathrb,iyrb,idayb,ihrb) - call YR4(io6,iyrb,ierr) - if(ierr.NE.0) stop 'Halted in RDCLD' - idathre=iyre*100000+idaye*100+ihre - idathrb=iyrb*100000+idayb*100+ihrb - - - call deltsec(ndathre,nsece,idathre,isece,ndelsec) - - if (ndelsec.lt.0) then -c if(idathr.lt.ndathr)then -c --- Hour expected not yet reached -- keep reading - go to 10 - else if (ndelsec.gt.0) then -c else if(idathr.gt.ndathr)then -c --- Hour read is past current hour -- error - write(io6,*)'ERROR in Subr. RDCLD -- Current time not ', - 1 'found -- current (NDATHRE, NSECE) = ',ndathre,nsece, - 2 ' value read from cloud file (IDATHRE, ISECE) = ', - 2 idathre,isece - stop - endif - else -c -c --------------------------------------- -c --- Formatted or free-formatted file -c --------------------------------------- -20 continue - read(io26,*)clabel,idathrb,isecb,idathre,isece, - : ((ccgrid(i,j),i=1,nx),j=1,ny) - - if(clabel.ne.'CLOUDFRA')then - write(io6,*)'ERROR in Subr. RDCLD -- Incorrect variable ', - 1 'label read from cloud file -- CLABEL = ',clabel, - 2 ' label expected: CLOUDFRA' - stop - endif - - -c --- Enforce YYYY format for year -c --- Both for beg and end times - call dedat(idathre,iyre,idaye,ihre) - call YR4(io6,iyre,ierr) - call dedat(idathrb,iyrb,idayb,ihrb) - call YR4(io6,iyrb,ierr) - if(ierr.NE.0) stop 'Halted in RDCLD' - idathre=iyre*100000+idaye*100+ihre - idathrb=iyrb*100000+idayb*100+ihrb - - call deltsec(ndathre,nsece,idathre,isece,ndelsec) - - if (ndelsec.lt.0) then -c if(idathr.lt.ndathr)then -c --- Hour expected not yet reached -- keep reading - go to 20 - else if (ndelsec.gt.0) then -c else if(idathr.gt.ndathr)then -c --- Hour read is past current hour -- error - write(io6,*)'ERROR in Subr. RDCLD -- Current time not ', - 1 'found -- current (NDATHRE, NSECE) = ',ndathre,nsece, - 2 ' value read from cloud file (IDATHRE, ISECE) = ', - 2 idathre,isece - stop - endif - endif -c - return - end -c---------------------------------------------------------------------- - subroutine outcld(ndathrb,nsecb,ndathre,nsece,nx,ny,nssta,icc, - : nears,iformc,icldout,mcloud,ccgrid) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 101206 OUTCLD -c --- J. Scire, SRC -c -c --- PURPOSE: Compute and write a hourly gridded cloud field -c -------------------------------------------------------------- -c --- Assumes missing values of cloud cover array have -c --- already been filled -c -------------------------------------------------------------- -c --- UPDATES: -c --- V6.330 Level 101006 to v6.331 101206 (F.Robe) -c - Bug fix: pass on beginning /ending time with seconds -c - output beg/end times with seconds in ascii format too -c (instead of beginning time without seconds) -c -c --- V6.222 Level 070404 to V6.330 Level 101006 (CEC) -c - Change ICLOUD into MCLOUD (and ICLDOUT) -c -c --- V6.2 Level 060215 to V6.222 Level 070404 (F.Robe) -c - Fill in the gridded cloud array ccgrid for -c also if icloud=0 (additional icloud in calling list) -c -c --- V5 Level 951021 to V6.2 Level 060215 (F.Robe) -c - Use explicit times in calling list to wrtr2d -c -c --- INPUTS: -c NDATHRB - integer - Beginning Date and hour(YYYYJJJHH) in LST -c NSECB - integer - Beginning Second in LST -c NDATHRE - integer - Ending Date and hour(YYYYJJJHH) in LST -c NSECE - integer - Ending Second in LST -c NX, NY - integers - No. X, Y grid cells -c NSSTA - integer - No. surface stations -c ICC(mxss) - int. array - Cloud cover (tenths) at each surface -c station -c NEARS(mxnx,mxny) - int. array - Closest surface station to each grid -c point -c IFORMC - integer - Format of CLOUD.DAT file -c (1=unformatted, 2=formatted) -c ICLDOUT - integer - CLOUD option (write out field if -c ICLDOUT=1) -c MCLOUD - integer - CLOUD option (put observations -c in gridded data if MCLOUD=1) -c Parameters: MXSS, MXNX, MXNY, IO26 -c -c --- OUTPUT: -c CCGRID(mxnx,mxny) - real array - Gridded cloud cover (fraction) -c -c --- OUTCLD called by: COMP -c --- OUTCLD calls: WRTR2D -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real ccgrid(mxnx,mxny),xbuf(mxnx,mxny) - real ccfract(mxss) - integer icc(nssta),nears(mxnx,mxny) - character*10 clab2 - character*8 clabel -c -ccec101006 --- limit the assignement of cloud fraction to -c each grid cell if clouds come from observations -c only if mcloud=1 -c --- Compute the cloud fraction field - - if(mcloud.eq.1) then -c --- Convert tenths to fraction - do i=1,nssta - ccfract(i)=0.1*float(icc(i)) - enddo - -c --- Assign cloud cover to each grid cell based on nearest -c --- station method - do i=1,nx - do j=1,ny - ista=nears(i,j) - ccgrid(i,j)=ccfract(ista) - enddo - enddo - endif -ccec101006 --- end limit assignment of cloud fraction to -c each grid cell if clouds come from observations -c only if mcloud=1 -c - -c --- Write the 2-D cloud cover field -ccec101006 if(icloud.eq.1) then - if(icldout.eq.1) then - - if(iformc.eq.1)then - clabel='CLOUDFRA' - call wrtr2d(io26,ccgrid,xbuf,mxnx,mxny,nx,ny,clabel, - : ndathrb,nsecb,ndathre,nsece) - else -c --- Read clab2 as a character*8 in free format ("s used as -c --- delimiters) - clab2='"CLOUDFRA"' -c --- 101206 - write out beginning and ending times -c write(io26,*)clab2,ndathr,((ccgrid(i,j),i=1,nx),j=1,ny) - write(io26,*)clab2,ndathrb,nsecb,ndathre,nsece, - : ((ccgrid(i,j),i=1,nx),j=1,ny) - endif - - endif -c - return - end -c---------------------------------------------------------------------- - subroutine rdi1d(iomet,mtver,io6,idat,nwords,clabel,ndathrb, - & nsecb,ndathre,nsece) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070929 RDI1D -c --- J. Scire, TRC -c --- Adapted from PRTMET (Version: 4.48, Level: 051012) -c -c --- PURPOSE: Read "NWORDS" of a one-dimensional integer array -c -c --- UPDATE -c --- V6.301-V6.302 070929 (JSS): Add checks on valid range of MTVER, -c write error message and update -c documentation -c --- V4.4-V4.41 051012 (DGS): resolve times to the second, and -c (PRTMET) include begin/end times for CALMET -c Version 6 (remains compatible with -c older end-time version) -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of input file -c MTVER - integer - Time-mark flag -c 0: end-time (no seconds) (V5 format) -c 1: begin-time/end-time w/ seconds -c (V6 format) -c IO6 - integer - Fortran unit number for error messages -c -c --- OUTPUT: -c IDAT(nwords) - integer array - Array read from file -c NWORDS - integer - Number of words to read -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning date and time (YYYYJJJHH) -c NSECB - integer - Beginning seconds (SSSS) -c NDATHRE - integer - Ending date and time (YYYYJJJHH) -c NSECE - integer - Ending seconds (SSSS) -c -c --- RDI1D called by: RDMET2 -c --- RDI1D calls: none -c---------------------------------------------------------------------- -c - integer idat(nwords) - character*8 clabel -c - if(mtver.EQ.1) then - read(iomet)clabel,ndathrb,nsecb,ndathre,nsece,idat - elseif(mtver.EQ.0) then - read(iomet)clabel,ndathre,idat - nsece=0 - ndathrb=0 - nsecb=0 - else - write(io6,*)'Error in RDI1D -- Invalid value of MTVER' - write(io6,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - write(*,*)'Error in RDI1D -- Invalid value of MTVER' - write(*,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - stop - endif -c - return - end -c---------------------------------------------------------------------- - subroutine rdr1d(iomet,mtver,io6,x,nwords,clabel, - & ndathrb,nsecb,ndathre,nsece) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070929 RDR1D -c --- J. Scire, TRC -c --- Adapted from PRTMET (Version: 4.48, Level: 051012) -c -c --- PURPOSE: Read "NWORDS" of a one-dimensional real array -c -c --- UPDATE -c --- V6.301-V6.302 070929 (JSS): Add checks on valid range of MTVER, -c write error message and update -c documentation -c --- V4.4-V4.41 051012 (DGS): resolve times to the second, and -c (PRTMET) include begin/end times for CALMET -c Version 6 (remains compatible with -c older version of CALMET) -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of input file -c MTVER - integer - Time-mark flag -c 0: end-time (no seconds) (V5 format) -c 1: begin-time/end-time w/ seconds -c (V6 format) -c IO6 - integer - Fortran unit number for error messages -c -c --- OUTPUT: -c X(nwords) - real array - Array read from file -c NWORDS - integer - Number of words to read -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning date and time (YYYYJJJHH) -c NSECB - integer - Beginning seconds (SSSS) -c NDATHRE - integer - Ending date and time (YYYYJJJHH) -c NSECE - integer - Ending seconds (SSSS) -c -c --- RDR1D called by: RDHDMET, RDMET2 -c --- RDR1D calls: none -c---------------------------------------------------------------------- -c - real x(nwords) - character*8 clabel -c - if(mtver.EQ.1) then - read(iomet)clabel,ndathrb,nsecb,ndathre,nsece,x - else if(mtver.EQ.0) then - read(iomet)clabel,ndathre,x - nsece=0 - ndathrb=0 - nsecb=0 - else - write(io6,*)'Error in RDR1D -- Invalid value of MTVER' - write(io6,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - write(*,*)'Error in RDR1D -- Invalid value of MTVER' - write(*,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - stop - endif -c - return - end -c---------------------------------------------------------------------- - subroutine rdr2d(iomet,mtver,io6,x,xbuf,mxnx,mxny,nx,ny, - & clabel,ndathrb,nsecb,ndathre,nsece,ieof) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070929 RDR2D -c --- J. Scire, TRC -c --- Adapted from PRTMET (Version: 4.48, Level: 051012) -c -c --- PURPOSE: Read NX * NY words of a 2-D real array -c -c --- UPDATE -c --- V6.301-V6.302 070929 (JSS): Add checks on valid range of MTVER, -c write error message and update -c documentation -c --- V4.4-V4.41 051012 (DGS): resolve times to the second, and -c (PRTMET) include begin/end times for CALMET -c Version 6 (remains compatible with -c older version of CALMET) -c --- 940830 to 040923 (DGS): add IEOF to recover from end-of-file -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of input file -c MTVER - integer - Time-mark flag -c 0: end-time (no seconds) (V5 format) -c 1: begin-time/end-time w/ seconds -c (V6 format) -c IO6 - integer - Fortran unit number for error messages -c XBUF(nx,ny) - real array - Buffer to hold input data -c MXNX,MXNY - integers - Dimensions of data array -c NX,NY - integers - Actual size of grid to read -c -c --- OUTPUT: -c X(mxnx,mxny) - real array - Input data array (padded if nec.) -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning date and time (YYYYJJJHH) -c NSECB - integer - Beginning seconds (SSSS) -c NDATHRE - integer - Ending date and time (YYYYJJJHH) -c NSECE - integer - Ending seconds (SSSS) -c IEOF - integer - End-of-File status -c 0 = pointer within file -c 1 = EOF reached on read -c -c --- RDR2D called by: RDHDMET, RDMET2, RDCLD -c --- RDR2D calls: none -c---------------------------------------------------------------------- - real x(mxnx,mxny),xbuf(nx,ny) - character*8 clabel - -c --- Set EOF - ieof=0 -c - if(nx.eq.mxnx.and.ny.eq.mxny)then -c -c --- entire array is being used -- read full grid - if(mtver.EQ.1) then - read(iomet,end=999)clabel,ndathrb,nsecb,ndathre,nsece,x - else if(mtver.EQ.0) then - read(iomet,end=999)clabel,ndathre,x - nsece=0 - ndathrb=0 - nsecb=0 - else - write(io6,*)'Error in RDR2D -- Invalid value of MTVER' - write(io6,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - write(*,*)'Error in RDR2D -- Invalid value of MTVER' - write(*,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - stop - endif - else -c -c --- only a portion of grid being used -- read and -c --- transfer from buffer - if(mtver.EQ.1) then - read(iomet,end=999)clabel,ndathrb,nsecb,ndathre,nsece,xbuf - else if(mtver.EQ.0) then - read(iomet,end=999)clabel,ndathre,xbuf - nsece=0 - ndathrb=0 - nsecb=0 - else - write(io6,*)'Error in RDR2D -- Invalid value of MTVER' - write(io6,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - write(*,*)'Error in RDR2D -- Invalid value of MTVER' - write(*,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - stop - endif -c - do 10 i=1,nx - do 10 j=1,ny - x(i,j)=xbuf(i,j) -10 continue - endif -c - return - -999 ieof=1 - return - - end -c----------------------------------------------------------------------- - subroutine rdi2d(iomet,mtver,io6,idat,ibuf,mxnx,mxny,nx,ny, - & clabel,ndathrb,nsecb,ndathre,nsece) -c----------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070929 RDI2D -c --- J. Scire, TRC -c --- Adapted from PRTMET (Version: 4.48, Level: 051012) -c -c --- PURPOSE: Read NX * NY words of a 2-D integer array -c -c --- UPDATE -c --- V6.301-V6.302 070929 (JSS): Add checks on valid range of MTVER, -c write error message and update -c documentation -c --- V4.4-V4.41 051012 (DGS): resolve times to the second, and -c (PRTMET) include begin/end times for CALMET -c Version 6 (remains compatible with -c older version of CALMET) -c -c --- INPUTS: -c IOMET - integer - Fortran unit number of input -c file -c MTVER - integer - Time-mark flag -c 0: end-time (no seconds) -c 1: begin-time / end-time -c IO6 - integer - Fortran unit number for error -c messages -c IBUF(nx,ny) - integer array - Buffer to hold input data -c MXNX,MXNY - integers - Dimensions of data array -c NX,NY - integers - Actual size of grid to read -c -c --- OUTPUT: -c IDAT(mxnx,mxny) - integer array - Input data array (padded if -c necessary) -c CLABEL - character*8 - Variable name -c NDATHRB - integer - Beginning date and time (YYYYJJJHH) -c NSECB - integer - Beginning seconds (SSSS) -c NDATHRE - integer - Ending date and time (YYYYJJJHH) -c NSECE - integer - Ending seconds (SSSS) -c -c --- RDI2D called by: RDHDMET, RDMET2 -c --- RDI2D calls: none -c---------------------------------------------------------------------- - integer idat(mxnx,mxny),ibuf(nx,ny) - character*8 clabel -c - if(nx.eq.mxnx.and.ny.eq.mxny)then -c -c --- entire array is being used -- read full grid - if(mtver.EQ.1) then - read(iomet)clabel,ndathrb,nsecb,ndathre,nsece,idat - else if(mtver.EQ.0) then - read(iomet)clabel,ndathre,idat - nsece=0 - ndathrb=0 - nsecb=0 - else - write(io6,*)'Error in RDI2D -- Invalid value of MTVER' - write(io6,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - write(*,*)'Error in RDI2D -- Invalid value of MTVER' - write(*,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - stop - endif - else -c -c --- only a portion of grid being used -- read and -c --- transfer from buffer -c - if(mtver.EQ.1) then - read(iomet)clabel,ndathrb,nsecb,ndathre,nsece,ibuf - else if(mtver.EQ.0) then - read(iomet)clabel,ndathre,ibuf - nsece=0 - ndathrb=0 - nsecb=0 - else - write(io6,*)'Error in RDI2D -- Invalid value of MTVER' - write(io6,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - write(*,*)'Error in RDI2D -- Invalid value of MTVER' - write(*,*)'MTVER must be 0 or 1 -- MTVER = ',MTVER - stop - endif -c - do 10 i=1,nx - do 10 j=1,ny - idat(i,j)=ibuf(i,j) -10 continue - endif -c - return - end -c---------------------------------------------------------------------- - subroutine tfercf -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 090511 TFERCF -c --- D. Strimaitis -c -c --- PURPOSE: Transfer image of control input file to scratch file -c -c --- UPDATES: -c --- V5.5 (030402) to V6.327 (090511) (DGS) -c - Reset length of line in control file to 200 -c (store image as 132, splitting lines if needed) -c -c --- INPUTS: -c -c Common block /QA/ -c ncommout -c Parameters: mxcol, iox, io5 -c -c --- OUTPUT: -c -c Common block /QA/ -c ncommout -c -c --- TFERCF called by: SETUP -c --- TFERCF calls: none -c---------------------------------------------------------------------- -c - include 'params.met' - include 'params.cal' - include 'qa.met' - - character*132 aline, blank - character*200 aline200, blank200 - character*33 blank33 - -c --- Set blanks - data blank33/' '/ - blank(1:33)=blank33 - blank(34:66)=blank33 - blank(67:99)=blank33 - blank(100:132)=blank33 - blank200(1:100)=blank(1:100) - blank200(101:200)=blank(1:100) - -c --- Confirm max size of control file record - if(mxcol.GT.200) then - write(*,*)'ERROR in TFERCF!' - write(*,*)'Control file records are assumed to be <= 200' - write(*,*)'Actual limit is MXCOL = ',mxcol - write(*,*)'CALMET code needs to be modified' - stop - endif - -c --- Reposition input control file - REWIND(io5) - -c --- Open scratch file - OPEN(iox,status='scratch') - -c --- Initialize number of records written to scratch file - ncommout=0 - -c --- Transfer control file records -10 aline=blank - aline200=blank200 - read(io5,'(a200)',end=999) aline200 - write(iox,'(a132)') aline200(1:132) - ncommout=ncommout+1 - klen=LEN_TRIM(aline200) - if(klen.GT.132) then -c --- Line is split - aline(1:68)=aline200(133:200) - write(iox,'(a132)') aline - ncommout=ncommout+1 - endif - goto 10 - -c --- Transfer completed -999 close(io5) - - return - end - - -c---------------------------------------------------------------------- - subroutine qaplot1(ibtz) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 060202 QAPLOT1 -c D. Strimaitis, Earth Tech -c -c --- PURPOSE: Pass SEA.DAT locations to files for making -c plots to verify configuration. Standard filenames -c and extensions are consistent with defaults used in -c the SURFER plotting system. All locations are in km. -c -c --- INPUTS: -c IBTZ - integer - Base time zone for CALMET run -c -c Common block /OUTPT/ variables: -c IQAPLOT -c -c Common block /OVRWAT/ variables: -c vectiow(9),vectoow(9), -c nowsta,ioow(mxows), -c zowsta(mxows),ztair(mxows),zsst(mxows), -c dtow(mxows),tairow(mxows),rhow(mxows),ziow(mxows), -c tgrada(mxows),tgradb(mxows), -c xowlon(mxows),wsow(mxows),wdow(mxows), -c rverow(mxows),twave(mxows),hwave(mxows), -c lremap, -c datumow,cactionow -c -c Common block /MAP/ variables: -c datum -c -c Parameters: -c MXOWS, IO28, IO6 -c -c --- OUTPUT: -c -c Files: -c QABUOYSTA.DAT - location of SEA.DAT stations -c -c -c --- QAPLOT1 called by: SETUP -c --- QAPLOT1 calls: RDHDOW, GLOBE -c---------------------------------------------------------------------- -c --- Include parameter statements - include 'params.met' - -c --- Include common blocks - include 'ovrwat.met' - include 'map.met' - - logical lfirst - -c --- For coordinate transformations - character*4 c4hem - -c --- Use file index io28 for QA file - ioqa=io28 - -c --- SEA.DAT station locations -c ----------------------------- - - if (nowsta .gt. 0) then - open(ioqa,file='qabuoysta.dat',status='unknown') - write(ioqa,'(a28)') '"Xkm" "Ykm" "Station" "Date"' - -c --- Loop over station-files - do i = 1,nowsta - call RDHDOW(i,ibtz) - - io=ioow(i) - lfirst=.TRUE. - xsave=0.0 - ysave=0.0 - -c --- Read data record -c --- SEA.DAT version 2.11 and higher: -c new variables:air temp sensor height (ztair), water temp -c sensor depth (zsst - positive downward) -100 if (rverow(i).ge.2.10999)then - read(io,*,end=900,err=900)xowkm,yowkm, - & zowsta(i),ztair(i),zsst(i),i1yr,i1jul,i1hr, - 1 i2yr,i2jul,i2hr,dtow(i),tairow(i),rhow(i),ziow(i), - 2 tgradb(i),tgrada(i),wsow(i),wdow(i),twave(i),hwave(i) - -c --- SEA.DAT version 2.1 and higher: new variables: twave,rwave -c -- Removed: xowlon - else if (rverow(i).ge.2.099)then - read(io,*,end=900,err=900)xowkm,yowkm, - & zowsta(i),i1yr,i1jul,i1hr, - 1 i2yr,i2jul,i2hr,dtow(i),tairow(i),rhow(i),ziow(i), - 2 tgradb(i),tgrada(i),wsow(i),wdow(i),twave(i),hwave(i) - else - read(io,*,end=900,err=900)xowkm,yowkm,xowlon(i), - & zowsta(i),i1yr,i1jul,i1hr, - 1 i2yr,i2jul,i2hr,dtow(i),tairow(i),rhow(i),ziow(i), - 2 tgradb(i),tgrada(i),wsow(i),wdow(i) - endif - - if(LFIRST .OR. xsave.NE.xowkm .OR. ysave.NE.yowkm) then -c --- Update current location - xsave=xowkm - ysave=yowkm -c --- Remap station (x,y) if needed - if(LREMAP) then - call GLOBE(io6,cactionow,datumow,vectiow,datum, - & vectoow,xowkm,yowkm,xkm,ykm,idum,c4hem) - else - xkm=xowkm - ykm=yowkm - endif -c --- Write QA record - write(ioqa,*) xkm,ykm,i,i1yr,i1jul,i1hr -c --- Reset FIRST flag - lfirst=.false. - endif - -c --- Next data record - goto 100 - -c --- End of station i data -900 REWIND(io) - end do - end if - - if(nowsta.GT.0) then - close(ioqa) - else - close(ioqa, status='DELETE') - endif - - return - end - -c ----------------------------------------------------------------------------------------- -c---------------------------------------------------------------------- - subroutine airden_ns(pres,tempk,nssta,rho) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070618 AIRDEN_NS -c --- J. Scire, SRC -c Modified by F.Robe, Earth Tech, to allow 2D arrays -c -c --- PURPOSE: Compute the air density (kg/m**3) using the ideal -c gas law -c -c --- INPUTS: -c PRES(mxss) - real array - Surface pressure (mb) -c TEMPK(mxss) - real array - Air temperature (deg. K) -c NSSTA - integer - Number of surface stations -c Parameters: MXSS, NEARS,NX,NY -c -c --- OUTPUT: -c RHO(mxnx,mxny) - real array - Air density (kg/m**3) -c -c --- AIRDEN_NS called by: DIAGNO, COMP -c --- AIRDEN_NS calls: none -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' - include 'grid.met' -c - real pres(mxss),tempk(mxss) -c frr (09/01) 2D rho -c real rho(mxss) - real rhos(mxss),rho(mxnx,mxny) -c -c Compute rho at the surface stations - do 100 i=1,nssta -c -c --- constant 0.3484321 = 100 kg / (m * sec**2) per mb divided by -c --- (287 m**2 / (deg K * sec**2)) - rhos(i)=0.3484321*pres(i)/tempk(i) -100 continue - -c 2-D density: take rho at closest station - do 200 j=1,ny - do 200 i=1,nx - nsta = nears(i,j) - rho(i,j)=rhos(nsta) -200 continue - -c - return - end -c---------------------------------------------------------------------- - subroutine t2d_nsp(nears,nx,ny,itprog,tprog,tsfnsp) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070618 T2D_NSP -c -c --- PURPOSE: Fill in 2D temperature field from either the nearest -c surface station data or prognostic data -c -c --- INPUTS: -c TEMPK(mxss) - real array - Air temperature (deg. K) -c NEARS(mxnx,mxny) - integer array - Station number of surface -c station closest to each grid pt -c NX - integer - Number of grid cells in X -c direction -c NY - integer - Number of grid cells in Y -c direction -c ITPROG - integer - Flag indicating if sf temperature -c from prognostic data -c (2 = yes, otherwise, no) -c TPROG - real array - 3D prognostic temperature -c -c Parameters: MXNX, MXNY, MXSS, MXNZ -c Common /MET2/ -c TEMPK -c -c --- OUTPUT: -c TSFNSP(mxnx,mxny) - real array - 2D surface air temperature (K) -c from either surface nearest sfc -c stations or prognostic data -c -c --- T2D_NSP called by: DIAGNO -c --- T2D_NSP calls: none -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' - include 'met2.met' - - integer nears(mxnx,mxny) - real tprog(mxnx,mxny,mxnz) - real tsfnsp(mxnx,mxny) - - do i=1,nx - do j=1,ny - if (itprog.lt.2) then - tsfnsp(i,j)=tempk(nears(i,j)) - else - tsfnsp(i,j)=tprog(i,j,1) - endif - enddo - enddo - -cc --- T2D_NSP DEBUG -c write(*,*)'T2D_NSP -- ITPROG,nx,ny = ',itprog,nx,ny -c write(*,*)'(1,1) tempk,tprog,tsfnsp= ', -c & tempk(nears(1,1)),tprog(1,1,1),tsfnsp(1,1) - - return - end -c --------------------------------------------------------------------- - function psiuc(z,zmol,ifit) -c --------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 070618 PSIUC -c -c --- PURPOSE: Compute surface layer wind speed profile stability -c correction using formulas from CALMET v5.53 -c -c --- INPUTS: -c Z - real - Height (m) -c ZMOL - real - M-O Length (m) -c ifit - integer - profile fit constant (either -c 15.0 or 16.0 are used, so arg -c is either 15 or 16) -c -c --- OUTPUT: -c psiuc - real - Wind speed profile stability -c correction factor -c -c --- PSIUC called by: ELUSTR, ELUSTR2, SIMILT -c --- PSIUC calls: none -c---------------------------------------------------------------------- -c --- include parameters - include 'params.met' - -c --- Check fit parameter - if(ifit.EQ.15) then - rfit=15.0 - elseif(ifit.EQ.16) then - rfit=16.0 - else - write(io6,*)'ERROR in PSIUC: invalid ifit provided' - write(io6,*)' Expected ifit = 15 or 16' - write(io6,*)' Found ifit = ',ifit - stop 'ERROR in PSIUC -- see list file' - endif - - if (zmol.GT.0.0) then -c --- Stable - psiuc = -17.*(1.-EXP(-0.29*z/zmol)) - else -c --- Unstable - x=(1.-rfit*z/zmol)**0.25 - psiuc=2.0*ALOG(0.5*(1.+x))+ALOG(0.5*(1.+x*x))- - & 2.0*ATAN(x)+1.5707963 - endif - - return - end -c---------------------------------------------------------------------- - subroutine surfvar_back(tprog,temp2d,irh2d,ipcode2d) -c---------------------------------------------------------------------- -c --- Previous version of SURFVAR dated Level 030119 re-introduced to -c --- obtain consistency with CALMET v5.5 series with ISFCMET=1 option -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 030119 SURFVAR -c --- F.Robe , Earth Tech -c -c --- PURPOSE: Fill out 2D arrays of surface temperature, -c relative humidity, and precipitation code, -c using surface observations or prognostic data -c -c --- UPDATES: -c --- V5.53c (030119) to V6.3 (070717) -c - Rename irhprog array to irhpg to be consistent with rest -c of the code and avoid conflict with irhprog flag -c -c --- INPUTS: -c TPROG(mxnx,mxny,mxnz) - real array - prognostic temperature -c on CALMET grid -c Common block /GRID/ -c NX,NY,NZ,NEARS(mxnx,mxny) -c Common block /MET1/ -c ITPROG,noobs,NPSTA -c Common block /MET2/ -c TEMPK(mxss), IRH(mxss), IPCODE(mxss) -c Common /SURFPROG/(with rdmm5) -c IRHPG(mxnx,mxny),IPCODEPG(mxnx,mxny) -c -c --- OUTPUT: -c TEMP2D(mxnx,mxny) - real array - surface temperature at all gridpoints -c IRH2D(mxnx,mxny) - int array - surface relative humidity -c IPCODE2D(mxnx,mxny) - int array - surface precipitation code -c---------------------------------------------------------------------- -c - include 'params.met' - include 'grid.met' - include 'met1.met' - include 'met2.met' - - common /surfprog/irhpg(mxnx,mxny),ipcodepg(mxnx,mxny) - real temp2d(mxnx,mxny),tprog(mxnx,mxny,mxnz) - integer irh2d(mxnx,mxny),ipcode2d(mxnx,mxny) - - do 1 j=1,ny - do 1 i=1,nx -c -c --- first initialize - temp2d(i,j)= 0. - irh2d(i,j) = 0 - ipcode2d(i,j) = 0 - -c --- Fill-in the 2-D surface arrays - - if (noobs.eq.2) then -c --- use prognostic data if no observations - temp2d(i,j) = tprog(i,j,1) - irh2d(i,j) = irhpg(i,j) - if (npsta.ne.0) ipcode2d(i,j) = ipcodepg(i,j) - else -c --- otherwise use values at closest surface station -c --- (except for Temp if itprog=2 and ipcode if npsta=-1) - nsta = nears (i,j) - if (itprog.ne.2)then - temp2d(i,j)=tempk(nsta) - else - temp2d(i,j)=tprog(i,j,1) - endif - irh2d(i,j) = irh(nsta) - if (npsta.gt.0) then - ipcode2d(i,j) = ipcode(nsta) - else if (npsta.eq.-1)then - ipcode2d(i,j) = ipcodepg(i,j) - endif - endif - - 1 continue - - return - end -c---------------------------------------------------------------------- - subroutine temp3d_back(nyrze,njulze,nhrze,nsece,tempk,ziconv, - 1 tzgraa,tzgrbb,ztemp,zi,tprog,mnmdav,hafang,u,v) -c---------------------------------------------------------------------- -c --- Previous version of TEMP3D dated Level 970825 re-introduced to -c --- obtain consistency with CALMET v5.5 series with ISFCMET=1 option -c --- With modifications for sub-hourly timesteps (explicit beg. times -c --- with seconds) -c---------------------------------------------------------------------- -c -c --- CALMET Version: 6.5.0 Level: 090511 TEMP3D -c --- R. Yamartino, SRC -c --- Modified by J. Scire to allow for missing data (900810) -c --- Modified by M. Fernau to allow for 1/Radius weighting -c --- and different treatment of land vs. water (940912) -c --- Modified for MM4 data only; no UPn.DAT (941101) -c --- Modified to have radius of influence and maximum number -c --- of stations in surface interpolation (950321) -c --- Modified by F.Robe to get 3D temp from prognostic data -c --- at upper levels and/or surface (030119)(param:ITPROG) -c -c --- PURPOSE: Compute a 3-D temperature field -c -c --- NOTE: Currently, if no upper air data exist, then MM4 data are -c used in place of NWS upper air data. If any NWS data -c exist, only NWS data are used. This should be modified -c to allow a weighted use of both. -c FRR (09/2001): if ITPROG=1 upper air temperature from MM5 -c if ITPROG=2 upper air and surface temperature from MM5 -c -c --- UPDATES: -c --- V6.32 Level 080205 to v6.327 Level 090511 (FRR) -c - Change text and number format in 1089-1090 error write -c to reflect time differences in seconds rather than hours -c -c --- V5.8 Level 070623 to V6.32 Level 080205 -c (1) Back to original end times (explicit with seconds) -c -c --- v5.53 level 970825 to V5.8 Level 070623 -c (1) bug fix: in noobs temp mode, adjust temperatures to adiabatic -c profile under convective mixing height was done under un-defined -c variable zic (i.e. 0 or random number depending on compiler) -c -c --- INPUTS: -c NYRZE - integer - Year of current hour (GMT) -c (explicit end time) -c NJULZE - integer - Day of current hour (GMT) -c (explicit end time) -c NHRZE - integer - Current hour GMT time (0-23) -c (explicit end time) -c NSECE - integer - Current beginning second -c TEMPK(mxss) - real array - Surface temp. observations -c (deg. K) -c (this actually is the otempk array w/ missing data) -c ZICONV(mxnx,mxny) - real array - Convective mixing height (m) -c ZI(mxnx,mxny) - real array - Mixing height (m) -c TZGRaa(mxnzp1,mxus) - real array - Grid face temp. interpolations -c for aa GMT sounding (deg. K) -c TZGRbb(mxnzp1,mxus) - real array - Grid face temp. interpolations -c for bb GMT sounding (deg. K) -c TPROG(mxnx,mxny,mxnz) - real array - MM4 temperature array on CALMET grid -c U(mxnx,mxny) - real array - level 1 winds for upwind averaging -c V(mxnx,mxny) - real array - level 1 winds for upwind averaging -c MNMDAV - integer - Max. grid cell search radius -c (outside of HAFANG cone region) -c for mixing depth averaging. -c HAFANG - real - Half-angle (degrees) of upwind -c looking cone for averaging. -c Common block /GRID/ -c nx,ny,nz,nzp1,dgrid,zface,zmid -c Common block /MET1/ -c nssta,nusta,xssta,yssta,xusta,yusta,noobs,ITPROG -c Common block /UPMET/ -c justa,justd,ntzaa,ntzbb -c Common block /TMP/ -c irad,numwb,tgdefb,tgdefa,jwat1,jwat2,trad,numts,iavet -c Common block /GEO/ -c ilandu,iwat1,iwat2,elev -c Common block /OVRWAT/ -c tairow,nowsta,tgrada,tgradb -c Parameters: mxnx, mxny, mxnz, mxnzp1, mxss, -c mxus, mxps, mxlev, mxtmp -c -c --- OUTPUT: -c ZTEMP(mxnx,mxny,mxnz) - real array - 3-D temperature field (deg. K) -c -c --- TEMP3D_BACK called by: COMP -c --- TEMP3D_BACK calls: DEDAT,DELTT -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.met' -c - real tempk(mxss) - real zi(mxnx,mxny),ziconv(mxnx,mxny) - real tzgraa(mxnzp1,mxus),tzgrbb(mxnzp1,mxus) - real ztemp(mxnx,mxny,mxnz),tprog(mxnx,mxny,mxnz) - real u(mxnx,mxny),v(mxnx,mxny) -c --- local arrays - real tzgr(mxnzp1,mxus),tgrdb(mxnx,mxny),tgrda(mxnx,mxny) - real tzua(mxnzp1) - real wtus(mxus) - real tmpwrk(mxtmp),tdist(mxtmp) - integer stlist(mxtmp) -c - include 'grid.met' - include 'met1.met' - include 'upmet.met' - include 'tmp.met' - include 'geo.met' - include 'ovrwat.met' -c - data xmiss/9999./ -c -c --- If no sf stations and no prognostic data, use default value for ZTEMP -c FRR (09/2001) -c if(nssta.le.0 ) return - if(nssta.le.0 .and. itprog.ne.2) return -c -c --- If no upper air stations, use default value for ZTEMP -c - if(nusta.le.0 .and. itprog.eq.0 ) return -c -c --- Current timestamp (End GMT time) - nowtze = nyrze*100000 + njulze*100 + nhrze - -c --- Compute time interpolated temperatures for each upper air station. -c Note that the aa and bb GMT values at each cell face are -c available in the tzgraa and tzgrbb arrays. -c -c FRR (9/2001) noobs (3 options) -c if (noobs .eq. 1) goto 6 - if (itprog.ge.1) goto 6 - do 10 iu = 1,nusta - jorder = justa(iu) - jdelta = jusdt(iu) - ntzaas = ntzaa(iu) - call dedat(ntzaas,jaayr,jaaday,jaahr) - ntzbbs = ntzbb(iu) - call dedat(ntzbbs,jbbyr,jbbday,jbbhr) - ibbsec=jbbsec(iu) - iaasec=jaasec(iu) - - - if (jorder .gt. 0) then -c call deltt(nyrz,njulz,nhrz,jbbyr,jbbday,jbbhr,jtogo) -c call deltt(jaayr,jaaday,jaahr,nyrz,njulz,nhrz,jpast) - call deltsec(nowtze,nsece,ntzbbs,ibbsec,jtogo) - call deltsec(ntzaas,iaasec,nowtze,nsece,jpast) - else -c call deltt(nyrz,njulz,nhrz,jaayr,jaaday,jaahr,jtogo) -c call deltt(jbbyr,jbbday,jbbhr,nyrz,njulz,nhrz,jpast) - call deltsec(nowtze,nsece,ntzaas,iaasec,jtogo) - call deltsec(ntzbbs,ibbsec,nowtze,nsece,jpast) - - end if -c -c --- Check for negative values of jtogo or jpast -c - if (jtogo .LT. 0 .OR. jpast .LT. 0) then -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1089)iu, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - -1089 format(//1x,'ERROR IN SUBR. TEMP3D_BACK -- Upper air ', - 1 'soundings do not straddle current hour'/ - 1 2x,'Station no.: ',i5/, - 2 38x,'Year Julian Day Month Day Hour Seconds '/, -c xxxx xxx xx xx xx xxxx - 4 ' Current model date/time (UTC-GMT): ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 1 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 2 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - stop - end if -c -c --- Double check for upper air data inconsistencies -c - if ((jpast + jtogo) .ne. jdelta) then - -c --- Convert to Gregorian Day for output purposes - call dedat(nowtze,ioutyz,ioutjz,iouthz) - call grday(io6,ioutyz,ioutjz,ioutmz,ioutdz) - call dedat(ntzaas,ioutya,ioutja,ioutha) - call grday(io6,ioutya,ioutja,ioutma,ioutda) - call dedat(ntzbbs,ioutyb,ioutjb,iouthb) - call grday(io6,ioutyb,ioutjb,ioutmb,ioutdb) - - write(io6,1090)iu, - : ioutyz,ioutjz,ioutmz,ioutdz,iouthz,nsece, - : ioutya,ioutja,ioutma,ioutda,ioutha,iaasec, - : ioutyb,ioutjb,ioutmb,ioutdb,iouthb,ibbsec - -1090 format(//1x,'ERROR IN SUBR. TEMP3D_BACK -- Inconsistent ', - 1 'upper air times for station ',i3/ - 2 38x,'Year Julian Day Month Day Hour Seconds '/, -c xxxx xxx xx xx xx xxxx - 4 ' Current model date/time (UTC-GMT): ', - 4 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 1 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4,/, - 5 'Sounding 2 Date/time in UP.DAT file: ', - 5 i5.4,i9.3,i9.2,i6.2,i5.2,i8.4) - - stop - end if -c -c --- Interpolate in time to current hour and loop over all levels -c - xfact = float(jtogo) / float(jdelta) - if (jorder .lt. 0) then - do 3 k = 2,nzp1 - 3 tzgr(k,iu) = tzgraa(k,iu) - (tzgraa(k,iu) - tzgrbb(k,iu)) - & * xfact - else - do 5 k = 2,nzp1 - 5 tzgr(k,iu) = tzgrbb(k,iu) - (tzgrbb(k,iu) - tzgraa(k,iu)) - & * xfact - end if -10 continue - 6 continue -c - dgridi = 1.0 / dgrid -c - -c --- Use Prognostic data for surface temperature if itprog=2 - if (itprog.eq.2) goto 49 - -c -c --- Determine whether overwater vs. land interpolation to be used -c (assume mxwb is hardwired to 1) -c -c --- Find maximum land use category -c - maxcat = 0 - do lwi = 1,nlu - if (ilucat(lwi) .gt. maxcat) maxcat = ilucat(lwi) - end do -c -c --- If maximum land use category is < jwat1, use all sites -c in the interpolation -c - ldwat = 1 - if (maxcat .lt. jwat1(mxwb)) ldwat = 0 -c -c --- Set LNDWAT = 0 so won't be undefined -c - lndwat = 0 -c -c --- Load surface temperature working array -c - nstat = nssta + nowsta - if ((nstat) .gt. mxtmp) then - write(io6,*) ' too many combined surface stations!' - write(io6,*) ' mxtmp = ',mxtmp,' nssta & nowsta = ', - & nssta,nowsta - stop - end if - do mstat = 1,nstat - if (mstat .le. nssta) then - tmpwrk(mstat) = tempk(mstat) - else - tmpwrk(mstat) = tairow(mstat - nssta) - end if - end do -c -c --- Reduce the missing value indicator by a small amount to allow -c for machine roundoff -c - xmissm=xmiss-0.01 -c -49 continue - -c --- Loop over grid cells -c - do 50 i = 1,nx -c -c --- Note,(xssta,yssta) are relative to the SW corner of grid pt (1,1) -c - xc = float(i) - 0.5 -c - do 50 j = 1,ny - yc = float(j) - 0.5 -c -c FRR (9/2001) - surface temp from prognostic model - if ( itprog .eq. 2 ) then - ztemp(i,j,1) = tprog(i,j,1) - goto 50 - endif - -c --- Compute the weights for the surface met stations -c and compute the average surface temperature -c and average temperature gradients -c (irad = 1 = 1/R; irad = 2 = 1/R**2) -c -c---------------------------------------------------------------- -c...multiple water body capability commented out for now (9/94) -c -c --- If using land/water interpolation, determine in which water -c body, if any, the grid cell is located -c -c.wb jwb = 0 -c.wb if (numwb .gt. 0) then -c.wb do iwb = 1,numwb -c.wb if (ilandu(i,j) .ge. jwat1(iwb) .and. -c.wb & ilandu(i,j) .le. jwat2(iwb)) then -c -c --- Grid cell land use places it in water body iwb -c -c.wb jwb = iwb -c.wb goto 27 -c.wb end if -c.wb end do -c -c --- Grid cell not in any water body of interest, call it land -c (jwb = 0) -c.wb -c.wb end if -c27 continue -c-------------------------------------------------------------------- -c FRR (09/2001) May want an option for observed water temp rather than -c prognostic temp in the future - -c --- If using land/water interpolation, determine whether water -c or land (assume mxwb is hardwired to 1) -c - if (ldwat .eq. 1) then - lndwat = 0 - if (ilandu(i,j) .ge. jwat1(mxwb) .and. - & ilandu(i,j) .le. jwat2(mxwb)) lndwat = 1 - end if -c -c --- Find valid stations -c - numsta = 0 - do 30 is = 1,nstat -c -c --- Skip this station if the temperature data is missing -c - if (tmpwrk(is) .ge. xmissm) goto 30 -c -c --- If not using L/W interpolation, skip this part and use all -c stations -c - if (ldwat .eq. 1) then -c -c --- Skip this station if using L/W interpolation, cell is water, -c and station is land -c - if (lndwat .eq. 1 .and. is .le. nssta) goto 30 -c -c --- Skip this station if using L/W interpolation, cell is land, -c and station is water -c - if (lndwat .eq. 0 .and. is .gt. nssta) goto 30 - end if -c -c--------------------------------------------------------------------- -c...multiple water body capability commented out for now (9/94) -c -c --- If number of water bodies to be interpolated = 0 then -c include all nonmissing stations (numwb = 0). -c --- If using water/land interpolation (numwb > 0), discard -c station if not located in interpolation area that corresponds -c to land use range for that water body/land. -c -c.wb if (numwb .gt. 0 .and. jwb .ne. jlandu(is)) goto 30 -c---------------------------------------------------------------------- -c - numsta = numsta + 1 - if (is .le. nssta) then - xxx = xssta(is) - yyy = yssta(is) - else - xxx = xowsta(is - nssta) - yyy = yowsta(is - nssta) - end if - r2 = (xxx * dgridi - xc)**2 + - & (yyy * dgridi - yc)**2 -c -c --- Valid station, store distance and site number -c - tdist(numsta) = sqrt(r2) - stlist(numsta) = is - 30 continue -c -c --- Sort list of eligible stations -c - if (numsta .gt. 1) then - do ii = 1,numsta-1 - do jj = ii+1,numsta - if (tdist(ii).gt.tdist(jj)) then - tmpvar = tdist(ii) - tdist(ii) = tdist(jj) - tdist(jj) = tmpvar - itmpvar = stlist(ii) - stlist(ii) = stlist(jj) - stlist(jj) = itmpvar - end if - end do - end do - end if - if (numsta .eq. 0) then -c -c --- No valid sites, stop program -c - write(io6,*) ' grid cell ',i,j,' has no valid sites for' - write(io6,*) ' interpolation. If it is a water body and' - write(io6,*) ' you are using land/water interpolation,' - write(io6,*) ' you must have at least 1 sea#.dat file!' -c -c------------------------------------------------------------------ -c...commented out because no multiple water bodies and no JLANDU -c -c.wb write(io6,*) ' you must assign it a real or pseudo' -c.wb write(io6,*) ' station in input group 7!' -c------------------------------------------------------------------- -c - stop - end if - sumwt = 0.0 - tsurf = 0.0 - tgrda(i,j) = 0.0 - tgrdb(i,j) = 0.0 - sumwt2 = 0.0 - sumwt3 = 0.0 -c -c --- Calculate average temperature and TGRADs -c - if (tdist(1) .gt. trad) then -c -c --- No stations within radius of influence, take nearest one -c - tsurf = tmpwrk(stlist(1)) - if (lndwat .eq. 1) then -c -c --- If LNDWAT = 1 then STLIST(1) always > NSSTA) -c - if (tgradb(stlist(1) - nssta) .lt. xmissm) then -c -c --- Use observed TGRAD -c - tgrdb(i,j) = tgradb(stlist(1) - nssta) - else -c -c --- Use default TGRAD -c -c *** if (i .eq. 1 .and. j .eq. 1) then -c *** write(io6,*) ' No TGRADB info in sea#.dat files!' -c *** write(io6,*) ' Default lapse rate used' -c *** end if - tgrdb(i,j) = tgdefb - end if - if (tgrada(stlist(1) - nssta) .lt. xmissm) then -c -c --- Use observed TGRAD -c - tgrda(i,j) = tgrada(stlist(1) - nssta) - else -c -c --- Use default TGRAD -c -c *** if (i .eq. 1 .and. j .eq. 1) then -c *** write(io6,*) ' No TGRADA info in sea#.dat files!' -c *** write(io6,*) ' Default lapse rate used' -c *** end if - tgrda(i,j) = tgdefa - end if - end if - else -c -c --- Some stations within radius, use up to NUMTS of them -c - do 888 is = 1,numsta - if (tdist(is) .gt. trad) goto 889 - if (is .gt. numts) goto 889 - if (irad .eq. 2) tdist(is) = tdist(is) * tdist(is) - if (tdist(is) .lt. 1.0) then - wt = 1.0 - else - wt = 1.0 / tdist(is) - endif - sumwt = sumwt + wt - tsurf = tsurf + wt*tmpwrk(stlist(is)) - if (lndwat .eq. 1) then -c -c --- If LNDWAT = 1 then STLIST(IS) always > NSSTA) -c - if (tgradb(stlist(is) - nssta) .lt. xmissm) then - sumwt2 = sumwt2 + wt - tgrdb(i,j) = tgrdb(i,j) + - & wt * tgradb(stlist(is) - nssta) - end if - if (tgrada(stlist(is) - nssta) .lt. xmissm) then - sumwt3 = sumwt3 + wt - tgrda(i,j) = tgrda(i,j) + - & wt * tgrada(stlist(is) - nssta) - end if - end if - 888 continue - 889 tsurf = tsurf / sumwt - if (lndwat .eq. 1) then - if (sumwt2 .gt. 0.) then -c -c --- Use observed TGRAD -c - tgrdb(i,j) = tgrdb(i,j) / sumwt2 - else -c -c --- Use default TGRAD -c -c *** if (i .eq. 1 .and. j .eq. 1) then -c *** write(io6,*) ' No TGRADB info in sea#.dat files!' -c *** write(io6,*) ' Default lapse rate used' -c *** end if - tgrdb(i,j) = tgdefb - end if - if (sumwt3 .gt. 0.) then -c -c --- Use observed TGRAD -c - tgrda(i,j) = tgrda(i,j) / sumwt3 - else -c -c --- Use default TGRAD -c -c *** if (i. eq. 1 .and. j .eq. 1) then -c *** write(io6,*) ' No TGRADA info in sea#.dat files!' -c *** write(io6,*) ' Default lapse rate used' -c *** end if - tgrda(i,j) = tgdefa - end if - end if - end if -c -c --- Always use the surface determined temperature for the lowest cell -c - ztemp(i,j,1) = tsurf - 50 continue -c -51 continue - -c --- Spatially average surface temperature -c --- (currently uses mixing height variables) -c - if (iavet.eq.1) call avetmp(nx,ny,mnmdav,hafang,dgrid, - & u,v,ztemp(1,1,1)) -c -c --- Load the 3-d temp array: -c - do 150 i = 1,nx -c -c --- Note,(xusta,yusta) are relative to the SW corner of grid pt (1,1) -c - xc = float(i) - 0.5 -c - do 150 j = 1,ny -c -c --- If using MM4/MM5 only aloft (no observations) just use TPROG as the -c temperature field aloft -c -c FRR(09/2001) - flag itprog for prognostic temperature -c if (noobs .eq. 1) then - if (itprog .ge. 1) then - do k = 2,nz - ztemp(i,j,k) = tprog(i,j,k) -c frr (09/01) -c --- Below convective mixing height, use dry adiabatic lapse rate -c --- this is needed because of the spatial and temporal interpolation -c --- performed on the prognostic data in RDMM5 -c --- bug fix: zic is not defined in noobs, use convective mixing height -c if (zmid(k).le.zic) - if (zmid(k).le.ziconv(i,j)) - & ztemp(i,j,k) = ztemp(i,j,1)-0.0098*(zmid(k)-zmid(1)) - enddo - go to 150 - endif -c - yc = float(j) - 0.5 -c -c --- Compute the weights for the upper air stations -c (irad = 1 = 1/R; irad = 2 = 1/R**2) -c - sumwt = 0.0 - do 115 iu = 1,nusta - wtus(iu) = 0.0 - r2 = (xusta(iu) * dgridi - xc)**2 + - & (yusta(iu) * dgridi - yc)**2 - if (irad .eq. 1) r2 = sqrt(r2) - if (r2 .lt. 1.0) then - wt = 1.0 - else - wt = 1.0 / r2 - endif - sumwt = sumwt + wt - wtus(iu) = wt - 115 continue -c -c --- Normalize the weights -c - sumwt = 1.0 / sumwt - do 117 iu = 1,nusta - 117 wtus(iu) = wtus(iu) * sumwt -c -c --- Load the upper air determined temperatures into tzua -c - do 125 k = 2,nzp1 - tzuas = 0.0 - do 120 iu = 1,nusta - 120 tzuas = tzuas + wtus(iu) * tzgr(k,iu) - tzua(k) = tzuas - 125 continue -c -c --- If using land/water interpolation, determine whether water -c or land (assume mxwb is hardwired to 1) -c - if (ldwat .eq. 1) then - lndwat = 0 - if (ilandu(i,j) .ge. jwat1(mxwb) .and. - & ilandu(i,j) .le. jwat2(mxwb)) lndwat = 1 - end if - if (ldwat .eq. 0 .or. lndwat .eq. 0) then -c -c --- Use convective mixing height, adiabatic lapse rate, upper air -c data method if not using L/W interpolation or if grid cell is -c on land -c -c --- Fetch the convective mixing height -c - zic = ziconv(i,j) -c - do 145 k=2,nz - kp1 = k + 1 - zlow = zface( k ) - tlow = tzua( k ) - zhgh = zface(kp1) - thgh = tzua(kp1) -c -c --- Entire layer above convective mixing height, use average of -c sounding levels -c - if (zlow .gt. zic) ztemp(i,j,k) = 0.5 * (tlow + thgh) -c -c --- Entire layer below convective mixing height, use adiabatic -c lapse rate -c - if (zhgh .le. zic) ztemp(i,j,k) = ztemp(i,j,1) - 0.0098 - & * 0.5 * (zlow + zhgh) - - if (zlow .le. zic .and. zhgh .gt. zic) then -c -c --- Convective mixing height located in layer, use 3-point thickness -c weighted average of temperature at the two cell faces and at -c the CMH -c - tlow = ztemp(i,j,1) - 0.0098 * zlow - tmid = ztemp(i,j,1) - 0.0098 * zic - ztemp(i,j,k) = 0.5 * ((tlow + tmid) * (zic - zlow) + - & (tmid + thgh) * (zhgh - zic)) / (zhgh - zlow) - endif - 145 continue - else -c -c --- Over water use user-determined TGRAD -c -c --- Substitute regular mixing height for convective MH -c - zic = zi(i,j) - do 146 k = 2,nz - kp1 = k + 1 - zlow = zface(k) - zhgh = zface(kp1) - if (zhgh .le. zic) then -c -c --- Entire layer below the mixing height, use tgrad below -c - ztemp(i,j,k) = ztemp(i,j,1) + tgrdb(i,j) * zmid(k) - else if (zlow .gt. zic) then -c -c --- Entire layer above the mixing height, use tgrad above for -c portion above the mixing height -c - ztemp(i,j,k) = ztemp(i,j,1) + tgrdb(i,j) * zic + - & tgrda(i,j) * (zmid(k) - zic) - else if (zlow .le. zic .and. zhgh .gt. zic) then -c -c --- Mixing height is located in layer, use thickness weighted -c 3-point average -c - tlow = ztemp(i,j,1) + tgrdb(i,j) * zlow - tmid = ztemp(i,j,1) + tgrdb(i,j) * zic - thgh = ztemp(i,j,1) + tgrdb(i,j) * zic + - & tgrda(i,j) * (zhgh - zic) - ztemp(i,j,k) = 0.5 * ((tlow + tmid) * (zic - zlow) + - & (tmid + thgh) * (zhgh - zic)) / (zhgh - zlow) - endif - 146 continue - end if - 150 continue - return - end - - -c------------------------------------------------------------------------------ - subroutine inout(xx,yy,iflag,xb,yb,nbpts) -c------------------------------------------------------------------------------ -c -c --- CALMET Version: 6.5.0 Level: 090511 INOUT -c --- Based on BOUND_2.FOR, V2.0, J. Scire -c -c --- PURPOSE: performs in/out test on single point (xx,yy) for boundary -c defined by xb,yb and returns in/out/on flag -c -c -c --- UPDATES: -c --- Bound_2.for v2.0 (2000-01-11) to V6.327 Level 090511 (F.Robe): -c - Adapted to CALMET (variable definitions, conventions, -c error messages,number of boundaries limited to 1 ) -c -c --- INPUT: -c xx, YY - real*8 - coordinates of CALMET gridpoint (km) -c XB (mxb3d),YB(mxb3d) - real*8 - Coordinates defining the boundary -c the boundary must be closed (start -c point=end point) -c -c via PARAMS.MET: io6,mxb3d (number of MM4/MM5 boundary points) -c -c NBPTS - integer - Number of points defining the boundary -c --- OUTPUT: -c IFLAG - integer - IN/OUT/ON flag -c = 0: CALMET gridpoint OUTside of boundaries -c = 1: CALMET gridpoint INside of boundaries -c =-1: CALMET gridpoint ON boundaries -c -c --- INOUT called by: RDHD4, RDHD5 -c --- INOUT calls: - -c -c ------------------------------------------------------------------------- - include 'params.met' - -c --- CALMET gridpoint (dubbed "receptor" in the subroutine) - real*8 xx,yy - -c --- boundary information - real*8 xb(mxb3d),yb(mxb3d) - - real*8 small - parameter(small=1.0d-3) !tolerance for being on boundary - -c --- test on boundary - real*8 xs,ys,xp,yp,xe,ye,d2,ds,dc,small2 - -c --- work array with segment no. of all segments intersecting Y coordinate -c --- of receptor - integer ibsave(mxb3d) - - small2 = small*small - - -c ----------------------------------------------- -c --- STEP 1 - Find all boundary segments which -c --- cross Y of the receptor -c ----------------------------------------------- - nseg=0 - -c --- Start and end indices of boundary points - ns = 1 - ne = nbpts - -c set nflag = 1 if we're starting above the line, =-1 if below -c (do loop necessary if boundary is on y = yy) - do j = ne,ns,-1 - if (yb(j).gt.yy) then - nflag = 1 - goto 100 - elseif (yb(j).lt.yy) then - nflag = -1 - goto 100 - endif -c if boundary is a straight line on yy, nflag = -1 - nflag = -1 - enddo - 100 continue - -c for each boundary, make list of segments intersecting Y coordinate - do j = ns+1,ne - if(nflag.eq.1.and.yb(j).lt.yy) then - nseg = nseg + 1 - ibsave(nseg) = j - nflag = -1 - elseif(nflag.eq.-1.and.yb(j).gt.yy) then - nseg = nseg + 1 - ibsave(nseg) = j - nflag = 1 - endif -c check if point is within 'small' of the boundary -c boundary segment vector: - xs = xb(j)-xb(j-1) - ys = yb(j)-yb(j-1) - ds = (xs*xs+ys*ys) !boundary segment length - if (ds.ne.0.0) then -c quietly ignore zero length segments -c receptor vector: - xp = xx-xb(j-1) - yp = yy-yb(j-1) -c perpendicular vector from boundary segment to receptor: - xe = (xp - ((xs*xp+ys*yp)/ds)*xs) - ye = (yp - ((xs*xp+ys*yp)/ds)*ys) - d2 = (xe*xe+ye*ye) !perpendicular distance squared to receptor -c projected position of perpendicular on segment: - dc = (xs*xp+ys*yp) - if (d2.lt.small2.and.dc.ge.(0.0-small2).and. - & dc.le.(ds+small2)) then - iflag = -1 - goto 101 -c return - endif - endif - enddo - -c --- The number of segments intersecting y=yy must be zero or -c --- an even number - if(mod(nseg,2).ne.0)then - write( 6,*)'ERROR -- STOP in subroutine INOUT' - write(io6,*)'ERROR -- STOP in subroutine INOUT' - write(io6,*)'Number of segments intersecting yy ', - 1 'must be zero or an even number -- NSEG = ',nseg - write(io6,*)'CALMET coordinates x,y:',xx,yy - write(io6,*)'IBSAVE = ',(ibsave(n),n=1,nseg) - stop - endif -c -c --- If no boundary segments intersect yy, receptor must be OUTSIDE -c --- of the boundary - if(nseg.eq.0) then - iflag = 0 - goto 101 - endif -c -c --------------------------------------------------- -c --- STEP 2 - count no. of segments on either side of xx -c --- even -> out -c --- odd -> in -c --- <> nseg -> boundary -c --------------------------------------------------- -c - nlow = 0 - nhigh = 0 - do i = 1,nseg - i1 = ibsave(i)-1 - i2 = ibsave(i) - xint = xb(i2)-(xb(i2)-xb(i1))*(yb(i2)-yy) - & /(yb(i2)-yb(i1)) - if (abs(xint-xx).lt.small) then -c boundary: - iflag = -1 - goto 101 -c return - elseif (xint.gt.xx) then - nhigh = nhigh + 1 - elseif (xint.lt.xx) then - nlow = nlow + 1 - endif - enddo - - if ((nhigh+nlow).eq.nseg) then - if (mod(nhigh,2).eq.0) then -c out: - iflag = 0 - else -c in: - iflag = 1 - endif - else -c boundary: - iflag = -1 - endif - - 101 continue - - return - end -c --------------------------------------------------------------------- \ No newline at end of file diff --git a/CALPUFF_SRC/CALMET/calutils.for b/CALPUFF_SRC/CALMET/calutils.for deleted file mode 100644 index 20bcf13..0000000 --- a/CALPUFF_SRC/CALMET/calutils.for +++ /dev/null @@ -1,2953 +0,0 @@ -c------------------------------------------------------------------------------ -c --- CALUTILS -- CALPUFF SYSTEM UTILITIES -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 141010 -c -c Copyright (c) 2014 by Exponent, Inc. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c --- Coordinates -c subroutine xtractll -c --- Year 2000 -c subroutine yr4 -c subroutine yr4c -c subroutine qayr4 -c --- Date/Time -c subroutine julday -c subroutine grday -c subroutine dedat -c subroutine deltt -c subroutine incr -c subroutine indecr -c subroutine incrs -c subroutine deltsec -c subroutine midnite -c subroutine basrutc -c subroutine utcbasr -c --- Control file -c subroutine filcase -c subroutine readin -c subroutine altonu -c subroutine deblnk -c subroutine deplus -c subroutine tright -c subroutine tleft -c subroutine setvar -c subroutine allcap -c --- System -c subroutine datetm -c subroutine fmt_date -c subroutine etime -c subroutine undrflw -c subroutine comline -c --- Error -c subroutine open_err -c ----------------------------- -c -c --- UPDATE -c --- V2.6.0-V2.7.0 141010 :Add error-report for file-open -c New : OPEN_ERR -c --- V2.58-V2.6.0 140318(MBN):Use F95 intrinsic procedures for date and time. -c Modified: DATETM -c Removed obsolete Compaq, Microsoft, and HP -c compiler codes, and removed getcl -c Modified: COMLINE -c --- V2.571-V2.58 110225(DGS):Add variable type 5 to control file processor -c to allow character array variables -c Modified: READIN, ALTONU, SETVAR -c --- V2.57-V2.571 090511(DGS):Add routine to reformat a date string -c New : FMT_DATE -c --- V2.56-V2.57 090202(DGS): Increase control file line length to 200 -c characters -c Modified: PARAMS.CAL, READIN -c Activate CPU clock using F95 system routine -c Modified: DATETM -c --- V2.55-V2.56 080407(DGS): Exponential notation processing in ALTONU did -c not properly interpret an entry without a -c decimal point. -c --- V2.54-V2.55 070327(DGS): Format for output time zone stringin BASRUTC -c wrote zone zero as 'UTC+0 0' instead of -c 'UTC+0000' -c Add RETURN statement to BASRUTC and UTCBASR -c --- V2.53-V2.54 061020(DGS): Allow negative increments in INCRS -c --- V2.52-V2.53 060626(DGS): Remove routine GLOBE1 (move to COORDLIB) -c --- V2.51-V2.52 060519(DGS): Modify search for '=' in READIN to allow -c for blanks between c*12 variable name and -c the '=' sign (internal blanks are not removed -c after V2.2) -c --- V2.5-V2.51 051019 (KAM): Add Albers Conical Equal Area projection -c in GLOBE1 -c --- V2.4-V2.5 041123 (FRR): add subroutine BASRUTC to convert real -c base time zone to character UTC time zone -c and UTCBASR for the backward conversion -c --- V2.3-V2.4 041029 (DGS): Add routine INCRS to change time by a -c number of seconds -c Add routine MIDNITE - converts timestamp -c from day N, time 0000 -c to day N-1, time 2400 -c --- V2.2-V2.3 040330 (DGS): Replace filename strings c*70 with c*132 -c (FILCASE, COMLINE) -c Allow for spaces within pathnames by adding -c new TLEFT and TRIGHT trim subroutines -c --- V2.1-V2.2 030528 (DGS): Screen for valid UTM zone using -c absolute value (S. Hem. zones are -c negative) in GLOBE1 -c --- V2.0-V2.1 030402 (DGS): Remove routine GLOBE -c Split DEBLNK action (removes ' ', '+') -c into DEBLNK and DEPLUS -c Add routine UNDRFLW -c Add false Easting and Northing (GLOBE1) -c Add TYPE argument to XTRACTLL -c Change format XTRACTLL (f16) to (f16.0) -c --- V1.1-V2.0 021018 (DGS): Add routines for new COORDS -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input (YR4C) -c -c -c---------------------------------------------------------------------- - subroutine xtractll(io,type,clatlon,rlatlon) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 XTRACTLL -c D. Strimaitis EarthTech -c -c --- PURPOSE: Extract the real latitude or longitude from a character -c string that contains the N/S or E/W convention -c character, and express result as either North Latitude -c or East Longitude -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (010713) (DGS) -c - Add TYPE argument for QA -c - Change format (f16) to (f16.0) to satisfy different -c compilers -c -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c TYPE - char*4 - LAT or LON -c CLATLON - char*16 - Latitude or longitude (degrees), with -c 1 character that denotes convention -c (e.g. 'N 45.222' or '-35.999s') -c -c --- OUTPUT: -c RLATLON - real - North Latitude or East Longitude -c (degrees) -c -c --- XTRACTLL called by: (utility) -c --- XTRACTLL calls: DEBLNK, ALLCAP -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' - - character*1 cstor1(mxcol),cstor2(mxcol) - character*16 clatlon, clatlon2 - character*4 type - logical ltype - - ltype=.FALSE. - -c --- Initialize character variables for output - clatlon2=' ' - do i=1,20 - cstor2(i)=' ' - enddo - -c --- Was valid type provided? - if(type.NE.'LAT ' .AND. type.NE.'LON ') then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'Invalid type: ',type - write(io,*) 'Expected LAT or LON' - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Pass c*16 string into storage array 1 - do i=1,16 - cstor1(i)=clatlon(i:i) - enddo -c --- Pad out to position 20 - do i=17,20 - cstor1(i)=' ' - enddo - -c --- Remove blank characters from string, place in storage array 2 -c --- (Use a 20-character field here for a margin at end of string) - call DEBLNK(cstor1,1,20,cstor2,nlim) -c -c --- Convert lower case letters to upper case - call ALLCAP(cstor2,nlim) - -c --- Interpret valid convention character (N,S,E,W) - nchar=0 - ichar=0 - ilat=0 - ilon=0 - - do i=1,nlim - if(cstor2(i).EQ.'N') then - ilat=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'S') then - ilat=2 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'W') then - ilon=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'E') then - ilon=2 - ichar=i - nchar=nchar+1 - endif - enddo - -c --- Was 1 valid character found? - if(nchar.NE.1) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character is missing or repeated' - write(io,*) 'Lat/Lon = ',clatlon - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Was valid character the right type? - if(type.EQ.'LAT ' .AND. ilat.EQ.0) ltype=.TRUE. - if(type.EQ.'LON ' .AND. ilon.EQ.0) ltype=.TRUE. - if(LTYPE) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character does not match type' - write(io,*) 'Lat/Lon = ',clatlon - write(io,*) 'type = ',type - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Remove character from string - do i=ichar,nlim - cstor2(i)=cstor2(i+1) - enddo - -c --- Search for position of decimal point - ipt=0 - do i=1,nlim - if(cstor2(i).EQ.'.') ipt=i - enddo - -c --- Add a decimal point if needed - if(ipt.EQ.0) then - cstor2(nlim)='.' - endif - -c --- Pass resulting "number" back into c*16 variable - do i=1,nlim - clatlon2(i:i)=cstor2(i) - enddo - -c --- Get real part - read(clatlon2,'(f16.0)') rlatlon - -c --- Convert to either N. Lat. or E. Lon., if needed - if(ilat.EQ.2) then - rlatlon=-rlatlon - elseif(ilon.EQ.1) then - rlatlon=-rlatlon - endif - -c --- Condition longitude to be -180 to +180 - if(ilon.GT.0) then - if(rlatlon.GT.180.) then - rlatlon=rlatlon-360. - elseif(rlatlon.LT.-180.) then - rlatlon=rlatlon+360. - endif - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4(io,iyr,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 991104 YR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year (YYYY or YY) -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c --- YR4 called by: Input routines reading 'year' data -c --- YR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - - ierr=0 - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.iyylo) then - iyr=(icclo+1)*100+iyr - else - iyr=icclo*100+iyr - endif - else -c --- Year not recognized - ierr=1 - write(io,*)'ERROR in YR4 --- Year not recognized: ',iyr - write(*,*)'ERROR in YR4 --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4c(iyr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 020828 YR4C -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year (CURRENT) -c -c --- UPDATE -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input -c -c --- INPUTS: -c IYR - integer - Year (YYYY or YY) -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c -c --- YR4C called by: host subroutines -c --- YR4C calls: none -c---------------------------------------------------------------------- -c --- Set parameters for converting a current year (1999 - 2098) -c --- Use KCCLO as century digits for years GE KYYLO - data kyylo/99/, kcclo/19/ - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.kyylo) then - iyr=(kcclo+1)*100+iyr - else - iyr=kcclo*100+iyr - endif - else -c --- Year not recognized - write(*,*)'ERROR in YR4C --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine qayr4(io,iyr,metrun,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 991104 QAYR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Defines century and year markers to use in converting -c --- 2-digit year to 4-digit year -c --- The IBYR (YYYY) must be provided in the control file -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year provided for start of run -c METRUN - integer - Flag to run period in met file -c 0 = do not run period -c 1 = run period -c -c --- OUTPUT: -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- QAYR4 called by: host subroutines -c --- QAYR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - -c --- Sets parameters for the starting century marker (CC) and the -c --- 2-digit year (YY) used as the marker between the starting century -c --- and the next century. For example, if CC=19 and YY=30, then a -c --- year less than 30 (say 15) is assumed to be 2015. Any year -c --- greater than or equal to 30 (say 56) is assumed to be 1956. - -c --- Set number of years prior to start of simulation that must not -c --- be placed in the next century - data ibackyr/50/ - - ierr=0 - -c --- Expect explicit starting year (YYYY) -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) -c --- Back up IBACKYR years to set IYYLO - kyr=iyr-ibackyr -c --- Extract starting 2-digit century and 2-digit year - icclo=kyr/100 - iyylo=kyr-icclo*100 - -c --- Warn user that control file input is used to convert to YYYY - iyr1=icclo*100+iyylo - iyr2=(icclo+1)*100+iyylo-1 - write(io,*) - write(io,*)'-------------------------------------------------' - write(io,*)'NOTICE: Starting year in control file sets the' - write(io,*)' expected century for the simulation. All' - write(io,*)' YY years are converted to YYYY years in' - write(io,*)' the range: ',iyr1,iyr2 - write(io,*)'-------------------------------------------------' - write(io,*) - else - ierr=1 - write(*,*) - write(*,*)'--------------------------------------------' - write(*,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(*,*)' and must always be provided' - endif - write(*,*)'--------------------------------------------' - write(*,*) - write(io,*) - write(io,*)'-------------------------------------------' - write(io,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(io,*)' and must always be provided' - endif - write(io,*)'-------------------------------------------' - write(io,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine julday(io,iyr,imo,iday,ijuldy) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 000602 JULDAY -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the Julian day number from the Gregorian -c date (month, day) -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c -c --- OUTPUT: -c IJUL - integer - Julian day -c -c --- JULDAY called by: host subroutines -c --- JULDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12) - data kday/0,31,59,90,120,151,181,212,243,273,304,334/ -c -c --- Check for valid input data - ierr=0 -c --- Check for valid month - if(imo.lt.1.or.imo.gt.12)ierr=1 -c --- Check for valid day in 30-day months - if(imo.eq.4.or.imo.eq.6.or.imo.eq.9.or.imo.eq.11)then - if(iday.gt.30)ierr=1 - else if(imo.eq.2)then - if(mod(iyr,4).eq.0)then -c --- February in a leap year - if(iday.gt.29)ierr=1 - else -c --- February in a non-leap year - if(iday.gt.28)ierr=1 - endif - else -c --- Check for valid day in 31-day months - if(iday.gt.31)ierr=1 - endif -c - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. JULDAY' - write(io,*)'Invalid date - IYR = ',iyr,' IMO = ', - 1 imo,' IDAY = ',iday - write(*,*) - stop 'Halted in JULDAY -- see list file.' - endif -c -c --- Compute the Julian day - ijuldy=kday(imo)+iday - if(imo.le.2)return - if(mod(iyr,4).EQ.0)ijuldy=ijuldy+1 -c - return - end -c---------------------------------------------------------------------- - subroutine grday(io,iyr,ijul,imo,iday) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 000602 GRDAY -c J. Scire, SRC -c -c --- PURPOSE: Compute the Gregorian date (month, day) from the -c Julian day -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IJUL - integer - Julian day -c -c --- OUTPUT: -c IMO - integer - Month -c IDAY - integer - Day -c -c --- GRDAY called by: host subroutines -c --- GRDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12,2) - data kday/31,59,90,120,151,181,212,243,273,304,334,365, - 1 31,60,91,121,152,182,213,244,274,305,335,366/ -c -c - ileap=1 - if(mod(iyr,4).eq.0)ileap=2 - if(ijul.lt.1.or.ijul.gt.kday(12,ileap))go to 11 -c - do 10 i=1,12 - if(ijul.gt.kday(i,ileap))go to 10 - imo=i - iday=ijul - if(imo.ne.1)iday=ijul-kday(imo-1,ileap) - return -10 continue -c -11 continue - write(io,12)iyr,ijul -12 format(//2x,'ERROR in SUBR. GRDAY -- invalid Julian day '//2x, - 1 'iyr = ',i5,3x,'ijul = ',i5) - write(*,*) - stop 'Halted in GRDAY -- see list file.' - end -c------------------------------------------------------------------------------ - subroutine dedat(idathr,iyr,ijul,ihr) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 941215 DEDAT -c --- J. Scire, SRC -c -c --- Decode a date-time variable -c -c --- INPUTS: -c IDATHR - integer - Date-time variable (YYYYJJJHH) -c -c --- OUTPUT: -c IYR - integer - Year of precip. data (4 digits) -c IJUL - integer - Julian day number of precip. data -c IHR - integer - Ending hour (1-24) of precip. data -c -c --- DEDAT called by: host subroutines -c --- DEDAT calls: none -c------------------------------------------------------------------------------ -c -c --- decode date and time - iyr=idathr/100000 - ijul=idathr/100-iyr*1000 - ihr=idathr-iyr*100000-ijul*100 -c - return - end -c------------------------------------------------------------------------------ - subroutine deltt(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jleng) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 941215 DELTT -c --- J. Scire, SRC -c -c --- Compute the difference (in hours) between two dates & times -c --- (time #2 - time #1) -c -c --- INPUTS: -c J1YR - integer - Year of date/time #1 -c J1JUL - integer - Julian day of date/time #1 -c J1HR - integer - Hour of date/time #1 -c J2YR - integer - Year of date/time #2 -c J2JUL - integer - Julian day of date/time #2 -c J2HR - integer - Hour of date/time #2 -c -c --- OUTPUT: -c JLENG - integer - Difference (#2 - #1) in hours -c -c --- DELTT called by: host subroutines -c --- DELTT calls: none -c------------------------------------------------------------------------------ -c - jmin=min0(j1yr,j2yr) -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the first date/hour - if(j1yr.eq.jmin)then - j1=0 - else - j1=0 - j1yrm1=j1yr-1 - do 10 i=jmin,j1yrm1 - if(mod(i,4).eq.0)then - j1=j1+8784 - else - j1=j1+8760 - endif -10 continue - endif - j1=j1+(j1jul-1)*24+j1hr -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the second date/hour - if(j2yr.eq.jmin)then - j2=0 - else - j2=0 - j2yrm1=j2yr-1 - do 20 i=jmin,j2yrm1 - if(mod(i,4).eq.0)then - j2=j2+8784 - else - j2=j2+8760 - endif -20 continue - endif - j2=j2+(j2jul-1)*24+j2hr -c -c --- compute the time difference (in hours) - jleng=j2-j1 -c - return - end -c---------------------------------------------------------------------- - subroutine incr(io,iyr,ijul,ihr,nhrinc) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 000602 INCR -c J. Scire, SRC -c -c --- PURPOSE: Increment the time and date by "NHRINC" hours -c -c --- UPDATE -c --- 000602 (DGS): add message to "stop" -c --- 980304 (DGS): Allow for a negative "increment" of -c up to 24 hours -c --- 980304 (DGS): Allow for arbitrarily large nhrinc -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year -c IJUL - integer - Current Julian day -c IHR - integer - Current hour (00-23) -c NHRINC - integer - Time increment (hours) -c -c NOTE: "NHRINC" must >= -24 -c Hour is between 00-23 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c -c --- INCR called by: host subroutines -c --- INCR calls: none -c---------------------------------------------------------------------- -c -c --- Check nhrinc - if(nhrinc.lt.-24) then - write(io,*)'ERROR IN SUBR. INCR -- Invalid value of NHRINC ', - 1 '-- NHRINC = ',nhrinc - write(*,*) - stop 'Halted in INCR -- see list file.' - endif - -c --- Save increment remaining (needed if nhrinc > 8760) - nleft=nhrinc -c -c --- Process change in hour - if(nhrinc.gt.0)then -c -10 ninc=MIN0(nleft,8760) - nleft=nleft-ninc -c -c --- Increment time - ihr=ihr+ninc - if(ihr.le.23)return -c -c --- Increment day - ijul=ijul+ihr/24 - ihr=mod(ihr,24) -c -c --- ILEAP = 0 (non-leap year) or 1 (leap year) - if(mod(iyr,4).eq.0)then - ileap=1 - else - ileap=0 - endif -c - if(ijul.gt.365+ileap) then -c --- Update year - iyr=iyr+1 - ijul=ijul-(365+ileap) - endif -c -c --- Repeat if more hours need to be added - if(nleft.GT.0) goto 10 -c - elseif(nhrinc.lt.0)then -c --- Decrement time - ihr=ihr+nhrinc - if(ihr.lt.0)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - endif -c - return - end -c------------------------------------------------------------------------------ - subroutine indecr(io,iyr,ijul,ihr,idelt,ihrmin,ihrmax) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 961014 INDECR -c --- J. Scire, SRC -c -c --- Increment or decrement a date/time by "IDELT" hours -c --- (-24 <= IDELT <= 24) -c --- Allows specification of 0-23 or 1-24 hour clock -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Input Year -c IJUL - integer - Input Julian day -c IHR - integer - Input hour (ihrmin <= IHR <= ihrmax) -c IDELT - integer - Change in time (hours) -- must be -c between -24 to +24, inclusive -c IHRMIN - integer - Minimum hour (i.e., either 0 or 1) -c IHRMAX - integer - Maximum hour (i.e., either 23 or 24) -c -c --- OUTPUT: -c IYR - integer - Year after change of "IDELT" hours -c IJUL - integer - Julian day after change of "IDELT" hours -c IHR - integer - Hour after change of "IDELT" hours -c -c --- INDECR called by: host subroutines -c --- INDECR calls: none -c------------------------------------------------------------------------------ -c - if(iabs(idelt).gt.24)then - write(io,10)'IDELT',iyr,ijul,ihr,idelt,ihrmin,ihrmax -10 format(/1x,'ERROR in subr. INDECR -- invalid "',a,'" -- ', - 1 ' iyr,ijul,ihr,idelt,ihrmin,ihrmax = ',6i10) - write(*,987) -987 format(1x,'ERROR in run - see the .LST file') - stop - endif - if(ihr.lt.ihrmin.or.ihr.gt.ihrmax)then - write(io,10)'IHR',iyr,ijul,ihr,idelt,ihrmin,ihrmax - write(*,987) - stop - endif -c - if(idelt.lt.0)then -c --- idelt is negative - ihr=ihr+idelt - if(ihr.lt.ihrmin)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - else -c --- idelt is positive or zero - ihr=ihr+idelt - if(ihr.gt.ihrmax)then - ihr=ihr-24 - ijul=ijul+1 - if(mod(iyr,4).eq.0)then - ndays=366 - else - ndays=365 - endif - if(ijul.gt.ndays)then - ijul=1 - iyr=iyr+1 - endif - endif - endif -c - return - end -c---------------------------------------------------------------------- - subroutine incrs(io,iyr,ijul,ihr,isec,nsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 061020 INCRS -c D. Strimaitis, EARTH TECH -c -c --- PURPOSE: Increment the time and date by "NSEC" seconds -c -c --- UPDATE -c --- V2.54 (061020) from V2.4 (041029) (DGS) -c - Allow negative increment -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year (YYYY) -c IJUL - integer - Current Julian day (JJJ) -c IHR - integer - Current hour (00-23) -c ISEC - integer - Current second (0000-3599) -c NSEC - integer - Time increment (seconds) -c Parameters: IO6 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c ISEC - integer - Updated seconds (0000-3599) -c -c --- INCRS called by: host subroutines -c --- INCRS calls: INCR -c---------------------------------------------------------------------- - - if(nsec.GE.0) then -c --- Increment seconds - isec=isec+nsec - if(isec.GE.3600) then - nhrinc=isec/3600 - isec=MOD(isec,3600) - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - - else -c --- Decrement seconds - isec=isec+nsec - if(isec.LT.0) then -c --- Earlier hour - ksec=-isec - if(ksec.GE.3600) then -c --- Back up at least 1 hour - nhrinc=ksec/3600 - ksec=MOD(ksec,3600) - nhrinc=-nhrinc - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - isec=-ksec - if(isec.LT.0) then -c --- Back up 1 more hour - nhrinc=-1 - isec=3600+isec - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - endif - - endif - - return - end -c---------------------------------------------------------------------- - subroutine deltsec(ndhrb,nsecb,ndhre,nsece,ndelsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 041029 DELTSEC -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Compute the difference (in seconds) between two dates & -c times (timeE - timeB) -c -c --- INPUTS: -c NDHRB - integer - Beginning year & hour (YYYYJJJHH) -c NSECB - integer - Beginning second (SSSS) -c NDHRE - integer - Ending year & hour (YYYYJJJHH) -c NSECE - integer - Ending second (SSSS) -c -c --- OUTPUT: -c NDELSEC - integer - Length of interval (seconds) -c -c --- DELTSEC called by: host subroutines -c --- DELTSEC calls: DELTT -c---------------------------------------------------------------------- -c -c --- Extract year, Julian day, and hour from date-time variables -c --- Beginning - j1yr=ndhrb/100000 - iyyjjj=ndhrb/100 - j1jul=iyyjjj-j1yr*1000 - j1hr=ndhrb-iyyjjj*100 -c --- Ending - j2yr=ndhre/100000 - iyyjjj=ndhre/100 - j2jul=iyyjjj-j2yr*1000 - j2hr=ndhre-iyyjjj*100 - -c --- Find difference between hours (in seconds) - call DELTT(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jdelhr) - ndelsec=jdelhr*3600 - -c --- Add difference between seconds - ndelsec=ndelsec+(nsece-nsecb) - - return - end -c---------------------------------------------------------------------- - subroutine midnite(io,ctrans,iyr,imo,iday,ijul, - & kyr,kmo,kday,kjul) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 041029 MIDNITE -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Converts date/time at midnight between day N, 0000 -c and day N-1, 2400. Direction is determined by the -c CTRANS instruction. -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c CTRANS - character - Instruction 'TO 24h' or 'TO 00h' -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c IJUL - integer - Julian day -c -c --- OUTPUT: -c KYR - integer - Year -c KMO - integer - Month -c KDAY - integer - Day -c KJUL - integer - Julian day -c -c --- MIDNITE called by: host subroutines -c --- MIDNITE calls: JULDAY, INCR, GRDAY -c---------------------------------------------------------------------- - character*6 ctrans - - ierr =0 - -c --- Get Julian day from month/day if needed - if(ijul.LE.0) call JULDAY(io,iyr,imo,iday,ijul) - - kyr=iyr - kmo=imo - kday=iday - kjul=ijul - - if(ctrans.EQ.'TO 24h') then -c --- Convert from 0000 on ijul to 2400 on kjul - ihr=0 - nhr=-1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - elseif(ctrans.EQ.'TO 00h') then -c --- Convert from 2400 on ijul to 0000 on kjul - ihr=23 - nhr=1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - else - ierr=1 - endif - - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. MIDNITE' - write(io,*)'Invalid instruction: ',ctrans - write(io,*)' Expected: TO 24h' - write(io,*)' OR : TO 00h' - write(*,*) - stop 'Halted in MIDNITE -- see list file.' - endif - - return - end -c---------------------------------------------------------------------- - subroutine utcbasr(axtz,xbtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 070327 UTCBASR -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts character string UTC time zone -c to real base time zone -c -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Add RETURN statement -c -c --- INPUT: -c AXTZ - char*8 - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c --- OUTPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) -c -c --- UTCBASR called by: host subroutines -c --- UTCBASR calls: none -c---------------------------------------------------------------------- - character*8 axtz - - read(axtz(4:6),'(i3)')ihr - read(axtz(7:8),'(i2)')imin - if(ihr.lt.0)imin=-imin - - xbtz=ihr+imin/60. - -c --- Flip sign as base time convention is opposite UTC/GMT - xbtz=-xbtz - - return - end -c---------------------------------------------------------------------- - subroutine basrutc(xbtz,axtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 070327 BASRUTC -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts real base time zone to character string -c UTC time zone -c -c --- UPDATE -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Fix output format of time zone string for zone=0 -c - Add RETURN statement -c -c --- INPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) - -c --- OUTPUT: -c AXTZ - real - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c -c --- BASRUTC called by: host subroutines -c --- BASRUTC calls: none -c---------------------------------------------------------------------- - character*8 axtz - - ixbtz=int(xbtz) -c convert fractional real to minutes - imin=(xbtz-ixbtz)*60 - ixbtz=ixbtz*100+imin - -c --- Define time as "UTC-HHMM" (hours/minutes) - axtz(1:3)="UTC" - -c --- Flip sign as base time zone is minus UTC zone - if (xbtz.gt.0.) then - axtz(4:4)="-" - else - axtz(4:4)="+" - endif -c --- Make sure time zone is written as 4 digits - write(axtz(5:8),'(i4.4)')abs(ixbtz) - - return - end -c---------------------------------------------------------------------- - subroutine filcase(lcfiles,cfile) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 FILCASE -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all characters within a file name to lower -c case (if LCFILES=T) or UPPER CASE (if LCFILES=F). -c -c --- UPDATE -c --- V2.2 (950610) to V2.3 (040330) DGS -c - Replace filename strings c*70 with c*132 -c -c --- INPUTS: -c -c LCFILES - logical - Switch indicating if all characters in the -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c CASE letters (LCFILES=F). -c CFILE - char*132- Input character string -c -c --- OUTPUT: -c -c CFILE - char*132- Output character string with -c letters converted -c -c --- FILCASE called by: READFN -c --- FILCASE calls: none -c---------------------------------------------------------------------- -c - character*132 cfile - character*1 cchar,clc(29),cuc(29) - logical lcfiles -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - if(lcfiles)then -c -c --- Convert file name to lower case letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.cuc(j))then - cfile(i:i)=clc(j) - go to 52 - endif - enddo -52 continue - enddo - else -c -c --- Convert file name to UPPER CASE letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.clc(j))then - cfile(i:i)=cuc(j) - go to 62 - endif - enddo -62 continue - enddo - endif -c - return - end -c---------------------------------------------------------------------- - subroutine readin(cvdic,ivleng,ivtype,ioin,ioout,lecho, - 1 i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15,i16,i17,i18, - 2 i19,i20,i21,i22,i23,i24,i25,i26,i27,i28,i29,i30,i31,i32,i33,i34, - 3 i35,i36,i37,i38,i39,i40,i41,i42,i43,i44,i45,i46,i47,i48,i49,i50, - 4 i51,i52,i53,i54,i55,i56,i57,i58,i59,i60) -c---------------------------------------------------------------------- -c *** Change number of characters in line from 150 to 200 *** -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 110225 READIN -c J. Scire -c -c --- PURPOSE: Read one input group of the free formatted control -c file -- allows comments within the input file -- -c ignores all text except that within delimiters -c -c --- NOTE: All variables (real, integer, logical, -c or character) must be 4 bytes -c --- NOTE: Character*4 array uses only one character -c per word -- it must be dimensioned large -c enough to accommodate the number of characters -c in the variable field -c -c --- UPDATE -c --- V2.58 (110225) from V2.57 (090202) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.57 (090202) from V2.52 (060519) (DGS) -c - Increase max line length from 150 to 200 -c (requires MXCOL=200) -c --- V2.52 (060519) from V2.3 (040330) (DGS) -c - Search for '=' beyond position 14 because blanks are -c not automatically removed within string -c --- V2.3 (040330) from V2.1 (030402) (DGS) -c - Preserve spaces within character variables -c --- V2.1 (030402) from V2.0 (000602) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c -c --- INPUTS: -c -c CVDIC(mxvar) - character*12 array - Variable dictionary -c containing up to "MXVAR" -c variable names -c IVLENG(mxvar) - integer array - Dimension of each variable -c (dim. of scalars = 1) -c IVTYPE(mxvar) - integer array - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c IOIN - integer - Fortran unit of control file -c input -c IOOUT - integer - Fortran unit of list file -c output -c LECHO - logical - Control variable determining -c if input data are echoed to -c list file (IOOUT) -c Parameters: MXVAR, MXCOL -c -c --- OUTPUT: -c -c I1, I2, ... - integer arrays - Variables being read -c (integer array locally, but can be a real, -c integer, logical, or character*4 array in -c the calling routine) -c -c --- READIN called by: host subroutines -c --- READIN calls: DEBLNK, ALTONU, SETVAR, ALLCAP, DEPLUS, -c TRIGHT, TLEFT -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - integer*4 i1(*),i2(*),i3(*),i4(*),i5(*),i6(*),i7(*),i8(*),i9(*), - 1 i10(*),i11(*),i12(*),i13(*),i14(*),i15(*),i16(*),i17(*),i18(*), - 2 i19(*),i20(*),i21(*),i22(*),i23(*),i24(*),i25(*),i26(*),i27(*), - 3 i28(*),i29(*),i30(*),i31(*),i32(*),i33(*),i34(*),i35(*),i36(*), - 4 i37(*),i38(*),i39(*),i40(*),i41(*),i42(*),i43(*),i44(*),i45(*), - 5 i46(*),i47(*),i48(*),i49(*),i50(*),i51(*),i52(*),i53(*),i54(*), - 6 i55(*),i56(*),i57(*),i58(*),i59(*),i60(*) - integer*4 ivleng(mxvar),jdex(mxvar),ivtype(mxvar) -c - logical*4 lv - logical lecho -c - character*12 cvdic(mxvar),cvar,cblank - character*4 cv(mxcol) - character*1 cstor1(mxcol),cstor2(mxcol) -c --- Intermediate scratch arrays - character*1 cstor3(mxcol),cstor4(mxcol) - character*1 cdelim,ceqls,ce,cn,cd,comma,cblnk -c - data cblank/' '/ - data cdelim/'!'/,ceqls/'='/,ce/'E'/,cn/'N'/,cd/'D'/,comma/','/ - data cblnk/' '/ -c - ilim2=99 - do 2 i=1,mxvar - jdex(i)=1 -2 continue -c -c --- begin loop over lines -c -c --- read a line of input -5 continue - read(ioin,10)cstor1 -10 format(200a1) - if(lecho)write(ioout,7)cstor1 -7 format(1x,200a1) -c -c --- check if this is a continuation line - if(ilim2.gt.0)go to 16 -c -c --- continuation line -- find the second delimiter - do 12 i=1,mxcol - if(cstor1(i).eq.cdelim)then - ilim2=i - go to 14 - endif -12 continue -14 continue - il2=ilim2 - if(il2.eq.0)il2=mxcol -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blank characters from string within delimiters -c call deblnk(cstor1,1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- -c --- Remove blank characters on right side - call TRIGHT(cstor1,1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- - icom=0 -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) - go to 55 -c -16 continue - ibs=1 -c -c --- begin loop over delimiter pairs -17 continue - if(ibs.ge.mxcol)go to 5 -c -c --- find location of delimiters - do 20 i=ibs,mxcol - if(cstor1(i).eq.cdelim)then - ilim1=i - if(ilim1.eq.mxcol)go to 22 - ip1=ilim1+1 - do 18 j=ip1,mxcol - if(cstor1(j).eq.cdelim)then - ilim2=j - go to 22 - endif -18 continue -c -c --- second delimiter not on this line - ilim2=0 - go to 22 - endif -20 continue -c -c --- no delimiters found -- skip line and read next line of text - go to 5 -22 continue - ibs=ilim2+1 - if(ilim2.eq.0)ibs=mxcol+1 -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blanks from string within delimiters -c il2=ilim2 -c if(il2.eq.0)il2=mxcol -c call deblnk(cstor1,ilim1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- - il2=ilim2 - if(il2.eq.0)il2=mxcol -c --- Remove blank characters on right side - call TRIGHT(cstor1,ilim1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) -c -c --- search for equals sign (cstor2(1) is delimiter; cstor2(2) is -c --- first letter of variable; cstor2(3) is earliest '=' can occur) -c --- (060519) Search entire string as now there may be blanks before '=' -c do 30 i=3,14 - do 30 i=3,nlim - if(cstor2(i).eq.ceqls)then - ieq=i - go to 32 - endif -30 continue -c -c --- "END" within delimiters signifies the end of the read for -c --- this input group - if(cstor2(2).eq.ce.and.cstor2(3).eq.cn.and.cstor2(4).eq.cd)return - write(ioout,31)(cstor2(n),n=1,nlim) -31 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable too long (Equals sign not found in string) -- ', - 2 'CSTOR2 = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- CVAR is character*12 variable name -32 continue - cvar=cblank - ieqm1=ieq-1 -c --- Grab string to left of '=', and remove blanks - call deblnk(cstor2,1,ieqm1,cstor3,keqm1) -c --- Pass string to variable name - do 40 i=2,keqm1 - il=i-1 - cvar(il:il)=cstor3(i) -40 continue -c -c --- find the variable name in the variable dictionary - do 50 i=1,mxvar - if(cvar.eq.cvdic(i))then - nvar=i - go to 52 - endif -50 continue - write(ioout,51)cvar,(cvdic(n),n=1,mxvar) -51 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable not found in variable dictionary'/ - 2 1x,'Variable: ',a12/ - 3 1x,'Variable Dictionary: ',9(a12,1x)/ - 4 10(22x,9(a12,1x)/)) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -52 continue -c --- Assign current variable type - itype=ivtype(nvar) -c -c --- Check for invalid value of variable type - if(itype.le.0.or.itype.ge.6)then - write(ioout,53)itype,nvar,ivtype(nvar),cvdic(nvar) -53 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Invalid value of variable type -- ITYPE must be 1, 2, 3, ', - 2 '4, or 5'/1x,'ITYPE = ',i10/1x,'NVAR = ',i10/1x, - 3 'IVTYPE(nvar) = ',i10/1x,'CVDIC(nvar) = ',a12) - write(*,*) - stop 'Halted in READIN -- see list file.' - endif -c -c --- search for comma - icom=ieq -c -c --- beginning of loop over values within delimiters -55 continue - ivb=icom+1 -c -c --- if reaches end of line, read next line - if(ivb.gt.nlim)go to 5 - do 60 i=ivb,nlim - if(cstor2(i).eq.comma)then - icom=i - go to 64 - endif -60 continue -c -c --- no comma found - icom=0 - ive=nlim-1 -c -c --- comma between last value and delimiter is allowed - if(cstor2(ivb).eq.cdelim.and.cstor2(ive).eq.comma)go to 17 -c -c --- if no comma & last non-blank character is not a delimiter, -c --- then the input is in error - if(cstor2(nlim).eq.cdelim)go to 66 - write(ioout,63)cstor1 -63 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'If a string within delimiters covers more than one line, ', - 2 'the last character in the line must be a comma'/ - 3 1x,'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -64 continue -c -c --- value of variable is contained in elements IVB to IVE of -c --- CSTOR2 array -c --- Include comma for variable type 5 (character array) so that it -c --- can be used outside of READIN to parse the array values from the -c --- single string that is returned - if(itype.EQ.5) then - ive=icom - else - ive=icom-1 - endif -66 continue -c ncar=ive-ivb+1 - index=jdex(nvar) -c -c --- Convert character string to numeric or logical value -c (if ITYPE = 1,2, or 3) -- If 4 or 5 transfer characters to the -c work array CV) - -c --- Remove all blanks from variable string if type is numeric or -c --- logical; otherwise, trim left and right side of string - if(itype.LT.4) then - call deblnk(cstor2,ivb,ive,cstor4,nv) -c --- Remove '+' characters as well (is this needed?) - if(nv.gt.0) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call deplus(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - else -c --- Pass variable string into cstor4 - nv=ive-ivb+1 - do k=1,nv - cstor4(k)=cstor2(ivb+k-1) - enddo - do k=nv+1,mxcol - cstor4(k)=cblnk - enddo -c --- Remove blank characters on right side of character variable -c --- if last character is either a blank or comma - if(cstor4(nv).EQ.cblnk .OR. - & cstor4(nv).EQ.comma) call TRIGHT(cstor2,ivb,ive,cstor4,nv) -c --- Remove blank characters on left side of character variable - if(nv.GT.0 .AND. cstor4(1).EQ.cblnk) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call TLEFT(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - endif -c -c --- check that array bounds are not exceeded - if(index+irep-1.gt.ivleng(nvar))go to 201 -c - go to (101,102,103,104,105,106,107,108,109,110,111,112,113,114, - 1 115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130, - 2 131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146, - 3 147,148,149,150,151,152,153,154,155,156,157,158,159,160),nvar -c -c --- code currently set up to handle up to 60 variables/source group - write(ioout,71)nvar,(cstor2(n),n=1,nlim) -71 format(/1x,'ERROR IN SUBR. READIN -- Current code ', - 1 'configuration allows up to 60 variables per source group'/ - 2 1x,'No. variables (NVAR) = ',i10/ - 3 1x,'Input data (CSTOR2) = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- transfer value into output variable -101 continue - call setvar(itype,irep,rlno,ino,lv,cv,i1(index),i1(index), - 1 i1(index),i1(index)) - go to 161 -102 continue - call setvar(itype,irep,rlno,ino,lv,cv,i2(index),i2(index), - 1 i2(index),i2(index)) - go to 161 -103 continue - call setvar(itype,irep,rlno,ino,lv,cv,i3(index),i3(index), - 1 i3(index),i3(index)) - go to 161 -104 continue - call setvar(itype,irep,rlno,ino,lv,cv,i4(index),i4(index), - 1 i4(index),i4(index)) - go to 161 -105 continue - call setvar(itype,irep,rlno,ino,lv,cv,i5(index),i5(index), - 1 i5(index),i5(index)) - go to 161 -106 continue - call setvar(itype,irep,rlno,ino,lv,cv,i6(index),i6(index), - 1 i6(index),i6(index)) - go to 161 -107 continue - call setvar(itype,irep,rlno,ino,lv,cv,i7(index),i7(index), - 1 i7(index),i7(index)) - go to 161 -108 continue - call setvar(itype,irep,rlno,ino,lv,cv,i8(index),i8(index), - 1 i8(index),i8(index)) - go to 161 -109 continue - call setvar(itype,irep,rlno,ino,lv,cv,i9(index),i9(index), - 1 i9(index),i9(index)) - go to 161 -110 continue - call setvar(itype,irep,rlno,ino,lv,cv,i10(index),i10(index), - 1 i10(index),i10(index)) - go to 161 -111 continue - call setvar(itype,irep,rlno,ino,lv,cv,i11(index),i11(index), - 1 i11(index),i11(index)) - go to 161 -112 continue - call setvar(itype,irep,rlno,ino,lv,cv,i12(index),i12(index), - 1 i12(index),i12(index)) - go to 161 -113 continue - call setvar(itype,irep,rlno,ino,lv,cv,i13(index),i13(index), - 1 i13(index),i13(index)) - go to 161 -114 continue - call setvar(itype,irep,rlno,ino,lv,cv,i14(index),i14(index), - 1 i14(index),i14(index)) - go to 161 -115 continue - call setvar(itype,irep,rlno,ino,lv,cv,i15(index),i15(index), - 1 i15(index),i15(index)) - go to 161 -116 continue - call setvar(itype,irep,rlno,ino,lv,cv,i16(index),i16(index), - 1 i16(index),i16(index)) - go to 161 -117 continue - call setvar(itype,irep,rlno,ino,lv,cv,i17(index),i17(index), - 1 i17(index),i17(index)) - go to 161 -118 continue - call setvar(itype,irep,rlno,ino,lv,cv,i18(index),i18(index), - 1 i18(index),i18(index)) - go to 161 -119 continue - call setvar(itype,irep,rlno,ino,lv,cv,i19(index),i19(index), - 1 i19(index),i19(index)) - go to 161 -120 continue - call setvar(itype,irep,rlno,ino,lv,cv,i20(index),i20(index), - 1 i20(index),i20(index)) - go to 161 -121 continue - call setvar(itype,irep,rlno,ino,lv,cv,i21(index),i21(index), - 1 i21(index),i21(index)) - go to 161 -122 continue - call setvar(itype,irep,rlno,ino,lv,cv,i22(index),i22(index), - 1 i22(index),i22(index)) - go to 161 -123 continue - call setvar(itype,irep,rlno,ino,lv,cv,i23(index),i23(index), - 1 i23(index),i23(index)) - go to 161 -124 continue - call setvar(itype,irep,rlno,ino,lv,cv,i24(index),i24(index), - 1 i24(index),i24(index)) - go to 161 -125 continue - call setvar(itype,irep,rlno,ino,lv,cv,i25(index),i25(index), - 1 i25(index),i25(index)) - go to 161 -126 continue - call setvar(itype,irep,rlno,ino,lv,cv,i26(index),i26(index), - 1 i26(index),i26(index)) - go to 161 -127 continue - call setvar(itype,irep,rlno,ino,lv,cv,i27(index),i27(index), - 1 i27(index),i27(index)) - go to 161 -128 continue - call setvar(itype,irep,rlno,ino,lv,cv,i28(index),i28(index), - 1 i28(index),i28(index)) - go to 161 -129 continue - call setvar(itype,irep,rlno,ino,lv,cv,i29(index),i29(index), - 1 i29(index),i29(index)) - go to 161 -130 continue - call setvar(itype,irep,rlno,ino,lv,cv,i30(index),i30(index), - 1 i30(index),i30(index)) - go to 161 -131 continue - call setvar(itype,irep,rlno,ino,lv,cv,i31(index),i31(index), - 1 i31(index),i31(index)) - go to 161 -132 continue - call setvar(itype,irep,rlno,ino,lv,cv,i32(index),i32(index), - 1 i32(index),i32(index)) - go to 161 -133 continue - call setvar(itype,irep,rlno,ino,lv,cv,i33(index),i33(index), - 1 i33(index),i33(index)) - go to 161 -134 continue - call setvar(itype,irep,rlno,ino,lv,cv,i34(index),i34(index), - 1 i34(index),i34(index)) - go to 161 -135 continue - call setvar(itype,irep,rlno,ino,lv,cv,i35(index),i35(index), - 1 i35(index),i35(index)) - go to 161 -136 continue - call setvar(itype,irep,rlno,ino,lv,cv,i36(index),i36(index), - 1 i36(index),i36(index)) - go to 161 -137 continue - call setvar(itype,irep,rlno,ino,lv,cv,i37(index),i37(index), - 1 i37(index),i37(index)) - go to 161 -138 continue - call setvar(itype,irep,rlno,ino,lv,cv,i38(index),i38(index), - 1 i38(index),i38(index)) - go to 161 -139 continue - call setvar(itype,irep,rlno,ino,lv,cv,i39(index),i39(index), - 1 i39(index),i39(index)) - go to 161 -140 continue - call setvar(itype,irep,rlno,ino,lv,cv,i40(index),i40(index), - 1 i40(index),i40(index)) - go to 161 -141 continue - call setvar(itype,irep,rlno,ino,lv,cv,i41(index),i41(index), - 1 i41(index),i41(index)) - go to 161 -142 continue - call setvar(itype,irep,rlno,ino,lv,cv,i42(index),i42(index), - 1 i42(index),i42(index)) - go to 161 -143 continue - call setvar(itype,irep,rlno,ino,lv,cv,i43(index),i43(index), - 1 i43(index),i43(index)) - go to 161 -144 continue - call setvar(itype,irep,rlno,ino,lv,cv,i44(index),i44(index), - 1 i44(index),i44(index)) - go to 161 -145 continue - call setvar(itype,irep,rlno,ino,lv,cv,i45(index),i45(index), - 1 i45(index),i45(index)) - go to 161 -146 continue - call setvar(itype,irep,rlno,ino,lv,cv,i46(index),i46(index), - 1 i46(index),i46(index)) - go to 161 -147 continue - call setvar(itype,irep,rlno,ino,lv,cv,i47(index),i47(index), - 1 i47(index),i47(index)) - go to 161 -148 continue - call setvar(itype,irep,rlno,ino,lv,cv,i48(index),i48(index), - 1 i48(index),i48(index)) - go to 161 -149 continue - call setvar(itype,irep,rlno,ino,lv,cv,i49(index),i49(index), - 1 i49(index),i49(index)) - go to 161 -150 continue - call setvar(itype,irep,rlno,ino,lv,cv,i50(index),i50(index), - 1 i50(index),i50(index)) - go to 161 -151 continue - call setvar(itype,irep,rlno,ino,lv,cv,i51(index),i51(index), - 1 i51(index),i51(index)) - go to 161 -152 continue - call setvar(itype,irep,rlno,ino,lv,cv,i52(index),i52(index), - 1 i52(index),i52(index)) - go to 161 -153 continue - call setvar(itype,irep,rlno,ino,lv,cv,i53(index),i53(index), - 1 i53(index),i53(index)) - go to 161 -154 continue - call setvar(itype,irep,rlno,ino,lv,cv,i54(index),i54(index), - 1 i54(index),i54(index)) - go to 161 -155 continue - call setvar(itype,irep,rlno,ino,lv,cv,i55(index),i55(index), - 1 i55(index),i55(index)) - go to 161 -156 continue - call setvar(itype,irep,rlno,ino,lv,cv,i56(index),i56(index), - 1 i56(index),i56(index)) - go to 161 -157 continue - call setvar(itype,irep,rlno,ino,lv,cv,i57(index),i57(index), - 1 i57(index),i57(index)) - go to 161 -158 continue - call setvar(itype,irep,rlno,ino,lv,cv,i58(index),i58(index), - 1 i58(index),i58(index)) - go to 161 -159 continue - call setvar(itype,irep,rlno,ino,lv,cv,i59(index),i59(index), - 1 i59(index),i59(index)) - go to 161 -160 continue - call setvar(itype,irep,rlno,ino,lv,cv,i60(index),i60(index), - 1 i60(index),i60(index)) -c -161 continue - jdex(nvar)=jdex(nvar)+irep -c -c --- continue reading values for this array until array is filled -c --- or delimiter is reached - if(icom.ne.0.and.jdex(nvar).le.ivleng(nvar))go to 55 - go to 17 -201 continue - iatt=index+irep-1 - write(ioout,202)cvdic(nvar),ivleng(nvar),iatt,cstor1 -202 format(/1x,'ERROR IN SUBR. READIN -- Error in input data', - 1 1x,'Array bounds exceeded -- Variable: ',a12,3x,' Declared ', - 2 'dimension = ',i8/1x,'Input attempted to element ',i8/1x, - 3 'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' - end -c---------------------------------------------------------------------- - subroutine altonu(ioout,alp,ncar,itype,irep,rlno,ino,lv,cv) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 110225 ALTONU -c --- J. Scire -c -c --- PURPOSE: Convert a character string into a real, integer or -c logical variable -- also compute the repetition factor -c for the variable -c -c --- UPDATES -c --- V2.58 (110225) from V2.56 (080407) (DGS) -c - Add ITYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.56 (080407) from V1.0 (000602) (DGS) -c - Treat case in which exponential notation is used -c without a decimal point. Pointer had been left at -c 'zero' which placed the decimal location in front of -c a number so that 2e02 became 0.2e02 instead of 2.0e02 -c - Trap case where no number appears in front the E or D -c in exponential notation -c -c --- 000602 (DGS): add message to "stop" -c -c --- INPUTS: -c IOOUT - integer - Fortran unit of list file -c output -c ALP(ncar) - character*1 array - Characters to be converted -c NCAR - integer - Number of characters -c ITYPE - integer - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c -c Parameter: MXCOL -c -c --- OUTPUT: -c IREP - integer - Repetition factor for value -c RLNO - real - Real variable produced from -c character string -c INO - integer - Integer variable produced from -c character string -c LV - logical*4 - Logical variable produced from -c character string -c CV(mxcol) - character*4 - Character*4 variable produced -c from character string -c (NOTE: Only 1 (NOT 4) -c character(s) per word) -c -c --- ALTONU called by: READIN -c --- ALTONU calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real*8 rno,xmult,ten - integer num2(mxcol) - logical*4 lv - character*4 cv(mxcol) - character*1 alp(ncar),alpsv,ad(17),astar,adec -c - data ad/'0','1','2','3','4','5','6','7','8','9','-', -c --- num2 = 0 1 2 3 4 5 6 7 8 9 11 - 1 '*','.','E','D','T','F'/ -c --- num2 = 12 13 14 15 16 17 - data astar/'*'/,adec/'.'/,ten/10.0d0/ -c -c --- If dealing with a character*4 variable, transfer characters -c into the work array CV (ONE character per 4-byte word) - if(itype.eq.4 .OR. itype.eq.5)then - do 5 i=1,ncar - cv(i)(1:1)=alp(i) -5 continue -c -c --- NOTE: Repetition factor refers to the number of -c characters in the field, if ITYPE = 4, 5 - irep=ncar - return - endif -c -c --- Convert character array elements into numeric codes - do 30 i=1,ncar - alpsv=alp(i) - do 20 j=1,17 - if(alpsv.eq.ad(j))then - num2(i)=j - if(j.lt.11)num2(i)=j-1 - go to 30 - endif -20 continue - write(ioout,21)(alp(n),n=1,ncar) -21 format(/1x,'ERROR IN SUBR. ALTONU -- Unrecognizable character ', - 1 'in input -- Character string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -30 continue -c -c --- Locally classify variable type (1=real, 2=integer, 3=logical) - do 40 i=1,ncar - if(num2(i).le.12)go to 40 - if(num2(i).ge.16)then -c -c --- logical variable ("T", "F") - jtype=3 - go to 41 - else -c -c --- real variable (".", "E", "D") - jtype=1 - go to 41 - endif -40 continue -c -c --- integer variable - jtype=2 -41 continue -c -c --- determine if repetition factor "*" is used - do 50 i=1,ncar - if(alp(i).eq.astar)then - istar=i - go to 51 - endif -50 continue - istar=0 -51 continue - if(istar.ne.0)go to 400 - irep=1 - go to (101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) -55 format(/1x,'ERROR IN SUBR. ALTONU -- JTYPE must be 1, 2, or 3 ', - 1 '-- JTYPE = ',i3/3x,'Text string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- REAL number w/o "*" -c -------------------------------------------------------------------- -c --- Determine sign -- ISTAR is position of array containing "*" -c (ISTAR = 0 if no repetition factor) -101 continue - if(num2(1+istar).eq.11)then - isgn=-1 - istart=istar+2 - else - isgn=1 - istart=istar+1 - endif -c -c --- Locate decimal point - idec=0 - do 109 i=istart,ncar - if(alp(i).eq.adec)then - if(idec.eq.0)then - idec=i - go to 109 - endif -c -c --- More than one decimal point found - write(ioout,120)(alp(n),n=1,ncar) -120 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid real variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif -109 continue -c -c --- Search for E or D - do 110 i=istart,ncar - if(num2(i).eq.14.or.num2(i).eq.15)then - istop=i-1 - go to 111 - endif -110 continue - istop=ncar -111 continue - -c --- 080407 Update: -c --- Correct for missing decimal point before decoding - if(idec.EQ.0) idec=istop+1 -c --- Trap missing number in front of E,D - if(istop.LT.1 .OR. istart.GT.istop) then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - write(*,*)'Missing number!' - stop 'Halted in ALTONU -- see list file.' - endif -c -c --- Convert integer numerics to real number - rno=0.0 - do 130 i=istart,istop - if(i.eq.idec)go to 130 - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=idec-i - if(iexp.gt.0)iexp=iexp-1 - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rno=rno+xmult*num2(i) - -130 continue -c -c --- Account for minus sign (if present) - rno=isgn*rno - rlno=rno -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - if(istop.eq.ncar)return -c -c --- Find exponent (istop+1 is position in array containing E or D) - isgn=1 - istart=istop+2 - if(num2(istart).ne.11)go to 135 - isgn=-1 - istart=istart+1 -135 continue - if(istart.gt.ncar)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - rexp=0.0 - do 140 i=istart,ncar - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=ncar-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rexp=rexp+xmult*num2(i) -140 continue - xmult=1.0 - if(rexp.ne.0.0)xmult=ten**(isgn*rexp) - rno=rno*xmult - rlno=rno -c -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - return -c -c -------------------------------------------------------------------- -c --- INTEGER variables -c -------------------------------------------------------------------- -201 continue - if(num2(1+istar).ne.11)go to 228 - isgn=-1 - istart=istar+2 - go to 229 -228 continue - isgn=1 - istart=istar+1 -229 continue - ino=0 - do 230 i=istart,ncar - if(num2(i).ge.10)go to 208 - iexp=ncar-i - xmult=1.0 - if(iexp.ne.10)xmult=ten**iexp - ino=ino+xmult*num2(i)+0.5 -230 continue - ino=isgn*ino -c -c --- Also set real variable in case of improper input - rlno=ino - return -208 continue - write(ioout,220)(alp(n),n=1,ncar) -220 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid integer variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- LOGICAL variables -c -------------------------------------------------------------------- -301 continue - if(ncar-istar.ne.1)go to 308 - if(num2(istar+1).eq.16)then -c -c --- Variable = T - lv=.true. - return - else if(num2(istar+1).eq.17)then -c -c --- Variable = F - lv=.false. - return - endif -308 continue - write(ioout,320)(alp(n),n=1,ncar) -320 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid logical variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c --- Determine repetition factor -400 continue - irep=0 -c -c --- ISTAR is the position of array containing "*" - istrm1=istar-1 - do 430 i=1,istrm1 - if(num2(i).ge.10)go to 408 - iexp=istrm1-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - irep=irep+xmult*num2(i)+0.5 -430 continue - go to(101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -408 continue - write(ioout,420)(alp(n),n=1,ncar) -420 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid repetition factor ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - end -c---------------------------------------------------------------------- - subroutine deblnk(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 DEBLNK -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank or "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (980918) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without blanks within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEBLNK called by: (utility) -c --- DEBLNK calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cblnk)go to 10 -c -c --- transfer non-blank character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine deplus(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 DEPLUS -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for plus begins -c IL2 - integer - Array element at which search -c for plus ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without plus within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEPLUS called by: (utility) -c --- DEPLUS calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk,cplus - data cblnk/' '/,cplus/'+'/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cplus)go to 10 -c -c --- transfer non-plus character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine tright(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 TRIGHT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the RIGHT of the last non-blank character -c in the string before il2. Also remove the character -c at il2 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=3, il2=21 -c CSTOR1 : 2 for this run ! -c Position : 000000000111111111122 -c 123456789012345678901 -c CSTOR2 : for this run! -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with right-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TRIGHT called by: (utility) -c --- TRIGHT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of last non-blank character - klast=0 - il2m1=il2-1 - do k=ilim1,il2m1 - if(cstor1(k).NE.cblnk) klast=k - enddo - -c --- Transfer all characters in range up to klast - ind=0 - if(klast.GT.0) then - do k=ilim1,klast - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif -c --- Add last character in range if non-blank - if(cstor1(il2).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(il2) - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine tleft(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 TLEFT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the LEFT of the first non-blank character -c in the string after ilim1. Also remove the character -c at ilim1 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=2, il2=19 -c CSTOR1 : 2 for this run ! -c Position : 123456789111111111122 -c 012345678901 -c CSTOR2 : 2for this run -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with left-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TLEFT called by: (utility) -c --- TLEFT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of first non-blank character - kfrst=0 - ilim1p1=ilim1+1 - do k=il2,ilim1p1,-1 - if(cstor1(k).NE.cblnk) kfrst=k - enddo - - ind=0 -c --- Pass first character in range if non-blank - if(cstor1(ilim1).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(ilim1) - endif - -c --- Transfer all characters in range from kfrst - if(kfrst.GT.0) then - do k=kfrst,il2 - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine setvar(itype,irep,xx,jj,ll,cv,xarr,jarr,larr,carr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 110225 SETVAR -c --- J. Scire -c -c --- PURPOSE: Fill the output variable or array with the value read -c from the input file -c -c --- UPDATE -c --- V2.58 (110225) from V1.0 (950122) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c -c --- INPUTS: -c -c ITYPE - integer - Variable type (1=real, 2=integer, -c 3=logical, 4=character*4, -c 5=character*4 includes commas) -c IREP - integer - Repetition factor -c If ITYPE = 4, IREP refers to the -c number of characters in the field) -c XX - real - Real value read from input -c file (Used only if ITYPE=1) -c JJ - integer - Integer value read from input -c file (Used only if ITYPE=2) -c LL - logical*4 - Logical value read from input -c file (Used only if ITYPE=3) -c CV(mxcol) - character*4 - Character*4 values read from input -c file (Used only if ITYPE=4) -c -c PARAMETER: MXCOL -c -c --- OUTPUT: -c -c XARR(*) - real array - Output real array (or scalar if -c IREP=1) -- Used only if ITYPE=1 -c JARR(*) - integer array - Output integer array (or scalar if -c IREP=1) -- Used only if ITYPE=2 -c LARR(*) - logical array - Output logical array (or scalar if -c IREP=1) -- Used only if ITYPE=3 -c CARR(*) - character*4 - Output character*4 array (or -c scalar if IREP=1) -- Used only if -c ITYPE=4 -c -c --- SETVAR called by: READIN -c --- SETVAR calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real xarr(*) - integer jarr(*) - logical*4 larr(*),ll - character*4 carr(*),cv(mxcol) -c - go to(10,20,30,40,50),itype -c -c --- real variable -10 continue - do 15 i=1,irep - xarr(i)=xx -15 continue - return -c -c --- integer variable -20 continue - do 25 i=1,irep - jarr(i)=jj -25 continue - return -c -c --- logical variable -30 continue - do 35 i=1,irep - larr(i)=ll -35 continue - return -c -c --- character*4 variable string -40 continue - do 45 i=1,irep - carr(i)=cv(i) -45 continue - return -c -c --- character*4 variable string -50 continue - do 55 i=1,irep - carr(i)=cv(i) -55 continue - return - - end -c---------------------------------------------------------------------- - subroutine allcap(cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 950122 ALLCAP -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all lower case letters within a character -c string to upper case -c -c --- INPUTS: -c -c CSTOR2(mxcol) - character*1 array - Input character string -c NLIM - integer - Length of string (characters) -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string with -c lower case letters converted -c to upper case -c -c --- ALLCAP called by: READIN -c --- ALLCAP calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor2(mxcol),cchar,clc(29),cuc(29) -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - do 100 i=1,nlim - cchar=cstor2(i) -c - do 50 j=1,29 - if(cchar.eq.clc(j))then - cstor2(i)=cuc(j) - go to 52 - endif -50 continue -52 continue -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine datetm(rdate,rtime,rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 140318 DATETM -c --- J. Scire -c -c --- PURPOSE: Get system date and time from system clock, and -c elapsed CPU time -c --- UPDATES -c --- V2.57-V2.6.0 140318(MBN):Remove obsolete Lahey F77L code, -c and etime calls. -c --- V1.0-V2.57 090202 (DGS): Activate CPU time (F95 call) -c -c --- INPUTS: none -c -c --- OUTPUT: rdate - C*10 - Current system date (MM-DD-YYYY) -c rtime - C*8 - Current system time (HH:MM:SS) -c rcpu - real - CPU time (sec) from system utility -c -c --- DATETM called by: SETUP, FIN -c --- DATETM calls: DATE_AND_TIME (F95) -c CPU_TIME (F95) -c YR4C -c---------------------------------------------------------------------- - character*8 rtime - character*10 rdate - -c --- Local store - character*11 stime - character*8 sdate - -c --- Set initial base CPU time to -1. - data rcpu0/-1./ - SAVE rcpu0 - -c --- System date in CCYYMMDD -c --- System clock in HHMMSS.sss, where sss = thousandths of seconds - call DATE_AND_TIME(sdate,stime) -c --- Pass to output formats (MM-DD-YYYY) and (HH:MM:SS) - rdate=' - - ' - rdate(1:2)=sdate(5:6) - rdate(4:5)=sdate(7:8) - rdate(7:10)=sdate(1:4) - rtime=' : : ' - rtime(1:2)=stime(1:2) - rtime(4:5)=stime(3:4) - rtime(7:8)=stime(5:6) -c --- Get CPU time from F95 intrinsic procedure - call CPU_TIME(rcpu1) - -c --- Construct 4-digit year from current 2-digit year (if found) - read(rdate(7:10),'(i4)') iyr - call YR4C(iyr) - write(rdate(7:10),'(i4)') iyr - -c --- Update base CPU time on first call - if(rcpu0.LT.0.0) rcpu0=rcpu1 - -c --- Return CPU time difference from base - rcpu=rcpu1-rcpu0 - -cc --- DEBUG -c write(*,*)'DATETM: stime,rcpu0,rcpu1,rcpu = ', -c & stime,rcpu0,rcpu1,rcpu - - return - end -c---------------------------------------------------------------------- - subroutine fmt_date(io,fmt1,fmt2,sdate) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 090511 FMT_DATE -c D. Strimaitis -c -c --- PURPOSE: Change the format of a date string -c -c --- INPUTS: -c io - integer - Listfile output unit number -c fmt1 - character*12 - Input date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c sdate - character*12 - Date string to convert -c fmt2 - character*12 - Output date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c -c --- OUTPUT: -c sdate - character*12 - Converted date string -c -c --- FMT_DATE called by: (any) -c --- FMT_DATE calls: ALLCAP -c---------------------------------------------------------------------- - character*12 fmt1,fmt2,sdate - character*3 month3(12),month3uc(12),amon3 - character*1 amon(3) - integer io - -c --- Set abbreviation names for months - data month3/'Jan','Feb','Mar','Apr','May','Jun', - & 'Jul','Aug','Sep','Oct','Nov','Dec'/ - data month3uc/'JAN','FEB','MAR','APR','MAY','JUN', - & 'JUL','AUG','SEP','OCT','NOV','DEC'/ - -c --- Extract input month, day and year - if(fmt1(1:10).EQ.'MM-DD-YYYY') then - read(sdate(1:2),'(i2)') imon - read(sdate(4:5),'(i2)') iday - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'DD-MM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:5),'(i2)') imon - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'YYYY-MM-DD') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') imon - read(sdate(9:10),'(i4)') iday - elseif(fmt1(1:10).EQ.'YYYY-DD-MM') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') iday - read(sdate(9:10),'(i4)') imon - elseif(fmt1(1:11).EQ.'DD-MMM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:6),'(3a1)') amon - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - elseif(fmt1(1:11).EQ.'MMM-DD-YYYY') then - read(sdate(1:3),'(3a1)') amon - read(sdate(5:6),'(i2)') iday - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - else - write(io,*)'FMT_DATE: Invalid input format = ',fmt1 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Check for valid month index - if(imon.LT.1 .OR. imon.GT.12) then - write(io,*)'FMT_DATE: Invalid month in date = ',sdate - write(io,*)' for input format = ',fmt1 - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Create output date string - if(fmt2(1:10).EQ.'MM-DD-YYYY') then - sdate='MM-DD-YYYY ' - write(sdate(1:2),'(i2.2)') imon - write(sdate(4:5),'(i2.2)') iday - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'DD-MM-YYYY') then - sdate='DD-MM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - write(sdate(4:5),'(i2.2)') imon - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'YYYY-MM-DD') then - sdate='YYYY-MM-DD ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') imon - write(sdate(9:10),'(i2.2)') iday - elseif(fmt2(1:10).EQ.'YYYY-DD-MM') then - sdate='YYYY-DD-MM ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') iday - write(sdate(9:10),'(i2.2)') imon - elseif(fmt2(1:11).EQ.'DD-MMM-YYYY') then - sdate='DD-MMM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - sdate(4:6)=month3(imon) - write(sdate(8:11),'(i4.4)') iyear - elseif(fmt2(1:11).EQ.'MMM-DD-YYYY') then - sdate='MMM-DD-YYYY ' - sdate(1:3)=month3(imon) - write(sdate(5:6),'(i2.2)') iday - write(sdate(8:11),'(i4.4)') iyear - else - write(io,*)'FMT_DATE: Invalid output format = ',fmt2 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - - return - end -c---------------------------------------------------------------------- - subroutine etime(rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 941215 ETIME -c --- J. Scire, SRC -c -c --- PURPOSE: Dummy system CPU time routine for PC -c DO NOT USE THIS ROUTINE ON SUNs -c -c --- INPUTS: none -c -c --- OUTPUT: RCPU - real - CPU time (sec) -- set to zero for PC -c -c --- ETIME called by: DATETM -c --- ETIME calls: none -c---------------------------------------------------------------------- - rcpu=0.0 -c - return - end -c---------------------------------------------------------------------- - subroutine undrflw(lflag) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 UNDRFLW -c D. Strimaitis, Earth Tech Inc. -c -c --- PURPOSE: This routine takes advantage of the Lahey F77L routine -c UNDER0 to set underflows to zero. When other compilers -c are used, there may be a similar routine. If none -c exists, place a dummy statement here and use compiler -c switches to configure the NDP response to an underflow. -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c---------------------------------------------------------------------- - logical lflag - -cc --- Lahey F77L Compiler (begin) -cc ------------------------------- -cc --- Lahey F77 compiler -- set underflows ( < 10**-38 ) to zero -c call UNDER0(lflag) -cc --- Lahey F77L Compiler (end) - -c --- Dummy (no action on underflows) -c ----------------------------------- - lflag=.TRUE. -c --- Dummy (end) - - return - end -c---------------------------------------------------------------------- - subroutine comline(ctext) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 COMLINE -c J. Scire, SRC -c -c --- PURPOSE: Call the compiler-specific system routine that will -c pass back the command line argument after the text -c that executed the program -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c --- UPDATE -c --- V2.3 (040330) to V2.6.0 (040330) MBN -c - Removed obsolete Compaq, Microsoft, and HP compiler codes -c - Removed getcl (Lahey-only function not needed) -c --- V2.2 (960521) to V2.3 (040330) DGS -c - Replace strings c*70 with c*132 -c -c --- INPUTS: -c -c CTEXT - character*132 - Default command line argument #1 -c -c --- OUTPUT: -c -c CTEXT - character*132 - Command line argument #1 -c If command line argument is -c missing, CTEXT is not changed -c -c --- COMLINE called by: SETUP -c --- COMLINE calls: IARGC, GETARG - compiler routines -c -c---------------------------------------------------------------------- -c - character*132 ctext,cdeflt -c -c --- The following is for any system without a command line routine -c --- and is also used as a default - cdeflt=ctext -c -c ---------------- -c --- Intel ifort, Lahey lf95, and GNU gfortran compilers: -c ---------------- - numargs=IARGC() - if(numargs.ge.1)then - call GETARG(1,ctext) - endif -c -c --- If no command line arguments, use default - if(ctext(1:1).eq.' ')ctext=cdeflt - - return - end - -c---------------------------------------------------------------------- - subroutine open_err(iolst,cfrom,cftype,cfname,iunit) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 141010 OPEN_ERR -c D. Strimaitis, Exponent Inc. -c -c --- PURPOSE: Report error in opening a file -c -c --- INPUTS: -c IOLST - integer - Unit number of output list file -c (<0 if not available) -c CFROM - char* - Called-From string to report error -c CFTYPE - char* - File-type string -c CFNAME - char* - File-name string -c IUNIT - integer - File unit number -c -c --- OUTPUT: -c -c --- OPEN_ERR called by: () -c --- OPEN_ERR calls: -c---------------------------------------------------------------------- - implicit none - -c --- Declare arguments - character(len=*) :: cfrom,cftype,cfname - integer :: iolst, iunit - - if(iolst.GT.0) then - write(iolst,*) - write(iolst,*)'ERROR opening '//TRIM(cftype) - write(iolst,*)' File Name: '//TRIM(cfname) - write(iolst,*)' File Unit: ',iunit - write(iolst,*)'Problem reported from '//TRIM(cfrom) - write(iolst,*) - write(iolst,*)'The file may not exist in this location' - write(iolst,*)'Check the spelling of the name and the location' - write(*,*) - stop 'ERROR: File not found -- see list file' - else - write(*,*) - write(*,*)'ERROR opening '//TRIM(cftype) - write(*,*)' File Name: '//TRIM(cfname) - write(*,*)' File Unit: ',iunit - write(*,*)'Problem reported from '//TRIM(cfrom) - write(*,*) - write(*,*)'The file may not exist in this location' - write(*,*)'Check the spelling of the name, and the location' - stop - endif - - end - diff --git a/CALPUFF_SRC/CALMET/coordlib.for b/CALPUFF_SRC/CALMET/coordlib.for deleted file mode 100644 index 956f226..0000000 --- a/CALPUFF_SRC/CALMET/coordlib.for +++ /dev/null @@ -1,8190 +0,0 @@ -c---------------------------------------------------------------------- -c --- COORDLIB -- COORDINATE SYSTEM UTILITIES -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.10.0 Level: 140313 -c -c Copyright (c) 2014 by Exponent, Inc. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c -c --- Interface routines -c subroutine GLOBE1 -c subroutine GLOBE -c subroutine NIMADATE -c subroutine COORDSVER -c -c --- Coordinate transformation engine -c subroutine COORDS -c (and subroutines) -c ----------------------------- -c -c --- UPDATE -c -c --- V1.98-V1.10.0 140313 (DGS): Modify UTM section of PJINIT in -c COORDS to fix erroneous non-zero -c false Northing when converting S. -c hemisphere locations to UTM-N -c coordinates -c Initialize full work arrays DWRK, -c DWRK2, TDUM to zero -c Initialize UTMOUT to zero -c -c --- V1.97-V1.98 060911 (DGS): Changes in COORDS that allow a higher -c level of FORTRAN error checking. -c -c --- V1.96-V1.97 060626 (DGS): Add subroutine GLOBE1 (from CALUTILS) -c after removing link to CALUTILS -c components -c -c --- V1.95-V1.96 051010 (KAM): ADD ALBERS CONICAL EQUAL AREA (ACEA) -c PROJECTION AS ONE OF THE SUPPORTED -c PROJECTIONS IN SUBROUTINE COORDS. -c -c --- V1.94-V1.95 050126 (GEM): FORBID UTM CONVERSION TO BE DONE -c FOR A NON-USGS SPHEROID. ADDED AN ERROR -c STRING TO THE COORDS CALL BETWEEN IRET -c AND DSTAMPIN. ADDED THE IRET CODE 99 -c FOR THE CASE WHEN THE FORBIDDEN UTM -c CONVERSION IS ENCOUNTERED. ALSO FIXED -c THE UTM TO UTM CASE WHEN THE OUTPUT UTM -c ZONE IS NOT SPECIFIED. USES THE INPUT -c (OR NATURAL) ZONE TO AVOID ZEROES. -C (GEM): Added IRET=98 error code for a LAZA -c projection with a datum that is not a -c sphere (e.g. not NWS-84 or ESR-S). -c (GEM): LAZA Projection: removed assignment -c of 6370 km earth radius (NWS-84 datum) -c when a value less than 6000 km is -c found. This assignment can override -c a requested radius of 6371 (ESR-S -c datum) if the NWS-84 datum is used -c with any valid projection prior to the -c request for ESR-S. LAZA(NWS-84) -c coordinate distances from the -c projection origin are about 0.016% -c smaller than LAZA(ESR-S). -c (DGS): Introduce subroutine COORDSVER -c --- V1.93-V1.94 041007 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY WHEN -c MOVING FROM ONE DATUM TO ANOTHER - A -c CONTINUATION OF THE FIX IN THE -c PREVIOUS VERSION. -c --- V1.92-V1.93 040713 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY AND -c FIXED THE CASE WHERE NWS-84 UNDER -c UTM USE DID NOT HAVE A VALID ELLIPSE -c MODEL INPUT -c --- V1.91-V1.92 031201 (GEM): CORRECTED CASE WHERE ONLY A CHANGE -C IN THE SAME PROJECTION IS DESIRED -c --- V1.9-V1.91 031017 (GEM): CORRECTED WGS 72 AND FIXED ELLIPSOID -c INITIALIZATION -c --- V1.15-V1.9 030905 (GEM): MAPLIB VERSION 1.9 030905 -c Rename MAPLIB system to COORDLIB -c --- V1.14-V1.15 030528 (DGS): MAPLIB VERSION 1.85 030528 -c --- V1.13-V1.14 030402 (DGS): MAPLIB VERSION 1.84 030402 -c --- V1.12-V1.13 030307 (DGS): MAPLIB VERSION 1.83 030307 -c NIMA Date now C*12 (MM-DD-YYYY ) -c --- V1.11-V1.12 030221 (DGS): Add routine to pass NIMA date -c --- V1.1-V1.11 030217 (DGS): Revise COORDS error message -c --- V1.0-V1.1 030117 (DGS): Add date stamp to COORDS call -c MAPLIB VERSION 1.8A 011403 -c -c---------------------------------------------------------------------- - subroutine globe1(cmapi,iutmzni,tmsfi,xlat1i,xlat2i,rlati,rloni, - & feasti,fnorti, - & cmapo,iutmzno,tmsfo,xlat1o,xlat2o,rlato,rlono, - & feasto,fnorto, - & caction,vecti,vecto) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.10.0 Level: 060626 GLOBE1 -c D. Strimaitis -c -c --- PURPOSE: Setup for coordinate transformation routine COORDS -c -c --- UPDATE -c --- V1.97(060626) (DGS) -c - Transferred from CALUTILS -c - Remove calls to DEBLNK and ALLCAP to isolate -c --- ...CALUTILS... -c --- V2.3 (051019) from V2.2 (030528) (KAM) -c - Add Albers Conical Equal Area projection -c --- V2.2 (030528) from V2.1 (030402) (DGS) -c - Screen for valid UTM zone using absolute value -c (S. Hem. zones are negative) -c --- V2.1 (030402) from V2.0 (021018) (DGS) -c - Add False Easting & Northing inputs -c -c --- INPUTS: -c CMAPI - char*8 - Map projection of input coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNI - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFI - real - Scale Factor for TM projection -c XLAT1I - real - Matching Equator-ward N.Latitude -c XLAT2I - real - Matching Pole-ward N.Latitude -c RLATI - real - Map origin N.Latitude -c RLONI - real - Map origin E.Longitude -c FEASTI - real - False Easting (km) at proj. origin -c FNORTI - real - False Northing (km) at proj. origin -c CMAPO - char*8 - Map projection of output coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNO - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFO - real - Scale Factor for TM projection -c XLAT1O - real - Matching Equator-ward N.Latitude -c XLAT2O - real - Matching Pole-ward N.Latitude -c RLATO - real - Map origin N.Latitude -c RLONO - real - Map origin E.Longitude -c FEASTO - real - False Easting (km) at proj. origin -c FNORTO - real - False Northing (km) at proj. origin -c -c -c --- OUTPUT: -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c -c -c --- GLOBE1 called by: (utility) -c --- GLOBE1 calls: none -c---------------------------------------------------------------------- - - character*1 cstor1(20),cstor2(20),clc(26),cuc(26) - - real*8 vecti(9),vecto(9) - character*12 caction - character*8 cmapi,cmapo - - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - & 'j','k','l','m','p','q','r','s','t','v','w','y','z'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - & 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z'/ - -c --- Set action string for conversion -c ------------------------------------ -c --- Initialize character variables for output - do i=1,20 - cstor1(i)=' ' - cstor2(i)=' ' - enddo - do i=1,8 - j=i+9 - cstor1(i)=cmapi(i:i) - cstor1(j)=cmapo(i:i) - enddo - cstor1(9)='2' -c --- Remove blank characters from string, place in storage array 2 - nlim=0 - do i=1,17 - if(cstor1(i).NE.' ') then -c --- Transfer non-blank character into array 2 - nlim=nlim+1 - cstor2(nlim)=cstor1(i) - endif - enddo -c --- Convert lower case letters to upper case - do i=1,nlim - do j=1,26 - if(cstor2(i).EQ.clc(j)) then - cstor2(i)=cuc(j) - go to 52 - endif - enddo -52 continue - enddo -c --- Transfer characters to action string - do i=1,12 - caction(i:i)=cstor2(i) - enddo - -c --- Set transformation vectors -c ------------------------------ -c --- Initialize transformation vectors - vecti(1)=999.0D0 - vecto(1)=999.0D0 - do i=2,9 - vecti(i)=0.0D0 - vecto(i)=0.0D0 - enddo - -c --- Input coords - if(cmapi.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzni).GT.0 .AND. - & IABS(iutmzni).LT.61) vecti(1)=DBLE(iutmzni) - else -c --- Matching points / origin - vecti(4)=DBLE(xlat1i) - vecti(5)=DBLE(xlat2i) - vecti(6)=DBLE(rloni) - vecti(7)=DBLE(rlati) - endif - if(cmapi.EQ.'TM') then -c --- TM Scale Factor - vecti(1)=DBLE(tmsfi) - endif - if(cmapi.EQ.'TM'.or.cmapi.EQ.'LCC'.or.cmapi.EQ.'LAZA'.or. - & cmapi.EQ.'ACEA') then - vecti(8)=DBLE(feasti) - vecti(9)=DBLE(fnorti) - endif - -c --- Output coords - if(cmapo.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzno).GT.0 .AND. - & IABS(iutmzno).LT.61) vecto(1)=DBLE(iutmzno) - else -c --- Matching points / origin - vecto(4)=DBLE(xlat1o) - vecto(5)=DBLE(xlat2o) - vecto(6)=DBLE(rlono) - vecto(7)=DBLE(rlato) - endif - if(cmapo.EQ.'TM') then -c --- TM Scale Factor - vecto(1)=DBLE(tmsfo) - endif - if(cmapo.EQ.'TM'.or.cmapo.EQ.'LCC'.or.cmapo.EQ.'LAZA'.or. - & cmapo.EQ.'ACEA') then - vecto(8)=DBLE(feasto) - vecto(9)=DBLE(fnorto) - endif - - return - end -c---------------------------------------------------------------------- - subroutine globe(iolst,caction,cdatumi,vecti,cdatumo,vecto, - & xinp4,yinp4,xout4,yout4,izone,utmhem) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.10.0 Level: 050126 GLOBE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Driver for coordinate transformation routine COORDS -c translates CALPUFF system information and provides -c fixed inputs -c -c --- UPDATE -c -c --- V1.13 (030307) to V1.95 (050126) -c - Added ESTRNG string to COORDS call for error message -c text. (GEM) -c - Added VERDOC string to COORDS call for identification -c text (DGS) -c --- V1.12 (030217) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c --- V1.1 (030117) to V1.11 (030217) (DGS) -c - Revise return error message -c --- V1.0 () to V1.1 (030117) (DGS) -c - Add date stamp to COORDS calls -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c CDATUMI - char*8 - Datum-region code for input coords -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CDATUMO - char*8 - Datum-region code for output coords -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c XINP4 - real*4 - Input Easting(km) (or E.Longitude deg) -c YINP4 - real*4 - Input Northing(km) (or N.Latitude deg) -c -c -c --- OUTPUT: -c XOUT4 - real*4 - Output Easting(km) (or E.Longitude deg) -c YOUT4 - real*4 - Output Northing(km) (or N.Latitude deg) -c IZONE - integer - UTM zone of output -c UTMHEM - char*4 - Hemisphere for UTM projection (N or S) -c -c --- GLOBE called by: (utility) -c --- GLOBE calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - logical ldb - - character*4 utmhem - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set debug output logical - ldb=.FALSE. - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - -c --- Convert output coordinates to single precision - xout4=SNGL(xyzio(1)) - yout4=SNGL(xyzio(2)) - utmzn=SNGL(utmout) - izone=NINT(utmzn) - -c --- Format UTM zone to CALPUFF convention - utmhem='N' - if(izone.LT.0) then - utmhem='S' - izone=-izone - endif - - if(LDB) then - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine nimadate(date) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.10.0 Level: 030905 NIMADATE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Passes the NIMA date from common to calling program -c -c --- UPDATE -c --- V1.13 (030307) to V1.9 (030905) (GEM) -c - Change to NIMA.CRD for MAPLIB VERSION 1.9 -c --- V1.12 (030221) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c -c --- INPUTS: -c none -c -c --- OUTPUT: -c DATE - char*12 - NIMA database date -c -c --- NIMADATE called by: (utility) -c --- NIMADATE calls: none -c---------------------------------------------------------------------- - include 'nima.crd' - character*12 date - - date=daten - - return - end -c---------------------------------------------------------------------- - subroutine coordsver(iolst,verdoc) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.10.0 Level: 050126 COORDSVER -c D. Strimaitis EarthTech -c -c --- PURPOSE: Accesses the COORDS version information by making one -c generic call to COORDS (like GLOBE) -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c -c --- OUTPUT: -c VERDOC - char*50 - COORDS version information -c -c --- COORDSVER called by: (utility) -c --- COORDSVER calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecti/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecto/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Set up converter for a null translation of lat/lon - xinp4= -90.0 - yinp4=45.0 - caction='LL2LL ' - cdatumi='WGS-84 ' - cdatumo='WGS-84 ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - - return - end -C---------------------------------------------------------------------- - SUBROUTINE COORDS(IO,IUNIT,IMODE,IPROJ,IDATMI,IDATMO,IPREC, - 1 CVECTI,CVECTO,NVEC,XYZIN,NC,XDATUM,NDAT,XYZIO,UTMOUT,IRET, - 2 ESTRNG,DSTAMPIN,VERDOC) -C---------------------------------------------------------------------- -C -C --- COORDLIB Version: 1.10.0 Level: 140313 COORDS -C -C --- Program was written by Gary Moore -C -C --- PROGRAM NOTES FOLLOW: -C -C --- Version 1.1 argument change -C -C --- IDATMI(O) - FULL CHARACTER STRING FOR GUI SUPPLIED (IRANK REMOVED) -C --- XDATUM,NDAT - PASS FULL ARRAY OF USER DEFINED DATUM INFO (DP) -C -C --- (1) - MAJOR RADIUS -C --- (2) - INVERSE FLATTENING -C --- (3) - ECCENTRICITY SQUARED -C --- (4) - DX -C --- (5) - DY -C --- (6) - DZ -C -C --- Version 1.2 argument change -C -C --- UTMOUT a double precision output UTM zone is used in the convert -C --- program as output to tell what UTM each point has been translated -C --- TO. -C -C --- Version 1.3 changes -C -C --- Addition of LL2ZONE subroutine for extracting the natural UTM zone -C --- when going FROM LCC TO UTMS - otherwise there is no way of knowing -C --- added extra projection calls in places to retrieve the geodetic -C --- coordinates. -C -C --- Version 1.4 changes -C -C --- Fixed the use of the FROM ellipsoid model for the final projection -C --- and changed to it to the TO ellipsoid model. Fixed the DAT2DAT and -C --- DATSHFT routines so that the proper reverse transformation proceedure -C --- is done (note - changed presentation figures) -C -C --- Version 1.5 changes -C -C --- Added more options for transformation - PS = Polar Stereographic -C --- and EM = Equatorial Mercator. Note - both of these will generally -C --- be used on a spherical earth represented by Datum 220, but can -C --- be projected to an ellipical surface - unlike the azimuthal -C --- projections that can only be done on a sphere. The LAZA was hardwired -C --- to do only a sphere with a radius of 6370 km (before it could float -C --- incorrectly). -C -C --- The block data variables were modified to accomodate the new NIMA -C --- data base. Block data call was moved to the INIT subroutine which -C --- sets up variables for COORDS and outputs several arrays for use with -C --- GUI's -C -C --- The NIMA data base use resulted in a considerable set of code -C --- revisions including (1) 8 Character Datum ID use for selecting the -C --- Datum (2) use of a 21 character ellipsoid string check (3) use of -C --- a revised 118 character region string. -C -C --- An INCLUDE file 'NIMA.CRD' was used to insert the NIMA common -C --- blocks into routines. -C -C --- version 1.6 changes -C -C --- Made several upgrades including: -C -C --- (1) adds a date check to make sure the block data is the right -C --- version. This requires adding an extra argument to COORDS -C -C --- (2) adds the Tranverse Mercator projection (TM) -C -C --- (3) add error codes for projections -C -C --- (4) allows the user input 'to' (output) utm zone to work -c -c --- Changed the ordering of CVECTI/CVECTO elements 4-7 to be consistent -c --- across all transformations, rather than following the USGS element -c --- definitions. Lat/Lon of origin of EM and PS projections is accepted -c --- and the corresponding false Easting/Northing values are computed -c --- and applied. The elements of the transformation vector are: -c (1) UTM Zone (for UTM), or Scale Factor (for TM) -c (2) radius of major axis of earth - (used for Azimuthal projections) -c (3) not currently used -c (4) True N. Latitude #1 (where applicable) -c (5) True N. Latitude #2 (where applicable) -c (6) E. Longitude of projection origin (where applicable) -c (7) N. Latitude of projection origin (where applicable) -c (8) False Easting (where applicable) -c (9) False Northing (where applicable) -C -C --- Version 1.7 changes -C -C --- Moved false northing determination of TO projections to a point -C --- where they occur AFTER a datum shift -C -C --- Added dummy arrays to keep longitude/latitudes from being written -C --- over. -C -C --- Removed writes to standard output so DLL's can be directly made -C -C --- Removed external date check changes to an internal one -C -C --- Further revisions to PS and EM cases the user cannot input a -C --- false northing and easting - and error is returned if they do -C -C --- Fixed PS2PS and EM2EM cases -C -C --- Version 1.8 changes -C -C --- Dealt with a major issue of projection initialization that is done -C --- with INZONE. Initialization is done when the UTM zone changes. Software -C --- was added to make sure this happens. -C -C --- The PS/EM projections had consistency problems when the offset is -C --- calculated with a 0.0 rather than a true longitude - the true longitude -C --- was used. -C -C --- An error in the PS/EM projection was corrected when the input -C --- parameter vector was found to be using an incorrect latitude of -C --- true scale. -C -C --- Error warnings were included to make sure that no false eastings -C --- or northings are input by the user of the PS and EM projections. -C -C --- Version 1.81 changes -C -C --- Modified USGS routines to force initialization every time by -C --- setting the switch array to zero for all projections on each call -C -C --- Added DGS approach to checking date stamp using DATEN and DATEB -C -C --- Added include for the block data (blockdat.crd) -C -C --- Version 1.82 changes -C -C --- Fixed the TM insertion of scaling factor - moved it from the USGS -C --- Element # 3 (CVECT element #4) to the CVECT element #1 normally -C --- (UTM ZONE) - the UTM zone is now set to 999. There is a mapping -C --- of the UTM ZONE to the USGS element 3 and a resetting of the -C --- UTM zone to 999 before entering the USGS subroutines. -C -C --- Scale false Easting/Northing to METERS -C --- Correct false Easting/Northing assignments after processing -C -C --- Convert main program to the CALPUFF Version/Level designation -C --- where Level is YYMMDD -C -C --- Added date-stamp argument DSTAMPIN to re-assign DSTAMP if the -C --- argument is non-blank -C -C --- Version 1.83 changes -C -C --- NIMA date variables changed from C*10 to C*12 -C --- DAT2DAT does not transform to/from WGS84 if input/output datum -C is for a sphere -C -C --- Version 1.84 changes -C -C --- Recast UTM-to-UTM conversions to properly handle zone overrides -C by adding IOVUTM: -C 0) finds native output UTM zone for output UTMs -C 1) no change to input coordinates when inzone=iozone -C 2) uses zone override for output UTMs -C -C --- Version 1.85 Level: 030528 changes -C -C --- Fix Polar Stereographic (PS) dummy array initialization which -C did not include the Earth Radius for spherical datum, and clarify -C code (remove unneeded dummy arrays) -c -c --- Take absolute value of UTM zone when testing for valid values -c (UTM is negative in S. Hemisphere) -c -C -C --- Version 1.9 Level: 030905 changes -C -C --- NEW BLOCK DATA!!!! The new block data was created by version 1.3 -C of BUILD.FOR which utilizes new data sources for DATUMs. These new -C files include: -C -C --- (1) New HEADER.TXT which defines two new global datum and removes -C one spherical earth datum (based on NAD 27). The two new datums -C are functionally equivalent and they serve as a placeholder to -C assure users they have the proper DATUM -C -C --- (2) New Datum data files GEOTRANS_02-21-2003.dat and ellips.dat -C These new data files are required since the DATUM listing text -C file produced by NIMA is not available for the latest changes -C in datum definitions. Instead the user is referred to the data -C files used by the NIMA GEOTRANS geocalculator. The ellips.dat -C file contains the parameters defining 23 ellipsoid models used -C to define the datums. These are matched by two character codes -C to the differences in geocentric coordinates of each datum -C relative to WGS-84 found in GEOTRANS_02-21-2003. The -C GEOTRANS_02-21-2003.dat file contains five new local datums - -C all which are Hawaian Island local variants. -C -C --- (3) NEWDATUM.TXT is a new file that has been added to allow insertion -C of new datums into the proper place in the master list of local -C datums. This file also allows one to add descriptive text (3 lines) -C describing the valid region or conditions of the datum. -C -C --- (4) Introduced the WGS72 global data and added formulas -C to deal with the coordinate transformations between WGS84. -C -C --- Version 1.91 Level: 031017 changes -C -C --- Made a change to TPARIN and TPARIO - Placed ellipsoid -C --- parameters in locations 14 (major radius) and 15 (eccentricity -C --- squared). Also forces the first pass initialization of GZTP0 -C --- to use the parameters rather than default to a CLARKE 1866. -C --- Also fixed a typo so that the USGS WGS 72 ellipsoid model in -C --- the USGS programs is used. -C -C --- Version 1.93 Level: 041307 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere). Also fixed a problem with NWS-84 and -C --- UTM combination where there is no difference in the results when -C --- going to and from this DATUM from other DATUMS. For UTM the 6371 km -C --- spherical ellipse model must be used when the 6370Km sphere is used -C --- because of USGS program input array conflicts. -C -C --- Version 1.94 Level: 041007 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere) when going from one DATUM to another. This -C --- is a continuation of the change made in version 1.93. -C -C --- Version 1.95 Level: 050126 changes -C -C --- Made it impossible to use a non-USGS earth spheroid when using UTM's -C --- Essentially reversed an attempted fix under version 1.93. -C --- EMG-96 is aliased to GRS 80 ellipsoid model. -C -C--------------- -C *** ALERT *** -C--------------- -C - COORDS versions prior to 1.93 used the Clark 1866 spheroid for -C - UTM conversions when a datum with a non-USGS earth spheroid is -C - specified. An example of this is the NWS-84 datum. -C - The UTM/NWS-84 fix implemented in version 1.93 and present in -C - version 1.94 whould have used a mixture of ESRI and Clarke 1866 -C - owing to the fix being applied only to one side of the -C - transformation. One should never mix versions 1.93 and 1.94 -C - with prior versions. ONE SHOULD NOT USE VERSIONS 1.93 and 1.94 -C - owing to the inconsistent nature of the transformation!!!! -C -C --- Added another IRET error code (IRET = 99) for this case. Added an -C --- error string (50 characters) between IRET and DSTAMPIN to the call -C --- to COORDS to return the error message text. -C -C --- Added yet another IRET error code (IRET = 98) for the case when -C --- one tries to use LAZA with a datum that is not a sphere (e.g. not -C --- (NWS-84 or ESR-S). -c -c --- Added VERDOC string to argument list for COORDS identification -c --- text. -c -c --- LAZA Projection: removed assignment of 6370 km earth radius -c --- (NWS-84 datum) when a value less than 6000 km is found. This -c --- assignment can override a requested radius of 6371 (ESR-S datum) -c --- if the NWS-84 datum is used with any valid projection prior to the -c --- request for ESR-S. LAZA(NWS-84) coordinate distances from the -c --- projection origin are about 0.016% smaller than LAZA(ESR-S). -c --- This undoes a change made in version 1.5. -C -C --- Fixed the case for a UTM to UTM transformation when the output UTM -C --- zone is not specified by the user. The UTM zone is set to the -C --- input UTM zone (or the natural UTM if it estimated) in order that -C --- the proper UTM zone is presented in the output rather than zero. -C --- This fix addresses a situation that arises in the coordinate -C --- conversion GUI. -C -C --- Version 1.96 Level: 051010 changes -C -C --- Add Albers Conical Equal Area projection as one of the supported -C --- projections. -C -C --- Version 1.98 Level: 060911 changes -C -c --- Changes that allow a higher level of FORTRAN error checking: -c --- Replace the constant 4 with an I*4 variable (IUNIT4) in -c calls to GTPZ0 from COORDS (to/from lat-lon). -c --- Set GTPZ0 argument LENGTH=100 (for direct access files that -c are not used). -c --- Replace constant 0 with I*4 variable (INSPHZERO) in argument 1 -c of SPHDZ0 call in GTPZ0 -c --- Change FUNCTION ADJLZ0 argument name and reassign to LON within -c (sub is called with a computed argument that should not be -c changed within subroutine) -c --- SAVE9 is undefined first time in PJINIT; set to zero in DATA - -C -C --- Version 1.10.0 Level: 140313 changes -C -c --- Modify UTM section of PJINIT to fix erroneous non-zero false -c --- Northing when converting S. hemisphere locations to UTM-N -c --- coordinates. Main subroutine also changed to remove patches -c --- that had corrected this problem when converting from lat/lon to -c --- UTM-N. The bug only affected conversions to N. hemisphere UTM -c --- coordinates when the location was in the S. hemisphere. The -c --- coordinates returned were actually in UTM-S. -c -c --- Initialize full real*8 work arrays DWRK, DWRK2, TDUM to zero. -c -c --- Initialize UTMOUT to zero. -C -C---------------------------------------------------------------------- -C -C --- PROGRAM FUNCTION: -C -C --- THIS IS THE MAIN DRIVER PROGRAM FOR THE MOLODENSKY DATUM -C --- CONVERSION AND THE USGS GCTP PROJECTION CONVERSION SOFTWARE. -C -C --- INPUT VARIABLES -C -C --- IO = LOGICAL FORTRAN UNIT FOR OUTPUT -C --- IUNIT = 10 CHARACTER UNITS STRING - 'METERS ' OR 'KILOMETERS' -C --- IMODE = 0 - USES DATA IN BLOCK DATA -C --- 1 - USER DEFINED DATUM INFORMATION (FROM) -C --- 2 - USER DEFINED DATUM INFORMATION (TO) -C --- 3 - USER DEFINED DATUM INFORMATION (FROM-TO) -C --- IPROJ = 12 CHARACTER PROJECTION ACTION STRING EG 'LL2UTM ' -C --- IDATMI = 8 CHARACTER INPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IDATMO = 8 CHARACTER OUTPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IPREC = 0 - SINGLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- 1 - DOUBLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- CVECTI = 1-D VECTOR OF INPUT PROJECTION PARAMETERS (DP) -C --- CVECTO = 1-D VECTOR OF OUTPUT PROJECTION PARAMETERS (DP) -C --- NVEC = NUMBER OF PARAMETERS IN THE CVECT ARRAYS -C --- XYZIN = 1-D ARRAY OF INPUT COORDINATES (X,Y,Z) (DP) -C --- NC = NUMBER OF VALID ELEMENTS IN XYZIN(O) (2 OR 3) (X,Y) OR (X,Y,Z) -C --- XDATUM = 1-D VECTOR OF DATUM DEFINITION PARAMETERS -C --- NDAT = NUMBER OF DATUM DEFINITION PARAMETERS (NORMALLY = 6) -C --- DSTAMPIN = 12 CHARACTER DATE STRING (MM-DD-YYYY ) FOR CHECKING -C --- NIMA PARAMS AND BLOCKDATA (Leave blank for default) - -C -C --- OUTPUT VARIABLES -C -C --- XYZIO = 1-D ARRAY OF OUTPUT COORDINATES (X,Y,Z) (DP) -C --- UTMOUT = UTM ZONE OF THE OUTPUT TO TRANSFORMATION (DP) -C --- IRET = RETURN FLAG (0) - SUCCESSFUL -C --- ESTRNG = 50 CHARACTER STRNG CONTAINING ERROR MESSAGE -C --- VERDOC = 50 character string containing COORDS version and level -C -C --- THIS PROGRAM CALLS: -C -C --- GTPZ0 - USGS GCTP MAIN SUBROUTINE -C --- ERRFLG - ERROR PRINTS FOR GTPZ0 -C --- DAT2DAT - MOLODENSKY DATUM SHIFT -C -C --- All NIMA BASED COMMON BLOCKS AND SUPPORTIVE DECLARATIVE -C --- STATEMENTS HAVE BEEN LUMPED INTO A SINGLE INCLUDE FILE -C --- CALLED 'NIMA.CRD' -C -c---------------------------------------------------------------------- -C - PARAMETER (MP = 64) -C - CHARACTER*128 FN27,FN83 - CHARACTER*50 IERR(12) - CHARACTER*50 ESTRNG, VERDOC - CHARACTER*12 JPROJ(MP),IPROJ - CHARACTER*8 IDATMI,IDATMO - CHARACTER*7 IPATH1,IPATH2 - CHARACTER*10 IUNIT - CHARACTER*21 ELIPSI,ELIPSO - CHARACTER*52 IDSTRNG - CHARACTER*12 DSTAMPIN -C - INTEGER*4 INSYS,INZONE,INUNIT,INSPH,IPR,JPR,LEMSG,LPARM,LN27, - 1 LN83,LENGTH,IOSYS,IOZONE,IOUNIT,IFLG - -c --- V1.98 (060911) - INTEGER*4 IUNIT4 - - INTEGER*4 SYSFLG(2,MP) - Integer*4 irnkin,irnkio - Integer*4 io,lpr, iret -C - Real*4 xdum,dxshft,dyshft,dzshft -C - REAL*8 CRDIN(2),TPARIN(15),CRDIO(2),TPARIO(15),DWRK(15), - 1 DWRK2(15) - REAL*8 XYZIN(NC), XYZIO(NC), CVECTI(NVEC), CVECTO(NVEC) - REAL*8 TDUM(15),XDATUM(NDAT) - Real*8 xlonin,xlatin,xlonio,xlatio - Real*8 flonin,flatin,flonio,flatio - Real*8 dd,dms,drad,dflt - Real*8 utmout - Real*8 TCRDIN(2),TCRDIO(2) -C -C --- Include the NIMA database - INCLUDE 'nima.crd' -C - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -C -C --- DEFAULT CONTROL SETTINGS AND ALLOWED PROJECTIONS - DATA IPATH1,IPATH2 /'NAD27SP','NAD83SP'/ - DATA LEMSG,LPARM,LN27,LN83 /16,17,18,19/ -c DATA IPR,JPR /0,0/ - DATA IPR,JPR /1,1/ - DATA JPROJ/ - * 'LL2LL ','LL2UTM ','LL2LCC ','LL2LAZA ', - * 'LL2PS ','LL2EM ','LL2TM ','LL2ACEA ', - * 'UTM2LL ','UTM2UTM ','UTM2LCC ','UTM2LAZA ', - * 'UTM2PS ','UTM2EM ','UTM2TM ','UTM2ACEA ', - * 'LCC2LL ','LCC2UTM ','LCC2LCC ','LCC2LAZA ', - * 'LCC2PS ','LCC2EM ','LCC2TM ','LCC2ACEA ', - * 'LAZA2LL ','LAZA2UTM ','LAZA2LCC ','LAZA2LAZA ', - * 'LAZA2PS ','LAZA2EM ','LAZA2TM ','LAZA2ACEA ', - * 'PS2LL ','PS2UTM ','PS2LCC ','PS2LAZA ', - * 'PS2PS ','PS2EM ','PS2TM ','PS2ACEA ', - * 'EM2LL ','EM2UTM ','EM2LCC ','EM2LAZA ', - * 'EM2PS ','EM2EM ','EM2TM ','EM2ACEA ', - * 'TM2LL ','TM2UTM ','TM2LCC ','TM2LAZA ', - * 'TM2PS ','TM2EM ','TM2TM ','TM2ACEA ', - * 'ACEA2LL ','ACEA2UTM ','ACEA2LCC ','ACEA2LAZA ', - * 'ACEA2PS ','ACEA2EM ','ACEA2TM ','ACEA2ACEA '/ - DATA SYSFLG/0,0,0,1,0,4,0,11,0,6,0,5,0,9,0,3, - * 1,0,1,1,1,4,1,11,1,6,1,5,1,9,1,3, - * 4,0,4,1,4,4,4,11,4,6,4,5,4,9,4,3, - * 11,0,11,1,11,4,11,11,11,6,11,5,11,9,11,3, - * 6,0,6,1,6,4,6,11,6,6,6,5,6,9,6,3, - * 5,0,5,1,5,4,5,11,5,6,5,5,5,9,5,3, - * 9,0,9,1,9,4,9,11,9,6,9,5,9,9,9,3, - * 3,0,3,1,3,4,3,11,3,6,3,5,3,9,3,3/ - DATA TDUM /15*1.0D0/ -C - FN27(1:7) = IPATH1 - FN83(1:7) = IPATH2 - LPR = IO - -c --- V1.98 (060911) -c --- Set units variable for steps with conversion to/from lat-lon - iunit4=4 -c --- Define record-length argument for GTPZ0 - length=100 - -c---------------------------------------------------------------------- -c --- Set the COORDS version and level string - - verdoc=' --- COORDLIB Version: 1.10.0 Level: 140313 ' - -c---------------------------------------------------------------------- - -C -C --- SET IRET TO ZERO - IRET = 0 -C -C --- PROPERLY INITIALIZE ESTRNG to BLANKS (NOT NULLS) - DO K = 1,50 - ESTRNG(K:K) = ' ' - ENDDO -C -C --- SPECIAL CHECK FOR NWS-84 SPHERE JUST IN CASE A LAZA PROJECTION -C --- IS DESIRED. A SPHERE FLAG IS INITIALIZED HERE (TO ZERO). IT IS -C --- SET TO 1 IF THE ELLIPSOID MODEL IS A SPHERE. - IBALLI = 0 - IBALLO = 0 - IF(IDATMI.EQ.'NWS-84')IBALLI = 1 - IF(IDATMO.EQ.'NWS-84')IBALLO = 1 -C -C --- Establish the date-stamp value - if(dstampin(1:1).NE.' ') dstamp=dstampin -C -C --- NOW FINDS OUT IF THE USER EXPECTED DATE STRING MATCHES THE -C --- ONE FOUND IN THE NIMA TEXT FILE - IF(DSTAMP.NE.DATEN)THEN - IRET = 10 - IERR(1)='DATE STAMP FAILURE FOR NIMA.CRD! ' - ESTRNG = IERR(1) - RETURN - ENDIF -C -C --- NOW FINDS OUT IF WE HAVE THE RIGHT BLOCK DATA FILE - IF(DSTAMP.NE.DATEB)THEN - IRET = 20 - IERR(2)='DATE STAMP FAILURE FOR BLOCKDATA! ' - ESTRNG = IERR(2) - RETURN - ENDIF -C -C --- IMMEDIATELY FINDS THE PROPER DATUM FROM THE PRESTORED SET - IRNKIN = 0 - IRNKIO = 0 - IF(IMODE.EQ.0)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 222 - ENDIF - ENDDO -222 CONTINUE - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 232 - ENDIF - ENDDO -232 CONTINUE - ENDIF - IF(IMODE.EQ.1)THEN - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 332 - ENDIF - ENDDO -332 CONTINUE - ENDIF - IF(IMODE.EQ.2)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 322 - ENDIF - ENDDO -322 CONTINUE - ENDIF -C -C --- IMMEDIATE CHECK FOR ILLEGAL DATUM POINTER - IF(IMODE.EQ.0)THEN - IF(IRNKIN.LT.1.OR.IRNKIN.GT.ND)THEN - IRET = 60 - IERR(6)='INPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(6) - RETURN - ENDIF - IF(IRNKIO.LT.1.OR.IRNKIO.GT.ND)THEN - IRET = 70 - IERR(7)='OUTPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(7) - RETURN - ENDIF - ENDIF -C -C --- CHECKS OPERATION MODE - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C --- NOW ESTABLISHES THE TRANSFORMATION TYPE - DO K = 1,MP - IF(JPROJ(K).EQ.IPROJ)THEN - INSYS = SYSFLG(1,K) - IOSYS = SYSFLG(2,K) - GOTO 101 - ENDIF - ENDDO - IRET = 40 - IERR(4) = 'THE PROJECTION PAIR IS UNDEFINED OR NOT ALLOWED! ' - ESTRNG = IERR(4) - RETURN - 101 CONTINUE -C -C --- NOW CHECKS FOR IMPROPER EASTING AND NORTHING OFFSETS FOR PS AND EM -C --- PROJECTIONS - IF((INSYS.EQ.5.OR.INSYS.EQ.6).AND.CVECTI(9).NE.0.0D+00)THEN - IRET = 80 - IERR(8) = 'ILLEGAL INPUT OF (FROM) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(8) - ENDIF - IF((IOSYS.EQ.5.OR.IOSYS.EQ.6).AND.CVECTO(9).NE.0.0D+00)THEN - IRET = 90 - IERR(9) = 'ILLEGAL INPUT OF (TO) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(9) - ENDIF -C -C --- NOW ESTABLISHES THE PROPER UNITS -C --- LL = DECIMAL DEGREES -C --- UTM,LCC,LAZA,PS,MC,ACEA = METERS OR KILOMETERS - XMULTI = 1.0 - IF(INSYS.EQ.0)THEN - INUNIT = 4 - ELSE - INUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTI = 1000.0 - ELSE - XMULTI = 1.0 - ENDIF - ENDIF - XMULTO = 1.0 - IF(IOSYS.EQ.0)THEN - IOUNIT = 4 - ELSE - IOUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTO = 0.001 - ELSE - XMULTO = 1.0 - ENDIF - ENDIF -C -C --- SINGLE PRECISION CHECK - SINGLE PRECISION IS NOT YET SUPPORTED - IF(IPREC.EQ.0)THEN - IRET = 50 - IERR(5) = 'NICE TRY - SINGLE PRECISION COORDS ARE ILLEGAL! ' - ESTRNG = IERR(5) - RETURN - ENDIF -c -c --- Store the ELon and NLat of the projection origin (DD) - FLONIN=CVECTI(6) - FLONIO=CVECTO(6) - FLATIN=CVECTI(7) - FLATIO=CVECTO(7) -C -C --- FILLS THE INPUT COORDINATES ARRAY CRDIN AND THE TPARIN ARRAY - CRDIN(1) = XYZIN(1)*DBLE(XMULTI) - CRDIN(2) = XYZIN(2)*DBLE(XMULTI) - IF(NVEC.GT.16)THEN - IRET = 60 - IERR(6) = 'TRUNCATED PROJECTION PARAMETER VECTOR! ' - ESTRNG = IERR(6) - NVEC = 16 - ENDIF - DO K = 1,15 - TPARIN(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTI(1)) - INZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIN(K-1) = CVECTI(K)*DBLE(XMULTI) - ELSE -C --- ASSIGN DIRECTLY FROM INPUT VECTOR - TPARIN(K-1) = CVECTI(K) - ENDIF - ENDDO -C -C --- FILLS THE TPARIO ARRAY (ALSO NEEDED) - DO K = 1,15 - TPARIO(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTO(1)) - IOZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIO(K-1) = CVECTO(K)/DBLE(XMULTO) - ELSE -C --- ASSIGN DIRECTLY FROM OUTPUT VECTOR - TPARIO(K-1) = CVECTO(K) - ENDIF - ENDDO - -c --- Initialize full work arrays - do k = 1,15 - dwrk(k) = 0.0D+00 - dwrk2(k) = 0.0D+00 - tdum(k) = 0.0D+00 - enddo - -c --- Initialize output variable UTMOUT - utmout = 0.0D+00 -C -C --- Now converts the TPARIN, TPARIO FROM DD to DDDMMMSSS.SS -C --- UTM's - IF(INSYS.EQ.1)THEN - DD = TPARIN(1) - CALL DD2DMS(DD,DMS) - TPARIN(1) = DMS - DD = TPARIN(2) - CALL DD2DMS(DD,DMS) - TPARIN(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(INSYS.EQ.4.OR.INSYS.EQ.3)THEN - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(3) = DMS - DD = TPARIN(4) - CALL DD2DMS(DD,DMS) - TPARIN(4) = DMS - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- EM & PS's (Note shift of arguments) - IF(INSYS.EQ.5.OR.INSYS.EQ.6)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - TPARIN(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(INSYS.EQ.9)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS -C --- NOW SWAP FROM CVECTI ELEMENT 1 TO USGS ELEMENT 3 - TPARIN(3) = CVECTI(1) - INZONE = 999 - ENDIF -C --- LAZA's - IF(INSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIN(1).LT.6000000.0D+00)THEN -C TPARIN(1) = 6370000.0D+00 -C ENDIF - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- UTM's - IF(IOSYS.EQ.1)THEN - DD = TPARIO(1) - CALL DD2DMS(DD,DMS) - TPARIO(1) = DMS - DD = TPARIO(2) - CALL DD2DMS(DD,DMS) - TPARIO(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(IOSYS.EQ.4.OR.IOSYS.EQ.3)THEN - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(3) = DMS - DD = TPARIO(4) - CALL DD2DMS(DD,DMS) - TPARIO(4) = DMS - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C --- EM AND PS's (Note shift of arguments) - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - TPARIO(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(IOSYS.EQ.9)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS -C --- NOW SWAP FROM CVECTO ELEMENT 1 TO USGS ELEMENT 3 - TPARIO(3) = CVECTO(1) - IOZONE = 999 - ENDIF -C --- LAZA's - IF(IOSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIO(1).LT.6000000.0D+00)THEN -C TPARIO(1) = 6370000.0D+00 -C ENDIF - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C -C --- NOW ESTABLISHES THE PROPER ELLIPSOID MODEL PARAMETERS - IF(IMODE.EQ.0.OR.IMODE.EQ.2)THEN - IDSTRNG = DATUM(DATTYP(IRNKIN)) - ELIPSI = IDSTRNG(32:52) - INSPH = -1 -c -c --- Special alias for EMG 96 - if(elipsi.eq.'EMG 96 ')INSPH = 8 - IF(ELIPSI.EQ.'Clarke 1866 ')INSPH = 0 - IF(ELIPSI.EQ.'Clarke 1880 ')INSPH = 1 - IF(ELIPSI.EQ.'Bessel 1841 ')INSPH = 2 - IF(ELIPSI.EQ.'International 1967 ')INSPH = 3 - IF(ELIPSI.EQ.'International 1909 ')INSPH = 4 - IF(ELIPSI.EQ.'WGS 72 ')INSPH = 5 - IF(ELIPSI.EQ.'Everest (1830) ')INSPH = 6 - IF(ELIPSI.EQ.'WGS 66 ')INSPH = 7 - IF(ELIPSI.EQ.'GRS 80 ')INSPH = 8 - IF(ELIPSI.EQ.'Airy ')INSPH = 9 - IF(ELIPSI.EQ.'Everest (1956) ')INSPH = 10 - IF(ELIPSI.EQ.'Modified Airy ')INSPH = 11 - IF(ELIPSI.EQ.'WGS 84 ')INSPH = 12 - IF(ELIPSI.EQ.'Modified Fischer 1960')INSPH = 13 - IF(ELIPSI.EQ.'Australian National ')INSPH = 14 - IF(ELIPSI.EQ.'Krassovsky 1940 ')INSPH = 15 - IF(ELIPSI.EQ.'Hough ')INSPH = 16 - IF(ELIPSI.EQ.'Mercury 1960 ')INSPH = 17 - IF(ELIPSI.EQ.'Modified Mercury 1968')INSPH = 18 - IF(ELIPSI.EQ.'Normal Sphere (6371) ')INSPH = 19 - IF(ELIPSI.EQ.'International 1924 ')INSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(INSPH.LT.0.AND.INSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmi -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(INSPH.EQ.19)IBALLI = 1 - IF(INSYS.EQ.11.AND.IBALLI.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmi -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF - IF(IMODE.EQ.0.OR.IMODE.EQ.1)THEN - IDSTRNG = DATUM(DATTYP(IRNKIO)) - ELIPSO = IDSTRNG(32:52) - IOSPH = -1 -c -c --- Special alias for EMG 96 - if(elipso.eq.'EMG 96 ')IOSPH = 8 - IF(ELIPSO.EQ.'Clarke 1866 ')IOSPH = 0 - IF(ELIPSO.EQ.'Clarke 1880 ')IOSPH = 1 - IF(ELIPSO.EQ.'Bessel 1841 ')IOSPH = 2 - IF(ELIPSO.EQ.'International 1967 ')IOSPH = 3 - IF(ELIPSO.EQ.'International 1909 ')IOSPH = 4 - IF(ELIPSO.EQ.'WGS 72 ')IOSPH = 5 - IF(ELIPSO.EQ.'Everest (1830) ')IOSPH = 6 - IF(ELIPSO.EQ.'WGS 66 ')IOSPH = 7 - IF(ELIPSO.EQ.'GRS 80 ')IOSPH = 8 - IF(ELIPSO.EQ.'Airy ')IOSPH = 9 - IF(ELIPSO.EQ.'Everest (1956) ')IOSPH = 10 - IF(ELIPSO.EQ.'Modified Airy ')IOSPH = 11 - IF(ELIPSO.EQ.'WGS 84 ')IOSPH = 12 - IF(ELIPSO.EQ.'Modified Fischer 1960')IOSPH = 13 - IF(ELIPSO.EQ.'Australian National ')IOSPH = 14 - IF(ELIPSO.EQ.'Krassovsky 1940 ')IOSPH = 15 - IF(ELIPSO.EQ.'Hough ')IOSPH = 16 - IF(ELIPSO.EQ.'Mercury 1960 ')IOSPH = 17 - IF(ELIPSO.EQ.'Modified Mercury 1968')IOSPH = 18 - IF(ELIPSO.EQ.'Normal Sphere (6371) ')IOSPH = 19 - IF(ELIPSO.EQ.'International 1924 ')IOSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(IOSPH.LT.0.AND.IOSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmo -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(IOSPH.EQ.19)IBALLO = 1 - IF(IOSYS.EQ.11.AND.IBALLO.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmo -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF -C -C --- STICKS THE ELLIPSOID PARAMETERS INTO ELEMENTS 1,2 OF -C --- TPARIN, TPARIO - IF(INSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIN(1) = DRADIM(IRNKIN) - TPARIN(2) = DEC2(IRNKIN) - ENDIF - IF(IOSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIO(1) = DRADIM(IRNKIO) - TPARIO(2) = DEC2(IRNKIO) - ENDIF -C -C --- SPECIAL SET FOR ELLIPSOID PARAMETERS IN TPARIN AND TPARIO ELEMENTS 14,15 - TPARIN(14) = DRADIM(IRNKIN) - TPARIN(15) = DEC2(IRNKIN) - TPARIO(14) = DRADIM(IRNKIO) - TPARIO(15) = DEC2(IRNKIO) -C -C-------------------------------------------------------------------- -C --- CRDIN = COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C --- INSYS = CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C --- INZONE = CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C --- TPARIN = PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C --- INUNIT = CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I* -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C -C --- INSPH = INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C --- 0 = CLARKE 1866 1 = CLARKE 1880 -C --- 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C --- 4 = INTERNATIONAL 1909 5 = WGS 72 -C --- 6 = EVEREST 7 = WGS 66 -C --- 8 = GRS 1980 9 = AIRY -C --- 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C --- 12 = WGS 84 13 = SOUTHEAST ASIA -C --- 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C --- 16 = HOUGH 17 = MERCURY 1960 -C --- 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C --- 20 = INTERNATIONAL 1924 -C -C --- IPR = PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C --- JPR = PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C --- LEMSG = LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C --- LPARM = LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C --- LN27 = LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C --- FN27 = FILE NAME OF NAD 1927 SPCS PARAMETERS -C --- LN83 = LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C --- FN83 = FILE NAME OF NAD 1983 SPCS PARAMETERS -C --- LENGTH = RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C -C--------------------------------------------------------------------- -C -C --- SETS IN NEW DATUM PARAMETERS AND CHECK FOR BAD MODE FLAG - IF(IMODE.EQ.1)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.2)THEN - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.3)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C********************************************************************** -C -C --- Now converts TLAT1 for EM,PS to LATITUDE OF TRUE SCALE -C --- and takes the Latitude of origin of projection and changes -C --- it to a false northing -C -C********************************************************************** -C -C --- (FROM) INPUT DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(INSYS.EQ.6.OR.INSYS.EQ.5)THEN -C -C --- SET COORDINATE ORIGIN AS THE PS POINT DESIRED - TCRDIN(1) = FLONIN - TCRDIN(2) = FLATIN -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIN(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE ADDED TO THE -C --- PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,INSYS,INZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) -C -C --- ERROR PROCESSING - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF -C -C --- NOW SHIFTS THE INPUT COORDS FROM DOMAIN CENTER TO THE POLE -C --- ASSUMES SINCE ONE IS NOT PUTTING IN OFFSETS THAT THE DATA -C --- COMING IN IS ALREADY OFFSET AND MUST BE SET TO THE POLE - CRDIN(1) = CRDIN(1) + TCRDIO(1) - CRDIN(2) = CRDIN(2) + TCRDIO(2) - ENDIF -C********************************************************************** -C -C --- OUTPUT (TO) DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(IOSYS.EQ.6.OR.IOSYS.EQ.5)THEN -C -C --- SET DOMAIN CENTER AS THE PS POINT DESIRED - TCRDIN(1) = FLONIO - TCRDIN(2) = FLATIO -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIO(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE SUBTRACTED -C --- FROM THE PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,IOSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,IOSYS,IOZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) -C -C --- ERROR PROCESSING - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - ENDIF -C********************************************************************** -C -C --- DOES A COMPLETE CYCLE PROJ/DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,0,TDUM,4,IOSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,0,TDUM,IUNIT4,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES ONLY A DATUM SHIFT - IF(INSYS.EQ.0.AND.IOSYS.EQ.0)THEN - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - UTMOUT = DBLE(INZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - FROM PROJ/DATUM TO LL (GEODETIC) - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.EQ.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE FROM LL (GEODETIC) TO DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.EQ.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 DATUM TRANSFORMATION - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IABS(IOZONE).GT.60)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 2 PROJECTION FROM LAT-LON - CALL GTPZ0(CRDIN,0,INZONE,TPARIN,INUNIT,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (140313) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - PROJ ONLY - NO DATUM CHANGE - IF(IRNKIN.EQ.IRNKIO)THEN -C -C --- GOES TO LL (GEODETIC IF IOSYS = 1) TO GET UTM ZONE FOR OUTPUT - IF(IOSYS.EQ.1)THEN - IF(INSYS.NE.0)THEN - DO KK = 1,NVEC - DWRK(KK) = 0.0D0 - DWRK2(KK) = TPARIN(KK) - ENDDO - CRDIO(1) = 0.0D0 - CRDIO(2) = 0.0D0 - IDUM = INZONE - JDUM = IOZONE - JOUNIT = 4 - JOSYS = 0 - CALL GTPZ0(CRDIN,INSYS,IDUM,DWRK2,INUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,CRDIO,JOSYS,JDUM,DWRK,JOUNIT,LN27, - . LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XLONIO = CRDIO(1) - XLATIO = CRDIO(2) - ELSE - XLONIO = CRDIN(1) - XLATIO = CRDIN(2) - ENDIF -C -C --- DETERMINE IF A VALID OUTPUT ZONE IS GIVEN - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -C --- MAKE SURE WE GET A DECENT ZONE IF WE ENTERED A BOGUS ONE INITIALLY - IF(IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -c PRINT *,'HEY - LATITUDE - UTM OUT: ',XLATIO,IOZONE - ENDIF -C -C --- SPECIAL CASE UTM2UTM WHERE OVERRIDE IS DESIRED - IF(INSYS.EQ.1.AND.IOSYS.EQ.1)THEN - CRDIN(1) = CRDIO(1) - CRDIN(2) = CRDIO(2) - JNUNIT = 4 - JNSYS = 0 - IF(IOVUTM.EQ.0)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE - IF(IOVUTM.EQ.2)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT, - 2 LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE -C -C --- DO NOTHING EXCEPT UNITS CHANGE - XYZIO(1) = XYZIN(1) - XYZIO(2) = XYZIN(2) - RETURN - ENDIF - ENDIF - -C -C --- SPECIAL CASE WHERE INZONE IS PROVIDED BUT IOZONE IS NOT - IF(IABS(INZONE).GT.0.AND.IABS(INZONE).LT.61)THEN - IOZONE = INZONE - ENDIF - UTMOUT = DBLE(IOZONE) - ELSE -C -C --- REGULAR CASES - IF(INSYS.NE.IOSYS)THEN - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (140313) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - ELSE ! CASE FROM ONE PROJECTION SETTING TO ANOTHER -C -C --- STEP 1 PROJECTION TO LAT-LON -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, -c 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,4,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,IUNIT4,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 FEED CHANGE BACK TO PROJECTION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - CRDIN(1) = XLONIN - CRDIN(2) = XLATIN -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,IOZONE,TDUM,4,IOSPH,IPR,JPR, -c 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,IOZONE,TDUM,IUNIT4,IOSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - ENDIF - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XYZIO(3) = XYZIN(3) - UTMOUT = DBLE(IOZONE) - ENDIF - ENDIF -C -C--------------------------------------------------------------------- -C -C --- IOSYS = CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C --- IOZONE = CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C --- TPARIO = PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY) -C --- IOUNIT = CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I -C --- CRDIO = COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY) -C --- IFLG = RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C -C---------------------------------------------------------------------- -C -C --- PUTS THE OUTPUT INFORMATION INTO XYZIO AND SCALES -C --- NOTE THAT TCRDIO ARRAY HAS BEEN FILLED APPROPRIATELY WHEN AN -C --- OFFSET IS COMPUTED FOR PS AND EM - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - XYZIO(1) = (CRDIO(1) - TCRDIO(1))*DBLE(XMULTO) - XYZIO(2) = (CRDIO(2) - TCRDIO(2))*DBLE(XMULTO) - ELSE - XYZIO(1) = CRDIO(1)*DBLE(XMULTO) - XYZIO(2) = CRDIO(2)*DBLE(XMULTO) - ENDIF -C -C --- NOW DOES A 'TO' (OUTPUT) PROJECTION CHECK - JFLG = 1 -C IF(FLONIO.NE.0.0.AND.FLATIO.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIO,FLATIO,JFLG,IRET) -C ELSE -C IF(FLONIN.NE.0.0.AND.FLATIN.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIN,FLATIN,JFLG,IRET) -C ENDIF -C ENDIF -C - 999 CONTINUE -C 999 PRINT *,'FINISHED NORMALLY' - RETURN - END -c -c----------------------------------------------------------------------- -c --- Bring in BLOCK DATA as an include file -c----------------------------------------------------------------------- - include 'blockdat.crd' -c -c---------------------------------------------------------------------- - SUBROUTINE PRJCHK(IO,INSYS,XLON,XLAT,IFLG,IRET) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.10.0 Level: 021024 PRJCHK -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the mapping -c --- to various projections when the longitude and latitude are set to -c --- some values that are outside the bounds of the various projections. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- insys = projection type -c --- xlon = double precision longitude -c --- xlat = double precision latitude -c --- iflg = error print flag -c -c --- Program outputs are: -c -c --- iret = error number -c -c---------------------------------------------------------------------- -c - Real*8 xlon, xlat -c - Real*4 xlono,xlato -c - Integer*4 iflg,io,iret,ichk -c - ichk = 0 - xlato = sngl(xlat) - xlono = sngl(xlon) -c -c --- Test for polar stereographic mapping - if(insys.eq.6.and.abs(xlato).le.45.0)iret = iret + 100 -c -c --- Test for mercator mapping - if(insys.eq.5.and.abs(xlato).ge.45.0)iret = iret + 200 -c -c --- Test for utm mapping - if(insys.eq.1.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret - 1 + 300 -c -c --- Test for transverse mercator mapping - if(insys.eq.9.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret+ - 1 400 -c -c --- Print out - IF(ICHK.GT.0)THEN -c PRINT *,' WARNING INAPPROPIATE LATITUDE ' - WRITE(IO,'(A29)')'WARNING INAPPROPIATE LATITUDE' - ENDIF - Return - End -c---------------------------------------------------------------------- - SUBROUTINE ERRPRT(IFLG,IO,IAPP) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.10.0 Level: 020623 ERRPRT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the USGS GCTP -c --- software. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- iflg = error flag -c --- iapp = application number -c---------------------------------------------------------------------- -C -C --- PRINT ERROR MESSAGES - IF(IFLG.NE.0)THEN -c PRINT *,' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - WRITE(IO,'(A35,I5)')' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - IF(IFLG.EQ.1)THEN -c PRINT *,' ILLEGAL INPUT SYSTEM CODE.' - WRITE(IO,'(A25)')'ILLEGAL INPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.2)THEN -c PRINT *,' ILLEGAL OUTPUT SYSTEM CODE.' - WRITE(IO,'(A26)')'ILLEGAL OUTPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.3)THEN -c PRINT *,' ILLEGAL INPUT UNIT CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.4)THEN -c PRINT *,' ILLEGAL OUTPUT UNIT CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.5)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR INPUT.' - WRITE(IO,'(A40)')'INCONSISTENT UNIT/SYSTEM CODES FOR INPUT' - ENDIF - IF(IFLG.EQ.6)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT.' - WRITE(IO,'(A41)')'INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT' - ENDIF - IF(IFLG.EQ.7)THEN -c PRINT *,' ILLEGAL INPUT ZONE CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT ZONE CODE' - ENDIF - IF(IFLG.EQ.8)THEN -c PRINT *,' ILLEGAL OUTPUT ZONE CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT ZONE CODE' - ENDIF - IF(IFLG.GT.8)THEN -c PRINT *,' REALLY BAD UNDETERMINED ERROR! ' - WRITE(IO,'(A30)')'REALLY BAD UNDETERMINED ERROR!' - STOP - ENDIF -c PRINT *,' WILL TRY NEXT COORDINATE SET: ' - ENDIF - RETURN - END -c---------------------------------------------------------------------- - Subroutine ll2zon(dxlon,dxlat,izone,iret) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.10.0 Level: 020710 LL2ZON -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in to UTM zone for use -c --- in estimating the UTM zone of any given latitude and longitude. -c -c --- Program inputs are: -c -c --- dxlon = longitude in decimal degrees (DP) -c --- dxlat = latitude in decimal degrees (DP) -c -c --- Program outputs are: -c -c --- izone = utm zone in the range -60 < -1 and 1 < 60 -c --- iret = a return code = 100 if the longitude is funky -c -c---------------------------------------------------------------------- -c - Real*8 dxlon,dxlat -c - iret = 0 - if(dabs(dxlon).gt.180.0D0)then - iret = 100 -c Print *,'magnitude of longitude is > 180 degrees!!!!' - Return - Endif -c -c --- NH E Quad - If(dxlon.ge.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 30 + izone - endif -c -c --- NH W Quad - If(dxlon.le.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 31 - izone - endif -c -c --- SH E Quad - If(dxlon.ge.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(30 + izone) - endif -c -c --- SH W Quad - If(dxlon.le.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(31 - izone) - endif - if(izone.gt.60)izone = 60 - if(izone.lt.-60)izone = -60 - Return - End -c---------------------------------------------------------------------- - Subroutine dd2dms(dd,dms) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.10.0 Level: 020624 DD2DMS -c -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- PROGRAM NOTES FOLLOW: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- Convert decimal degrees to packed degrees,mintues,econds format -c -c --- dd.ddddd to dddmmmsss.ss -c -c --- Program Inputs -c -c --- dd = decimal degrees (dp) -c -c --- Program Outputs -c -c --- dms = packed degrees minutes seconds format (dp) -c -c---------------------------------------------------------------------- -c - real*8 dd,dms - real*4 sdd -c - sdd = sngl(dd) - ideg = int(sdd) - xminit = (sdd - ideg)*60.0 - iminit = int(xminit) - xsec = (xminit - iminit)*60.0 - dms = 1000000.D0*ideg + 1000.D0*iminit + 1.0D0*xsec - return - end - -c---------------------------------------------------------------------- - Subroutine dat2dat(lpr,ipr,xlonin,xlatin,zlevin,irnkin, - 1 irnkio,xlonio,xlatio,zlevio) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.10.0 Level: 030905 DAT2DAT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c --- Added a 9999 datum designamtion to do a manual datum trasformation -c --- using user input information in the common block XDATM (version 1.1 -c --- 062002) -c -c --- Version 1.2 (071102) -c -c --- Changed calls to DATSHFT by adding IFLG so that a proper paired -c --- set of FROM-TO transformations could be made. -c -c --- Added the NIMA.CRD include. Use the new strings and pointers for -c --- handling the NIMA dataset. -c -c --- Version 1.3 102802 -c -c --- Corrected the ao,fo - ai,fi used (switched order) on from ref to -c --- output datum -c -c --- Version 1.4 030703 -c -c --- Blocked datum conversion to/from WGS84 lat-lon for sphere datums -c -c --- Version 1.9 Level: 030905 -c -c --- Add iflg values 2 and 3 to datshft calls to go to and from WGS-72 -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in one datum to the -c --- longitude,latitude in another. The program also does a shift in -c --- elevation due to a change in the geoid. -c -c --- Program inputs are: -c -c --- lpr = FORTRAN logical unit for output -c --- ipr = print flag => 0 to avoid printing -c --- xlonin = input longitude in decimal degrees (dp) -c --- xlatin = input latitude in decimal degrees (dp) -c --- zlevin = elevation of the input point of interest in meters -c --- irnkin = input datum pointer -c --- irnkio = output datum pointer -c -c --- Program outputs are: -c -c --- xlonio = output longitude in decimal degrees (dp) -c --- xlatio = output latitude in decimal degrees (dp) -c --- zlevio = revised elevation output of the input point in meters -c -c --- subroutine calls: -c -c --- DATSHFT -c -c---------------------------------------------------------------------- -c - Real*8 ai, ao, fi, fo, dx, dy, dz, xlonin, xlatin, zhti, - 1 xlonio, xlatio, zhto - Real*8 xlato,xlono,drad,dflt -c - Integer*4 iposi,iposo -c - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -c -c --- NIMA data base include - Include 'nima.crd' -c -c --- reference definition - the convention will be it is always 1! - iref = 1 -c -c --- asigns the positions - if(irnkin.ne.9999)then - iposi = irnkin - else - iposi = 0 - endif - if(irnkio.ne.9999)then - iposo = irnkio - else - iposo = 0 - endif -c -c --- Print out information - if(ipr.ne.1.and.iposi.ne.0)then - Write(lpr,'(a12,a8,1x,a50,1x,a60)')'From datum: ', - 1 datcod(iposi),datum(dattyp(iposi)),geodat1(iposi) - endif - if(ipr.ne.1.and.iposo.ne.0)then - Write(lpr,'(a10,a8,1x,a50,1x,a60)')'To datum: ', - 1 datcod(iposo),datum(dattyp(iposo)),geodat1(iposo) - endif -c -c --- datum to reference shift (i= input o = output) - if(iposi.ne.0)then - ai = dradim(iposi) - fi = 1.0/dflat(iposi) - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxmod(iposi)) - dy = dble(dymod(iposi)) - dz = dble(dzmod(iposi)) - zhti = dble(zlevin) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - zhti = dble(zlevin) - endif -c --- Transform to WGS84 only if input datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposi).eq.'WGS-72 ')then - iiflag = 2 - else - iiflag = 0 - endif - Call datshft(xlonin,xlatin,zhti,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlono,xlato,zhto) - else - xlono=xlonin - xlato=xlatin - zhto=zhti - endif -c -c --- reference to datum shift (i = input o = output) note same diffierence -c --- but a negative sign is used - this insures we get back to where -c --- we started!!!! - if(iposo.ne.0)then - ao = dradim(iref) - fo = 1.0/dflat(iref) - ai = dradim(iposo) - fi = 1.0/dflat(iposo) - dx = dble(dxmod(iposo)) - dy = dble(dymod(iposo)) - dz = dble(dzmod(iposo)) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - endif -c --- Transform from WGS84 only if output datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposo).eq.'WGS-72 ')then - iiflag = 3 - else - iiflag = 1 - endif - Call datshft(xlono,xlato,zhto,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlonio,xlatio,zhti) - else - xlonio=xlono - xlatio=xlato - zhti=zhto - endif - zlevio = sngl(zhti) -c - Return - End -c--------------------------------------------------------------------- - subroutine datshft(xloni,xlati,zhti,ai,fi,fo,ao,dx,dy,dz,iflg, - 1 xlono,xlato,zhto) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.10.0 Level: 030905 DATSHFT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Standard Modolensky Datum Transformation -c -c -c---------------------------------------------------------------------- -c -c --- Program notes -c --- Added the IFLG argument for proper FROM - TO conversions -c -c -c --- Version 1.1 -c --- Modified code constants to insure everything is DP -c --- Modified calculation of the reverse transformation. The reverse -c --- is done by subtracting the geodetics rather than inputing negative -c --- delta X,Y,Z. -c -c --- Version 1.9 Level: 030905 -c -c --- Add equations and special option to go to and from WGS-72 -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts the lat/lon/height of one datum to another -c --- assuming an earth center shift of dx,dy,dz (geoid specific) and the -c --- ellipsoid major axis and flattening of each datum. -c -c --- Input arguments - double precision -c -c --- xlati = input latitude in decimal dgrees -c --- xloni = input longitude in decimal degrees -c --- zhti = input elevation in meters -c --- ai = input major radius in meters -c --- fi = input flattening factor -c --- fo = output flattening factor -c --- ao = output major radius -c --- dx = datum to reference earth center shift in meters -c --- dy = datum to reference earth center shift in meters -c --- dz = datum to reference earth center shift in meters -c --- iflg = 0 FROM datum A TO WGS84 = 1 TO datum B FROM WGS84 -c --- iflg = 2 FROM datum A to WGS72 = 3 TO datum B FROM WGS72 -c -c --- Output arguments - double precision -c -c --- xlato = output longitude in decimal degrees -c --- xlono = output longitude in decimal degrees -c --- zhto = output elevation in meters -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - real*8 xlati,xloni,zhti,ai,fi,fo,ao,dx,dy,dz,xlato,xlono,zhto - real*8 deg2rad,rad2deg,da,df,sithet,siphi,cithet,ciphi,siphi2 - real*8 rn,rm,dlat,dlon,dh,one,two,dlat72,dh72 - real*8 es,bda,c1,c2,c3,c4,d1,d2,e1,e2,e3,e4,e5 -c -c --- compute some double precision constants - deg2rad = 0.01745329252D0 - rad2deg = 57.295779513D0 - one = 1.0D0 - two = 2.0D0 -c -c --- compute delta radius/flattening - double precision - da = ao - ai - df = fo - fi - es = two*fi - fi*fi ! eccentricity squared - bda = one - fi !pole/equator radius ratio -c -c --- compute sin,cos of theta and phi - double precision - siphi = dsin(xlati*deg2rad) - siphi2 = dsin(xlati*2.0*deg2rad) - ciphi = dcos(xlati*deg2rad) - sithet = dsin(xloni*deg2rad) - cithet = dcos(xloni*deg2rad) -c -c --- radius of curvature - prime vertical - rn = ai/dsqrt(one - es*siphi**2) -c -c --- radius of curvature - prime meridian - rm = ai*(one - es)/(one - es*siphi**2)**1.5 -c -c --- shift in latitude - c1 = -dx*siphi*cithet - dy*siphi*sithet + dz*ciphi - c2 = da*(rn*es*siphi*ciphi)/ai - c3 = df*(rm/bda + rn*bda)*siphi*ciphi - c4 = rm + zhti - dlat = (c1 + c2 + c3)/c4 - dlat72 = 4.5D0*ciphi/(ai*sin(1.0*deg2rad/3600.0)) + - 1 df*siphi2/(sin(1.0*deg2rad/3600.0)) -c -c --- shift in longitude - d1 = -dx*sithet + dy*cithet - d2 = (rn + zhti)*ciphi - dlon = d1/d2 -c -c --- shift in height - e1 = dx*ciphi*cithet - e2 = dy*ciphi*sithet - e3 = dz*siphi - e4 = da*ai/rn - e5 = df*bda*rn*siphi*siphi - dh = e1 + e2 + e3 - e4 + e5 - dh72 = 4.5D0*siphi + ai*df*siphi*siphi - da + 1.4D0 -c -c --- estimate the output arguments - if(iflg.eq.0)then - xlato = xlati + dlat*rad2deg - xlono = xloni + dlon*rad2deg - zhto = zhti + dh - endif - if(iflg.eq.1)then - xlato = xlati - dlat*rad2deg - xlono = xloni - dlon*rad2deg - zhto = zhti - dh - endif -c -c --- Special WGS-72 change 030905 - if(iflg.eq.2)then - xlato = xlati + dlat72/3600.0D0 - xlono = xloni + 0.554D0/3600.0D0 - zhto = zhti + dh72 - endif - if(iflg.eq.3)then - xlato = xlati - dlat72/3600.0D0 - xlono = xloni - 0.554D0/3600.0D0 - zhto = zhti - dh72 - endif -c - return - end -c---------------------------------------------------------------------- - Subroutine init(datloc,datnam,datid,datreg1,datreg2,datreg3, - 1 max,maxd) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.10.0 Level: 021016 INIT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Initializes the NIMA data label arrays -c -c---------------------------------------------------------------------- -c -c --- Program notes -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program does some string housekeeping and outputs the strings -c --- for use by a GUI or some other management routines. It starts -c --- with the NIMA common blocks that are input via the NIMA.CRD include -c --- block. -c -c --- Input arguments: -c -c --- MAX = maximum number of datums in the data base -c -c --- Output arguments - double precision -c -c --- DATID = 8 character ID code array for each datum -c --- DATLOC = 20 character Atlas location string array -c --- DATNAM = 50 character Datum name string array -c --- DATREG1 = 60 character Region descriptor string array - line 1 -c --- DATREG2 = 60 character Region descriptor string array - line 2 -c --- DATREG3 = 60 character Region descriptor string array - line 3 -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - CHARACTER*8 DATID(MAX) - CHARACTER*20 DATLOC(MAX) - CHARACTER*50 ISTRNG, DATNAM(MAX) - CHARACTER*60 DATREG1(MAX), DATREG2(MAX), DATREG3(MAX) -c -c --- Calls the include - Include 'nima.crd' -c -c --- First maps the DATLOC and DATNAM arrays - maxd = kmax - Do i = 1,kmax - DATLOC(i) = Atlas(dattyp(i)) - DATNAM(i) = Datum(dattyp(i)) - DATID(i) = Datcod(i) - DATREG1(i) = Geodat1(i) - DATREG2(i) = Geodat2(i) - DATREG3(i) = Geodat3(i) - Enddo -c -c --- Now compresses the Datum name string - Do k = 1,kmax - istrng = datnam(k) - Do j = 1,29 - jj = 29 - j + 1 - if(istrng(jj:jj).ne.' ')then - jbeg = jj + 2 - go to 444 - endif - Enddo -444 continue - jend = jbeg + 20 - if(jend.gt.50)jend = 50 - istrng(jbeg:jend) = istrng(30:50) - if(jend.lt.50)then - Do j = jend+1,50 - istrng(j:j) = ' ' - Enddo - endif - datnam(k) = istrng - Enddo - Return - End -C----------------------------------------------------------------------- -C GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE - VERSION 2.0.2 -C FORTRAN 77 LANGUAGE FOR IBM, AMDAHL, ENCORE, VAX, CONCURRENT, AND -C DATA GENERAL COMPUTERS -C ADJLZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ADJLZ0 (LONIN) - -c --- V1.98 (060911) -c --- Change argument name and reassign (sub is called with a computed -c --- argument that should not be changed within subroutine) - -C -C FUNCTION TO ADJUST LONGITUDE ANGLE TO MODULO 180 DEGREES. -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,PI /2.0D0,3.14159265358979323846D0/ - -c --- V1.98 (060911) - LON=LONIN -C - 020 ADJLZ0 = LON - IF (DABS(LON) .LE. PI) RETURN - TWOPI = TWO * PI - LON = LON - DSIGN (TWOPI,LON) - GO TO 020 -C - END -C ASINZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ASINZ0 (CON) -C -C THIS FUNCTION ADJUSTS FOR ROUND-OFF ERRORS IN COMPUTING ARCSINE -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - IF (DABS(CON) .GT. ONE) THEN - CON = DSIGN (ONE,CON) - ENDIF - ASINZ0 = DASIN (CON) - RETURN -C - END -C DMSPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION DMSPZ0 (SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT UNPACKED DMS TO PACKED DMS ANGLE -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,NEG - DATA CON1,CON2 /1000000.0D0,1000.0D0/ - DATA NEG /'-'/ -C - CON = DBLE (DEGS) * CON1 + DBLE (MINS) * CON2 + DBLE (SECS) - IF (SGNA .EQ. NEG) CON = - CON - DMSPZ0 = CON - RETURN -C - END -C E0FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E0FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E0). -C - IMPLICIT REAL*8 (A-Z) - DATA QUART,ONE,ONEQ,THREE,SIXT /0.25D0,1.0D0,1.25D0,3.0D0,16.0D0/ -C - E0FNZ0 = ONE - QUART * ECCNTS * (ONE + ECCNTS / SIXT * - . (THREE + ONEQ * ECCNTS)) -C - RETURN - END -C E1FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E1FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E1). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2,CON3 /0.375D0,0.25D0,0.46875D0/ - DATA ONE /1.0D0/ -C - E1FNZ0 = CON1 * ECCNTS * (ONE + CON2 * ECCNTS * - . (ONE + CON3 * ECCNTS)) -C - RETURN - END -C E2FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E2FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E2). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2 /0.05859375D0,0.75D0/ - DATA ONE /1.0D0/ -C - E2FNZ0 = CON1 * ECCNTS * ECCNTS * (ONE + CON2 * ECCNTS) -C - RETURN - END -C E3FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E3FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E3). -C - IMPLICIT REAL*8 (A-Z) -C - E3FNZ0 = ECCNTS*ECCNTS*ECCNTS*(35.D0/3072.D0) -C - RETURN - END -C E4FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E4FNZ0 (ECCENT) -C -C FUNCTION TO COMPUTE CONSTANT (E4). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ONE + ECCENT - COM = ONE - ECCENT - E4FNZ0 = DSQRT ((CON ** CON) * (COM ** COM)) -C - RETURN - END -C GTPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) -C -C ********************************************************************** -C -C INPUT **************************************************************** -C CRDIN : COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C INSYS : CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C INZONE : CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C TPARIN : PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C INUNIT : CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I*4) -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C INSPH : INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C IPR : PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C JPR : PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C LEMSG : LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C LPARM : LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C LN27 : LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C FN27 : FILE NAME OF NAD 1927 SPCS PARAMETERS -C LN83 : LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C FN83 : FILE NAME OF NAD 1983 SPCS PARAMETERS -C LENGTH : RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C OUTPUT *** ***** -C IOSYS : CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C IOZONE : CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C TPARIO : PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C IOUNIT : CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I*4) -C CRDIO : COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY). -C IFLG : RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C OTHERWISE , ERROR CODE FROM PROJECTION COMPUTATIONAL MODULE. -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 NAD27(134), NAD83(134), NADUT(54), SPTYPE(134) - INTEGER*4 SYSUNT(24), SWITCH(23), ITER - -c --- V1.98 (060911) - INTEGER*4 INSPHZERO - - INTEGER*2 INMOD, IOMOD, FWD, INV - CHARACTER*128 FN27, FN83, FILE27, FILE83 - DIMENSION CRDIN(2),CRDIO(2),TPARIN(15),TPARIO(15),COORD(2) - DIMENSION DUMMY(15), PDIN(15), PDIO(15) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /PROJZ0/ IPROJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /TOGGLE/ SWITCH -C - PARAMETER (MAXUNT=6, MAXSYS=23) - PARAMETER (FWD=0, INV=1) - DATA SYSUNT / 0 , 23*2 / - DATA PDIN/15*0.0D0/, PDIO/15*0.0D0/ - DATA INSP/999/, INPJ/999/, INZN/99999/ - DATA IOSP/999/, IOPJ/999/, IOZN/99999/ - DATA ITER /0/ - DATA JFLAG/0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C -C TABLE OF UNIT CODES AS SPECIFIED BY STATE LAWS AS OF 2/1/92 -C FOR NAD 1983 SPCS - 1 = U.S. SURVEY FEET, 2 = METERS, -C 5 = INTERNATIONAL FEET -C -C NADUT - UNIT CODES FOR THE STATES ARRANGED IN STATE NUMBER ORDER -C (FIRST TWO DIGITS OF ZONE NUMBER) -C - DATA NADUT /1, 5, 1, 1, 5, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 2, - . 1, 1, 5, 2, 1, 2, 5, 1, 2, 2, 2, 1, 1, 1, 5, 2, 1, 5, - . 2, 2, 5, 2, 1, 1, 5, 2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 2/ -C -C TABLE OF STATE PLANE ZONE TYPES: 4 = LAMBERT, 7 = POLYCONIC, -C 9 = TRANSVERSE MERCATOR, AND 20 = OBLIQUE MERCATOR -C - DATA SPTYPE / 9, 9, 4, 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - . 9, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 9, 4, 4, - . 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 9, 9, 9, 9, 9, 4, 4, - . 4, 4, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, - . 9, 9, 9,20, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 7/ -C -C SETUP -C - IOSPH = INSPH - IPEMSG = IPR - IPPARM = JPR - IPELUN = LEMSG - IPPLUN = LPARM - IPROJ = INSYS - LU27 = LN27 - FILE27 = FN27 - LU83 = LN83 - FILE83 = FN83 - LEN = LENGTH -C -C INITIALIZE SWITCH FOR EACH PROJECTION TO ZERO -C - ITER = ITER + 1 - IF (ITER .LE. 1) THEN - DO 5 I=1,15 - DUMMY(I) = 0.0D0 - 5 CONTINUE - MSYS = 2 - END IF - INSPCS = 2 - IOSPCS = 2 - IF (JFLAG.NE.0) GO TO 10 - EZ = 0.0D0 - ESZ = 0.0D0 - -c --- V1.98 (060911) -c CALL SPHDZ0(0,DUMMY) -c --- Set sphere as a variable instead of a constant - insphzero=0 - CALL SPHDZ0(insphzero,DUMMY) -C -C --- SPECIAL TREATMENT FOR STARTUP - IF(TPARIO(14).NE.0D0.AND.TPARIO(15).NE.0D0)THEN - DUMMY(1) = TPARIO(14) - DUMMY(2) = TPARIO(15) - ENDIF - JFLAG = 1 -C -C CHECK VALIDITY OF CODES FOR REFERENCE SYSTEMS. -C - 10 IF (INSYS.LT.0 .OR. INSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INSYS - 2000 FORMAT (' ILLEGAL SOURCE REFERENCE SYSTEM CODE = ',I6) - IFLG = 1 - RETURN - END IF -C - IF (IOSYS.LT.0 .OR. IOSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOSYS - 2010 FORMAT (' ILLEGAL TARGET REFERENCE SYSTEM CODE = ',I6) - IFLG = 2 - RETURN - END IF -C -C FORCE INITIALIZATION OF PROJECTIONS IF SPHEROID OR PROJECTION -C HAS CHANGED FROM PREVIOUS INPUT - OUTPUT SET -C -C -C---------------------------------------------------------------------- -C -C --- THIS SECTION IS TO BE PLACED IN ALL VERSIONS OF USGS CODE TO FORCE -C --- REINITIALIZATION EACH TIME. -C -C---------------------------------------------------------------------- - DO I = 1,MAXSYS - SWITCH(I) = 0 - ENDDO -C---------------------------------------------------------------------- -C - IF (INSPH .NE. INSP) THEN - DO 11 I = 1,MAXSYS - SWITCH(I) = 0 - 11 CONTINUE - END IF -C - IF (INSYS .GT. 0) THEN - IF (INSYS .NE. INPJ .AND. INSYS .NE. IOPJ) SWITCH(INSYS) = 0 - IF (SWITCH(INSYS) .NE. INZONE .AND. SWITCH(INSYS) .NE. IOZONE) - . SWITCH(INSYS) = 0 - END IF -C - IF (IOSYS .GT. 0) THEN - IF (IOSYS .NE. INPJ .AND. IOSYS .NE. IOPJ) SWITCH(IOSYS) = 0 - IF (SWITCH(IOSYS) .NE. INZONE .AND. SWITCH(IOSYS) .NE. IOZONE) - . SWITCH(IOSYS) = 0 - END IF -C -C CHECK FOR REPEAT OF INPUT SYSTEM -C - INMOD = 1 - IF (INSYS .EQ. 2) THEN - IF (INZONE .GT. 0) THEN - ID = 0 - IF (INSPH .EQ. 0) THEN - DO 12 I = 1,134 - IF (INZONE .EQ. NAD27(I)) ID = I - 12 CONTINUE - END IF - IF (INSPH .EQ. 8) THEN - DO 13 I = 1,134 - IF (INZONE .EQ. NAD83(I)) ID = I - 13 CONTINUE - END IF - IF (ID .NE. 0) INSPCS = SPTYPE(ID) - IF (INZONE .NE. SWITCH(INSPCS)) GO TO 15 - END IF - END IF - IF (INSP .NE. INSPH) GO TO 15 - IF (INPJ .NE. INSYS) GO TO 15 - IF (INZN .NE. INZONE) GO TO 15 - IF (INSYS .GE. 3) THEN - DO 14 I=1,15 - IF (TPARIN(I) .NE. PDIN(I)) GO TO 15 - 14 CONTINUE - END IF - INMOD = 0 - GO TO 30 -C -C SAVE INPUT SYSTEM PARAMETERS -C - 15 INSP = INSPH - INPJ = INSYS - INZN = INZONE - DO 16 I=1,15 - 16 PDIN(I) = TPARIN(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (INUNIT.LT.0 .OR. INUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2020) INUNIT - 2020 FORMAT (' ILLEGAL SOURCE UNIT CODE = ',I6) - IFLG = 3 - RETURN - END IF -C -C CHECK FOR REPEAT OF OUTPUT SYSTEM -C - 30 IOMOD = 1 - IF (IOSYS .EQ. 2) THEN - IF (IOZONE .GT. 0) THEN - ID = 0 - IF (IOSPH .EQ. 0) THEN - DO 32 I = 1,134 - IF (IOZONE .EQ. NAD27(I)) ID = I - 32 CONTINUE - END IF - IF (IOSPH .EQ. 8) THEN - DO 33 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) ID = I - 33 CONTINUE - END IF - IF (ID .NE. 0) IOSPCS = SPTYPE(ID) - IF (IOZONE .NE. SWITCH(INSPCS)) GO TO 35 - END IF - END IF - IF (IOSP .NE. INSPH) GO TO 35 - IF (IOSP .NE. IOSPH) GO TO 35 - IF (IOPJ .NE. IOSYS) GO TO 35 - IF (IOZN .NE. IOZONE) GO TO 35 - IF (IOSYS .GE. 3) THEN - DO 34 I=1,15 - IF (TPARIO(I) .NE. PDIO(I)) GO TO 35 - 34 CONTINUE - END IF - IOMOD = 0 - GO TO 80 -C -C SAVE OUTPUT SYSTEM PARAMETERS -C - 35 IOSP = INSPH - IOPJ = IOSYS - IOZN = IOZONE - DO 36 I=1,15 - 36 PDIO(I) = TPARIO(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (IOUNIT.LT.0 .OR. IOUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2030) IOUNIT - 2030 FORMAT (' ILLEGAL TARGET UNIT CODE = ',I6) - IFLG = 4 - RETURN - END IF -C - 80 IUNIT = SYSUNT(INSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) INUNIT=1 - IF (INSPH .EQ. 8 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) THEN - IND = 0 - DO 90 I = 1,134 - IF (INZONE .EQ. NAD83(I)) IND = I - 90 CONTINUE - IF (IND .NE. 0) INUNIT = NADUT( INT(INZONE/100)) - END IF - CALL UNTFZ0 (INUNIT,IUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 100 - IFLG = 5 - RETURN - 100 COORD(1) = FACTOR * CRDIN(1) - COORD(2) = FACTOR * CRDIN(2) - IUNIT = SYSUNT(IOSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) IOUNIT=1 - IF (INSPH .EQ. 8 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) THEN - IND = 0 - DO 110 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) IND = I - 110 CONTINUE - IF (IND .NE. 0) IOUNIT = NADUT( INT(IOZONE/100)) - END IF - CALL UNTFZ0 (IUNIT,IOUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 120 - IFLG = 6 - RETURN - 120 IF (INSYS.NE.IOSYS.OR.INZONE.NE.IOZONE.OR.INZONE.LE.0) GO TO 140 - CRDIO(1) = FACTOR * COORD(1) - CRDIO(2) = FACTOR * COORD(2) - RETURN -C -C COMPUTE TRANSFORMED COORDINATES AND ADJUST THEIR UNITS. -C - 140 IF (INSYS .EQ. 0) GO TO 520 - IF (INZONE.GT.60 .OR. INSYS.EQ.1) GO TO 200 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2040) INZONE - 2040 FORMAT (' ILLEGAL SOURCE ZONE NUMBER = ',I6) - IFLG = 7 - RETURN -C -C INVERSE TRANSFORMATION. -C - 200 IPROJ=INSYS - ISPHER = INSPH - IF (INSYS.GE.3) CALL SPHDZ0(INSPH,TPARIN) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE INPUT PROJECTION -C - IF (INSYS .EQ. 1 .AND. INZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - INMOD = 1 - END IF - IF (INSYS .EQ. 2 .AND. INZONE .NE. SWITCH(INSPCS)) THEN - SWITCH(2) = 0 - INMOD = 1 - END IF - IF (INZONE .NE. SWITCH(INSYS)) THEN - SWITCH(INSYS) = 0 - INMOD = 1 - END IF -C - IF (INSYS .EQ. 1) THEN - IF (INZONE.EQ.0.AND.TPARIN(1).NE.0.0D0) GO TO 211 - TPARIN(1) = 1.0D6*DBLE(6*INZONE-183) - TPARIN(2) = DSIGN(4.0D7,DBLE(INZONE)) - 211 CALL SPHDZ0(INSPH,DUMMY) - TPARIN(14) = DUMMY(1) - TPARIN(15) = DUMMY(2) - IF (INMOD .NE. 0) THEN - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - CALL PJ01Z0 (COORD,CRDIO,INV) - END IF -C - IF (INSYS .GT. 1) THEN - IF (INMOD .NE. 0) THEN - MSYS = INSPCS - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - IF (INSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,INV) - END IF -C - 500 IFLG = IERROR - DO 510 I = 1,15 - 510 TPARIN(I) = PDIN(I) - IF (IFLG .NE. 0) RETURN - CRDIO(1) = ADJLZ0(CRDIO(1)) - IF (IOSYS .EQ. 0) GO TO 920 - COORD(1) = CRDIO(1) - COORD(2) = CRDIO(2) - 520 IF (INSYS .EQ. 0 .AND. IOSYS .EQ. 0) THEN - CRDIO(1) = COORD(1) - CRDIO(2) = COORD(2) - GO TO 920 - END IF - IF (IOZONE.GT.60 .OR. IOSYS.EQ.1) GO TO 540 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2050) IOSYS - 2050 FORMAT (' ILLEGAL TARGET ZONE NUMBER = ',I6) - IFLG = 8 - RETURN -C -C FORWARD TRANSFORMATION. -C - 540 IPROJ=IOSYS - ISPHER = INSPH - IF (IOSYS.GE.3) CALL SPHDZ0(INSPH,TPARIO) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE OUTPUT PROJECTION -C - IF (IOSYS .EQ. 1 .AND. IOZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - IOMOD = 1 - END IF - IF (IOSYS .EQ. 2 .AND. IOZONE .NE. SWITCH(IOSPCS)) THEN - SWITCH(2) = 0 - IOMOD = 1 - END IF - IF (IOZONE .NE. SWITCH(IOSYS)) THEN - SWITCH(IOSYS) = 0 - IOMOD = 1 - END IF -C - IF (IOSYS .EQ. 1) THEN - TPARIO(1) = COORD(1) - TPARIO(2) = COORD(2) - CALL SPHDZ0(INSPH,DUMMY) - TPARIO(14) = DUMMY(1) - TPARIO(15) = DUMMY(2) - IF (IOMOD .NE. 0) THEN - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - CALL PJ01Z0 (COORD,CRDIO,FWD) - END IF -C - IF (IOSYS .GT. 1) THEN - IF (IOMOD .NE. 0) THEN - MSYS = IOSPCS - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - IF (IOSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,FWD) - END IF -C - 900 IFLG = IERROR - DO 910 I = 1,15 - 910 TPARIO(I) = PDIO(I) - 920 CRDIO(1) = FACTOR * CRDIO(1) - CRDIO(2) = FACTOR * CRDIO(2) - RETURN -C - END -C MLFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MLFNZ0 (E0,E1,E2,E3,PHI) -C -C FUNCTION TO COMPUTE CONSTANT (M). -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ -C - MLFNZ0 = E0 * PHI - E1 * DSIN (TWO * PHI) + E2 * DSIN (FOUR * PHI) - * - E3 * DSIN (SIX * PHI) -C - RETURN - END -C MSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL M). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ECCENT * SINPHI - MSFNZ0 = COSPHI / DSQRT (ONE - CON * CON) -C - RETURN - END -C PAKCZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKCZ0 (PAK) -C -C SUBROUTINE TO CONVERT 2 DIGIT PACKED DMS TO 3 DIGIT PACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,10000.0D0,100.0D0/ - DATA CON3,CON4 /1000000.0D0,1000.0D0/ - DATA TOL /1.0D-3/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = DMOD (CON , CON2) -C - CON = DBLE (DEGS) * CON3 + DBLE (MINS) * CON4 + SECS - IF (SGNA .EQ. NEG) CON = - CON - PAKCZ0 = CON - RETURN -C - END -C PAKDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PAKDZ0 (PAK,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT PACKED DMS TO UNPACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,1000000.0D0,1000.0D0/ - DATA TOL /1.0D-4/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = SNGL ( DMOD (CON , CON2)) - RETURN -C - END -C PAKRZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKRZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO RADIANS. -C - IMPLICIT REAL*8 (A-H,O-Z) - DATA SECRAD /0.4848136811095359D-5/ -C -C CONVERT ANGLE TO SECONDS OF ARC -C - SEC = PAKSZ0 (ANG) -C -C CONVERT ANGLE TO RADIANS. -C - PAKRZ0 = SEC * SECRAD -C - RETURN - END -C PAKSZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKSZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO SECONDS OF ARC. -C - IMPLICIT REAL*8 (A-H,M-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - DIMENSION CODE(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA CODE /1000000.0D0,1000.0D0/ - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA C1,C2 /3600.0D0,60.0D0/ - DATA TOL /1.0D-4/ -C -C SEPARATE DEGREE FIELD. -C - FACTOR = ONE - IF (ANG .LT. ZERO) FACTOR = - ONE - SEC = DABS(ANG) - TMP = CODE(1) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 360) GO TO 020 - DEG = DBLE (I) -C -C SEPARATE MINUTES FIELD. -C - SEC = SEC - DEG * TMP - TMP = CODE(2) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 60) GO TO 020 - MIN = DBLE (I) -C -C SEPARATE SECONDS FIELD. -C - SEC = SEC - MIN * TMP - IF (SEC .GT. C2) GO TO 020 - SEC = FACTOR * (DEG * C1 + MIN * C2 + SEC) - GO TO 040 -C -C ERROR DETECTED IN DMS FORM. -C - 020 WRITE (IPELUN,2000) ANG - 2000 FORMAT ('0ERROR PAKSZ0'/ - . ' ILLEGAL DMS FIELD =',F15.3) - STOP 16 -C - 040 PAKSZ0 = SEC -C - RETURN - END -C PHI1Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI1Z0 (ECCENT,QS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-1). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE /0.5D0,1.0D0/ - DATA EPSLN,TOL,NIT /1.0D-7,1.0D-10,15/ -C - PHI1Z0 = ASINZ0 (HALF * QS) - IF (ECCENT .LT. EPSLN) RETURN -C - ECCNTS = ECCENT * ECCENT - PHI = PHI1Z0 - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - COSPI = DCOS (PHI) - CON = ECCENT * SINPI - COM = ONE - CON * CON - DPHI = HALF * COM * COM / COSPI * (QS / (ONE - ECCNTS) - - . SINPI / COM + HALF / ECCENT * DLOG ((ONE - CON) / - . (ONE + CON))) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI1Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,QS - 2000 FORMAT ('0ERROR PHI1Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' QS =',D25.16) - IERROR = 001 - RETURN -C - END -C PHI2Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI2Z0 (ECCENT,TS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-2). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA TOL,NIT /1.0D-10,15/ - DATA HALFPI /1.5707963267948966D0/ -C - ECCNTH = HALF * ECCENT - PHI = HALFPI - TWO * DATAN (TS) - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - CON = ECCENT * SINPI - DPHI = HALFPI - TWO * DATAN (TS * ((ONE - CON) / - . (ONE + CON)) ** ECCNTH) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI2Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,TS - 2000 FORMAT ('0ERROR PHI2Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' TS =',D25.16) - IERROR = 002 - RETURN -C - END -C PHI3Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI3Z0 (ML,E0,E1,E2,E3) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-3). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = ML - DO 020 II = 1,NIT - DPHI = (ML + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0 - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI3Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ML,E0,E1,E2,E3 - 2000 FORMAT ('0ERROR PHI3Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ML =',D25.16,' E0 =',D25.16/ - . ' E1 =',D25.16,' E2 =',D25.16,' E3=',D25.16) - IERROR = 003 - RETURN -C - END -C PHI4Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PHI4Z0 (ECCNTS,E0,E1,E2,E3,A,B,C,PHI) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-4). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA ONE,TWO,FOUR,SIX /1.0D0,2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = A - DO 020 II = 1,NIT - SINPHI = DSIN (PHI) - TANPHI = DTAN (PHI) - C = TANPHI * DSQRT (ONE - ECCNTS * SINPHI * SINPHI) - SIN2PH = DSIN (TWO * PHI) - ML = E0 * PHI - E1 * SIN2PH + E2 * DSIN (FOUR * PHI) - . - E3 * DSIN (SIX * PHI) - MLP = E0 - TWO * E1 * DCOS (TWO * PHI) + FOUR * E2 * - . DCOS (FOUR * PHI) - SIX * E3 * DCOS (SIX * PHI) - CON1 = TWO * ML + C * (ML * ML + B) - TWO * A * - . (C * ML + ONE) - CON2 = ECCNTS * SIN2PH * (ML * ML + B - TWO * A * ML) / (TWO * C) - CON3 = TWO * (A - ML) * (C * MLP - TWO / SIN2PH) - TWO * MLP - DPHI = CON1 / (CON2 + CON3) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,E0,E1,E2,E3,A,B,C, - . ECCNTS - 2000 FORMAT ('0ERROR PHI4Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' E0 =',D25.16,' E1 =',D25.16/ - . ' E2 =',D25.16,' E3 =',D25.16/ - . ' A =',D25.16,' B =',D25.16/ - . ' C =',D25.16/ - . ' ECCENTRICITY SQUARE =',D25.16) - IERROR = 004 - RETURN -C - END -C PJINIT -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PJINIT (ISYS,ZONE,DATA) -cc ---------------------------------------------------------------------- -c --- UPDATE (for use in COORDS) -c -c --- V1.98-V1.10.0 140313 (DGS) -c Modify UTM section of PJINIT in to fix erroneous non-zero -c false Northing when converting S. hemisphere locations to UTM-N -c coordinates. Calls from COORDS to GTPZ0 manage the UTM zone -c (negative for S. hemisphere) so the zone alone should be used to -c set the false Northing for UTM in the S. hemisphere. Calls made -c with a positive zone MUST result in UTM-N coordinates, which are -c negative in the S. hemisphere. -c ---------------------------------------------------------------------- -C - IMPLICIT REAL*8 (A-Z) - REAL*4 SECS(5) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,ITEMP - INTEGER*4 LAND, PATH, LIMIT, IND02, IND06, IND09, ISYS, KEEPZN - INTEGER*4 SWITCH(23),I,ZONE,DEGS(5),MINS(5) - INTEGER*4 ID, IND, ITEM, ITYPE, MODE, N, MSYS - INTEGER*4 ISPHER, LUNIT, LU27, LU83, LEN, NAD27(134), NAD83(134) - CHARACTER*128 DATUM, FILE27, FILE83 - CHARACTER*32 PNAME - CHARACTER*1 SGNA(5) -C - DIMENSION DATA(15),BUFFL(15) - DIMENSION TABLE(9) - DIMENSION PR(20),XLR(20) - DIMENSION ACOEF(6),BCOEF(6) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /NORM/ Q,T,U,W,ES22,P22,SA,CA,XJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /PJ02/ ITYPE - COMMON /PJ03/ A03,LON003,X003,Y003,C,E03,ES03,NS03,RH003 - COMMON /PJ04/ A04,LON004,X004,Y004,E04,F04,NS04,RH004 - COMMON /PJ05/ A05,LON005,X005,Y005,E05,M1 - COMMON /PJ06/ A06,LON006,X006,Y006,E06,E4,FAC,MCS,TCS,IND06 - COMMON /PJ07/ A07,LON007,X007,Y007,E07,E007,E107,E207,E307,ES07, - . ML007 - COMMON /PJ08/ A08,LON008,X008,Y008,E008,E108,E208,E308,GL,NS08, - . RH008 - COMMON /PJ09/ A09,LON009,X009,Y009,ES09,ESP,E009,E109,E209,E309, - . KS009,LAT009,ML009,IND09 - COMMON /PJ10/ A10,LON010,X010,Y010,COSP10,LAT010,SINP10 - COMMON /PJ11/ A11,LON011,X011,Y011,COSP11,LAT011,SINP11 - COMMON /PJ12/ A12,LON012,X012,Y012,COSP12,LAT012,SINP12 - COMMON /PJ13/ A13,LON013,X013,Y013,COSP13,LAT013,SINP13 - COMMON /PJ14/ A14,LON014,X014,Y014,COSP14,LAT014,SINP14 - COMMON /PJ15/ A15,LON015,X015,Y015,COSP15,LAT015,P,SINP15 - COMMON /PJ16/ A16,LON016,X016,Y016 - COMMON /PJ17/ A17,LON017,X017,Y017,LAT1 - COMMON /PJ18/ A18,LON018,X018,Y018 - COMMON /PJ19/ A19,LON019,X019,Y019 - COMMON /PJ20/ LON020,X020,Y020,AL,BL,COSALF,COSGAM,E20,EL,SINALF, - . SINGAM,U0 - COMMON /PJ21/ A21,LON021,X021,Y021,PR,XLR - COMMON /PJ22/ A22,X022,Y022,A2,A4,B,C1,C3,LAND,PATH - COMMON /PJ23/ A23,LON023,X023,Y023,ACOEF,BCOEF,EC,LAT023, - . CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH -C - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE,TWO /0.0D0,0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-10/ - DATA TOL /1.0D-7/ - DATA TOL09 /1.0D-5/ - DATA NINTYD /90000000.0D0/ - DATA DG1 /0.01745329252D0/ - -c --- V1.98 (060911) -c --- Set initial value of SAVE9 - data SAVE9/0.0D0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C .................................................................... -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . U T M . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 1) THEN -C - IERROR = 0 - IF (SWITCH(1).NE.0 .AND. SWITCH(1).EQ.ZONE) RETURN - SWITCH(1) = ZONE - IF (SWITCH(9).NE.0.AND.SWITCH(9).EQ.ZONE.AND.DATA(14).EQ.SAVE) - . RETURN - KEEPZN = ZONE - ZONE = IABS(ZONE) - SAVE = DATA(1) - IF (ZONE .EQ. 0) THEN - ZONE = IDINT( ( (DATA(1) * 180.0D0 / PI) - . + (TOL09 / 3600.D0) ) / 6.D0 ) - IND = 1 - IF (DATA(1) .LT. ZERO) IND = 0 - ZONE = MOD ((ZONE + 30), 60) + IND - KEEPZN = ZONE - IF (DATA(2) .LT. ZERO) KEEPZN = -ZONE - ENDIF - IF (ZONE.LT.1 .OR. ZONE.GT.60) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,140) KEEPZN - 140 FORMAT ('0ERROR PJ01Z0'/ - . ' ILLEGAL ZONE NO. : ',I10) - IERROR = 011 - RETURN - ENDIF - BUFFL(1) = DATA(14) - BUFFL(2) = DATA(15) - BUFFL(3) = 0.9996D0 - BUFFL(4) = ZERO - BUFFL(5) = DBLE (6 * ZONE - 183) * 1.0D6 - BUFFL(6) = ZERO - BUFFL(7) = 500000.0D0 - BUFFL(8) = ZERO - -c --- COORDS -c --- Use just the ZONE provided when setting the false Northing -c IF (DATA(2) .LT. ZERO) BUFFL(8) = 10000000.0D0 - - IF (KEEPZN .LT. 0) BUFFL(8) = 10000000.0D0 - IF (BUFFL(1).NE.0.0D0.AND.BUFFL(1).NE.SAVE9) SWITCH(9) = 0 - SAVE9 = BUFFL(1) - ITEMP = IPPARM - IPPARM = 1 - DO 145 I=1,8 - DATA(I) = BUFFL(I) - 145 CONTINUE - AZ = DATA(14) - EZ = DATA(15) - SWITCH(9) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STATE PLANE . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 2) THEN -C - IERROR = 0 - IF (SWITCH(2).NE.0 .AND. SWITCH(2).EQ.ZONE) RETURN - IF (ISPHER .NE. 0 .AND. ISPHER .NE. 8) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,205) ISPHER - 205 FORMAT('0ERROR PJ02Z0'/ - . ' SPHEROID NO. ',I4,' IS INVALID FOR STATE PLANE', - . ' TRANSFORMATIONS') - IERROR = 020 - RETURN - ENDIF - IF (ZONE .GT. 0) THEN - IND02 = 0 - IF (ISPHER .EQ. 0) THEN - DO 210 I = 1,134 - IF (ZONE .EQ. NAD27(I)) IND02 = I - 210 CONTINUE - ENDIF - IF (ISPHER .EQ. 8) THEN - DO 220 I = 1,134 - IF (ZONE .EQ. NAD83(I)) IND02 = I - 220 CONTINUE - ENDIF - IF (IND02 .EQ. 0) THEN - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - ELSE - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - IF (ISPHER .EQ. 0) THEN - LUNIT = LU27 - DATUM = FILE27 - ENDIF - IF (ISPHER .EQ. 8) THEN - LUNIT = LU83 - DATUM = FILE83 - ENDIF - OPEN (UNIT=LUNIT,FILE=DATUM,STATUS='OLD',ACCESS='DIRECT', - . RECL=LEN) - READ (UNIT=LUNIT,REC=IND02) PNAME,ID,TABLE - CLOSE (UNIT=LUNIT,STATUS='KEEP') - IF (ID .LE. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,240) ZONE, ISPHER - 240 FORMAT('0ERROR PJ02Z0'/ - . ' ILLEGAL ZONE NO. : ',I8,' FOR SPHEROID NO. : ',I4) - IERROR = 021 - RETURN - ENDIF - ITYPE = ID - AZ = TABLE(1) - ES = TABLE(2) - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - ITEMP = IPPARM - IPPARM = 1 -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - DATA(3) = TABLE(4) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 9 - SWITCH(MSYS) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - DATA(3) = PAKCZ0(TABLE(6)) - DATA(4) = PAKCZ0(TABLE(5)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 4 - SWITCH(MSYS) = 0 - KSYS = 4 - GO TO 400 - ENDIF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(4)) - DATA(7) = TABLE(5) - DATA(8) = TABLE(6) - MSYS = 7 - SWITCH(MSYS) = 0 - KSYS = 7 - GO TO 700 - ENDIF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - DATA(3) = TABLE(4) - DATA(4) = PAKCZ0(TABLE(6)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - DATA(13) = ONE - MSYS = 20 - SWITCH(MSYS) = 0 - KSYS = 20 - GO TO 2000 - ENDIF -C - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ALBERS CONICAL EQUAL AREA . -C ...................................................................... -C - IF (ISYS .EQ. 3) THEN -C - IERROR = 0 - IF (SWITCH(3).NE.0 .AND. SWITCH(3).EQ.ZONE) RETURN - SWITCH(3) = 0 - A03 = AZ - E03 = EZ - ES03 = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,340) - 340 FORMAT ('0ERROR PJ03Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 031 - RETURN - END IF - LON003 = PAKRZ0 (DATA(5)) - LAT003 = PAKRZ0 (DATA(6)) - X003 = DATA(7) - Y003 = DATA(8) - SINP03 = DSIN (LAT1) - CON = SINP03 - COSP03 = DCOS (LAT1) - MS1 = MSFNZ0 (E03,SINP03,COSP03) - QS1 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT2) - COSP03 = DCOS (LAT2) - MS2 = MSFNZ0 (E03,SINP03,COSP03) - QS2 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT003) - COSP03 = DCOS (LAT003) - QS0 = QSFNZ0 (E03,SINP03,COSP03) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS03 = (MS1 * MS1 - MS2 * MS2) / (QS2 - QS1) - ELSE - NS03 = CON - END IF - C = MS1 * MS1 + NS03 * QS1 - RH003 = A03 * DSQRT (C - NS03 * QS0) / NS03 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON003,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT003,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,350) A03,ES03, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X003,Y003 - 350 FORMAT ('0INITIALIZATION PARAMETERS (ALBERS CONICAL EQUAL-AREA', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A03 - DATA(2) = ES03 - SWITCH(3) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT CONFORMAL CONIC . -C ...................................................................... -C -400 CONTINUE - IF (KSYS.EQ.4.OR.ISYS .EQ. 4) THEN -C - IERROR = 0 - IF (SWITCH(4).NE.0 .AND. SWITCH(4).EQ.ZONE) RETURN - SWITCH(4) = 0 - A04 = AZ - E04 = EZ - ES = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,440) - 440 FORMAT ('0ERROR PJ04Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 041 - RETURN - END IF - LON004 = PAKRZ0 (DATA(5)) - LAT004 = PAKRZ0 (DATA(6)) - X004 = DATA(7) - Y004 = DATA(8) - SINP04 = DSIN (LAT1) - CON = SINP04 - COSP04 = DCOS (LAT1) - MS1 = MSFNZ0 (E04,SINP04,COSP04) - TS1 = TSFNZ0 (E04,LAT1,SINP04) - SINP04 = DSIN (LAT2) - COSP04 = DCOS (LAT2) - MS2 = MSFNZ0 (E04,SINP04,COSP04) - TS2 = TSFNZ0 (E04,LAT2,SINP04) - SINP04 = DSIN (LAT004) - TS0 = TSFNZ0 (E04,LAT004,SINP04) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS04 = DLOG (MS1 / MS2) / DLOG (TS1 / TS2) - ELSE - NS04 = CON - END IF - F04 = MS1 / (NS04 * TS1 ** NS04) - RH004 = A04 * F04 * TS0 ** NS04 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON004,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT004,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,450) A04,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X004,Y004 - 450 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT CONFORMAL CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A04 - DATA(2) = ES - SWITCH(4) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - 470 FORMAT (' INITIALIZATION PARAMETERS (STATE PLANE PROJECTION)'/ - . ' ZONE NUMBER = ',I4,5X,' ZONE NAME = ',A32) - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 5) THEN -C - IERROR = 0 - IF (SWITCH(5).NE.0 .AND. SWITCH(5).EQ.ZONE) RETURN - SWITCH(5) = 0 - A05 = AZ - E05 = EZ - ES = ESZ - LON005 = PAKRZ0 (DATA(5)) - LAT1 = PAKRZ0 (DATA(6)) - M1 = DCOS(LAT1) / (DSQRT( ONE - ES * DSIN(LAT1) **2)) - X005 = DATA(7) - Y005 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON005,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,550) A05,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X005,Y005 - 550 FORMAT ('0INITIALIZATION PARAMETERS (MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' CENTRAL LONGITUDE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A05 - DATA(2) = ES - SWITCH(5) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLAR STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 6) THEN -C - IERROR = 0 - IF (SWITCH(6).NE.0 .AND. SWITCH(6).EQ.ZONE) RETURN - SWITCH(6) = 0 - A06 = AZ - E06 = EZ - ES = ESZ - E4 = E4Z - LON006 = PAKRZ0 (DATA(5)) - SAVE = DATA(6) - LATC = PAKRZ0 (SAVE) - X006 = DATA(7) - Y006 = DATA(8) - FAC = ONE - IF (SAVE .LT. ZERO) FAC =-ONE - IND06 = 0 - IF (DABS(SAVE) .NE. NINTYD) THEN - IND06 = 1 - CON1 = FAC * LATC - SINPHI = DSIN (CON1) - COSPHI = DCOS (CON1) - MCS = MSFNZ0 (E06,SINPHI,COSPHI) - TCS = TSFNZ0 (E06,CON1,SINPHI) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON006,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LATC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,650) A06,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X006,Y006 - 650 FORMAT ('0INITIALIZATION PARAMETERS (POLAR STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF Y-AXIS = ',A1,2I3,F7.3/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A06 - DATA(2) = ES - SWITCH(6) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLYCONIC . -C ...................................................................... -C - 700 CONTINUE - IF (KSYS.EQ.7.OR.ISYS .EQ. 7) THEN -C - IERROR = 0 - IF (SWITCH(7).NE.0 .AND. SWITCH(7).EQ.ZONE) RETURN - SWITCH(7) = 0 - A07 = AZ - E07 = EZ - ES07 = ESZ - E007 = E0Z - E107 = E1Z - E207 = E2Z - E307 = E3Z - LON007 = PAKRZ0 (DATA(5)) - LAT007 = PAKRZ0 (DATA(6)) - X007 = DATA(7) - Y007 = DATA(8) - ML007 = MLFNZ0 (E007,E107,E207,E307,LAT007) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON007,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT007,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,750) A07,ES07, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X007,Y007 - 750 FORMAT ('0INITIALIZATION PARAMETERS (POLYCONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A07 - DATA(2) = ES07 - SWITCH(7) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIDISTANT CONIC . -C ...................................................................... -C - IF (ISYS .EQ. 8) THEN -C - IERROR = 0 - IF (SWITCH(8).NE.0 .AND. SWITCH(8).EQ.ZONE) RETURN - SWITCH(8) = 0 - A08 = AZ - E = EZ - ES = ESZ - E008 = E0Z - E108 = E1Z - E208 = E2Z - E308 = E3Z - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,840) - 840 FORMAT ('0ERROR PJ08Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 081 - RETURN - END IF - LON008 = PAKRZ0 (DATA(5)) - LAT0 = PAKRZ0 (DATA(6)) - X008 = DATA(7) - Y008 = DATA(8) - SINPHI = DSIN (LAT1) - COSPHI = DCOS (LAT1) - MS1 = MSFNZ0 (E,SINPHI,COSPHI) - ML1 = MLFNZ0 (E008,E108,E208,E308,LAT1) - IND = 0 - IF (DATA(9) .NE. ZERO) THEN - IND = 1 - SINPHI = DSIN (LAT2) - COSPHI = DCOS (LAT2) - MS2 = MSFNZ0 (E,SINPHI,COSPHI) - ML2 = MLFNZ0 (E008,E108,E208,E308,LAT2) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS08 = (MS1 - MS2) / (ML2 - ML1) - ELSE - NS08 = SINPHI - END IF - ELSE - NS08 = SINPHI - END IF - GL = ML1 + MS1 / NS08 - ML0 = MLFNZ0 (E008,E108,E208,E308,LAT0) - RH008 = A08 * (GL - ML0) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON008,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT0,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IND .NE. 0) THEN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,850) A08,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X008,Y008 - 850 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - ELSE - IF (IPPARM .EQ. 0) WRITE (IPPLUN,860) A08,ES, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=3,4), - . X008,Y008 - 860 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - END IF - DATA(1) = A08 - DATA(2) = ES - SWITCH(8) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . TRANSVERSE MERCATOR . -C ...................................................................... -C - 900 CONTINUE - IF (KSYS.EQ.9.OR.ISYS .EQ. 9) THEN -C - IERROR = 0 - IF (DATA(1).NE.0.0D0.AND.DATA(1).NE.SAVE) SWITCH(9) = 0 - IF (SWITCH(9).NE.0 .AND. SWITCH(9).EQ.ZONE) RETURN - SWITCH(9) = 0 - SAVE = DATA(1) - A09 = AZ - E09 = EZ - ES09 = ESZ - E009 = E0Z - E109 = E1Z - E209 = E2Z - E309 = E3Z - KS009 = DATA(3) - LON009 = PAKRZ0 (DATA(5)) - LAT009 = PAKRZ0 (DATA(6)) - X009 = DATA(7) - Y009 = DATA(8) - ML009 = A09 * MLFNZ0 (E009,E109,E209,E309,LAT009) - IND09 = 1 - ESP = ES09 - IF (E09 .GE. TOL09) THEN - IND09 = 0 - ESP = ES09 / (ONE - ES09) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON009,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT009,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,950) A09,ES09,KS009, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X009,Y009 - 950 FORMAT ('0INITIALIZATION PARAMETERS (TRANSVERSE MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE FACTOR AT C. MERIDIAN =',F9.6/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A09 - DATA(2) = ES09 - SWITCH(9) = ZONE -C -C LIST UTM PROJECTION INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 1) THEN - IPPARM = ITEMP - BUFFL(1) = A09 - BUFFL(2) = ES09 - ZONE = KEEPZN - SWITCH(9) = ZONE - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,960) ZONE,BUFFL(1), - . BUFFL(2),BUFFL(3), - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . BUFFL(7),BUFFL(8) - 960 FORMAT ('0INITIALIZATION PARAMETERS (U T M PROJECTION)'/ - . ' ZONE = ',I3/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID = ',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED = ',F18.15/ - . ' SCALE FACTOR AT C. MERIDIAN = ',F9.6/ - . ' LONGITUDE OF CENTRAL MERIDIAN= ',A1,2I3,F7.3/ - . ' FALSE EASTING = ',F12.2,' METERS'/ - . ' FALSE NORTHING = ',F12.2,' METERS') - SWITCH(1) = ZONE - RETURN - END IF -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 10) THEN -C - IERROR = 0 - IF (SWITCH(10).NE.0 .AND. SWITCH(10).EQ.ZONE) RETURN - SWITCH(10) = 0 - A10 = AZZ - LON010 = PAKRZ0 (DATA(5)) - LAT010 = PAKRZ0 (DATA(6)) - X010 = DATA(7) - Y010 = DATA(8) - SINP10 = DSIN (LAT010) - COSP10 = DCOS (LAT010) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON010,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT010,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1050) A10, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X010,Y010 - 1050 FORMAT ('0INITIALIZATION PARAMETERS (STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A10 - SWITCH(10) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT AZIMUTHAL EQUAL-AREA . -C ...................................................................... -C - IF (ISYS .EQ. 11) THEN -C - IERROR = 0 - IF (SWITCH(11).NE.0 .AND. SWITCH(11).EQ.ZONE) RETURN - SWITCH(11) = 0 - A11 = AZZ - LON011 = PAKRZ0 (DATA(5)) - LAT011 = PAKRZ0 (DATA(6)) - X011 = DATA(7) - Y011 = DATA(8) - SINP11 = DSIN (LAT011) - COSP11 = DCOS (LAT011) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON011,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT011,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1150) A11, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X011,Y011 - 1150 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT AZIMUTHAL EQUAL-AREA' - . ,' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A11 - SWITCH(11) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . AZIMUTHAL EQUIDISTANT . -C ...................................................................... -C - IF (ISYS .EQ. 12) THEN -C - IERROR = 0 - IF (SWITCH(12).NE.0 .AND. SWITCH(12).EQ.ZONE) RETURN - SWITCH(12) = 0 - A12 = AZZ - LON012 = PAKRZ0 (DATA(5)) - LAT012 = PAKRZ0 (DATA(6)) - X012 = DATA(7) - Y012 = DATA(8) - SINP12 = DSIN (LAT012) - COSP12 = DCOS (LAT012) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON012,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT012,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1250) A12, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X012,Y012 - 1250 FORMAT ('0INITIALIZATION PARAMETERS (AZIMUTHAL EQUIDISTANT', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A12 - SWITCH(12) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GNOMONIC . -C ...................................................................... -C - IF (ISYS .EQ. 13) THEN -C - IERROR = 0 - IF (SWITCH(13).NE.0 .AND. SWITCH(13).EQ.ZONE) RETURN - SWITCH(13) = 0 - A13 = AZZ - LON013 = PAKRZ0 (DATA(5)) - LAT013 = PAKRZ0 (DATA(6)) - X013 = DATA(7) - Y013 = DATA(8) - SINP13 = DSIN (LAT013) - COSP13 = DCOS (LAT013) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON013,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT013,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1350) A13, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X013,Y013 - 1350 FORMAT ('0INITIALIZATION PARAMETERS (GNOMONIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A13 - SWITCH(13) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ORTHOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 14) THEN -C - IERROR = 0 - IF (SWITCH(14).NE.0 .AND. SWITCH(14).EQ.ZONE) RETURN - SWITCH(14) = 0 - A14 = AZZ - LON014 = PAKRZ0 (DATA(5)) - LAT014 = PAKRZ0 (DATA(6)) - X014 = DATA(7) - Y014 = DATA(8) - SINP14 = DSIN (LAT014) - COSP14 = DCOS (LAT014) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON014,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT014,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1450) A14, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X014,Y014 - 1450 FORMAT ('0INITIALIZATION PARAMETERS (ORTHOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A14 - SWITCH(14) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GENERAL VERTICAL NEAR-SIDE PERSPECTIVE . -C ...................................................................... -C - IF (ISYS .EQ. 15) THEN -C - IERROR = 0 - IF (SWITCH(15).NE.0 .AND. SWITCH(15).EQ.ZONE) RETURN - SWITCH(15) = 0 - A15 = AZZ - P = ONE + DATA(3) / A15 - LON015 = PAKRZ0 (DATA(5)) - LAT015 = PAKRZ0 (DATA(6)) - X015 = DATA(7) - Y015 = DATA(8) - SINP15 = DSIN (LAT015) - COSP15 = DCOS (LAT015) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON015,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT015,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1550) A15,DATA(3), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X015,Y015 - 1550 FORMAT ('0INITIALIZATION PARAMETERS (GENERAL VERTICAL NEAR-SIDE', - . ' PERSPECTIVE PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' HEIGHT OF PERSPECTIVE POINT'/ - . ' ABOVE SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A15 - SWITCH(15) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SINUSOIDAL . -C ...................................................................... -C - IF (ISYS .EQ. 16) THEN -C - IERROR = 0 - IF (SWITCH(16).NE.0 .AND. SWITCH(16).EQ.ZONE) RETURN - SWITCH(16) = 0 - A16 = AZZ - LON016 = PAKRZ0 (DATA(5)) - X016 = DATA(7) - Y016 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON016,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1650) A16, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X016,Y016 - 1650 FORMAT ('0INITIALIZATION PARAMETERS (SINUSOIDAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A16 - SWITCH(16) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIRECTANGULAR . -C ...................................................................... -C - IF (ISYS .EQ. 17) THEN -C - IERROR = 0 - IF (SWITCH(17).NE.0 .AND. SWITCH(17).EQ.ZONE) RETURN - SWITCH(17) = 0 - A17 = AZZ - LAT1 = PAKRZ0 (DATA(6)) - LON017 = PAKRZ0 (DATA(5)) - X017 = DATA(7) - Y017 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON017,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1750) A17, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X017,Y017 - 1750 FORMAT ('0INITIALIZATION PARAMETERS (EQUIRECTANGULAR PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I2,F7.3/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A17 - SWITCH(17) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MILLER CYLINDRICAL . -C ...................................................................... -C - IF (ISYS .EQ. 18) THEN -C - IERROR = 0 - IF (SWITCH(18).NE.0 .AND. SWITCH(18).EQ.ZONE) RETURN - SWITCH(18) = 0 - A18 = AZZ - LON018 = PAKRZ0 (DATA(5)) - X018 = DATA(7) - Y018 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON018,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1850) A18, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X018,Y018 - 1850 FORMAT ('0INITIALIZATION PARAMETERS (MILLER CYLINDRICAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A18 - SWITCH(18) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . VAN DER GRINTEN I . -C ...................................................................... -C - IF (ISYS .EQ. 19) THEN -C - IERROR = 0 - IF (SWITCH(19).NE.0 .AND. SWITCH(19).EQ.ZONE) RETURN - SWITCH(19) = 0 - A19 = AZZ - LON019 = PAKRZ0 (DATA(5)) - X019 = DATA(7) - Y019 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON019,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1950) A19, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X019,Y019 - 1950 FORMAT ('0INITIALIZATION PARAMETERS (VAN DER GRINTEN I', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A19 - SWITCH(19) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . OBLIQUE MERCATOR (HOTINE) . -C ...................................................................... -C - 2000 CONTINUE - IF (KSYS.EQ.20.OR.ISYS .EQ. 20) THEN -C - IERROR = 0 - IF (SWITCH(20).NE.0 .AND. SWITCH(20).EQ.ZONE) RETURN - SWITCH(20) = 0 - MODE = 0 - IF (DATA(13) .NE. ZERO) MODE = 1 - A = AZ - E20 = EZ - ES = ESZ - KS0 = DATA(3) - LAT0 = PAKRZ0 (DATA(6)) - X020 = DATA(7) - Y020 = DATA(8) - SINPH0 = DSIN (LAT0) - COSPH0 = DCOS (LAT0) - CON = ONE - ES * SINPH0 * SINPH0 - COM = DSQRT (ONE - ES) - BL = DSQRT (ONE + ES * COSPH0 ** 4 / (ONE - ES)) - AL = A * BL * KS0 * COM / CON - IF (DABS(LAT0).LT.EPSLN) TS0 = 1.0D0 - IF (DABS(LAT0).LT.EPSLN) D=1.0D0 - IF (DABS(LAT0).LT.EPSLN) EL=1.0D0 - IF (DABS(LAT0).GE.EPSLN) THEN - TS0 = TSFNZ0 (E20,LAT0,SINPH0) - CON = DSQRT (CON) - D = BL * COM / (COSPH0 * CON) - F = D + DSIGN (DSQRT (DMAX1 ((D * D - ONE), 0.0D0)) , LAT0) - EL = F * TS0 ** BL - END IF - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2050) A,ES,KS0 - 2050 FORMAT ('0INITIALIZATION PARAMETERS (OBLIQUE MERCATOR ''HOTINE''', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE AT CENTER =',F12.9) - IF (MODE .NE. 0) THEN - ALPHA = PAKRZ0 (DATA(4)) - LONC = PAKRZ0 (DATA(5)) - G = HALF * (F - ONE / F) - GAMMA = ASINZ0 (DSIN (ALPHA) / D) - LON020 = LONC - ASINZ0 (G * DTAN (GAMMA)) / BL -C -C LIST INITIALIZATION PARAMETERS (CASE B). -C - CALL RADDZ0 (ALPHA,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LONC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT0,SGNA(3),DEGS(3),MINS(3),SECS(3)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2060) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,3) - 2060 FORMAT (' AZIMUTH OF CENTRAL LINE = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - CON = DABS (LAT0) - IF (CON.GT.EPSLN .AND. DABS(CON - HALFPI).GT.EPSLN) THEN - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - 2040 FORMAT ('0ERROR PJ20Z0'/ - . ' INPUT DATA ERROR') - IERROR = 201 - RETURN - END IF - END IF - LON1 = PAKRZ0 (DATA(9)) - LAT1 = PAKRZ0 (DATA(10)) - LON2 = PAKRZ0 (DATA(11)) - LAT2 = PAKRZ0 (DATA(12)) - SINPHI = DSIN (LAT1) - TS1 = TSFNZ0 (E20,LAT1,SINPHI) - SINPHI = DSIN (LAT2) - TS2 = TSFNZ0 (E20,LAT2,SINPHI) - H = TS1 ** BL - L = TS2 ** BL - F = EL / H - G = HALF * (F - ONE / F) - J = (EL * EL - L * H) / (EL * EL + L * H) - P = (L - H) / (L + H) - CALL RADDZ0 (LON2,SGNA(3),DEGS(3),MINS(3),SECS(3)) - DLON = LON1 - LON2 - IF (DLON .LT. -PI) LON2 = LON2 - 2.D0 * PI - IF (DLON .GT. PI) LON2 = LON2 + 2.D0 * PI - DLON = LON1 - LON2 - LON020 = HALF * (LON1 + LON2) - DATAN (J * DTAN (HALF * BL * - . DLON) / P) / BL - DLON = ADJLZ0 (LON1 - LON020) - GAMMA = DATAN (DSIN (BL * DLON) / G) - ALPHA = ASINZ0 (D * DSIN (GAMMA)) - CALL RADDZ0 (LON1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT1,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT2,SGNA(4),DEGS(4),MINS(4),SECS(4)) - CALL RADDZ0 (LAT0,SGNA(5),DEGS(5),MINS(5),SECS(5)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2070) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,5) - 2070 FORMAT (' LONGITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LONGITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - IF (DABS(LAT1 - LAT2) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - CON = DABS (LAT1) - END IF - IF (CON.LE.EPSLN .OR. DABS(CON - HALFPI).LE.EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - IF (DABS(DABS(LAT0) - HALFPI) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - END IF - END IF - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - 2080 FORMAT (' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ROBINSON . -C ...................................................................... -C - IF (ISYS .EQ. 21) THEN -C - IERROR = 0 - IF (SWITCH(21).NE.0 .AND. SWITCH(21).EQ.ZONE) RETURN - SWITCH(21) = 0 - A21 = AZZ - LON021 = PAKRZ0 (DATA(5)) - X021 = DATA(7) - Y021 = DATA(8) - PR(1)=-0.062D0 - XLR(1)=0.9986D0 - PR(2)=0.D0 - XLR(2)=1.D0 - PR(3)=0.062D0 - XLR(3)=0.9986D0 - PR(4)=0.124D0 - XLR(4)=0.9954D0 - PR(5)=0.186D0 - XLR(5)=0.99D0 - PR(6)=0.248D0 - XLR(6)=0.9822D0 - PR(7)=0.31D0 - XLR(7)=0.973D0 - PR(8)=0.372D0 - XLR(8)=0.96D0 - PR(9)=0.434D0 - XLR(9)=0.9427D0 - PR(10)=0.4958D0 - XLR(10)=0.9216D0 - PR(11)=0.5571D0 - XLR(11)=0.8962D0 - PR(12)=0.6176D0 - XLR(12)=0.8679D0 - PR(13)=0.6769D0 - XLR(13)=0.835D0 - PR(14)=0.7346D0 - XLR(14)=0.7986D0 - PR(15)=0.7903D0 - XLR(15)=0.7597D0 - PR(16)=0.8435D0 - XLR(16)=0.7186D0 - PR(17)=0.8936D0 - XLR(17)=0.6732D0 - PR(18)=0.9394D0 - XLR(18)=0.6213D0 - PR(19)=0.9761D0 - XLR(19)=0.5722D0 - PR(20)=1.0D0 - XLR(20)=0.5322D0 - DO 2110 I=1,20 - 2110 XLR(I)=XLR(I) * 0.9858D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON021,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2150) A21, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X021,Y021 - 2150 FORMAT ('0INITIALIZATION PARAMETERS (ROBINSON', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A21 - SWITCH(21) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SPACE OBLIQUE MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 22) THEN -C - IERROR = 0 - IF (SWITCH(22).NE.0 .AND. SWITCH(22).EQ.ZONE) RETURN - SWITCH(22) = 0 - A22 = AZ - E = EZ - ES22 = ESZ - X022 = DATA(7) - Y022 = DATA(8) - LAND = IDINT(DATA(3)+TOL) - PATH = IDINT(DATA(4)+TOL) -C -C CHECK IF LANDSAT NUMBER IS WITHIN RANGE 1 - 5 -C - IF (LAND .GT. 0 .AND. LAND .LE. 5) THEN - IF (LAND .LE. 3) LIMIT = 251 - IF (LAND .GE. 4) LIMIT = 233 - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - IERROR = 221 - RETURN - END IF -C -C CHECK IF PATH NUMBER IS WITHIN RANGE 1 - 251 FOR LANDSATS 1 - 3 -C OR RANGE 1 - 233 FOR LANDSATS 4 - 5 -C - IF (PATH .LE. 0 .OR. PATH .GT. LIMIT) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - 2240 FORMAT ('0ERROR PJ22Z0'/ - . ' LANDSAT NUMBER ',I2,' AND / OR PATH NUMBER ',I4, - . ' ARE OUT OF RANGE') - IERROR = 221 - RETURN - END IF - P1=1440.0D0 - IF (LAND.LE.3) THEN - P2=103.2669323D0 - ALF=99.092D0*DG1 - ELSE - P2=98.8841202D0 - ALF=98.20D0*DG1 - END IF - SA=DSIN(ALF) - CA=DCOS(ALF) - IF (DABS(CA).LT.1.D-9) CA=1.D-9 - ESC=ES22*CA*CA - ESS=ES22*SA*SA - W=((ONE-ESC)/(ONE-ES22))**TWO-ONE - Q=ESS/(ONE-ES22) - T=(ESS*(TWO-ES22))/(ONE-ES22)**TWO - U=ESC/(ONE-ES22) - XJ=(ONE-ES22)**3 - P22=P2/P1 -C -C COMPUTE FOURIER COEFFICIENTS. LAM IS CURRENT VALUE OF -C LAMBDA DOUBLE-PRIME. -C - LAM=0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=FA2 - SUMA4=FA4 - SUMB=FB - SUMC1=FC1 - SUMC3=FC3 - DO 2210 I=9,81,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+4.0D0*FA2 - SUMA4=SUMA4+4.0D0*FA4 - SUMB=SUMB+4.0D0*FB - SUMC1=SUMC1+4.0D0*FC1 - SUMC3=SUMC3+4.0D0*FC3 - 2210 CONTINUE - DO 2220 I=18,72,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+TWO*FA2 - SUMA4=SUMA4+TWO*FA4 - SUMB=SUMB+TWO*FB - SUMC1=SUMC1+TWO*FC1 - SUMC3=SUMC3+TWO*FC3 - 2220 CONTINUE - LAM=90.0D0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+FA2 - SUMA4=SUMA4+FA4 - SUMB=SUMB+FB - SUMC1=SUMC1+FC1 - SUMC3=SUMC3+FC3 -C -C THESE ARE THE VALUES OF FOURIER CONSTANTS. -C - A2=SUMA2/30.D0 - A4=SUMA4/60.D0 - B=SUMB/30.D0 - C1=SUMC1/15.D0 - C3=SUMC3/45.D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2250) A22,ES22,LAND,PATH, - . X022,Y022 - 2250 FORMAT ('0INITIALIZATION PARAMETERS (SPACE OBL. MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LANDSAT NO. = ',I3/ - . ' PATH = ',I5/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS'/) - DATA(1) = A22 - DATA(2) = ES22 - SWITCH(22) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) . -C ...................................................................... -C - IF (ISYS .EQ. 23) THEN -C - IERROR = 0 - IF (SWITCH(23).NE.0 .AND. SWITCH(23).EQ.ZONE) RETURN - SWITCH(23) = 0 - A23 = AZ - EC2 = 0.6768657997291094D-02 - EC = DSQRT (EC2) - N=6 - LON023 = -152.0D0*DG1 - LAT023 = 64.0D0*DG1 - X023 = DATA(7) - Y023 = DATA(8) - ACOEF(1)=0.9945303D0 - ACOEF(2)=0.0052083D0 - ACOEF(3)=0.0072721D0 - ACOEF(4)=-0.0151089D0 - ACOEF(5)=0.0642675D0 - ACOEF(6)=0.3582802D0 - BCOEF(1)=0.0D0 - BCOEF(2)=-.0027404D0 - BCOEF(3)=0.0048181D0 - BCOEF(4)=-0.1932526D0 - BCOEF(5)=-0.1381226D0 - BCOEF(6)=-0.2884586D0 - ESPHI=EC*DSIN(LAT023) - CHIO=TWO*DATAN(DTAN((HALFPI+LAT023)/TWO)*((ONE-ESPHI)/ - . (ONE+ESPHI))**(EC/TWO)) - HALFPI - SCHIO=DSIN(CHIO) - CCHIO=DCOS(CHIO) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON023,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT023,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2350) A23,EC2, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X023,Y023 - 2350 FORMAT ('0INITIALIZATION PARAMETERS (MOD. STEREOGRAPHIC', - . ' CONFORMAL PROJECTION, ALASKA)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A23 - SWITCH(23) = ZONE - RETURN - END IF -C -C INITIALIZATION OF PROJECTION COMPLETED -C - END -C PJ01Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * U T M * -C ********************************************************************** -C - SUBROUTINE PJ01Z0 (COORD,CRDIO,INDIC) -C -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /TOGGLE/ SWITCH - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ01Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 013 - RETURN - 140 CALL PJ09Z0 (GEOG,PROJ,FWD) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 160 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 014 - RETURN - 160 CALL PJ09Z0 (PROJ,GEOG,INV) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ02Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * STATE PLANE * -C ********************************************************************** -C - SUBROUTINE PJ02Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23), ITYPE - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ02/ ITYPE - COMMON /TOGGLE/ SWITCH -C - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - 250 FORMAT ('0ERROR PJ02Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 023 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (GEOG,PROJ,FWD) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (GEOG,PROJ,FWD) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (GEOG,PROJ,FWD) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (GEOG,PROJ,FWD) - END IF -C - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - IERROR = 025 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (PROJ,GEOG,INV) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (PROJ,GEOG,INV) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (PROJ,GEOG,INV) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (PROJ,GEOG,INV) - END IF -C - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ03Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ALBERS CONICAL EQUAL AREA * -C ********************************************************************** -C - SUBROUTINE PJ03Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,C,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ03/ A,LON0,X0,Y0,C,E,ES,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ03Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 033 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - QS = QSFNZ0 (E,SINPHI,COSPHI) - RH = A * DSQRT (C - NS * QS) / NS - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 034 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - CON = RH * NS / A - QS = (C - CON * CON) / NS - IF (E .LT. TOL) GO TO 260 - CON = ONE - HALF * (ONE - ES) * DLOG ((ONE - E) / - . (ONE + E)) / E - IF ((DABS(CON) - DABS(QS)) .GT. TOL) GO TO 260 - GEOG(2) = DSIGN (HALFPI , QS) - GO TO 280 - 260 GEOG(2) = PHI1Z0 (E,QS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 035 - RETURN - 280 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ04Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT CONFORMAL CONIC * -C ********************************************************************** -C - SUBROUTINE PJ04Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,F,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ04/ A,LON0,X0,Y0,E,F,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 200 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ04Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 043 - RETURN - 200 CON = DABS (DABS (GEOG(2)) - HALFPI) - IF (CON .GT. EPSLN) GO TO 220 - CON = GEOG(2) * NS - IF (CON .GT. ZERO) GO TO 210 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ04Z0'/ - . ' POINT CANNOT BE PROJECTED') - IERROR = 044 - RETURN - 210 RH = ZERO - GO TO 230 - 220 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - RH = A * F * TS ** NS - 230 THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 045 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X*X + Y*Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - IF (RH.NE.ZERO .OR. NS.GT.ZERO) GO TO 250 - GEOG(2) = - HALFPI - GO TO 260 - 250 CON = ONE / NS - TS = (RH / (A * F)) ** CON - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 260 - IERROR = 046 - RETURN - 260 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ05Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ05Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,X0,Y0,NS,F,RH0,LAT1,M1 ************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ05/ A,LON0,X0,Y0,E,M1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ05Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 052 - RETURN - 220 IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ05Z0'/ - . ' TRANSFORMATION CANNOT BE COMPUTED AT THE POLES') - IERROR = 053 - RETURN - 240 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - PROJ(1) = X0 + A * M1 * ADJLZ0 (GEOG(1) - LON0) - PROJ(2) = Y0 - A * M1 * DLOG (TS) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 260 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 054 - RETURN - 260 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - TS = DEXP (- Y / (A * M1)) - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 055 - RETURN - 280 GEOG(1) = ADJLZ0 (LON0 + X / (A * M1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ06Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLAR STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ06Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),IND - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,E4,MCS,TCS,FAC,IND ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ06/ A,LON0,X0,Y0,E,E4,FAC,MCS,TCS,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ06Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 062 - RETURN - 220 CON1 = FAC * ADJLZ0 (GEOG(1) - LON0) - CON2 = FAC * GEOG(2) - SINPHI = DSIN (CON2) - TS = TSFNZ0 (E,CON2,SINPHI) - IF (IND .EQ. 0) GO TO 240 - RH = A * MCS * TS / TCS - GO TO 260 - 240 RH = TWO * A * TS / E4 - 260 PROJ(1) = X0 + FAC * RH * DSIN (CON1) - PROJ(2) = Y0 - FAC * RH * DCOS (CON1) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 063 - RETURN - 320 X = FAC * (PROJ(1) - X0) - Y = FAC * (PROJ(2) - Y0) - RH = DSQRT (X * X + Y * Y) - IF (IND .EQ. 0) GO TO 340 - TS = RH * TCS / (A * MCS) - GO TO 360 - 340 TS = RH * E4 / (TWO * A) - 360 GEOG(2) = FAC * PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 380 - IERROR = 064 - RETURN - 380 IF (RH .NE. ZERO) GO TO 400 - GEOG(1) = FAC * LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 GEOG(1) = ADJLZ0 (FAC * DATAN2 (X , -Y) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ07Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLYCONIC * -C ********************************************************************** -C - SUBROUTINE PJ07Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,E0,E1,E2,ML0 ************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ07/ A,LON0,X0,Y0,E,E0,E1,E2,E3,ES,ML0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ07Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 072 - RETURN - 220 CON = ADJLZ0 (GEOG(1) - LON0) - IF (DABS(GEOG(2)) .GT. TOL) GO TO 240 - PROJ(1) = X0 + A * CON - PROJ(2) = Y0 - A * ML0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 240 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - MS = MSFNZ0 (E,SINPHI,COSPHI) - CON = CON * SINPHI - PROJ(1) = X0 + A * MS * DSIN (CON) / SINPHI - PROJ(2) = Y0 + A * (ML - ML0 + MS * (ONE - DCOS(CON)) / SINPHI) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 073 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - AL = ML0 + Y / A - IF (DABS (AL) .GT. TOL) GO TO 340 - GEOG(1) = X / A + LON0 - GEOG(2) = ZERO - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 340 B = AL * AL + (X / A) ** 2 - CALL PHI4Z0 (ES,E0,E1,E2,E3,AL,B,C,GEOG(2)) - IF (IERROR .EQ. 0) GO TO 360 - IERROR = 074 - RETURN - 360 GEOG(1) = ADJLZ0 (ASINZ0 (X * C / A) / DSIN (GEOG(2)) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ08Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIDISTANT CONIC * -C ********************************************************************** -C - SUBROUTINE PJ08Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C ** PARAMETERS * A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,E0,E1,E2,E3,NS,GL,RH0 - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ08/ A,LON0,X0,Y0,E0,E1,E2,E3,GL,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 300 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ08Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 083 - RETURN - 300 ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - RH = A * (GL - ML) - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - IERROR = 084 - RETURN - 320 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - ML = GL - RH / A - GEOG(2) = PHI3Z0 (ML,E0,E1,E2,E3) - IF (IERROR .EQ. 0) GO TO 340 - IERROR = 085 - RETURN - 340 GEOG(1) = ADJLZ0 (LON0 + THETA / NS) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ09Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * TRANSVERSE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ09Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),I,IND,NIT - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS ** A,E,ES,KS0,LON0,LAT0,X0,Y0,E0,E1,E2,E3,ESP,ML0,IND - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ09/ A,LON0,X0,Y0,ES,ESP,E0,E1,E2,E3,KS0,LAT0,ML0,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,HALF,ONE,TWO,THREE /0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ - DATA FOUR,FIVE,SIX,EIGHT,NINE /4.0D0,5.0D0,6.0D0,8.0D0,9.0D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TEN /10.0D0/ - DATA EPSLN,NIT /1.0D-10,6/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ09Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 092 - RETURN - 220 DLON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (IND .EQ. 0) GO TO 240 - COSPHI = DCOS (LAT) - B = COSPHI * DSIN (DLON) - IF (DABS(DABS(B) - ONE) .GT. EPSLN) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ09Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 093 - RETURN - 230 PROJ(1) = HALF * A * KS0 * DLOG ((ONE + B) / (ONE - B)) + X0 - CON = DACOS (COSPHI * DCOS (DLON) / DSQRT (ONE - B * B)) - IF (LAT .LT. ZERO) CON =-CON - PROJ(2) = A * KS0 * (CON - LAT0) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN -C - 240 SINPHI = DSIN (LAT) - COSPHI = DCOS (LAT) - AL = COSPHI * DLON - ALS = AL * AL - C = ESP * COSPHI * COSPHI - TQ = DTAN (LAT) - T = TQ * TQ - N = A / DSQRT (ONE - ES * SINPHI * SINPHI) - ML = A * MLFNZ0 (E0,E1,E2,E3,LAT) - PROJ(1) = KS0 * N * AL * (ONE + ALS / SIX * (ONE - T + C + - . ALS / 20.0D0 * (FIVE - 18.0D0 * T + T * T + 72.0D0 * - . C - 58.0D0 * ESP))) + X0 - PROJ(2) = KS0 *(ML - ML0 + N * TQ *(ALS *(HALF + ALS / 24.0D0 * - . (FIVE - T + NINE * C + FOUR * C * C + ALS / 30.0D0 * - . (61.0D0 - 58.0D0 * T + T * T + 600.0D0 * C - - . 330.0D0 * ESP))))) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 094 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - IF (IND .EQ. 0) GO TO 340 - F = DEXP (X / (A * KS0)) - G = HALF * (F - ONE / F) - TEMP = LAT0 + Y / (A * KS0) - H = DCOS (TEMP) - CON = DSQRT ((ONE - H * H) / (ONE + G * G)) - GEOG(2) = ASINZ0 (CON) - IF (TEMP .LT. ZERO) GEOG(2) =-GEOG(2) - IF (G.NE.ZERO .OR. H.NE.ZERO) GO TO 330 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 330 GEOG(1) = ADJLZ0 (DATAN2 (G,H) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN -C - 340 CON = (ML0 + Y / KS0) / A - PHI = CON - DO 360 I = 1,NIT - DPHI = ((CON + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .LE. EPSLN) GO TO 380 - 360 CONTINUE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) NIT - 2030 FORMAT ('0ERROR PI09Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS') - IERROR = 095 - RETURN - 380 IF (DABS(PHI) .LT. HALFPI) GO TO 400 - GEOG(2) = DSIGN (HALFPI , Y) - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 SINPHI = DSIN (PHI) - COSPHI = DCOS (PHI) - TANPHI = DTAN (PHI) - C = ESP * COSPHI * COSPHI - CS = C * C - T = TANPHI * TANPHI - TS = T * T - CON = ONE - ES * SINPHI * SINPHI - N = A / DSQRT (CON) - R = N * (ONE - ES) / CON - D = X / (N * KS0) - DS = D * D - GEOG(2) = PHI - (N * TANPHI * DS / R) * (HALF - DS / 24.0D0 * - . (FIVE + THREE * T + TEN * C - FOUR * CS - NINE * ESP - . - DS / 30.0D0 * (61.0D0 + 90.0D0 * T + 298.0D0 * C + - . 45.0D0 * TS - 252.0D0 * ESP - THREE * CS))) - GEOG(1) = ADJLZ0 (LON0 + (D * (ONE - DS / SIX * (ONE + TWO * - . T + C - DS / 20.0D0 * (FIVE - TWO * C + 28.0D0 * T - - . THREE * CS + EIGHT * ESP + 24.0D0 * TS))) / COSPHI)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ10Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ10Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ10/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ10Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 102 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(G + ONE) .GT. EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ10Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 103 - RETURN - 140 KSP = TWO / (ONE + G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 104 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = TWO * DATAN (RH / (TWO * A)) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ11Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT AZIMUTHAL EQUAL-AREA * -C ********************************************************************** -C - SUBROUTINE PJ11Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ11/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ11Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 112 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .NE. -ONE) GO TO 140 - CON = TWO * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO A CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 113 - RETURN - 140 KSP = DSQRT (TWO / (ONE + G)) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 114 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - CON = RH / (TWO * A) - IF (CON .LE. ONE) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ11Z0'/ - . ' INPUT DATA ERROR') - IERROR = 115 - RETURN - 230 Z = TWO * ASINZ0 (CON) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (CON .EQ. ZERO) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ12Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * AZIMUTHAL EQUIDISTANT * -C ********************************************************************** -C - SUBROUTINE PJ12Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ12/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ12Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 122 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(DABS(G) - ONE) .GE. EPSLN) GO TO 140 - KSP = ONE - IF (G .GE. ZERO) GO TO 160 - CON = TWO * HALFPI * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 123 - RETURN - 140 Z = DACOS (G) - KSP = Z / DSIN (Z) - 160 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 124 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. (TWO * HALFPI * A)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ12Z0'/ - . ' INPUT DATA ERROR') - IERROR = 125 - RETURN - 230 Z = RH / A - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ13Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GNOMONIC * -C ********************************************************************** -C - SUBROUTINE PJ13Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ13/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ13Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 132 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GT. ZERO) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT PROJECTS INTO INFINITY') - IERROR = 133 - RETURN - 140 KSP = ONE / G - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 134 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = DATAN (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ14Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ORTHOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ14Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ14/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ14Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 142 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - KSP = ONE - IF (G.GT.ZERO .OR. DABS(G).LE.EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 143 - RETURN - 140 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 144 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. A) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ14Z0'/ - . ' INPUT DATA ERROR') - IERROR = 145 - RETURN - 230 Z = ASINZ0 (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ15Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GENERAL VERTICAL NEAR-SIDE PERSPECTIVE * -C ********************************************************************** -C - SUBROUTINE PJ15Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,P,LON0,LAT0,X0,Y0,SINPH0,COSPH0 *************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ15/ A,LON0,X0,Y0,COSPH0,LAT0,P,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ15Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 152 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GE. (ONE / P)) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 153 - RETURN - 140 KSP = (P - ONE) / (P - G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 154 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - R = RH / A - CON = P - ONE - COM = P + ONE - IF (R .LE. DSQRT (CON / COM)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ15Z0'/ - . ' INPUT DATA ERROR') - IERROR = 155 - RETURN - 230 SINZ = (P - DSQRT (ONE - R * R * COM / CON)) / - . (CON / R + R / CON) - Z = ASINZ0 (SINZ) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ16Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SINUSOIDAL * -C ********************************************************************** -C - SUBROUTINE PJ16Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ16/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ16Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 162 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS (GEOG(2)) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 163 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ16Z0'/ - . ' INPUT DATA ERROR') - IERROR = 164 - RETURN - 230 CON = DABS (GEOG(2)) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 240 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS (GEOG(2)))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ17Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIRECTANGULAR * -C ********************************************************************** -C - SUBROUTINE PJ17Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0,LAT1 ******************************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ17/ A,LON0,X0,Y0,LAT1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ17Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 172 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS(LAT1) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 173 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ17Z0'/ - . ' INPUT DATA ERROR') - IERROR = 174 - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS(LAT1) )) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ18Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MILLER CYLINDRICAL * -C ********************************************************************** -C - SUBROUTINE PJ18Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ18/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA FORTPI /0.78539816339744833D0/ - DATA ZERO,ONEQ,TWOH /0.0D0,1.25D0,2.5D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ18Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 182 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 + A * DLOG (DTAN (FORTPI + GEOG(2) / TWOH)) * ONEQ - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 183 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(1) = ADJLZ0 (LON0 + X / A) - GEOG(2) = TWOH * DATAN (DEXP (Y / A / ONEQ)) - FORTPI * TWOH - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ19Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * VAN DER GRINTEN I * -C ********************************************************************** -C - SUBROUTINE PJ19Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ19/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN/1.0D-10/ - DATA ZERO,HALF,ONE,TWO,THREE/0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ19Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 192 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (DABS(LAT) .GT. EPSLN) GO TO 140 - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 140 THETA = ASINZ0 (DMIN1(DABS (LAT /HALFPI),ONE)) - IF (DABS(LON).GT.EPSLN.AND.DABS(DABS(LAT)-HALFPI).GT.EPSLN) - . GO TO 160 - PROJ(1) = X0 - PROJ(2) = Y0 + PI * A * DSIGN( DTAN (HALF * THETA), LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 160 AL = HALF * DABS (PI / LON - LON / PI) - ASQ = AL * AL - SINTHT = DSIN (THETA) - COSTHT = DCOS (THETA) - G = COSTHT / (SINTHT + COSTHT - ONE) - GSQ = G * G - M = G * (TWO / SINTHT - ONE) - MSQ = M * M - CON = PI * A * (AL * (G - MSQ) + DSQRT (ASQ * (G - MSQ)**2 - - . (MSQ + ASQ) * (GSQ - MSQ))) / (MSQ + ASQ) - CON = DSIGN (CON , LON) - PROJ(1) = X0 + CON - CON = DABS (CON / (PI * A)) - PROJ(2) = Y0 + DSIGN (PI * A * DSQRT (ONE - CON * CON - - . TWO * AL * CON) , LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ALGORITHM DEVELOPED BY D.P. RUBINCAM, THE AMERICAN CARTOGRAPHER, -C 1981, V. 8, NO. 2, P. 177-180. -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 193 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - CON = PI * A - XX = X / CON - YY = Y / CON - XYS = XX * XX + YY * YY - C1 = -DABS(YY) * (ONE + XYS) - C2 = C1 - TWO * YY * YY + XX * XX - C3 = -TWO * C1 + ONE + TWO * YY * YY + XYS*XYS - D = YY * YY / C3 + (TWO * C2 * C2 * C2/ C3/ C3/ C3 - 9.0D0 * C1 - . * C2/ C3/ C3) / 27.0D0 - A1 = (C1 - C2 * C2/ THREE/ C3)/ C3 - M1 = TWO * DSQRT(-A1/ THREE) - CON = ((THREE * D) / A1) / M1 - IF (DABS(CON).GT.ONE) CON = DSIGN(ONE,CON) - TH1 = DACOS(CON)/THREE - GEOG(2) = (-M1 * DCOS(TH1 + PI/ THREE) - C2/ THREE/ C3) - . * DSIGN(PI,Y) - IF (DABS(XX).GE.EPSLN) GO TO 230 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 230 CONTINUE - GEOG(1) = LON0 + PI * (XYS - ONE + DSQRT(ONE + TWO * (XX * XX - . - YY * YY) + XYS * XYS))/ TWO/ XX - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ20Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * OBLIQUE MERCATOR (HOTINE) * -C ********************************************************************** -C - SUBROUTINE PJ20Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,KS0,ALPHA,LONC,LON1,LAT1,LON2,LAT2,LAT0 ** -C ********************** X0,Y0,GAMMA,LON0,AL,BL,EL ********************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ20/ LON0,X0,Y0,AL,BL,COSALF,COSGAM,E,EL,SINALF,SINGAM,U0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TOL,EPSLN /1.0D-7,1.0D-10/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - 2050 FORMAT ('0ERROR PJ20Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 204 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - DLON = ADJLZ0 (GEOG(1) - LON0) - VL = DSIN (BL * DLON) - IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 230 - UL = SINGAM * DSIGN (ONE , GEOG(2)) - US = AL * GEOG(2) / BL - GO TO 250 - 230 TS = TSFNZ0 (E,GEOG(2),SINPHI) - Q = EL / TS ** BL - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - UL = (S * SINGAM - VL * COSGAM) / T - CON = DCOS (BL * DLON) - IF (DABS(CON) .LT. TOL) GO TO 240 - US = AL * DATAN ((S * COSGAM + VL * SINGAM) / CON) / BL - IF (CON .LT. ZERO) US = US + PI * AL / BL - GO TO 250 - 240 US = AL * BL * DLON - 250 IF (DABS(DABS(UL) - ONE) .GT. EPSLN) GO TO 255 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2060) - 2060 FORMAT ('0ERROR PJ20Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 205 - RETURN - 255 VS = HALF * AL * DLOG ((ONE - UL) / (ONE + UL)) / BL - US = US - U0 - PROJ(1) = X0 + VS * COSALF + US * SINALF - PROJ(2) = Y0 + US * COSALF - VS * SINALF - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 280 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - IERROR = 206 - RETURN - 280 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - VS = X * COSALF - Y * SINALF - US = Y * COSALF + X * SINALF - US = US + U0 - Q = DEXP (- BL * VS / AL) - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - VL = DSIN (BL * US / AL) - UL = (VL * COSGAM + S * SINGAM) / T - IF (DABS (DABS (UL) - ONE) .GE. EPSLN) GO TO 300 - GEOG(1) = LON0 - GEOG(2) = DSIGN (HALFPI , UL) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 300 CON = ONE / BL - TS = (EL / DSQRT ((ONE + UL) / (ONE - UL))) ** CON - GEOG(2) = PHI2Z0 (E,TS) - CON = DCOS (BL * US / AL) - LON = LON0 - DATAN2 ((S * COSGAM - VL * SINGAM) , CON) / BL - GEOG(1) = ADJLZ0 (LON) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ21Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ROBINSON * -C ********************************************************************** -C - SUBROUTINE PJ21Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,IP1,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . PR(20),XLR(20) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ21/ A,LON0,X0,Y0,PR,XLR - COMMON /TOGGLE/ SWITCH - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ21Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 212 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - P2=DABS(GEOG(2)/5.0D0/DG1) - IP1=IDINT(P2-EPSLN) -C -C STIRLING'S INTERPOLATION FORMULA (USING 2ND DIFF.) -C USED WITH LOOKUP TABLE TO COMPUTE RECTANGULAR COORDINATES -C FROM LAT/LONG. -C - P2=P2-DBLE(IP1) - X=A*(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0)*LON - Y=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . *DSIGN(1.0D0,GEOG(2)) - PROJ(1) = X0 + X - PROJ(2) = Y0 + Y - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 213 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - YY = 2.0D0 * Y / PI / A - PHID = YY * 90.0D0 - P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - IF (IP1.EQ.0) IP1 = 1 - NN = 0 -C -C STIRLING'S INTERPOLATION FORMULA AS USED IN FORWARD TRANSFORMATION -C IS REVERSED FOR FIRST ESTIMATION OF LAT. FROM RECTANGULAR -C COORDINATES. LAT. IS THEN ADJUSTED BY ITERATION UNTIL USE OF -C FORWARD SERIES PROVIDES CORRECT VALUE OF Y WITHIN TOLERANCE. -C - 230 U = PR(IP1 + 3) - PR(IP1 + 1) - V = PR(IP1 + 3) - 2.0D0 * PR(IP1 + 2) + PR(IP1 + 1) - T = 2.0D0 * (DABS(YY) - PR(IP1 + 2))/ U - C = V / U - P2 = T * (1.0D0 - C * T * (1.0D0 - 2.0D0 * C * T)) - IF (P2.LT.0.0D0.AND.IP1.NE.1) GO TO 240 - PHID = DSIGN((P2 + DBLE(IP1)) * 5.0D0, Y) - 235 P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - P2 = P2 - DBLE(IP1) - Y1=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . * DSIGN(1.0D0,Y) - PHID = PHID - 180.0D0* (Y1 - Y) / PI / A - NN = NN + 1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,245) - IERROR = 214 - RETURN - 237 IF (DABS(Y1 - Y).GT.0.00001D0) GO TO 235 - GO TO 250 - 240 IP1 = IP1 - 1 - GO TO 230 - 245 FORMAT ('0ERROR PJ21Z0'/ - . ' TOO MANY ITERATIONS FOR INVERSE ROBINSON') - 250 GEOG(2) = PHID * DG1 -C -C CALCULATE LONG. USING FINAL LAT. WITH TRANSPOSED FORWARD -C STIRLING'S INTERPOLATION FORMULA. -C - GEOG(1)=LON0+X/A/(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0) - GEOG(1) = ADJLZ0(GEOG(1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ22Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SPACE OBLIQUE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ22Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,PATH,LAND,NN,L - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,MCS,TCS,FAC,IND ********** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - COMMON /PJ22/ A,X0,Y0,A2,A4,B,C1,C3,LAND,PATH - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ22Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 222 - RETURN - 220 IF (LAND.GE.4) GO TO 225 - LON=GEOG(1)-128.87D0*DG1+PI*TWO/251.D0*DBLE(PATH) - GO TO 230 - 225 LON=GEOG(1)-129.30D0*DG1+PI*TWO/233.D0*DBLE(PATH) - 230 LAT=GEOG(2) -C -C TEST FOR LAT. AND LONG. APPROACHING 90 DEGREES. -C - IF (LAT.GT.1.570796D0) LAT=1.570796D0 - IF (LAT.LT.-1.570796D0) LAT =-1.570796D0 - IF (LAT.GE.0) LAMPP=PI/TWO - IF (LAT.LT.0) LAMPP=1.5D0*PI - NN=0 - 231 SAV=LAMPP - L=0 - LAMTP=LON+P22*LAMPP - CL=DCOS(LAMTP) - IF (DABS(CL).LT.TOL) LAMTP=LAMTP-TOL - FAC=LAMPP-(DSIGN(ONE,CL))*DSIN(LAMPP)*PI/TWO - 232 LAMT=LON+P22*SAV - C=DCOS(LAMT) - IF (DABS(C).LT.TOL) THEN - LAMDP = SAV - GO TO 233 - END IF - XLAM=((ONE-ES)*DTAN(LAT)*SA+DSIN(LAMT)*CA)/C - LAMDP=DATAN(XLAM) - LAMDP=LAMDP+FAC - DIF=DABS(SAV)-DABS(LAMDP) - IF (DABS(DIF).LT.TOL) GO TO 233 - SAV=LAMDP - L=L+1 - IF (L.GT.50) GO TO 234 - GO TO 232 -C -C ADJUST FOR LANDSAT ORIGIN. -C - 233 RLM=PI*(16.D0/31.D0+ONE/248.D0) - RLM2=RLM+TWO*PI - NN=NN+1 - IF (NN.GE.3) GO TO 236 - IF (LAMDP.GT.RLM.AND.LAMDP.LT.RLM2) GO TO 236 - IF (LAMDP.LE.RLM) LAMPP=2.5D0*PI - IF (LAMDP.GE.RLM2) LAMPP=PI/TWO - GO TO 231 - 234 IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ22Z0'/ - . ' 50 ITERATIONS WITHOUT CONVERGENCE.') - IERROR = 223 - 236 CONTINUE -C -C LAMDP COMPUTED. NOW COMPUTE PHIDP. -C - SP=DSIN(LAT) - PHIDP=ASINZ0(((ONE-ES)*CA*SP-SA*DCOS(LAT)*DSIN(LAMT))/DSQRT(ONE - . -ES*SP*SP)) -C -C COMPUTE X AND Y -C - TANPH=DLOG(DTAN(PI/4.0D0+PHIDP/TWO)) - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE - . +Q*SDSQ))) - D=DSQRT(XJ*XJ+S*S) - X=B*LAMDP+A2*DSIN(TWO*LAMDP)+A4*DSIN(4.0D0*LAMDP)-TANPH*S/D - X=A*X - Y=C1*SD+C3*DSIN(3.0D0*LAMDP)+TANPH*XJ/D - Y=A*Y - PROJ(1)=X+X0 - PROJ(2)=Y+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 224 - RETURN - 320 X = PROJ(1) -X0 - Y = PROJ(2) -Y0 -C -C COMPUTE TRANSFORMED LAT/LONG AND GEODETIC LAT/LONG, GIVEN X,Y. -C -C BEGIN INVERSE COMPUTATION WITH APPROXIMATION FOR LAMDP. SOLVE -C FOR TRANSFORMED LONG. -C - LAMDP=X/A/B - NN=0 - 325 SAV=LAMDP - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE+Q - . *SDSQ))) - LAMDP=X/A+Y/A*S/XJ-A2*DSIN(TWO*LAMDP)-A4*DSIN(4.0D0*LAMDP) - . -(S/XJ)*(C1*DSIN(LAMDP)+C3*DSIN(3.0D0*LAMDP)) - LAMDP=LAMDP/B - DIF=LAMDP-SAV - IF (DABS(DIF).LT.TOL) GO TO 330 - NN=NN+1 - IF (NN.EQ.50) GO TO 330 - GO TO 325 -C -C COMPUTE TRANSFORMED LAT. -C - 330 SL=DSIN(LAMDP) - FAC=DEXP(DSQRT(ONE+S*S/XJ/XJ)*(Y/A-C1*SL-C3*DSIN(3.0D0*LAMDP))) - ACTAN=DATAN(FAC) - PHIDP=TWO*(ACTAN-PI/4.0D0) -C -C COMPUTE GEODETIC LATITUDE. -C - DD=SL*SL - IF (DABS(DCOS(LAMDP)).LT.TOL) LAMDP=LAMDP-TOL - SPP=DSIN(PHIDP) - SPPSQ=SPP*SPP - LAMT=DATAN(((ONE-SPPSQ/(ONE-ES))*DTAN(LAMDP)*CA-SPP*SA*DSQRT(( - . ONE+Q*DD)*(ONE-SPPSQ)-SPPSQ*U)/DCOS(LAMDP))/(ONE-SPPSQ*(ONE+U)) - . ) -C -C CORRECT INVERSE QUADRANT. -C - IF (LAMT.GE.0) SL=ONE - IF (LAMT.LT.0) SL=-ONE - IF (DCOS(LAMDP).GE.0) SCL=ONE - IF (DCOS(LAMDP).LT.0) SCL=-ONE - LAMT=LAMT-PI/TWO*(ONE-SCL)*SL - LON=LAMT-P22*LAMDP -C -C COMPUTE GEODETIC LATITUDE. -C - IF (DABS(SA).LT.TOL) LAT=ASINZ0(SPP/DSQRT((ONE-ES)*(ONE-ES) - . +ES*SPPSQ)) - IF (DABS(SA).LT.TOL) GO TO 335 - LAT=DATAN((DTAN(LAMDP)*DCOS(LAMT)-CA*DSIN(LAMT))/((ONE-ES)*SA)) - 335 CONTINUE - IF (LAND.GE.4) GO TO 370 - GEOG(1)=LON+128.87D0*DG1-PI*TWO/251.D0*DBLE(PATH) - GO TO 380 - 370 GEOG(1)=LON+129.30D0*DG1-PI*TWO/233.D0*DBLE(PATH) - 380 GEOG(2)=LAT - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ23Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) * -C ********************************************************************** -C - SUBROUTINE PJ23Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,N,J,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . ACOEF(6),BCOEF(6) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ23/ A,LON0,X0,Y0,ACOEF,BCOEF,EC,LAT0,CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ23Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 232 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) -C -C CALCULATE X-PRIME AND Y-PRIME FOR OBLIQUE STEREOGRAPHIC PROJ. -C FROM LAT/LONG. -C - SINLON = DSIN (LON) - COSLON = DCOS (LON) - ESPHI = EC *DSIN(GEOG(2)) - CHI=TWO*DATAN(DTAN((HALFPI+GEOG(2))/TWO)*((ONE-ESPHI)/(ONE - . +ESPHI))**(EC/TWO)) - HALFPI - SCHI=DSIN(CHI) - CCHI=DCOS(CHI) - G=SCHIO*SCHI+CCHIO*CCHI*COSLON - S=TWO/(ONE+G) - XP=S*CCHI*SINLON - YP=S*(CCHIO*SCHI-SCHIO*CCHI*COSLON) -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C OBLIQUE STEREOGRAPHIC TO MODIFIED-STEREOGRAPHIC COORD. -C - R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - DO 140 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 140 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - 140 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - X=XP*AR-YP*AI+BR - Y=YP*AR+XP*AI+BI - PROJ(1)=X*A+X0 - PROJ(2)=Y*A+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 234 - RETURN - 220 X = (PROJ(1) - X0)/A - Y = (PROJ(2) - Y0)/A - XP=X - YP=Y - NN=0 -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C MODIFIED-STEREOGRAPHIC CONFORMAL TO OBLIQUE STEREOGRAPHIC -C COORDINATES (XP,YP). -C - 225 R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - CR=DBLE(N)*AR - CI=DBLE(N)*AI - DR=(DBLE(N-1))*BR - DI=(DBLE(N-1))*BI - DO 230 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 230 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - CRN=DR+R*CR - CIN=DI+R*CI - DR=DBLE(N-J)*ACOEF(N-J)-S*CR - DI=DBLE(N-J)*BCOEF(N-J)-S*CI - CR=CRN - CI=CIN - 230 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - FXYR=XP*AR-YP*AI+BR-X - FXYI=YP*AR+XP*AI+BI-Y - FPXYR=XP*CR-YP*CI+DR - FPXYI=YP*CR+XP*CI+DI - DEN=FPXYR*FPXYR+FPXYI*FPXYI - DXP=-(FXYR*FPXYR+FXYI*FPXYI)/DEN - DYP=-(FXYI*FPXYR-FXYR*FPXYI)/DEN - XP=XP+DXP - YP=YP+DYP - DS=DABS(DXP)+DABS(DYP) - NN=NN+1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN ITERATING INVERSE') - IERROR = 235 - GO TO 238 - 237 IF (DS.GT.EPSLN) GO TO 225 -C -C CONVERT OBLIQUE STEREOGRAPHIC COORDINATES TO LAT/LONG. -C - 238 RH = DSQRT (XP * XP + YP * YP) - Z = TWO * DATAN (RH / TWO) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 CHI = ASINZ0 (COSZ * SCHIO + YP *SINZ * CCHIO / RH) - NN=0 - PHI=CHI - 250 ESPHI=EC*DSIN(PHI) - DPHI=TWO*DATAN(DTAN((HALFPI+CHI)/TWO)*((ONE+ESPHI)/(ONE-ESPHI)) - . **(EC/TWO)) - HALFPI - PHI - PHI = PHI + DPHI - NN = NN + 1 - IF (NN.LE.20) GO TO 257 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,255) - 255 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN CALCULATING PHI FROM CHI') - IERROR = 236 - GO TO 260 - 257 IF (DABS(DPHI).GT.EPSLN) GO TO 250 - 260 GEOG(2)=PHI - GEOG(1) = ADJLZ0 (LON0 + DATAN2(XP*SINZ, RH*CCHIO*COSZ-YP*SCHIO - . *SINZ)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C QSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION QSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL Q). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-7/ -C - IF (ECCENT .LT. EPSLN) GO TO 020 - CON = ECCENT * SINPHI - QSFNZ0 = (ONE - ECCENT * ECCENT) * (SINPHI / (ONE - CON * CON) - - . (HALF / ECCENT) * DLOG ((ONE - CON) / (ONE + CON))) - RETURN -C - 020 QSFNZ0 = TWO * SINPHI - RETURN - END -C RADDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE RADDZ0 (RAD,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT ANGLE FROM RADIANS TO SIGNED DMS -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - REAL*8 RAD,CON,RADSEC,ZERO,TOL - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,BLANK,NEG - DATA RADSEC /206264.806247D0/ - DATA ZERO,TOL /0.0D0,1.0D-4/ - DATA BLANK,NEG /' ','-'/ -C -C CONVERT THE ANGLE TO SECONDS. -C - CON = DABS(RAD) * RADSEC - ISEC = IDINT(CON + TOL) -C -C DETERMINE THE SIGN OF THE ANGLE. -C - SGNA = BLANK - IF (RAD .LT. ZERO .AND. CON .GE. 0.00005D0) SGNA = NEG - IF (CON .LT. 0.00005D0) CON = ZERO -C -C COMPUTE DEGREES PART OF THE ANGLE. -C - INTG = ISEC / 3600 - DEGS = INTG - ISEC = INTG * 3600 - CON = CON - DBLE(ISEC) - ISEC = IDINT(CON + TOL) -C -C COMPUTE MINUTES PART OF THE ANGLE. -C - MINS = ISEC / 60 - ISEC = MINS * 60 - CON = CON - DBLE(ISEC) -C -C COMPUTE SECONDS PART OF THE ANGLE. -C - SECS = SNGL(CON) -C -C INCREASE MINS IF SECS CLOSE TO 60.000 -C - IF(SECS .LT. 59.9995D0) RETURN - MINS = MINS + 1 - SECS = 0.0 -C -C INCREASE DEGS IF MINS EQUAL 60 -C - IF(MINS .LE. 59) RETURN - MINS = 0 - DEGS = DEGS + 1 -C - RETURN - END -C SERAZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) -C -C COMPUTES INTEGRAL FUNCTION OF TRANSFORMED LONG. FOR FOURIER -C CONSTANTS A2, A4, B, C1, AND C3. -C LAM IS INTEGRAL VALUE OF TRANSFORMED LONG. -C - IMPLICIT REAL*8 (A-Z) - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - DATA DG1 /0.01745329252D0/ - DATA ONE,TWO /1.0D0,2.0D0/ - LAM=LAM*DG1 - SD=DSIN(LAM) - SDSQ=SD*SD - S=P22*SA*DCOS(LAM)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ) - . *(ONE+Q*SDSQ))) - H=DSQRT((ONE+Q*SDSQ)/(ONE+W*SDSQ))*(((ONE+W*SDSQ)/ - . ((ONE+Q*SDSQ)**TWO))-P22*CA) - SQ=DSQRT(XJ*XJ+S*S) - FB=(H*XJ-S*S)/SQ - FA2=FB*DCOS(TWO*LAM) - FA4=FB*DCOS(4.0D0*LAM) - FC=S*(H+XJ)/SQ - FC1=FC*DCOS(LAM) - FC3=FC*DCOS(3.0D0*LAM) - RETURN - END -C SPHDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SPHDZ0(ISPH,PARM) -C -C SUBROUTINE TO COMPUTE SPHEROID PARAMETERS -C -C ISPH IS THE SPHEROID CODE FROM THE FOLLOWING LIST: -C 0 = CLARKE 1866 1 = CLARKE 1880 -C 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C 4 = INTERNATIONAL 1909 5 = WGS 72 -C 6 = EVEREST 7 = WGS 66 -C 8 = GRS 1980 9 = AIRY -C 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C 12 = WGS 84 13 = SOUTHEAST ASIA -C 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C 16 = HOUGH 17 = MERCURY 1960 -C 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C 20 = INTERNATIONAL 1924 -C -C PARM IS ARRAY OF PROJECTION PARAMETERS: -C PARM(1) IS THE SEMI-MAJOR AXIS -C PARM(2) IS THE ECCENTRICITY SQUARED -C -C IF ISPH IS NEGATIVE, USER SPECIFIED PROJECTION PARAMETERS ARE TO -C DEFINE THE RADIUS OF SPHERE OR ELLIPSOID CONSTANTS AS APPROPRIATE -C -C IF ISPH = 0 , THE DEFAULT IS RESET TO CLARKE 1866 -C -C **** ***** -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION PARM(15),AXIS(21),BXIS(21) -C - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PROJZ0/ IPROJ -C - DATA ZERO,ONE /0.0D0,1.0D0/ -C - DATA AXIS/6378206.4D0,6378249.145D0,6377397.155D0,6378157.5D0, - . 6378388.0D0,6378135.0D0,6377276.3452D0,6378145.0D0,6378137.0D0, - . 6377563.396D0,6377304.063D0,6377340.189D0,6378137.0D0,6378155.D0, - . 6378160.0D0,6378245.0D0,6378270.0D0,6378166.0D0,6378150.0D0, - . 6370997.0D0,6378388.0D0/ -C - DATA BXIS/6356583.8D0,6356514.86955D0,6356078.96284D0, - . 6356772.2D0,6356911.94613D0,6356750.519915D0,6356075.4133D0, - . 6356759.769356D0,6356752.314140D0,6356256.91D0,6356103.039D0, - . 6356034.448D0,6356752.314245D0,6356773.3205D0,6356774.719D0, - . 6356863.0188D0,6356794.343479D0,6356784.283666D0,6356768.337303D0 - . ,6370997.0D0,6356911.95D0/ -C - IF (ISPH.GE.0) GO TO 5 -C -C INITIALIZE USER SPECIFIED SPHERE AND ELLIPSOID PARAMETERS -C - AZZ = ZERO - AZ = ZERO - EZ = ZERO - ESZ = ZERO - E0Z = ZERO - E1Z = ZERO - E2Z = ZERO - E3Z = ZERO - E4Z = ZERO -C -C FETCH FIRST TWO USER SPECIFIED PROJECTION PARAMETERS -C - A = DABS(PARM(1)) - B = DABS(PARM(2)) - IF (A .GT. ZERO .AND. B .GT. ZERO) GO TO 13 - IF (A .GT. ZERO .AND. B .LE. ZERO) GO TO 12 - IF (A .LE. ZERO .AND. B .GT. ZERO) GO TO 11 -C -C DEFAULT NORMAL SPHERE AND CLARKE 1866 ELLIPSOID -C - JSPH = 1 - GO TO 10 -C -C DEFAULT CLARKE 1866 ELLIPSOID -C - 11 A = AXIS(1) - B = BXIS(1) - GO TO 14 -C -C USER SPECIFIED RADIUS OF SPHERE -C - 12 AZZ = A - GO TO 15 -C -C USER SPECIFIED SEMI-MAJOR AND SEMI-MINOR AXES OF ELLIPSOID -C - 13 IF (B .LE. ONE) GO TO 15 - 14 ES = ONE - (B / A)**2 - GO TO 16 -C -C USER SPECIFIED SEMI-MAJOR AXIS AND ECCENTRICITY SQUARED -C - 15 ES = B - 16 AZ = A - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - PARM(1) = A - PARM(2) = ES - RETURN -C -C CHECK FOR VALID SPHEROID SELECTION -C - 5 IF (PARM(1).NE.ZERO.AND.IPROJ.NE.1) RETURN - JSPH = IABS(ISPH) + 1 - IF (JSPH.LE.21) GO TO 10 - IERROR = 999 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,1) ISPH - 1 FORMAT('0ERROR SPHDZ0: SPHEROID CODE OF ',I5,' RESET TO 0') - ISPH = 0 - JSPH = 1 -C -C RETRIEVE A AND B AXES FOR SELECTED SPHEROID -C - 10 A = AXIS(JSPH) - B = BXIS(JSPH) - ES = ONE - (B / A)**2 -C -C SET COMMON BLOCK PARAMETERS FOR SELECTED SPHEROID -C - AZZ = 6370997.0D0 - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - AZ = A - ESZ = ES - IF (ES.EQ.ZERO) AZZ=A -C - PARM(1) = A - PARM(2) = ES - RETURN - END -C TSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION TSFNZ0 (ECCENT,PHI,SINPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL T). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE /0.5D0,1.0D0/ - DATA HALFPI /1.5707963267948966D0/ -C - CON = ECCENT * SINPHI - COM = HALF * ECCENT - CON = ((ONE - CON) / (ONE + CON)) ** COM - TSFNZ0 = DTAN (HALF * (HALFPI - PHI)) / CON -C - RETURN - END -C UNTFZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE UNTFZ0 (INUNIT,IOUNIT,FACTOR,IFLG) -C -C SUBROUTINE TO DETERMINE CONVERGENCE FACTOR BETWEEN TWO LINEAL UNITS -C -C * INPUT ........ -C * INUNIT * UNIT CODE OF SOURCE. -C * IOUNIT * UNIT CODE OF TARGET. -C -C * OUTPUT ....... -C * FACTOR * CONVERGENCE FACTOR FROM SOURCE TO TARGET. -C * IFLG * RETURN FLAG .EQ. 0 , NORMAL RETURN. -C RETURN FLAG .NE. 0 , ABNORMAL RETURN. -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION FACTRS(6,6) - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - PARAMETER (ZERO = 0.0D0, MAXUNT = 6) - DATA FACTRS /0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.2062648062470963D06 , - . 0.5729577951308231D02 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.3048006096012192D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000002000004000D01 , - . 0.0000000000000000D00 , 0.3280833333333333D01 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3280839895013124D01 , - . 0.4848136811095360D-5 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.2777777777777778D-3 , 0.0000000000000000D00 , - . 0.1745329251994330D-1 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3600000000000000D04 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.9999980000000000D00 , - . 0.3048000000000000D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 / -C - IF (INUNIT .GE. 0 .AND. INUNIT .LT. MAXUNT .AND. - . IOUNIT .GE. 0 .AND. IOUNIT .LT. MAXUNT) THEN - FACTOR = FACTRS(IOUNIT+1 , INUNIT+1) - IF (FACTOR .NE. ZERO) THEN - IFLG = 0 - RETURN - ELSE - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INUNIT,IOUNIT - 2000 FORMAT (' INCONSISTENT UNIT CODES = ',I6,' / ',I6) - IFLG = 12 - RETURN - END IF - ELSE - IF (INUNIT.LT.0 .OR. INUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) INUNIT,IOUNIT - 2010 FORMAT (' ILLEGAL SOURCE OR TARGET UNIT CODE = ',I6,' / ', - . I6) - END IF - IF (IOUNIT.LT.0 .OR. IOUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOUNIT,IOUNIT - END IF - IFLG = 11 - RETURN - END IF -C - END diff --git a/CALPUFF_SRC/CALMET/cpl.bat b/CALPUFF_SRC/CALMET/cpl.bat deleted file mode 100644 index f2f6a69..0000000 --- a/CALPUFF_SRC/CALMET/cpl.bat +++ /dev/null @@ -1,14 +0,0 @@ -REM Compiling and linking with CALMET using Lahey LF95 for Windows - -lf95 calmet.for -o0 -co -sav -trap doi -out calmet.exe >cpl.txt - -del *.obj -del *.map - -rem Switch settings ------------------------------ -rem -o0 No optimization -rem -co Display the compiler options that are used -rem -sav Save local variables -rem -trap doi Trap NDP divide-by-zero (d), overflow (o), and invalid operation (i) -rem -out Name the compiled executable to "calmet.exe" -rem > Send compiler screen output to file "cpl.txt" diff --git a/CALPUFF_SRC/CALMET/cpl.txt b/CALPUFF_SRC/CALMET/cpl.txt deleted file mode 100644 index 792696b..0000000 --- a/CALPUFF_SRC/CALMET/cpl.txt +++ /dev/null @@ -1,283 +0,0 @@ -Lahey/Fujitsu Fortran 95 Express Release 7.20.00 S/N: 00608146752761010 -Copyright (C) 1994-2009 Lahey Computer Systems. All rights reserved. -Copyright (C) 1998-2009 FUJITSU LIMITED. All rights reserved. -Options: --nap -nc -nchk -nchkglobal -concc --ndal -ndbl -ndll -nf95 -fix --ng -nin -ninfo -ninline -li --nlst -nlong -maxfatals 50 -o0 -out calmet.exe --npause -nprefetch -nprivate -npca -nquad --sav -nsse2 -staticlib -nstaticlink -stchk --tpp -trace -trap doi -nunroll -nvarheap --w -nwide -winconsole -nwo -nxref --zero -nzfm - -Compiling program unit calmet at line 1: -Compiling program unit __BLKDT__ at line 1706: -Compiling program unit xtractll at line 1890: -Compiling program unit yr4 at line 276: -Compiling program unit yr4c at line 327: -Compiling program unit qayr4 at line 371: -Compiling program unit julday at line 458: -Compiling program unit grday at line 523: -Compiling program unit dedat at line 573: -Compiling program unit deltt at line 601: -Compiling program unit incr at line 667: -Compiling program unit indecr at line 761: -Compiling program unit incrs at line 840: -Compiling program unit deltsec at line 907: -Compiling program unit midnite at line 951: -Compiling program unit utcbasr at line 1020: -Compiling program unit basrutc at line 1056: -Compiling program unit filcase at line 1103: -Compiling program unit readin at line 1177: -Compiling program unit altonu at line 1829: -Compiling program unit deblnk at line 2165: -Compiling program unit deplus at line 2226: -Compiling program unit tright at line 2282: -Compiling program unit tleft at line 2360: -Compiling program unit setvar at line 2439: -Compiling program unit allcap at line 2535: -Compiling program unit datetm at line 2587: -Compiling program unit fmt_date at line 2655: -Compiling program unit etime at line 2790: -Compiling program unit undrflw at line 2811: -Compiling program unit comline at line 2844: -Compiling program unit open_err at line 2900: -Compiling program unit globe1 at line 2953: -Compiling program unit globe at line 293: -Compiling program unit nimadate at line 456: -Compiling program unit coordsver at line 487: -Compiling program unit COORDS at line 573: -Compiling program unit DATUMS at line 1989: -Compiling program unit PRJCHK at line 1994: -Compiling program unit ERRPRT at line 2061: -Compiling program unit ll2zon at line 2132: -Compiling program unit dd2dms at line 2200: -Compiling program unit dat2dat at line 2243: -Compiling program unit datshft at line 2422: -Compiling program unit init at line 2563: -Compiling program unit ADJLZ0 at line 2648: -Compiling program unit ASINZ0 at line 2680: -Compiling program unit DMSPZ0 at line 2700: -Compiling program unit E0FNZ0 at line 2727: -Compiling program unit E1FNZ0 at line 2745: -Compiling program unit E2FNZ0 at line 2764: -Compiling program unit E3FNZ0 at line 2782: -Compiling program unit E4FNZ0 at line 2798: -Compiling program unit GTPZ0 at line 2817: -Compiling program unit MLFNZ0 at line 3368: -Compiling program unit MSFNZ0 at line 3386: -Compiling program unit PAKCZ0 at line 3404: -Compiling program unit PAKDZ0 at line 3441: -Compiling program unit PAKRZ0 at line 3474: -Compiling program unit PAKSZ0 at line 3497: -Compiling program unit PHI1Z0 at line 3553: -Compiling program unit PHI2Z0 at line 3598: -Compiling program unit PHI3Z0 at line 3638: -Compiling program unit PHI4Z0 at line 3675: -Compiling program unit PJINIT at line 3726: -Compiling program unit PJ01Z0 at line 5310: -Compiling program unit PJ02Z0 at line 5372: -Compiling program unit PJ03Z0 at line 5485: -Compiling program unit PJ04Z0 at line 5575: -Compiling program unit PJ05Z0 at line 5672: -Compiling program unit PJ06Z0 at line 5753: -Compiling program unit PJ07Z0 at line 5842: -Compiling program unit PJ08Z0 at line 5934: -Compiling program unit PJ09Z0 at line 6014: -Compiling program unit PJ10Z0 at line 6173: -Compiling program unit PJ11Z0 at line 6279: -Compiling program unit PJ12Z0 at line 6393: -Compiling program unit PJ13Z0 at line 6509: -Compiling program unit PJ14Z0 at line 6614: -Compiling program unit PJ15Z0 at line 6725: -Compiling program unit PJ16Z0 at line 6841: -Compiling program unit PJ17Z0 at line 6923: -Compiling program unit PJ18Z0 at line 6998: -Compiling program unit PJ19Z0 at line 7068: -Compiling program unit PJ20Z0 at line 7192: -Compiling program unit PJ21Z0 at line 7308: -Compiling program unit PJ22Z0 at line 7436: -Compiling program unit PJ23Z0 at line 7635: -Compiling program unit QSFNZ0 at line 7831: -Compiling program unit RADDZ0 at line 7854: -Compiling program unit SERAZ0 at line 7919: -Compiling program unit SPHDZ0 at line 7951: -Compiling program unit TSFNZ0 at line 8102: -Compiling program unit UNTFZ0 at line 8123: -Compiling program unit outauxhd at line 1895: -Compiling program unit auxout at line 174: -Compiling program unit xtract at line 407: -Compiling program unit comprs at line 457: -Compiling program unit wrdat at line 540: -Compiling program unit wrint at line 573: -Compiling program unit prfvar at line 606: -Compiling program unit z2face at line 722: -Compiling program unit adjust at line 1900: -Compiling program unit airden at line 2051: -Compiling program unit avemix at line 2103: -Compiling program unit avetmp at line 2355: -Compiling program unit barier at line 2589: -Compiling program unit r2interpi at line 2706: -Compiling program unit r2interp at line 2771: -Compiling program unit r2interp2 at line 2836: -Compiling program unit cinterp at line 2897: -Compiling program unit box at line 2974: -Compiling program unit cgamma at line 3030: -Compiling program unit cgamma2 at line 3252: -Compiling program unit chksum at line 3398: -Compiling program unit cmpd2 at line 3426: -Compiling program unit comp at line 3461: -Compiling program unit diag2 at line 4899: -Compiling program unit diagi at line 4961: -Compiling program unit diagno at line 5252: -Compiling program unit divcel at line 6245: -Compiling program unit divpr at line 6304: -Compiling program unit elustr at line 6332: -Compiling program unit elustr2 at line 6579: -Compiling program unit esat at line 6897: -Compiling program unit facet at line 6928: -Compiling program unit fillgeo at line 6982: -Compiling program unit fin at line 7105: -Compiling program unit fminf at line 7255: -Compiling program unit fradj at line 7288: -Compiling program unit gride at line 7456: -Compiling program unit INTERPQR at line 7747: -Compiling program unit heatfx at line 7998: -Compiling program unit inter2 at line 8123: -Compiling program unit interb at line 8617: -Compiling program unit interp at line 8676: -Compiling program unit intp at line 9121: -Compiling program unit ireplac at line 9215: -Compiling program unit llbreez at line 9280: -Compiling program unit microi at line 9492: -Compiling program unit minim at line 9644: -Compiling program unit missfc at line 9761: -Compiling program unit mixdt at line 10004: -Compiling program unit mixdt2 at line 10202: -Compiling program unit mixht at line 10410: -Compiling program unit mixhtST at line 10683: -Compiling program unit mixht2 at line 10936: -Compiling program unit mixht2ST at line 11126: -Compiling program unit MIXHBG at line 11302: -Compiling program unit fbg at line 11544: -Compiling program unit mixhmc at line 11557: -Compiling program unit openot at line 11743: -Compiling program unit out at line 12048: -Compiling program unit outfil at line 12277: -Compiling program unit outhd at line 12326: -Compiling program unit surfvar at line 12543: -Compiling program unit outhr at line 13065: -Compiling program unit pack at line 13238: -Compiling program unit pgtstb at line 13294: -Compiling program unit prepdi at line 13499: -Compiling program unit progrd at line 14131: -Compiling program unit qcksrt3 at line 14421: -Compiling program unit rdhd at line 14574: -Compiling program unit rdhdu at line 15088: -Compiling program unit rdhdow at line 15435: -Compiling program unit rdhd4 at line 15971: -Compiling program unit rdhd5 at line 16422: -Compiling program unit rdhd51 at line 16925: -Compiling program unit rdhd52 at line 17273: -Compiling program unit rdhd53 at line 17658: -Compiling program unit rdhdmet at line 18314: -Compiling program unit RDCALMET at line 19056: -Compiling program unit rdmet2 at line 19290: -Compiling program unit rdmm4 at line 19684: -Compiling program unit rdmm5 at line 20612: -Compiling program unit STULL at line 22483: -Compiling program unit STULL0 at line 22595: -Compiling program unit rdnwd at line 22650: -Compiling program unit rdow at line 22675: -Compiling program unit rdp at line 22990: -Compiling program unit rdpn at line 23103: -Compiling program unit rds at line 23308: -Compiling program unit rdsn at line 23436: -Compiling program unit rdup at line 23661: -Compiling program unit rdupn at line 24011: -Compiling program unit rdupn2 at line 24445: -Compiling program unit rdwt at line 24924: -Compiling program unit readcf at line 25062: -Compiling program unit readge at line 27789: -Compiling program unit lrsame at line 28429: -Compiling program unit readhd at line 28476: -Compiling program unit rreplac at line 29476: -Compiling program unit rsqwts at line 29540: -Compiling program unit rtheta at line 29659: -Compiling program unit setcom at line 29717: -Compiling program unit setup at line 29897: -Compiling program unit similt at line 30096: -Compiling program unit slope at line 30371: -Compiling program unit smooth at line 30605: -Compiling program unit cloud3 at line 30682: -Compiling program unit cloud4 at line 30736: -Compiling program unit solar at line 30869: -Compiling program unit stheor at line 30991: -Compiling program unit temp3d at line 31158: -Compiling program unit setcoast at line 31710: -Compiling program unit terset at line 31803: -Compiling program unit topof2 at line 31903: -Compiling program unit unidot at line 32053: -Compiling program unit unpack at line 32078: -Compiling program unit unpcks at line 32136: -Compiling program unit vertav at line 32252: -Compiling program unit water at line 32403: -Compiling program unit waterp at line 33085: -Compiling program unit DELTAT at line 33542: -Compiling program unit water2 at line 33719: -Compiling program unit water2p at line 34153: -Compiling program unit COARE at line 34503: -Compiling program unit bulk_flux at line 34902: -Compiling program unit ASL at line 35188: -Compiling program unit humidity at line 35411: -Compiling program unit psiu at line 35426: -Compiling program unit psit at line 35465: -Compiling program unit ZETA at line 35494: -Compiling program unit H_ADJUST at line 35533: -Compiling program unit gravity at line 35591: -Compiling program unit psiuD at line 35627: -Compiling program unit psitD at line 35672: -Compiling program unit radflx at line 35708: -Compiling program unit wind1 at line 35828: -Compiling program unit windbc at line 36403: -Compiling program unit windpr at line 36442: -Compiling program unit wndlpt at line 36492: -Compiling program unit wndpr2 at line 36592: -Compiling program unit wrt at line 36633: -Compiling program unit wrt2 at line 36670: -Compiling program unit wrti1d at line 36695: -Compiling program unit wrti2d at line 36733: -Compiling program unit wrtr1d at line 36789: -Compiling program unit wrtr2d at line 36828: -Compiling program unit wstarr at line 36883: -Compiling program unit xmit at line 36950: -Compiling program unit outpc1 at line 36976: -Compiling program unit outpc at line 37084: -Compiling program unit wpcr2d at line 37233: -Compiling program unit wpci2d at line 37275: -Compiling program unit pacave at line 37316: -Compiling program unit readfn at line 37497: -Compiling program unit wrfiles at line 37959: -Compiling program unit rdcld at line 38180: -Compiling program unit rdcldn at line 38289: -Compiling program unit outcld at line 38417: -Compiling program unit rdi1d at line 38528: -Compiling program unit rdr1d at line 38589: -Compiling program unit rdr2d at line 38650: -Compiling program unit rdi2d at line 38750: -Compiling program unit tfercf at line 38842: -Compiling program unit qaplot1 at line 38926: -Compiling program unit airden_ns at line 39061: -Compiling program unit t2d_nsp at line 39114: -Compiling program unit psiuc at line 39173: -Compiling program unit surfvar_back at line 39223: -Compiling program unit temp3d_back at line 39305: -Compiling program unit inout at line 40017: -Encountered 0 errors, 0 warnings in file calmet.for. -Microsoft (R) Incremental Linker Version 6.00.8447 -Copyright (C) Microsoft Corp 1992-1998. All rights reserved. - -calmet.exe : warning LNK4084: total image size 892452864 exceeds max (268435456); image may not run -Compiling file calmet.for. diff --git a/CALPUFF_SRC/CALMET/d1.met b/CALPUFF_SRC/CALMET/d1.met deleted file mode 100644 index d5d57b4..0000000 --- a/CALPUFF_SRC/CALMET/d1.met +++ /dev/null @@ -1,15 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /D1/ -- Wind field common block #1 CALMET -c---------------------------------------------------------------------- -c - COMMON /D1/ U(mxnx,mxny,mxnz),V(mxnx,mxny,mxnz), - 1 W(mxnx,mxny,mxnzp1), UB(mxny,2,mxnz), VB(mxnx,2,mxnz), - 1 USLOPE(mxnx,mxny,mxnz), VSLOPE(mxnx,mxny,mxnz), - 1 UG(mxnx,mxny,mxnz), VG(mxnx,mxny,mxnz), - 1 HTOPO(mxnx,mxny), HMAX(mxnx,mxny), - 1 UTMXST(mxwnd), UTMYST(mxwnd), WT(mxwnd), - 1 RS(mxwnd), IS(mxwnd), IST(mxwnd), JST(mxwnd), - 1 US(mxnz,mxwnd), VS(mxnz,mxwnd), - 1 CELLZB(mxnzp1), CELLZC(mxnz), - 1 PEXP(7), FEXTRP(mxnz), DIV(mxnx,mxny,mxnz), - 1 NINTRP(mxnz) diff --git a/CALPUFF_SRC/CALMET/d3.met b/CALPUFF_SRC/CALMET/d3.met deleted file mode 100644 index 277ff81..0000000 --- a/CALPUFF_SRC/CALMET/d3.met +++ /dev/null @@ -1,21 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /D3/ -- Wind field common block #3 -BARRIERS- CALMET -c---------------------------------------------------------------------- -c - COMMON /D3/ NBAR, KBAR, BARXY(4,MXBAR), IFIN, SLPIN(2,MXBAR) -C -C NBAR (I) - NUMBER OF BARRIERS (UP TO MXBAR) -c KBAR (I) - Vertical level up to which barriers are applied -c -C BARXY(1,MXBAR) (R) - X COORDINATE OF FIRST BARRIER END POINT -c (in km relative to CALMET origin) -C BARXY(2,MXBAR) (R) - Y COORDINATE OF FIRST BARRIER END POINT -c (in km relative to CALMET origin) -C BARXY(3,MXBAR) (R) - X COORDINATE OF SECOND BARRIER END POINT -c (in km relative to CALMET origin) -C BARXY(4,MXBAR) (R) - Y COORDINATE OF SECOND BARRIER END POINT -c (in km relative to CALMET origin) -C IFIN (I) - IF 0 SET UP PT SLOPE LINES -c SLPIN(1,mxbar) (R) - SLOPE OF LINE -C SLPIN(2,mxbar) (R) - INTERCEPT OF LINE - diff --git a/CALPUFF_SRC/CALMET/d4.met b/CALPUFF_SRC/CALMET/d4.met deleted file mode 100644 index 41fc75a..0000000 --- a/CALPUFF_SRC/CALMET/d4.met +++ /dev/null @@ -1,5 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /D4/ -- Wind field common block #4 CALMET -c---------------------------------------------------------------------- -c - COMMON /D4/ EDIT, EDITL, IEDIT, IEDITL diff --git a/CALPUFF_SRC/CALMET/d6.met b/CALPUFF_SRC/CALMET/d6.met deleted file mode 100644 index 0a704c1..0000000 --- a/CALPUFF_SRC/CALMET/d6.met +++ /dev/null @@ -1,5 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /D6/ -- Wind field common block #6 CALMET -c---------------------------------------------------------------------- -c - common/d6/ird,iwr,ifile,irdp diff --git a/CALPUFF_SRC/CALMET/filnam.met b/CALPUFF_SRC/CALMET/filnam.met deleted file mode 100644 index bf3a372..0000000 --- a/CALPUFF_SRC/CALMET/filnam.met +++ /dev/null @@ -1,88 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /FILNAM/ -- CALMET file names CALMET -c---------------------------------------------------------------------- -c - character*132 metinp,geodat,srfdat,prcdat,diadat,prgdat, - 1 mm4dat,wtdat,updat,seadat,metlst,metdat,pacdat,tstprt, - 2 tstout,tstkin,tstfrd,tstslp,clddat,m3ddat,igfdat,dcstgd - logical lcfiles -c - common/filnam/metinp,geodat,srfdat,prcdat,diadat,prgdat, - 1 mm4dat,wtdat,updat(mxus),seadat(mxows),metlst,metdat,pacdat, - 2 tstprt,tstout,tstkin,tstfrd,tstslp,clddat,m3ddat(mxm3d), - 3 igfdat(mxigf),dcstgd - common/fillog/lcfiles -c -c --- COMMON BLOCK /FILNAM/, /FILLOG/ Variables: -c METINP - char*132- Path & filename for the control file -c (default: CALMET.INP) -c GEODAT - char*132- Path & filename for the geophysical data -c file (default: GEO.DAT) -c SRFDAT - char*132- Path & filename for the hourly surface -c meteorological data file -c (default: SURF.DAT) -c PRCDAT - char*132- Path & filename for the hourly -c precipitation data file -c (default: PRECIP.DAT) -c DIADAT - char*132- Path & filename for the preprocessed -c meteorological diagnostic wind data -c (default: DIAG.DAT) -c PRGDAT - char*132- Path & filename for the gridded CSUMM -c meteorological fields -c (default: PROG.DAT) -c MM4DAT - char*132- Path & filename for the gridded MM4 -c meteorological fields -c (default: MM4.DAT) -c WTDAT - char*132- Path & filename for the gridded terrain -c weighting factors used to weight observed -c winds and the MM4 winds -c (default: WT.DAT) -c UPDAT(mxus) - char*132- Path & filenames for the upper air data -c array files (default: UPn.DAT, n=1,2,3,...) -c SEADAT(mxows) - char*132- Path & filenames for the overwater data -c array files (default: SEAn.DAT, n=1,2,3,...) -c METLST - char*132- Path & filename for the output CALMET -c list file -c (default: CALMET.LST) -c METDAT - char*132- Path & filename for the output CALMET -c binary meteorological file in -c CALPUFF/CALGRID format -c (default: CALMET.DAT) -c PACDAT - char*132- Path & filename for the output CALMET -c binary meteorological file in MESOPUFF II -c format -c (default: PACOUT.DAT) -c TSTPRT - char*132- Path & filename for the test/debug output -c file from the wind field module containing -c intermediate winds and misc. input and -c internal variables -c (default: TEST.DAT) -c TSTOUT - char*132- Path & filename for the test/debug output -c file from the wind field module containing -c the final wind fields -c (default: TEST.OUT) -c TSTKIN - char*132- Path & filename for the test/debug output -c file from the wind field module containing -c the wind fields after kinematic effects -c (default: TEST.KIN) -c TSTFRD - char*132- Path & filename for the test/debug output -c file from the wind field module containing -c the wind fields after Froude No. effects -c (default: TEST.FRD) -c TSTSLP - char*132- Path & filename for the test/debug output -c file from the wind field module containing -c the wind fields after slope flow effects -c (default: TEST.SLP) -c LCFILES - logical - Switch indicating if all characters in the -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c case letters (LCFILES=F). -c CLDDAT - char*132- Path & filename for the hourly gridded -c cloud data file -c (default: CLOUD.DAT) -c M3DDAT(mxm3d) - char*132- Path & filenames for 3D.DAT files -c array (default: MM5n.DAT, n=1,2,3,...) -c IGFDAT(mxigf) - char*132- Path & filenames for IGF.DAT files -c array (default: IGFn.DAT, n=1,2,3,...) -c DCSTGD - char*132- Path & filename for the "distance-to-the-coast -c file (.GRD format) diff --git a/CALPUFF_SRC/CALMET/flags.met b/CALPUFF_SRC/CALMET/flags.met deleted file mode 100644 index d6834b4..0000000 --- a/CALPUFF_SRC/CALMET/flags.met +++ /dev/null @@ -1,14 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /FLAGS/ -- Runtime message controls CALMET -c---------------------------------------------------------------------- -c - logical lmesg -c - common/flags/lmesg,iomesg -c -c --- COMMON BLOCK /FLAGS/ Variables: -c LMESG - logical - Messages tracking progress of run -c printed to the screen or disk file ? -c (F = no, T = yes) -c IOMESG - integer - Fortran unit number of screen or disk -c file for run progress messages diff --git a/CALPUFF_SRC/CALMET/gen.met b/CALPUFF_SRC/CALMET/gen.met deleted file mode 100644 index 49ccab8..0000000 --- a/CALPUFF_SRC/CALMET/gen.met +++ /dev/null @@ -1,81 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /GEN/ -- General run data CALMET -c---------------------------------------------------------------------- -c - logical*4 lcalgrd - character*8 axtz -c - common/gen/ibyr,ibmo,ibdy,ibjul,ibhr,ibyrn,ibmon,ibdyn,ibjuln, - 1 ibhrn,ibsecn,ieyrn,iemon,iedyn,iejuln,iehrn,iesecn,axtz,ibtz, - 2 irlg,irsublg,nsecdt,nyr,nmo,nday,njul,nhr,nhrind,ndathr, - 3 nyrb,nmob,ndayb,njulb,nhrb,nsecb,nyre,nmoe,ndaye,njule,nhre, - 4 nsece,ndathrb,ndathre,irtype,lcalgrd,nendhr, - 5 itimstep,sinalp(mxnx,mxny,26),sinalpc(mxnx,mxny),mreg -c -c --- COMMON BLOCK /GEN/ Variables: -c IBYR - integer - Beginning year of run (4 digits) -c IBMO - integer - Beginning month of run -c IBDY - integer - Beginning day of run -c IBJUL - integer - Beginning Julian day of run -c IBHR - integer - Beginning hour of run (00-23) -c IBYRN - integer - Beginning year of run (4 digits)(explicit) -c IBMON - integer - Beginning month of run(4 digits)(explicit) -c IBDYN - integer - Beginning day of run(4 digits)(explicit) -c IBJULN - integer - Beginning Julian day of run (4 digits)(explicit) -c IBHRN - integer - Beginning hour of run (00-23)(4 digits)(explicit) -c IBSECN - integer - Beginning second run (00-3600)(4 digits)(explicit) -c IEYRN - integer - Beginning year of run (4 digits)(explicit) -c IEMON - integer - Beginning month of run(4 digits)(explicit) -c IEDYN - integer - Beginning day of run(4 digits)(explicit) -c IEJULN - integer - Beginning Julian day of run (4 digits)(explicit) -c IEHRN - integer - Beginning hour of run (00-23)(4 digits)(explicit) -c IESECN - integer - Beginning second run (00-3600)(4 digits)(explicit) -c AXTZ - char*8 - UTC base time zone (UTC+HHMM) -c IBTZ - integer - Base time zone -c IRLG - integer - Run length (hours) -c IRSUBLG - integer - Run length (sub-hourly timesteps) -c NSECDT - integer - Timestep in seconds -c NYR - integer - Year of current time step -c NMO - integer - Month of current time step -c NDAY - integer - Day of current time step -c NJUL - integer - Julian day of current time step -c NHR - integer - Hour of current time step (00-23) -c NHRIND - integer - Array index (1-24) of current hour -c NDATHR - integer - Coded integer containing date & hour -c of current time step (YYYYJJJHH) -c NYRB - integer - Beginning Year of current time step (explicit) -c NMOB - integer - Beginning Month of current time step (explicit) -c NDAYB - integer - Beginning Day of current time step (explicit) -c NJULB - integer - Beginning Julian day of current time step (explicit) -c NHRB - integer - Beginning Hour of current time step (00-23) (explicit) -C NSECB - integer - Beginning Second of current timestep (explicit) -c NYRE - integer - Ending Year of current time step (explicit) -c NMOE - integer - Ending Month of current time step (explicit) -c NDAYE - integer - Ending Day of current time step (explicit) -c NJULE - integer - Ending Julian day of current time step (explicit) -c NHRE - integer - Ending Hour of current time step (00-23) (explicit) -C NSECE - integer - Ending Second of current timestep (explicit) -c NDATHRB - integer - Coded integer containing beginning date & hour -c of current time step (YYYYJJJHH) (explicit) -c NDATHRE - integer - Coded integer containing ending date & hour -c of current time step (YYYYJJJHH) (explicit) -c IRTYPE - integer - Run type flag -c (0 = Computes wind fields only -c 1 = Computes wind fields and -c micrometeorological variables) -c LCALGRD - logical*4 - Flag to control calculation of special -c data fields needed by CALGRID (i.e., -c 3-D W winds and temperatures) -c NENDHR - integer - Flag for last hour in the run -c (1 = last hour; 0 = otherwise) -c ITIMSTEP - integer - Current timestep -c SINALP(mxnx, - real - Sine of solar elevation angle at each -c mxny,26) gridpoint (hourly values from 23:30 previous day -c to 0:30 next day) -c SINALPC(mxnx,mxny) - real - Sine of solar elevation angle at each -c gridpoint at the midpoint of current timestep -c (interpolated from hourly values) -c MREG - integer - Regulatory configuration option -c (0 = NO checks are made -c 1 = Technical options must conform to -c USEPA guidance diff --git a/CALPUFF_SRC/CALMET/geo.met b/CALPUFF_SRC/CALMET/geo.met deleted file mode 100644 index 0eaf399..0000000 --- a/CALPUFF_SRC/CALMET/geo.met +++ /dev/null @@ -1,39 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /GEO/ -- Geophysical data CALMET -c---------------------------------------------------------------------- -c - common/geo/ilandu(mxnx,mxny),elev(mxnx,mxny),z0(mxnx,mxny), - 1 xlai(mxnx,mxny),ilucat(mxlu),z0lu(mxlu),alblu(mxlu),bowlu(mxlu), - 2 hcglu(mxlu),qflu(mxlu),xlailu(mxlu),iwat1,iwat2,nlu,iogeo -c -c --- COMMON BLOCK /GEO/ Variables: -c ILANDU(mxnx,mxny) - int. array - Land use category at each grid -c point -c ELEV(mxnx,mxny) - real array - Terrain elevation (m) above MSL -c Z0(mxnx,mxny) - real array - Surface roughness length (m) -c XLAI(mxnx,mxny) - real array - Leaf area index -c ILUCAT(mxlu) - int. array - Array of possible land use -c categories -c Z0LU(mxlu) - real array - Default or user-input roughness -c length associated with each land -c use category -c ALBLU(mxlu) - real array - Default or user-input albedo -c associated with each land use -c category -c BOWLU(mxlu) - real array - Default or user-input Bowen ratio -c associated with each land use -c category -c HCGLU(mxlu) - real array - Default or user-input soil heat -c flux parameter associated with -c each land use category -c QFLU(mxlu) - real array - Default or user-input anthropogenic -c heat flux associated with each land -c use category -c XLAILU(mxlu) - real array - Default or user-input leaf area -c index associated with each land -c use category -c IWAT1,IWAT2 - integers - Range of land use categories -c associated with water surfaces -c NLU - integer - Number of land use categories -c IOGEO - integer - Fortran unit number of geophysical -c data file (GEO.DAT) diff --git a/CALPUFF_SRC/CALMET/grid.cmn b/CALPUFF_SRC/CALMET/grid.cmn deleted file mode 100644 index 4490c65..0000000 --- a/CALPUFF_SRC/CALMET/grid.cmn +++ /dev/null @@ -1,45 +0,0 @@ -------------------------------------------------------------------------------- - GRID FILE - --------------- - -! IMAP = UTM ! -! IUTMZN = 19 ! -! LSOHEM = N ! -* LCCRLAT0 = * -* LCCRLON0 = * -* LCCRLAT1 = * -* LCCRLAT2 = * -* LCCFEAST = * -* LCCFNORTH = * -* TTMRLAT0 = * -* TTMRLON0 = * -* TTMFEAST = * -* TTMFNORTH = * -* PSRLAT0 = * -* PSRLON0 = * -* PSRLAT1 = * -* EMRLAT0 = * -* EMRLON0 = * -* LZRLAT0 = * -* LZRLON0 = * -* LAZAFEAST = * -* LAZAFNORTH = * -! DATUM = NAS-C ! -! XREFKM = 310 ! -! YREFKM = 4820 ! -! DGRIDKM = 1 ! -! NX = 99 ! -! NY = 99 ! -! NZ = 10 ! -! XBTZ = 5 ! -! ZFACE = 0 ! -! ZFACE = 20 ! -! ZFACE = 40 ! -! ZFACE = 80 ! -! ZFACE = 160 ! -! ZFACE = 300 ! -! ZFACE = 600 ! -! ZFACE = 1000 ! -! ZFACE = 1500 ! -! ZFACE = 2200 ! -! ZFACE = 3000 ! diff --git a/CALPUFF_SRC/CALMET/grid.met b/CALPUFF_SRC/CALMET/grid.met deleted file mode 100644 index d6aec47..0000000 --- a/CALPUFF_SRC/CALMET/grid.met +++ /dev/null @@ -1,59 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /GRID/ -- Grid parameters CALMET -c---------------------------------------------------------------------- -c - common/grid/nx,ny,nz,nzp1,dgrid,zface(mxnzp1),zmid(mxnz), - 1 xorigr,yorigr,xlat0,xlon0,xmap0,ymap0,nears(mxnx,mxny), - 2 nearu(mxnx,mxny),nearp(mxnx,mxny),disthmax(mxnx,mxny), - 3 dx,dy,dz(mxnz),nzprnt,disthmin(mxnx,mxny),hmin(mxnx,mxny), - 4 dcoast(mxnx,mxny),xlat(mxnx,mxny),xlon(mxnx,mxny), - 5 xabskm(mxnx),yabskm(mxny) -c -c --- COMMON BLOCK /GRID/ Variables: -c NX - integer - Number of grid points in X direction -c NY - integer - Number of grid points in Y direction -c NZ - integer - Number of vertical levels -c NZP1 - integer - Number of vertical cell faces (NZ+1) -c DGRID - real - Grid spacing (m) -c ZFACE(mxnzp1) - real array - Cell face heights (m) (NZP1 values) -c ZMID(mxnz) - real array - Cell center (grid point) heights (m) -c XORIGR - real - Reference X coordinate (m) of -c southwest corner of grid -c YORIGR - real - Reference Y coordinate (m) of -c southwest corner of grid -c XLAT0 - real - Latitude (deg.) of SW corner of -c grid (positive - No. Hemisphere, -c negative - So. Hemisphere) -c XLON0 - real - Longitude (deg.) of SW corner of -c grid (positive - Western Hemisphere, -c negative - Eastern Hemisphere) -c XMAP0, YMAP0 - real - Reference coordinates (km) of SW grid -c corner = (XORIGR, YORIGR) /1000 -c NEARS(MXNX,MXNY)- int. array - Number of the closest surface met. -c station to each grid point -c NEARU(MXNX,MXNY)- int. array - Number of the closest upper air met. -c station to each grid point -c NEARP(MXNX,MXNY)- int. array - Number of the closest precipitation -c station to each grid point -c DISTHMAX(MXNX,MXNY)- real - Distance from the gridpoint to the -c array highest peak within a radius TERRAD -c DISTHMIN(MXNX,MXNY)- real - Distance from the gridpoint to the -c array lowest valley bottom within a radius TERRAD -c HMIN(MXNX,MXNY) - real - Altitude of the lowest valley bottom -c array within a radius TERRAD -c DCOAST(MXNX,MXNY) - real - Distance to coast (for water cells) -c array -c XLAT(MXNX,MXNY) - real - Gridpoint North latitude -c array -c XLON(MXNX,MXNY) - real - GridPoint East longitude -c array -c XABSKM(MXNX) - real - Gridpoint absolute X coordinate (km) -c array -c YABSKM(MXNY) - real - Gridpoint absolute X coordinate (km) -c array -c The following variables used to be in D5.MET (before 12/20/96) -c DX - real - Grid spacing in the X direction (=DGRID) -c DY - real - Grid spacing in the Y direction (=DGRID) -c DZ(MXNZ) - real array - Grid spacing in the Z direction -c NZPRNT - integer - Number of vertical levels to print -c (=NZPRN2 in WPARM.MET) diff --git a/CALPUFF_SRC/CALMET/hflux.met b/CALPUFF_SRC/CALMET/hflux.met deleted file mode 100644 index 7fcaf13..0000000 --- a/CALPUFF_SRC/CALMET/hflux.met +++ /dev/null @@ -1,27 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /HFLUX/ -- Heat flux parameters CALMET -c---------------------------------------------------------------------- -c - common/hflux/qf(mxnx,mxny),hcg(mxnx,mxny),albedo(mxnx,mxny), - 1 bowen(mxnx,mxny),ha1,ha2,hb1,hb2,hc1,hc2,hc3,hc3p1,imixh -c -c --- COMMON BLOCK /HFLUX/ Variables: -c QF(mxnx,mxny) - real array - Anthropogenic heat flux (W/m**2) -c at each grid point -c HCG(mxnx,mxny) - real array - Soil heat flux parameter at each -c grid point -c ALBEDO(mxnx,mxny) - real array - Albedo at each grid point -c BOWEN(mxnx,mxny) - real array - Bowen ratio at each grid point -c IMIXH - integer - mixing height parametirzation option -c 1: Maul Carson for land and water -c -1: Maul Carson for land only (OCD for OW) -c 2: Batchvarova & Gryning for land and water -c -2: Batchvarova & Gryning for land only (OCD for OW) -c -c --- Energy budget variables -- Holtslag and van Ulden (1973) -c HA1, HA2, HB1, HB2, HC1, HC2, HC3 -c -c UNITS: HA1 (W/m**2), HA2 (W/m**2), -c HB1 (no units), HB2 (no units) -c HC1 (W/m**2/deg. K**6), HC2 (W/m**2), HC3 (no units) -c HC3P1 (=HC3+1) (no units) diff --git a/CALPUFF_SRC/CALMET/igf.met b/CALPUFF_SRC/CALMET/igf.met deleted file mode 100644 index 7c7128e..0000000 --- a/CALPUFF_SRC/CALMET/igf.met +++ /dev/null @@ -1,90 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /IGF/ -- IGF-CALMET.DAT data CALMET -c---------------------------------------------------------------------- - - - logical*4 lccigf,lremapigf - logical*4 lpsigf - -c --- Put double-precision arrays first, and all character variables -c --- last - common/IGF/MTVER,IBYRI,IBJULI,IBHRI,IBSECI, - 1 IEYRI,IEJULI,IEHRI,IESECI,NXI,NYI,NZI, - 2 XIGF0(mxnxi,mxnyi),Yigf0(mxnxi,mxnyi), - 2 XIGF(mxnxi,mxnyi),Yigf(mxnxi,mxnyi), - 3 cellzci(mxnzi),nearsi(mxnxi,mxnyi), - 4 z0i(mxnxi,mxnyi),dwdi(mxnxi,mxnyi), - 5 igrabi(mxnx,mxny,4),jgrabi(mxnx,mxny,4), - 6 NSSTAi,NPSTAi,I2DMET,JBTZi,nfigf,Nigf, - 7 kdathrei,nsecei, - 8 lremapigf,lccigf - 9 ,lpsigf -c - - - -c -c --- COMMON BLOCK /IGF/ Variables: -c MTVER - integer - Flag indicating if IGF CALMET IS -c igfmod=0 : hour-ending times (MOD5) -c igfmod=1 : explicit times with seconds(MOD6) -c IBYRI - integer - Beginning Year in the IGF-CALMET -c data file (in IGF CALMET base time zone) -c IBJULI - integer - Julian day of the start of the IGF-CALMET data -c -c IBHRI - integer - Starting hour of the IGF-CALMET data -c IBSECI - integer - Starting second of the IGF-CALMET data -c IEYRI - integer - Ending Year of the IGF-CALMET -c data file -c IEJULI - integer - Ending Julian day of the IGF-CALMET data -c IEHRI - integer - Ending hour (GMT) of the IGF-CALMET data -c IESECI - integer - Ending second of the IGF-CALMET data -c NXI - integer - Number of grid cells in the X direction -c in the extraction domain -c NYI - integer - Number of grid cells in the Y direction -c in the extraction domain -c NZI - integer - Number of levels in the IGF-CALMET file -c -c Xigf0(mxnxi,mxnyi) - real array - X coordinate of each IGF-CALMET grid cell -c in the IGF-CALMET grid system (in km) -c Yigf0(mxnxi,mxnyi) - real array - Y coordinate of each IGF-CALMET grid cell -c in the IGF-CALMET grid system (in km) -c Xigf(mxnxi,mxnyi) - real array - X coordinate of each IGF-CALMET grid cell -c in the current CALMET grid system (in km) -c Yigf(mxnxi,mxnyi) - real array - Y coordinate of each IGF-CALMET grid cell -c in the current CALMET grid system (in km) -c z0i(mxnxi,mxnyi) - real array - Roughness length at each IGF-CALMET grid cell -c -c CELLZCI(mxnzi) - real array - IGF-CALMET levels (height above ground in m) -c NEARSi(mxnxi,mxnyi) - int array - nearest surface station to each IGF-CALMET gridpoint -c in IGF calmet run -c -c IGRABi(mxnx,mxny,4) - integer array - I index (1, 2, ... MXNXi) of four -c closest IGF-CALMET grid points to -c each CALMET grid point -c JGRABi(mxnx,mxny,4) - integer array - J index (1, 2, ... MXNYi) of four -c closest IGF-CALMET grid points to -c each CALMET grid point -c NSSTAi - integer - Number of surface met. stations in coarse -c IGF CALMET.DAT file -c NPSTAi - integer - Number of precipitation stations in coarse -c IGF CALMET.DAT file in coarse IGF CALMET.DAT -c I2DMET - integer - Flag for 2 D array of sfc met variables in -c IGF CALMET.DAT -c 0: 2D arrays NOT available -c 1: 2D arrays available -c JBTZi - integer - Timezone of IGF-CALMET runs -c (JBTZP>0 in Western Hemisphere) -c nfigf - integer - IGF-CALMET file number currently accessed -c Nigf - integer - Total number of IGF-CALMET files. -c KDATHREI - integer - Ending date of last read IGF-CALMET record -c NSECEI - integer - Ending second of last read IGF-CALMET record -c -c --- Map projection Information: -c LREMAPIGF - logical*4 - Flag for different IGF-Current coordinate systems -c LCCIGF - logical*4 - Flag for IGF- Lambert Conformal projection -c LPSIGF - logical*4 - Flag for IGF- Polar Stereographic projection -c DWDI(mxni,mxnyi) - real array - Wind direction adjustement if the IGF and/or -c current CALMET map projections are Lambert Conformal -c (and LREMAPIGF=TRUE) - diff --git a/CALPUFF_SRC/CALMET/lon.met b/CALPUFF_SRC/CALMET/lon.met deleted file mode 100644 index b1c6fbd..0000000 --- a/CALPUFF_SRC/CALMET/lon.met +++ /dev/null @@ -1,14 +0,0 @@ -c------------------------------------------------------------------------- -c --- COMMON BLOCK /LON/ -- Delta longitude data for Met. stations CALMET -c------------------------------------------------------------------------- -c - common/lon/dlongs(mxss),dlongu(mxus) -c -c --- COMMON BLOCK /LON/ Variables: -c -c DLONGS(mxss) - real array - Difference in W. Longitude between the -c map reference, rlon0, and each surface -c station xslon(i): rlon0-xslon(i) -c DLONGU(mxus) - real array - Difference in W. Longitude between the -c map reference, rlon0, and each upper air -c station xulon(i): rlon0-xulon(i) diff --git a/CALPUFF_SRC/CALMET/m3dmet.met b/CALPUFF_SRC/CALMET/m3dmet.met deleted file mode 100644 index cd43710..0000000 --- a/CALPUFF_SRC/CALMET/m3dmet.met +++ /dev/null @@ -1,22 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /M3DMET/ -- 3D.DAT variables CALMET -c---------------------------------------------------------------------- - - common/m3dmet/tairp(mxnxp,mxnyp),sstp(mxnxp,mxnyp), - 1 rhp(mxnxp,mxnyp),z1p(mxnxp,mxnyp) - - -c --- COMMON BLOCK /3MDMET/ Variables: -c -c TAIRP(mxnxp*mxnyp) - real array - air temperature at first half-sigma -c level at each 3D.DAT gridpoint -c (in degrees kelvin) -c SSTP(mxnxp*mxnyp) - real array - surface temperature at each 3D.DAT -c gridpoint (in degrees kelvin) -c RHP(mxnxp*mxnyp) - real array - relative humidity at first half-sigma -c level at each 3D.DAT gridpoint -c (in %) -c Z1P(mxnxp*mxnyp) - real array - height above ground of first half-sigma -c level at each 3D.DAT gridpoint -c (in meters) -c diff --git a/CALPUFF_SRC/CALMET/map.met b/CALPUFF_SRC/CALMET/map.met deleted file mode 100644 index 94ec1c2..0000000 --- a/CALPUFF_SRC/CALMET/map.met +++ /dev/null @@ -1,67 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MAP/ -- Map Projection & Datum CALMET -c---------------------------------------------------------------------- - logical*4 lutm,llcc,lps,lem,llaza,lttm - character*4 utmhem - character*8 datum,pmap - character*12 daten,cactionll - real*8 vectill(9),vectoll(9) - - character*16 clat0,clon0,clat1,clat2 -c - common/map/vectill,vectoll,lutm,llcc,lps,lem,llaza,lttm, - & iutmzn,conec,feast,fnorth, - & rnlat0,relon0,rlat0,rlon0,xlat1,xlat2, - & pmap,utmhem,datum,daten,clat0,clon0,clat1,clat2, - & cactionll -c -c --- COMMON BLOCK /MAP/ Variables: -c -c VECTILL - real(9) - Mapping vector from (X,Y)CALMET to Lat,Lon -c VECTOLL - real(9) - Mapping vector from (X,Y)CALMET to Lat,Lon -c LUTM - logical*4 - Flag for Universal Transverse Mercator -c LLCC - logical*4 - Flag for Lambert Conformal Conic -c LPS - logical*4 - Flag for Polar Stereographic -c LEM - logical*4 - Flag for Equatorial Mercator -c LLAZA - logical*4 - Flag for Lambert Azimuthal Equal Area -c LTTM - logical*4 - Flag for Tangential Transverse Mercator -c -c IUTMZN - integer - UTM zone for UTM projection -c CONEC - real - "Constant of cone" for 2 standard -c parallels that define Lambert Conformal -c grid -c FEAST (km) - real - False Easting at projection origin -c FNORTH (km) - real - False Northing at projection origin -c RNLAT0, - real - N. latitude & E. longitude of x=0 and y=0 -c RELON0 (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RLAT0,RLON0 - real - N. latitude & W. longitude of x=0 and y=0 -c of map projection (degrees, + = N,W) -c (Much of code written for W. Longitude, -c so RLAT0=RNLAT0 and RLON0=-RELON0 -c XLAT1, - real - Matching N. latitude(s) for projection -c XLAT2 (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c PMAP - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEM - character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUM - character - Datum-Region for grid coordinates -c DATEN - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c CLAT0 - character - Character version of RNLAT0 -c CLON0 - character - Character version of RELON0 -c CLAT1 - character - Character version of XLAT1 -c CLAT2 - character - Character version of XLAT2 -c CACTIONLL - character - Mapping action from (X,Y)CALMET to Lat,Lon diff --git a/CALPUFF_SRC/CALMET/met1.met b/CALPUFF_SRC/CALMET/met1.met deleted file mode 100644 index 59b4793..0000000 --- a/CALPUFF_SRC/CALMET/met1.met +++ /dev/null @@ -1,135 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MET1/ -- Met. station data CALMET -c---------------------------------------------------------------------- - character*4 csnam,cunam,cpnam - CHARACTER*16 datavers,dataverp,dataveru - logical lcfsfc,lcfupr,lcfprc -c - common/met1/nssta,nusta,npsta,iforms,iformp,ios,iou,iop, - 1 datavers,dataverp,dataveru, - 1 ispack,ippack,idssta(mxss),idusta(mxus),idpsta(mxps), - 2 csnam(mxss),xssta(mxss),yssta(mxss),xslat(mxss),xslon(mxss), - 3 xstz(mxss),zanem(mxss),zlogsta(mxss),iadj(mxss),cunam(mxus), - 4 xusta(mxus),yusta(mxus),xulat(mxus),xulon(mxus),xutz(mxus), - 5 uelev(mxus),iiup(mxus),jjup(mxus), - 5 cpnam(mxps),xpsta(mxps),ypsta(mxps),xplat(mxps), - 6 xplon(mxps),jlandu(mxss),nflagp,sigmap,cutp,noobs,itprog,icloud, - 7 irhprog,iformc,ifmtu(mxus),lcfsfc,lcfupr,lcfprc,mcloud,icldout -c -c --- COMMON BLOCK /MET1/ Variables: -c NSSTA - integer - Number of surface met. stations -c NUSTA - integer - Number of upper air met. stations -c NPSTA - integer - Number of precipitation stations -c IFORMS - integer - Surface meteorological data file format -c (1 = unformatted (e.g., SMERGE output)) -c (2 = formatted(free-formatted user input)) -c IFORMP - integer - Precipitation data file format -c (1 = unformatted (e.g., PMERGE output)) -c (2 = formatted(free-formatted user input)) -c IOS - integer - Fortran unit no. of surface data file -c IOU - integer - Fortran unit no. of first upper air data -c file (2nd, 3rd, etc = IOU+1, IOU+2, ...) -c IOP - integer - Fortran unit no. of precipitation file -c DATAVERS - char*16 - SURF.DAT data version number -c DATAVERP - char*16 - PRECIP.DAT data version number -c DATAVERU - char*16 - UP.DAT data version number -c ISPACK - integer - Packing code for surface data -c IPPACK - integer - Packing code for precipitation data -c (0=not packed, 1=packed) -c IDSSTA(mxss) - int. array - Surface station ID numbers -c IDUSTA(mxus) - int. array - Upper air station ID numbers - -c IDPSTA(mxps) - int. array - Precipitation station station codes -c CSNAM(mxss) - char*4 array - Surface station names -c XSSTA(mxss) - real array - Surface station X coordinates (m) -c relative to grid origin at (0.0, 0.0) -c YSSTA(mxss) - real array - Surface station Y coordinates (m) -c relative to grid origin at (0.0, 0.0) -c XSLAT(mxss) - real array - Surface station latitude (deg.) -c XSLON(mxss) - real array - Surface station longitude (deg.) -c XSTZ(mxss) - real array - Surface station time zone -c ZANEM(mxss) - real array - Surface station anemometer hts. (m) -c ZLOGSTA(mxss) - real array - Surface station vert. extrapolation -c scaling parameter -c IADJ(mxss) - real array - Surface station anenometer adjustment -c flag (0 if znamem=zmid(1), 1 otherwise) -c SELEV(mxss) - real array - Surface station elevation (m) MSL -c -c CUNAM(mxus) - char*4 array - Upper air station names -c XUSTA(mxus) - real array - Upper air station X coordinates (m) -c relative to grid origin at (0.0, 0.0) -c YUSTA(mxus) - real array - Upper air station Y coordinates (m) -c relative to grid origin at (0.0, 0.0) -c XULAT(mxus) - real array - Upper air station latitude (deg.) -c XULON(mxus) - real array - Upper air station longitude (deg.) -c XUTZ(mxus) - real array - Upper air station time zone -c UELEV(mxus) - real array - Upper air station elevation (m) MSL -c IIUP(mxus) - int array - Nearest gridpoint I to upper air station -c JJUP(mxus) - int array - Nearest gridpoint Jto upper air station -c CPNAM(mxps) - char*4 array - Precip. station names -c XPSTA(mxps) - real array - Precip. station X coordinates (m) -c relative to grid origin at (0.0, 0.0) -c YPSTA(mxps) - real array - Precip. station Y coordinates (m) -c relative to grid origin at (0.0, 0.0) -c XPLAT(mxps) - real array - Precip. station latitude (deg.) -c XPLON(mxps) - real array - Precip. station longitude (deg.) -c JLANDU(mxps) - int. array - Land use of station location -c (0 = land, 1+ = water bodies) -c NOT CURRENTLY INPUT TO CALMET -c NFLAGP - integer - Precipitation interpolation method -c (1 = 1/Radius, 2=1/Radius**2, -c 3=[1/Radius**2]*exp) -c SIGMAP - real - Radius of influence for precipitation -c interpolation (km) -c (only used when NFLAGP = 3) -c CUTP - real - Minimum allowed precipitation (mm/hr) -c -c NOOBS - integer - Observations used with prognostic data? -c 0 = sfc and upper air stations used -c 1 = sfc stations used (no upper air) -c 2 = only prognostic data -c -c ITPROG - integer - Use temperature from 3D prognostic data? -c 0 = temperature from observations -c 1 = surface temperature from observations -c upper air temperature from prognostic data -c 2 = temperature from prognostic data -c -c IRHPROG - integer - Use RH from 3D prognostic data? -c 0 = RH from observations -c 1 = RH from prognostic data -c -c ICLOUD - integer - Gridded cloud field options -c 0 = gridded CLOUD.DAT file not used -c 1 = gridded CLOUD.DAT file generated -c as OUTPUT -c 2 = gridded CLOUD.DAT file read as -c INPUT -c 3 = gridded cloud data computed from -c prognostic relative humidity -c -c MCLOUD and ICLDOUT replace ICLOUD in calmet.inp version 2.2 -c -c ICLDOUT - integer - Output options of cloud data -c 0 = no - no cloud.dat files are created -c 1 = yes - a cloud.dat file is created -c -c MCLOUD - integer - Gridded cloud field options -c 1 = Clouds data generated from Observations -c 2 = Clouds data read from CLOUD.DAT file -c (no output of cloud data possible) -c 3 = gridded cloud data computed from -c prognostic relative humidity -c 4 = Gridded cloud cover from Prognostic -c Rel. Humidity at all levels -c -c IFORMC - integer - Cloud data file format -c (1 = unformatted) -c (2 = formatted) -c -c IFMTU(mxus) - integer array- UP.DAT file format -c 1=original slash-delimited (/) format -c 2=comma-delimited data records) -c LCFSFC - logical - T: surface station data in control file -c LCFUPR - logical - T: upper station data in control file -c LCFPRC - logical - T: precip station data in control file diff --git a/CALPUFF_SRC/CALMET/met2.met b/CALPUFF_SRC/CALMET/met2.met deleted file mode 100644 index 30c10da..0000000 --- a/CALPUFF_SRC/CALMET/met2.met +++ /dev/null @@ -1,23 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MET2/ -- Hourly surface met. data CALMET -c---------------------------------------------------------------------- -c - common/met2/ws(mxss),wd(mxss),iceil(mxss),icc(mxss),otempk(mxss), - 1 tempk(mxss),irh(mxss),pres(mxss),ipcode(mxss),ibuf(3,mxss) -c -c --- COMMON BLOCK /MET2/ Variables: -c WS(mxss) - real array - Wind speed (m/s) at each surface -c met. station -c WD(mxss) - real array - Wind direction (deg.) -c ICEIL(mxss) - int. array - Ceiling height (hundreds of ft) -c ICC(mxss) - int. array - Opaque sky cover (tenths) -c TEMPK(mxss) - real array - Air temperature (deg. K)- after missfc -c no missing temp (replaced by nearest station -c value -c OTEMPK(mxss)- real array - Air temperature (deg. K) including missing data -c IRH(mxss) - int. array - Relative humidity (%) -c PRES(mxss) - real array - Station pressure (mb) -c IPCODE(mxss) - int. array - Precipitation code -c IBUF(3,mxss) - int. array - Buffer to temporarily store packed -c data (used only if packing option -c used, i.e., ISPACK = 1) diff --git a/CALPUFF_SRC/CALMET/met3.met b/CALPUFF_SRC/CALMET/met3.met deleted file mode 100644 index a1e9959..0000000 --- a/CALPUFF_SRC/CALMET/met3.met +++ /dev/null @@ -1,10 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MET3/ -- Hourly precipitation data CALMET -c---------------------------------------------------------------------- -c - common/met3/xprecp(mxps) -c -c --- COMMON BLOCK /MET3/ Variables: -c XPRECP(mxps) - real array - Hourly precipitation amounts (mm/hr) -c at each precip. station (9999. indicates -c a missing value) diff --git a/CALPUFF_SRC/CALMET/metgrd.met b/CALPUFF_SRC/CALMET/metgrd.met deleted file mode 100644 index 4e50b85..0000000 --- a/CALPUFF_SRC/CALMET/metgrd.met +++ /dev/null @@ -1,22 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /METGRD/ -- Hourly gridded met. fields CALMET -c---------------------------------------------------------------------- -c - common/metgrd/ipgt(mxnx,mxny),qh(mxnx,mxny), - 1 ustar(mxnx,mxny),zi(mxnx,mxny),el(mxnx,mxny), - 2 wstar(mxnx,mxny),rmm(mxnx,mxny),ztemp(mxnx,mxny,mxnz) -c -c --- COMMON BLOCK /METGRD/ Variables: -c IPGT(mxnx,mxny) - int. array - PGT stability class (1-6) at -c each grid point -c QH(mxnx,mxny) - real array - Sensible heat flux (W/m**2) -c Actually it contains sensible heat -c flux values overland and buoyancy -c fluxes overwater where the effect of -c moisture on stability cannot be neglected -c USTAR(mxnx,mxny) - real array - Surface friction velocity (m/s) -c ZI(mxnx,mxny) - real array - Mixing height (m) -c EL(mxnx,mxny) - real array - Monin-Obukhov Length (m) -c WSTAR(mxnx,mxny) - real array - Convective velocity scale (m/s) -c RMM(mxnx,mxny) - real array - Precipitation rate (mm/hr) -c ZTEMP(mxnx,mxny,mxnz) - real array - 3-D temperature field (deg. K) diff --git a/CALPUFF_SRC/CALMET/metpac.met b/CALPUFF_SRC/CALMET/metpac.met deleted file mode 100644 index ef27823..0000000 --- a/CALPUFF_SRC/CALMET/metpac.met +++ /dev/null @@ -1,28 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /METPAC/ -- Meteorological parameters CALMET -c needed for MESOPAC II output -c format -c---------------------------------------------------------------------- -c - common/metpac/xscoor(mxss),yscoor(mxss),xucoor(mxus), - 1 yucoor(mxus),srad(mxss),ul(mxnx,mxny),vl(mxnx,mxny), - 2 uup(mxnx,mxny),vup(mxnx,mxny) -c -c --- COMMON BLOCK /METPAC/ Variables: -c XSCOOR(mxss) - real array - Surface station X coordinates (in -c grid units relative to the MESOPAC II -c origin at (1.0, 1.0)) -c YSCOOR(mxss) - real array - Surface station Y coordinates (in -c grid units relative to the MESOPAC II -c origin at (1.0, 1.0)) -c XUCOOR(mxss) - real array - Upper air station X coordinates (in -c grid units relative to the MESOPAC II -c origin at (1.0, 1.0)) -c YUCOOR(mxss) - real array - Upper air station Y coordinates (in -c grid units relative to the MESOPAC II -c origin at (1.0, 1.0)) -c SRAD(mxss) - real array - Solar radiation (KW/m**2) -c UL(mxnx,mxny) - real array - Lower-layer U wind components (m/s) -c VL(mxnx,mxny) - real array - Lower-layer V wind components (m/s) -c UUP(mxnx,mxny) - real array - Upper-layer U wind components (m/s) -c VUP(mxnx,mxny) - real array - Upper-layer V wind components (m/s) diff --git a/CALPUFF_SRC/CALMET/mm4hdo.met b/CALPUFF_SRC/CALMET/mm4hdo.met deleted file mode 100644 index c058140..0000000 --- a/CALPUFF_SRC/CALMET/mm4hdo.met +++ /dev/null @@ -1,118 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MM4HDO/ -- MM4/MM5/3D.DAT data CALMET -c---------------------------------------------------------------------- - character*8 datum3d - character*16 cname3d,cver3d - character*64 ctitle3d - character*132 comm3d - - - common/MM4HDO/IBYRM,IBJULM,IBHRM,IBSECM,IEYRM,IEJULM,IEHRM,IESECM, - 1 NXMM4,NYMM4,NZP,PTOPMM4,I1,J1,NXP,NYP, - 2 SIGMA(mxnzp),XLAT4(mxnxp,mxnyp),XLONG4(mxnxp,mxnyp), - 3 IELEV4(mxnxp,mxnyp),ILU4(mxnxp,mxnyp), - 4 XLCMM4(mxnxp,mxnyp),YLCMM4(mxnxp,mxnyp), - 4 X04(mxnxp*mxnyp),Y04(mxnxp*mxnyp), - 4 INEARG(mxnxp,mxnyp),JNEARG(mxnxp,mxnyp), - 5 IGRAB(mxnx,mxny,4),JGRAB(mxnx,mxny,4), - 5 IGRABW(mxnx,mxny),JGRABW(mxnx,mxny), - 6 IOUTMM5,IMM53D,ISTEPPG,ISTEPPGS, - 7 NCOMM3D,CNAME3D,CVER3D,CTITLE3D,COMM3D, - 7 DATUM3D,NM3D,ILUOC3D -c -c --- COMMON BLOCK /MM4HDO/ Variables: -c IBYRM - integer - Year of beginning of data in the MM4/MM5 -c data file -c IBJULM - integer - Julian day of the start of the MM4/MM5 data -c IBHRM - integer - Starting hour (GMT) of the MM4/MM5 data -c IBSECM - integer - Starting second of the MM4/MM5 data -c IEYRM - integer - Ending year of the MM4/MM5 data -c IEJULM - integer - Ending Julian day of the MM4/MM5 data -c IEHRM - integer - Ending hour (GMT) of the MM4/MM5 data -c IESECM - integer - Ending second of the MM4/MM5 data -c NXMM4 - integer - Number of X cells in the original MM4/MM5 -c modeling domain -c NYMM4 - integer - Number of Y cells in the original MM4/MM5 -c modeling domain -c NZP - integer - Number of levels in the MM4/MM5 file -c PTOPMM4 - real - Top pressure level (mb) of data in the -c MM4/MM5 file -c I1 - integer - X index of the lower left corner of the -c extraction domain -c J1 - integer - Y index of the lower left corner of the -c extraction domain -c NXP - integer - Number of grid cells in the X direction -c in the extraction domain -c NYP - integer - Number of grid cells in the Y direction -c in the extraction domain -c SIGMA(mxnzp) - real array - Array of sigma levels defining -c each of the NZP MM4/MM5 layers -c XLAT4(mxnxp,mxnyp) - real array - Latitude (deg.) of each MM4/MM5 -c grid point (positive in NH, -c negative in SH). -c XLONG4(mxnxp,mxnyp) - real array - Longitude (deg.) of each MM4/MM5 -c grid point (N.B. MM4/MM5 convention -c is different from CALMET convention, -c i.e., positive for Eastern Hemisphere -c and negative for Western Hemisphere) -c IELEV4(mxnxp,mxnyp) - integer array - Terrain elevation (m) of each grid -c point in the MM4/MM5 extraction -c subdomain -c ILU4(mxnxp,mxnyp) - integer array - Land use code of each grid point -c in the MM4/MM5 extraction subdomain -c XLCMM4(mxnxp,mxnyp) - real array - X coordinate of each MM5 grid cell -c in the CALMET Lambert Conformal -c grid system (in km) -c YLCMM4(mxnxp,mxnyp) - real array - Y coordinate of each MM5 grid cell -c in the CALMET Lambert Conformal -c grid system (in km) -c X04(mxnxp*mxnyp) - real array - X coordinate of each MM5 grid cell -c relative to the domain origin -c (in meters) -c Y04(mxnxp*mxnyp) - real array - Y coordinate of each MM5 grid cell -c relative to the domain origin -c (in meters) -c INEARG(mxnxp,mxnyp) - integer array - I index (1, 2, ... MXNX) of -c closest CALMET grid point to -c MM4/MM5/3D grid point -c JNEARG(mxnxp,mxnyp) - integer array - J index (1, 2, ... MXNY) of -c closest CALMET grid point to -c MM4/MM5/3D grid point -c IGRAB(mxnx,mxny,4) - integer array - I index (1, 2, ... MXNXP) of four -c closest MM4/MM5 grid points to -c each CALMET grid point -c JGRAB(mxnx,mxny,4) - integer array - J index (1, 2, ... MXNYP) of four -c closest MM4/MM5 grid points to -c each CALMET grid point -c IGRABW(mxnx,mxny) - integer array - I index (1, 2, ... MXNXP) of -c closest 3D.DAT ocean grid point to -c each CALMET offshore grid point -c JGRABW(mxnx,mxny) - integer array - J index (1, 2, ... MXNYP) of -c closest 3D.DAT ocean grid point to -c each CALMET offshore grid point -c IOUTMM5 - integer - Flag indicating contents of the -c MM5.DAT file -c IMM53D - integer - Flag indicating if MM5 file in -c MM5.DAT format (IMM53D=0), -c 3D.DAT format (IMM53D=1) (< V2.0) -c 3D.DAT format (IMM53D=2) (V2.0+) -c ISTEPPG - integer - MM5 Timestep (hr) (default isteppg=1) -c ISTEPPGS - integer - MM5 Timestep (in seconds) -c (default isteppgs=3600) -cc NCOMM3D - integer - Number of comment lines in 3D.DAT -c file (used only with 3D.DAT files -c Version 2.0 or later) -c CNAME3D - character*16 - Dataset name (3D.DAT - used only for -c 3D.DAT Version 2.0 or later) -c CVER3D - character*16 - Dataset version (used only for 3D.DAT -c files Version 2.0 or later) -c CTITLE3D - character*64 - Dataset title (used only for 3D.DAT -c file Version 2.0 or later) -c COMM3D - character*132 - Character variable to hold one record -c of comments from the 3D.DAT file -c (used only for 3D.DAT file Version 2.0 -c or later) -c DATUM3D - character - Datum-Region for mesoscale model -c NM3D - integer - Number of MM4/MM5/3D.DAT files -c ILUOC3D - integer - Land Use category flagging ocean surface -c in 3D.DAT datasets (only used for ITWPROG=2) diff --git a/CALPUFF_SRC/CALMET/nima.crd b/CALPUFF_SRC/CALMET/nima.crd deleted file mode 100644 index fb463a1..0000000 --- a/CALPUFF_SRC/CALMET/nima.crd +++ /dev/null @@ -1,34 +0,0 @@ -c************************************************************ -c -c --- BUILD manufactored NIMA INCLUDE statement -c --- NIMA.CRD -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - Parameter (ndt = 132) - Parameter (nd = 234) -c -c --- Stamp this NIMA include file - Character*12 daten - Parameter (daten='02-21-2003 ') -c - Character*60 geodat1, geodat2, geodat3 - Character*8 datcod - Character*52 datum - Character*20 atlas - Character*12 dateb,dstamp -c - Real*4 dxmod, dymod, dzmod - Real*8 dradim, dflat, dec2 -c - Integer*4 dattyp -c - common /datr4/ dxmod(nd), dymod(nd), dzmod(nd) - common /datr8/ dradim(nd), dflat(nd), dec2(nd) - common /datchr/ datcod(nd), geodat1(nd), geodat2(nd), - 1 geodat3(nd), atlas(ndt), datum(ndt), - 2 dstamp,dateb - common /dati4/ kmax, nudat, dattyp(nd) -c diff --git a/CALPUFF_SRC/CALMET/outpt.met b/CALPUFF_SRC/CALMET/outpt.met deleted file mode 100644 index e1e5acd..0000000 --- a/CALPUFF_SRC/CALMET/outpt.met +++ /dev/null @@ -1,56 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /OUTPT/ -- Output options and flags CALMET -c---------------------------------------------------------------------- -c - logical lsave,lprint,ldb,ldbcst,ldbhr -c - common/outpt/lsave,iformo,lprint,iprinf,ldb,ldbhr,nn1,nn2, - 1 ldbcst,iuvout(mxnz),iwout(mxnz),itout(mxnz),imtout(8),iomet, - 2 iqaplot,iauxlwc -c -c --- COMMON BLOCK /OUTPT/ Variables: -c LSAVE - logical - Flag to save computed gridded met. -c fields in the output file "CALMET.DAT" -c or "PACOUT.DAT" (depending on value of -c IFORMO) -c IFORMO - integer - Format of output file (1=CALMET format, -c 2=MESOPAC II format) -c LPRINT - logical - Flag to control printing of met. -c fields -c IPRINF - integer - Interval between printing of gridded -c fields (e.g., 2=print every 2nd hour) -c LDB - logical - Flag to control printing of internal -c data (useful for debugging) -c LDBHR - logical - Flag to control printing of internal -c data on hourly basis (useful for debugging) -c NN1 - integer - First time step for which internal -c data are printed -c NN2 - integer - Last time step for which internal -c data are printed -c LDBCST - logical - Flag to control printing of distance to -c the coast in grd format (useful for QA-ing) -c IUVOUT(mxnz) - int. array - Flags to control which layers of -c U, V winds are printed -c IWOUT(mxnz) - int. array - Flags to control which levels of -c W winds are printed -c ITOUT(mxnz) - int. array - Flags to control which levels of -c 3-D temperature are printed -c IMTOUT(8) - int. array - Flags to control which met. variables -c are printed. The elements of the array -c correspond to: -c (1) Stability class, -c (2) Friction velocity -c (3) Monin-Obukhov length -c (4) Mixing height -c (5) Convective velocity scale -c (6) Precipitation rate -c (7) Sensible heat flux -c (8) Convective mixing height -c IOMET - integer - Fortran unit no. output met. data file -c (CALMET.DAT) -c IQAPLOT - integer - Flag for creating QA plot file(s) of -c station locations -c (0 = No; 1 = YES) -c IAUXLWC - integer - Flag for creating AUX file with cloud -c liquid water content -c (0 = No; 1 = YES) diff --git a/CALPUFF_SRC/CALMET/ovrwat.met b/CALPUFF_SRC/CALMET/ovrwat.met deleted file mode 100644 index ab6f7d5..0000000 --- a/CALPUFF_SRC/CALMET/ovrwat.met +++ /dev/null @@ -1,169 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /OVRWAT/ -- Overwater param.+ met station data - CALMET -c---------------------------------------------------------------------- -c - character*132 chowsta - - real*8 vectiow,vectoow - character*12 cactionow - - logical*4 lremap - character*8 datumow, pmapow - character*12 datenow - character*4 utmhemow - -c --- Put double-precision arrays first, and all character variables -c --- last - - common/ovrwat/vectiow(9),vectoow(9), - 1 nowsta,ioow(mxows),xowsta(mxows),yowsta(mxows), - 2 zowsta(mxows),ztair(mxows),zsst(mxows), - 2 iowbeg(mxows),iowend(mxows),dtow(mxows), - 3 tairow(mxows),rhow(mxows),ziow(mxows),ziminw,zimaxw,constw, - 4 xor2,yor2,tgrada(mxows),tgradb(mxows),idowsta(mxows), - 5 xowlon(mxows),xowlat(mxows),wsow(mxows),wdow(mxows), - 6 rverow(mxows),icoare,jwave,dshelf,iwarm,icool,twave(mxows), - 6 hwave(mxows),zlogwsta(mxows),z0ow(mxows),itwprog,threshw, - 7 lremap,iutmznow,feastow,fnorthow, - 8 rnlat0ow,relon0ow,xlat1ow,xlat2ow, - 9 chowsta(mxows),pmapow,utmhemow,datumow,datenow,cactionow -c -c --- COMMON BLOCK /OVRWAT/ Variables: -c NOWSTA - integer - Number of overwater met. stations -c IOOW(mxows) - int. array - Fortran unit no. of each overwater -c met. station file -c XOWSTA(mxows) - real array - Overwater met. station X coordinates -c (km) -c YOWSTA(mxows) - real array - Overwater met. station Y coordinates -c (km) -c ZOWSTA(mxows) - real array - Anemometer height (m) above water of -c each station's data -c ZTAIR(mxows) - real array - Air Temp Measurement height (m) above -c water of each station's data -c ZSST(mxows) - real array - SST measurement depth (m) below water -c surface (>0 downward) of each station's data -c IOWBEG(mxows) - int. array - Beginning date/time of current -c record's data (YYYYJJJHH) -c IOWEND(mxows) - int. array - Ending date/time of current -c record's data (YYYYJJJHH) -c DTOW(mxows) - real array - Air-water temperature difference -c (K) -c TAIROW(mxows) - real array - Air temperature (K) -c RHOW(mxows) - real array - Relative humidity (%) -c ZIOW(mxows) - real array - Overwater mixing height (m) -c TGRADB(mxows) - real array - Temperature gradient below mixing -c height over water (K/m) -c 9999. = missing -c TGRADA(mxows) - real array - Temperature gradient above mixing -c height over water (K/m) -c 9999. = missing -c IDOWSTA(mxows) - int. array - Station IDs (number) -c CHOWSTA(mxows) - ch*132 array - Station IDs (character) -c XOWLON(mxows) - real array - Station Longitudes (EAST!!!) -c XOWLAT(mxows) - real array - Station Latitudes (North) -c WSOW(mxows) - real array - Station Wind Speeds (m/s) -c 9999. = missing -c WDOW(mxows) - real array - Station Wind Directions (degrees) -c 9999. = missing -c -c RVEROW(mxows) - real array - SEA.DAT version number (>=2.1 for COARE<0) -c ZIMINW - real - Minimum calculated overwater mixing -c height (m) -- Not used in overwater -c mixing heights have been specified in -c ZIOW -c ZIMAXW - real - Maximum calculated overwater mixing -c height (m) -- Not used in overwater -c mixing heights have been specified in -c ZIOW -c CONSTW - real - Overwater mixing ht. constant (default -c value = 0.16) -c XOR2 - real - Reference X coordinate of southwest -c corner of grid (km) -c YOR2 - real - Reference Y coordinate of southwest -c corner of grid (km) -c -c Overwater boundary layer method: -c ICOARE - integer - Overwater method -c 0: original deltaT method (OCD) -c 10,11,12: COARE with wave method jwave=0,1,2 -c JWAVE - integer - Wave method -c 0: COARE wave method jwave=0 (Charnok) -c 1: COARE wave method jwave 1 (Oost et al) -c 2: COARE wave option 2 (Taylor and Yelland) -c DSHELF - real - Coastal/shallow water lengthscale in km -c IWARM - integer - COARE warm layer computation option -c 1: on - 0: off -c ICOOL - integer - COARE cool skin computation option -c 1: on - 0: off -c TWAVE (mxows) - real - Dominant wave period (seconds) -c HWAVE (mxows) - real - Dominant wave height (meters) -c -c ZLOGWSTA(MXOWS) - real - Scaling factor for adjustment from anemometer -c height to first CALMET level -c Z0OW(MXOWS) - real - Overwater roughness length -c -c THRESHW - real - threshold surface buoyancy flux required for mixing height -c growth overwater -c (unit: energy flux per meter of marine boundary layer i.e. W/m3) -c (default: 0.05 W/m2 /m) -c -c ITWPROG - integer - Flag to use SEA.DAT and/or prognostic offshore temperatures -c and lapse rates -c 0 : use SEA.DAT air/sea temperatures and lapse rates -c 1 : use SEA.DAT air/sea temperatures and prognostic lapse rates -c 2 : use prognostic air/sea temperatures and prognostic lapse rates -c -c --- Map Projection Information -c -c LREMAP - logical*4 - Flag for remapping (X,Y) to match CALMET -c VECTIOW(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c VECTOOW(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c IUTMZNOW - integer - UTM zone for UTM projection -c FEASTOW (km) - real - False Easting at projection origin -c FNORTHOW (km) - real - False Northing at projection origin -c RNLAT0OW, - real - N. latitude & E. longitude of x=0 and y=0 -c RELON0OW (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c XLAT1OW, - real - Matching N. latitude(s) for projection -c XLAT2OW (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c PMAPOW - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMOW - character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMOW - character - Datum-Region for grid coordinates -c DATENOW - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c CACTIONOW - char*12 - Map conversion string (e.g., UTM2LCC) -c to remap overwater (x,y) to CALMET -c (x,y) diff --git a/CALPUFF_SRC/CALMET/params.cal b/CALPUFF_SRC/CALMET/params.cal deleted file mode 100644 index 6a77e6b..0000000 --- a/CALPUFF_SRC/CALMET/params.cal +++ /dev/null @@ -1,12 +0,0 @@ -c---------------------------------------------------------------------- -c --- PARAMETER statements CALUTILS -c---------------------------------------------------------------------- -c --- Specify parameters - parameter(mxvar=60,mxcol=200) -c -c --- CONTROL FILE READER definitions: -c MXVAR - Maximum number of variables in each input group -c MXCOL - Maximum length (bytes) of a control file input record -c---------------------------------------------------------------------- - - \ No newline at end of file diff --git a/CALPUFF_SRC/CALMET/qa.met b/CALPUFF_SRC/CALMET/qa.met deleted file mode 100644 index 986adb3..0000000 --- a/CALPUFF_SRC/CALMET/qa.met +++ /dev/null @@ -1,18 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /QA/ -- Model version data CALMET -c---------------------------------------------------------------------- -c - character*8 level,rtime - character*12 ver - character*10 rdate -c - common/qa/ncommout,rcpu,ver,level,rtime,rdate -c -c --- COMMON BLOCK /QA/ Variables: -c NCOMMOUT - integer - Number of comment lines written to -c CALMET.DAT header for QA -c RCPU - real - Computed CPU time of the run -c VER - char*12 - Model version number -c LEVEL - char*8 - Model level number -c RTIME - char*8 - System time of the run (hh:mm:ss) -c RDATE - char*10 - System date of the run (mm-dd-yyyy) diff --git a/CALPUFF_SRC/CALMET/tmp.met b/CALPUFF_SRC/CALMET/tmp.met deleted file mode 100644 index 3652084..0000000 --- a/CALPUFF_SRC/CALMET/tmp.met +++ /dev/null @@ -1,31 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /TMP/ -- Flags for Temperature Calculation CALMET -c---------------------------------------------------------------------- -c - common/tmp/irad,iavet,numwb,tgdefb,tgdefa, - & jwat1(mxwb),jwat2(mxwb),tradkm,trad,numts -c -c --- COMMON BLOCK /TMP/ Variables: -c IRAD - integer - Type of interpolation -c 1 = 1/Radius, 2 = 1/Radius**2 -c IAVET - integer - (0/1) 1 = use spatial averaging of -c temperature -c NUMWB - integer - Number of bodies of water to be treated -c separately in temperature interpolation. -c (Currently hardwired to 1 - not input) -c TGDEFB - real - Default temperature gradient below the -c mixing height over water (K/m). -c TGDEFA - real - Default temperature gradient above the -c mixing height over water (K/m). -c JWAT1 - integer - Range of land uses to be considered as -c JWAT2 array water in the land/water 3-D temperature -c calculation for each of NUMWB bodies of -c water. -c (Currently only 1 allowed) -c TRADKM - real - Radius of influence for temperature -c interpolation (in km) -c TRAD - real - Radius of influence for temperature -c interpolation (in grid cells) - -c computed from TRADKM and DGRIDKM -c NUMTS - integer - Maximum # of sites to include in temperature -c interpolation diff --git a/CALPUFF_SRC/CALMET/tmpold.met b/CALPUFF_SRC/CALMET/tmpold.met deleted file mode 100644 index c327527..0000000 --- a/CALPUFF_SRC/CALMET/tmpold.met +++ /dev/null @@ -1,25 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /TMP/ -- Flags for Temperature Calculation CALMET -c---------------------------------------------------------------------- -c - common/tmp/irad,iavet,numwb,tgdefb,tgdefa, - & jwat1(mxwb),jwat2(mxwb) -c -c --- COMMON BLOCK /TMP/ Variables: -c IRAD - integer - Type of interpolation -c 1 = 1/Radius, 2 = 1/Radius**2 -c IAVET - integer - (0/1) 1 = use spatial averaging of -c temperature -c NUMWB - integer - Number of bodies of water to be treated -c separately in temperature interpolation. -c (Currently hardwired to 1 - not input) -c TGDEFB - real - Default temperature gradient below the -c mixing height over water (K/m). -c TGDEFA - real - Default temperature gradient above the -c mixing height over water (K/m). -c JWAT1 - integer - Range of land uses to be considered as -c JWAT2 array water in the land/water 3-D temperature -c calculation for each of NUMWB bodies of -c water. -c (Currently only 1 allowed) - \ No newline at end of file diff --git a/CALPUFF_SRC/CALMET/upmet.met b/CALPUFF_SRC/CALMET/upmet.met deleted file mode 100644 index 44d2740..0000000 --- a/CALPUFF_SRC/CALMET/upmet.met +++ /dev/null @@ -1,37 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /UPMET/ -- Upper meteorological data CALMET -c---------------------------------------------------------------------- -c - common/upmet/paa(mxus,mxlev),zlaa(mxus,mxlev), - 1 tzaa(mxus,mxlev),uaa(mxus,mxlev),vaa(mxus,mxlev), - 2 pbb(mxus,mxlev),zlbb(mxus,mxlev),tzbb(mxus,mxlev), - 3 ubb(mxus,mxlev),vbb(mxus,mxlev),nlaa(mxus),nlbb(mxus), - 4 justa(mxus),jusdt(mxus),ntzaa(mxus),ntzbb(mxus), - 5 jaasec(mxus),jbbsec(mxus),isnap(mxus) -c -c --- COMMON BLOCK /UPMET/ Variables: -c Paa(mxus,mxlev) - real array - aa GMT pressure (mb) -c ZLaa(mxus,mxlev) - real array - aa GMT height (m above LGL) -c TZaa(mxus,mxlev) - real array - aa GMT air temp. (deg. K) -c Uaa(mxus,mxlev) - real array - aa GMT U wind component (m/s) -c Vaa(mxus,mxlev) - real array - aa GMT V wind component (m/s) -c Pbb(mxus,mxlev) - real array - bb GMT pressure (mb) -c ZLbb(mxus,mxlev) - real array - bb GMT height (m above LGL) -c TZbb(mxus,mxlev) - real array - bb GMT air temp. (deg. K) -c Ubb(mxus,mxlev) - real array - bb GMT U wind component (m/s) -c Vbb(mxus,mxlev) - real array - bb GMT V wind component (m/s) -c NLaa(mxus) - int. array - Number of aa GMT sounding levels -c NLbb(mxus) - int. array - Number of bb GMT sounding levels -c JUSTA(mxus) - int. array - Flag (+1,-1) indicating that aa -c data (preceeds,follows) bb data -c JUSDT(mxus) - int. array - No. seconds between sounding times. -c NTZaa(mxus) - int. array - Julian YYYYDDDHH GMT for aa data. -c NTZbb(mxus) - int. array - Julian YYYYDDDHH GMT for bb data. -c JAAsec(mxus) - int. array - Seconds GMT for aa data. -c (beginning time of record) -c JBBsec(mxus) - int. array - Seconds GMT for bb data. -c (beginning time of record) -c ISNAP(mxus) - int. array - Snapshot vs. time-averaged -c sounding flag: -c 0= time-averaged -c 1= snapshot diff --git a/CALPUFF_SRC/CALMET/wparm.met b/CALPUFF_SRC/CALMET/wparm.met deleted file mode 100644 index 9b8866c..0000000 --- a/CALPUFF_SRC/CALMET/wparm.met +++ /dev/null @@ -1,14 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WPARM/ -- Wind module parameters CALMET -c---------------------------------------------------------------------- - logical lvary - -c - common/wparm/iwfcod,rmin,rmax1,rmax2,rmax3,r1,r2,divlim, - 1 niter,nsmth(mxnz),nintr2(mxnz),iextrp,rmin2,fextr2(mxnz),critfn, - 2 terrad,ifradj,ikine,alpha,nzprn2,ipr0,ipr1,ipr2,ipr3,ipr4, - 3 ipr5,ipr6,ipr7,ipr8,icalc,ioutd,i3dctw,nsurf,nwind,nupper, - 4 utmxor,utmyor,namst(mxwnd),tinf,lvary, - 5 htfac,ifilek,ifilef,ifiles,iobr,iprog,rprog,ioprog, - 6 idiopt(5),isurft,iupt,zupt,iupwnd,zupwnd(2),iiupt,jjupt, - 7 bias(mxnz),islope,icalm,igfmet,isfcmet,ipsifcn diff --git a/CALPUFF_SRC/CALMET/wtgrd.met b/CALPUFF_SRC/CALMET/wtgrd.met deleted file mode 100644 index 08dcb37..0000000 --- a/CALPUFF_SRC/CALMET/wtgrd.met +++ /dev/null @@ -1,12 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WT/ -- Gridded weighting factors CALMET -c---------------------------------------------------------------------- -c - common/wt/wo(mxnx,mxny,mxnz) -c -c --- COMMON BLOCK /WT/ Variables: -c -c WO(mxnx,mxny,mxnz) real array - Gridded weighting factors used -c for station observations vs the -c MM4 gridded wind data used as -c observations diff --git a/CALPUFF_SRC/CALMET/y2k.met b/CALPUFF_SRC/CALMET/y2k.met deleted file mode 100644 index 8694eca..0000000 --- a/CALPUFF_SRC/CALMET/y2k.met +++ /dev/null @@ -1,10 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /Y2K/ -- YY to YYYY conversion variables CALMET -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo -c -c --- COMMON BLOCK /Y2K/ Variables: -c IYYLO - integer - Smallest 2-digit year for which 'old' -c century marker is used -c ICCLO - integer - 2-digit ('old') century diff --git a/CALPUFF_SRC/CALMET/ziparm.met b/CALPUFF_SRC/CALMET/ziparm.met deleted file mode 100644 index c29ed23..0000000 --- a/CALPUFF_SRC/CALMET/ziparm.met +++ /dev/null @@ -1,58 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /ZIPARM/ -- Mixing height parameters CALMET -c---------------------------------------------------------------------- -c - common/ziparm/constb,conste,constn,threshl,dptmin,dzzi,zimax, - 1 zimin,cmech(mxnx,mxny),twodte,onedte,iavezi,mnmdav,hafang, - 2 ilevzi,fcoriol,fcori(mxnx,mxny),izicrlx,tzicrlx -c -c --- COMMON BLOCK /ZIPARM/ Variables: -c CONSTB - real - Constant for neutral, mechanical eqn. -c Default: 1.41 -c CONSTE - real - Constant for convective mixing ht. eqn. -c Default: 0.15 -c CONSTN - real - Constant for stable mixing ht. eqn. -c Default: 2400. -c THRESHL -real - Threshold buoyancy flux required for convective -c boundary layer growth overland - Expressed as -c a heat flux per meter of mixing height (W/m2/m) -c DPTMIN - real - Minimum potential temperature lapse -c rate in the stable layer above the -c current convective mixing ht. (deg. K/m) -c Default: 0.001 deg. K/m -c DZZI - real - Depth of layer above current conv. -c mixing height through which lapse -c rate is computed (m) -c Default: 200. m -c ZIMAX - real - Maximum overland mixing height (m) -c Default: 2500. m -c ZIMIN - real - Minimum overland mixing height (m) -c Default: 20. m -c IZICRLX - integer - Flag to relax convective mixing height to -c equilibrium convective mixing height when -c 0 g/m3(air) - lwc=cldamr*rhoaira -c --- Set minimum cloud fraction to 10% - fcloud=MAX(fcloud,0.1) - pcloud=prate/fcloud -c --- Fraction of puff within cloud horizontally and vertically - fcloud2=fcloud*fzcld - - elseif (fcloud.gt.0. .and. temp.gt.273.15) then - if (prate .gt. 0.) then - lwc = 0.5 - else - lwc = 0.1 - end if - else - lwc = 0. - end if - - if(l_kgpcm) then -c --- Units for lwc in AQRADM are kg/m3 - lwc=0.001*lwc - endif - - if (lwc .gt. 0.) then -c -c --- Calculate concs in moles/mole air units - do ii = 1, 6 - -c --- 6.42_x1.1 - con(ii) = MAX(confcta*q(ii)/rmwt(ii),0.) - - end do -c -c --- Get HNO3 conc from total nitrate and PM nitrate - con(5) = MAX(con(5) - con(6),0.) -c - cozm = coz * 1.E-9 - ch2o2m = ch2o2 * 1.E-9 - ctnh3m = ctnh3 * 1.E-9 -c -c --- Call aqueous-phase chemistry module - taucld = delt * 3600. ! timestep in seconds - -c --- 6.42_x1.1 - rhoairm = rhoaira * 1.E3/28.97 ! air density in moles/m3 - if(ldb1) then - write(io6,*)'AQRADM:cldta,cldpa,pcloud,lwc,cozm,'// - & 'ch2o2m,ctnh3m,con6= ' - write(io6,*)'called: ',cldta,cldpa,pcloud,lwc,cozm, - & ch2o2m,ctnh3m,con - endif - call AQRADM(cldta,cldpa,taucld,pcloud,lwc,cozm,ch2o2m, - & ctnh3m,con,rhoairm,zlen,scav) - if(ldb1) then - write(io6,*)'returned: ',cldta,cldpa,pcloud,lwc,cozm, - & ch2o2m,ctnh3m,con - write(io6,*)' scav: ',scav - endif - -c --- Assign adjusted SO2 and SO4 concs; adjust for cloud cover - q(1) = q(1)*(1. - fcloud2) + fcloud2*con(1)*rmwt(1)/confcta - q(2) = q(2)*(1. - fcloud2) + fcloud2*con(2)*rmwt(2)/confcta -c -c --- Adjusted oxidant concs - coz = coz*(1. - fcloud2) + fcloud2*cozm*1.E9 - ch2o2 = ch2o2*(1. - fcloud2) + fcloud2*ch2o2m*1.E9 - -c -c --- Adjusted scavenging rates - if (prate .gt. 0.) then -c --- Possible alternate method (NA) -c --- if(l_raincloud .AND. fcloud.LT.0.99) then -c --- do ii = 1, 6 -c --- scav(ii)=-ALOG(1.0 - fcloud* -c --- & (1.0 - EXP(-scav(ii)*taucld) ))/taucld -c --- end do -c --- else - do ii = 1, 6 - scav(ii) = scav(ii) * fcloud - end do -c --- endif - end if - end if - end if - -c --- Condition mass results - do is = 1,iss - q(is) = MAX(q(is),0.0) - end do - -c --- Compute ending concentrations as PPB - do is = 1,iss - ppb(is) = (1.0e09)*confct*q(is)/rmwt(is) - end do - -c --- Compute conversion rates (%/hr) for QA review - do i = 1,4 - rate(i) = 0.0 - end do - -c --- Compute these logs only if debug output is ON - if(ldb1) then - dt = .01*delt -c --- SOX: - if(ppbi(1).GT.0.0 .AND. ppb(1).GT.0.0) rate(1) = -ALOG(ppb(1)/ - & ppbi(1))/dt -c --- NOX: - ppbix = ppbi(4) + ppbi(3) - ppbx = ppb(4) + ppb(3) - if(ppbix.GT.0.0 .AND. ppbx.GT.0.0) rate(2) = -ALOG(ppbx/ - & ppbix)/dt -c --- TNO3: Conversion of NO2 after NO:NO2 process - ppbi4 = ppbi(4) + ppbi(3) - ppb(3) - if(ppbi4.GT.0.0 .AND. ppb(4).GT.0.0) rate(3) = -ALOG(ppb(4)/ - & ppbi4)/dt -c --- NO: - delno = ppb(3) - ppbi(3) - if(delno.LT.0.0) then - if(ppbi(3).GT.0.0 .AND. ppb(3).GT.0.0) rate(4) = - & ALOG(ppb(3)/ppbi(3))/dt - elseif(delno.GT.0.0) then - if(ppbi4.GT.0.0 .AND. ppb(4).GT.0.0) rate(4) = -ALOG(ppbi4/ - & ppbi(4))/dt - endif - endif - -c --- Inorganic aerosol equilibrium with ISORROPIA - if(q(5).gt.0.0)then -c -c --- concs in mols/m3 - -c --- 6.42_x1.1 -c --- Apply so4(g/m3) concentration constraint from control file - tso4=q(2)*pivol - tso4=MAX(tso4,so4_isrp)/rmwt(2) - - tso4 = MAX(tso4,1.E-12) - tno3 = q(5) * pivol / rmwt(6) - tnh3 = ctnh3 * rhoair / 28.97E6 - -c --- 6.42_x1.1 -c --- Apply RH(%) constraint from control file to compute RH fraction - rhfrac=0.01*MAX(rhum,rh_isrp) - - if(tno3.gt.1.E-10)then - if(ldb1) then - -c --- 6.42_x1.1 - write(io6,*)'ISODRIVER:tso4,tno3,tnh3,rhfrac,temp = ' - write(io6,*)'called: ',tso4,tno3,tnh3,rhfrac,temp - - endif - call isodriver(tso4,tno3,tnh3,rhfrac,temp,pno3) - if(ldb1) then - write(io6,*)'returned: ',tso4,tno3,tnh3,rhfrac,temp,pno3 - endif - - elseif(l_tno3floor) then - tno3floor=1.E-10 - if(ldb1) then - write(io6,*) - & 'ISODRIVER:tso4,tno3floor,tnh3,rhfrac,temp,pno3= ' - -c --- 6.42_x1.1 - write(io6,*)'called: ', - & tso4,tno3floor,tnh3,rhfrac,temp - - endif - call isodriver(tso4,tno3floor,tnh3,rhfrac,temp,pno3) - if(ldb1) then - write(io6,*)'returned: ', - & tso4,tno3floor,tnh3,rhfrac,temp,pno3 - endif - pno3=pno3*(tno3/tno3floor) - - else - pno3 = 0. - endif - q(6) = pno3 * rmwt(6) / pivol - -c --- 6.42_x1.1 -c --- Condition NO3 (q(6)) to be no smaller than zero - if(q(6).LT.0.0) then - write(io6,*)'CHEMRIV6 Warning: reset NO3(g) from ', - & q(6),' to ZERO' - q(6)=0.0 - endif -c --- Condition NO3 to be no larger than TNO3 (q(5)) -c --- (q(5)>0.0 in this block) - test=q(6)/q(5)-1.0 - if(test.GT.1.0e-06) then - write(io6,*)'CHEMRIV6 Warning: reset NO3(g) from ', - & q(6),' to ',q(5) - endif - q(6)=MIN(q(5),q(6)) - - endif - -c --- Transfer revised mass data to original array - do is = 1,iss - qin(is) = q(is) - end do - - if(ldb1) then - write(io6,*)'After ISODRIVER, Puff Mass (g) -----' - write(io6,'(3x,6f10.2)') (qin(j),j=1,6) - write(io6,*) - endif - - return - end - -c---------------------------------------------------------------------- - subroutine chemriv7(delt,qin,coz,ctnh3,ch2o2,maqchem,rshet,temp, - 1 rhum,rhoair,pivol,zlen,zpuf,cldamr,fzcld, - 2 cldt,cldp,cloud,prate,zcoef,nspec,ldb1,io6, - & rh_isrp,so4_isrp, - 3 rate,scav) -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.1.0 Level: 140521 CHEMRIV7 -c P. Karamchandani, AER (Adapted from chemriv) -c -c --- PURPOSE: This routine sets up call to RIVAD chemical -c transformation subroutines, and passes results to -c calling program -c -c --- UPDATES: -c -c --- V6.41-V6.42_x1.1 140521 : Use cloud fraction to set puff mass -c altered when using AUX-file LWC -c Use local temperature, pressure for AQ -c Adjust mass transformed by fraction of -c puff that overlays cloud water layers -c Condition NO3 to be no larger than TNO3 -c and no smaller than zero -c Add list file unit to SOADRIVER -c Add minimum RH and SO4 for ISORROPIA -c -c --- V6.302-V6.41 110301 (DGS): Treat aqueous-phase transformation -c case of precip without cloud water -c (from AUX file) by using a default -c lwc=0.5g/m3 with at least 10% cloud -c cover -c --- V5.8-V6.302 100917 (DGS): Pass RSHET(fraction/hr) for setting -c heterogeneous SO2 reaction rate -c (DGS): Add local cloud water mixing ratio -c to input argument list (MLWC option) -c (DGS): Add local logical to convert LWC -c passed to AQRADM from g/m3 to kg/m3 -c (DGS): Add local logical to use the minimum -c TNO3 as a floor rather than as a -c breakpoint for NO3=0.0 -c (DGS): Add local logical to set a minimum -c cloud cover (10%) whenever there is -c liquid precipitation for use in the -c aqueous phase reaction/scavenging, -c and add but do not activate code to -c change the effective scavenging -c coefficients by limiting their action -c in any timestep to just the cloud -c fraction affecting the puff mass. -c -c --- INPUTS: -c DELT - real - integration time interval (hours) -c QIN(mxspec) - real - Pollutant mass (g) in the puff -c QIN(1) = SO2 -c QIN(2) = SO4 -c QIN(3) = NO -c QIN(4) = NO2 -c QIN(5) = TNO3 (HNO3 + NO3) -c QIN(6) = NH4NO3 -c QIN(7) = Primary OC (POC) -c QIN(8) = TOL (Toluene) -c QIN(9) = TOLAER1 (Condensable product) -c QIN(10) = TOLAER2 (Condensable product) -c QIN(11) = ATOLA1 (SOA 1 from TOL) -c QIN(12) = ATOLA2 (SOA 2 from TOL) -c QIN(13) = XYL (Xylene) -c QIN(14) = XYLAER1 (Condensable product) -c QIN(15) = XYLAER2 (Condensable product) -c QIN(16) = AXYLA1 (SOA 1 from XYL) -c QIN(17) = AXYLA2 (SOA 2 from XYL) -c QIN(18) = ALKH (Higher alkanes) -c QIN(19) = ALKHAER (Condensable product) -c QIN(20) = ALKHA (SOA 1 from ALKH) -c QIN(21) = PAH -c QIN(22) = PAHAER1 (Condensable product) -c QIN(23) = PAHAER2 (Condensable product) -c QIN(24) = APAHA1 (SOA 1 from PAH) -c QIN(25) = APAHA2 (SOA 2 from PAH) -c -c COZ - real - puff ozone concentration (ppb) -c CTNH3 - real - background ammonia concentration (ppb) -c CH2O2 - real - puff H2O2 concentration (ppb) -c MAQCHEM - integer - Aqueous phase transformation flag -c 0 = aqueous phase transformation -c not modeled -c 1 = transformation rates adjusted -c for aqueous phase reactions -c RSHET - real - SO2 heterogeneous loss rate (fraction/hr) -c TEMP - real - temperature (deg. K) -c RHUM - real - relative humidity (percent) -c RHOAIR - real - surface air density (kg/m**3) -c PIVOL - real - Reciprocal of puff volume (1/m**3) -C ZLEN - real - Puff vertical length scale (m) -c ZPUF - real - Puff/Slug elevation (m MSL) -c CLDAMR - real - Average cloud water mixing ratio (g/kg) -c -c --- 6.42_x1.1 -c FZCLD - real - Fraction of puff layer in cloud -c CLDT - real - Average cloud temperature (K) -c CLDP - real - Average cloud pressure (atm) -c RH_ISRP - real - Minimum relative humidity (%) -c for ISORROPIA -c SO4_ISRP - real - Minimum SO4 (g/m3) for ISORROPIA -c -c CLOUD - real - Cloud cover (tenths) -c PRATE - real - Precip. rate (mm/hr) -c ZCOEF - real - Cosine of solar zenith angle -c NSPEC - real - number of species -c LDB1 - logical - Control variable for printing of debug -c information -c IO6 - integer - Fortran unit number of printed output -c -c -c --- OUTPUT: -c QIN(mxspec) - real - Pollutant mass (g) in the puff -c QIN(1) = SO2 -c QIN(2) = SO4 -c QIN(3) = NO -c QIN(4) = NO2 -c QIN(5) = TNO3 (HNO3 + NO3) -c QIN(6) = NH4NO3 -c QIN(7) = Primary OC (POC) -c QIN(8) = TOL (Toluene) -c QIN(9) = TOLAER1 (Condensable product) -c QIN(10) = TOLAER2 (Condensable product) -c QIN(11) = ATOLA1 (SOA 1 from TOL) -c QIN(12) = ATOLA2 (SOA 2 from TOL) -c QIN(13) = XYL (Xylene) -c QIN(14) = XYLAER1 (Condensable product) -c QIN(15) = XYLAER2 (Condensable product) -c QIN(16) = AXYLA1 (SOA 1 from XYL) -c QIN(17) = AXYLA2 (SOA 2 from XYL) -c QIN(18) = ALKH (Higher alkanes) -c QIN(19) = ALKHAER (Condensable product) -c QIN(20) = ALKHA (SOA 1 from ALKH) -c QIN(21) = PAH -c QIN(22) = PAHAER1 (Condensable product) -c QIN(23) = PAHAER2 (Condensable product) -c QIN(24) = APAHA1 (SOA 1 from PAH) -c QIN(25) = APAHA2 (SOA 2 from PAH) -c RATE(8) - real - Transformation rates (percent/hour) -c R(1) -- SO2 loss rate -c R(2) -- NOX loss rate -c R(3) -- TNO3 formation rate -c R(4) -- NO loss rate -c R(5) -- TOL loss rate -c R(6) -- XYL loss rate -c R(7) -- ALKH loss rate -c R(8) -- PAH loss rate -c SCAV(6) - real - Scavenging coefficients (1/s) -c SCAV(1) -- SO2 -c SCAV(2) -- SO4 -c SCAV(3) -- NO -c SCAV(4) -- NO2 -c SCAV(5) -- HNO3 -c SCAV(6) -- NO3 -c -c --- CHEMRIV7 called by: CHEM -c --- CHEMRIV7 calls: PHOT, CHMRIV7, ISODRIVER, SOADRIVER, AQRADM -c---------------------------------------------------------------------- -c - implicit none - -! --- Arguments - integer nspec, maqchem, io6 - real delt, coz, ctnh3, ch2o2, temp, rhum, rhoair, pivol, zlen - real zpuf, cloud, prate, zcoef, rshet - real qin(nspec), scav(nspec) - real rate(8) - real cldamr - -c --- 6.42_x1.1 - real cldt,cldp,fzcld,fcloud2 - real rh_isrp,so4_isrp - real cldta,cldpa - real confcta,rhoaira - real test - - logical ldb1 - -! --- Locals - real ppb(25),ppbi(25),q(25) - real rmwt(25) - real lwc ! Liquid water content, g/m3 - real cozm, ch2o2m, ctnh3m ! Concentrations in mols/mols air units - real tno3floor -c --- 6.42_x1.1 - real tso4min -c --- Local controls - logical l_kgpcm, l_tno3floor, l_raincloud - -c --- Concentration array (moles/mole of air) for AQRADM - real con(6) - -c --- Note: TNO3 is weighted as NO3 - data rmwt/64.,96.,30.,46.,62.,62.,180., - & 5*92.,5*106.,3*226.,5*156./ - - real dt, vkgmol, confct, rk1, zcoefb, o3ppm - real presur, f, ppbix, ppbi4, ppbx - real delno, tso4, tno3, tnh3, rhfrac, pno3 - real patm, taucld, rhoairm - integer is, iss, j, ii, i -c - real pcloud, fcloud - -c ---------------------- -c --- Set local controls -c ---------------------- -c --- These enable 2 changes to the code to be reverted to their -c --- original condition. -c --- 1. Selecting l_kgpcm=.TRUE. converts the LWC passed to AQRADM -c --- from g/m3 to kg/m3, since AQRADM assumes it to be kg/m3. -c --- Selecting l_kgpcm=.FALSE. retains the original code and -c --- passes LWC to AQRADM in g/m3. - data l_kgpcm/.TRUE./ -c --- 2. Selecting l_tno3floor=.TRUE. uses the cut-off TNO3 -c --- concentration as a floor, and computes NO3 corresponding -c --- to this floor for all TNO3 less than this floor. The -c --- resulting ratio of NO3/TNO3(floor) is then multiplied by -c --- the actual TNO3 to obtain the final NO3 concentration. -c --- Selecting l_tno3floor=.FALSE. retains the original code -c --- and NO3=0.0 for all TNO3 g/m3(air) - lwc=cldamr*rhoaira -c --- Set minimum cloud fraction to 10% - fcloud=MAX(fcloud,0.1) - pcloud=prate/fcloud -c --- Fraction of puff within cloud horizontally and vertically - fcloud2=fcloud*fzcld - - elseif (fcloud.gt.0. .and. temp.gt.273.15) then - if (prate .gt. 0.) then - lwc = 0.5 - else - lwc = 0.1 - end if - else - lwc = 0. - end if - - if(l_kgpcm) then -c --- Units for lwc in AQRADM are kg/m3 - lwc=0.001*lwc - endif - - if (lwc .gt. 0.) then -c -c --- Calculate concs in moles/mole air units - do ii = 1, 6 - -c --- 6.42_x1.1 - con(ii) = MAX(confcta*q(ii)/rmwt(ii),0.) - - end do -c -c --- Get HNO3 conc from total nitrate and PM nitrate - con(5) = MAX(con(5) - con(6),0.) -c - cozm = coz * 1.E-9 - ch2o2m = ch2o2 * 1.E-9 - ctnh3m = ctnh3 * 1.E-9 -c -c --- Call aqueous-phase chemistry module - taucld = delt * 3600. ! timestep in seconds - -c --- 6.42_x1.1 - rhoairm = rhoaira * 1.E3/28.97 ! air density in moles/m3 - if(ldb1) then - write(io6,*)'AQRADM:cldta,cldpa,pcloud,lwc,cozm,'// - & 'ch2o2m,ctnh3m,con6= ' - write(io6,*)'called: ',cldta,cldpa,pcloud,lwc,cozm, - & ch2o2m,ctnh3m,con - endif - call AQRADM(cldta,cldpa,taucld,pcloud,lwc,cozm,ch2o2m, - & ctnh3m,con,rhoairm,zlen,scav) - if(ldb1) then - write(io6,*)'returned: ',cldta,cldpa,pcloud,lwc,cozm, - & ch2o2m,ctnh3m,con - write(io6,*)' scav: ',scav - endif - -c --- Assign adjusted SO2 and SO4 concs; adjust for cloud cover - q(1) = q(1)*(1. - fcloud2) + fcloud2*con(1)*rmwt(1)/confcta - q(2) = q(2)*(1. - fcloud2) + fcloud2*con(2)*rmwt(2)/confcta -c -c --- Adjusted oxidant concs - coz = coz*(1. - fcloud2) + fcloud2*cozm*1.E9 - ch2o2 = ch2o2*(1. - fcloud2) + fcloud2*ch2o2m*1.E9 - -c -c --- Adjusted scavenging rates - if (prate .gt. 0.) then -c --- Possible alternate method (NA) -c --- if(l_raincloud .AND. fcloud.LT.0.99) then -c --- do ii = 1, 6 -c --- scav(ii)=-ALOG(1.0 - fcloud* -c --- & (1.0 - EXP(-scav(ii)*taucld) ))/taucld -c --- end do -c --- else - do ii = 1, 6 - scav(ii) = scav(ii) * fcloud - end do -c --- endif - end if - end if - end if - -c --- Condition mass results - do is = 1,iss - q(is) = MAX(q(is),0.0) - end do - -c --- Compute ending concentrations as PPB - do is = 1,iss - ppb(is) = (1.0e09)*confct*q(is)/rmwt(is) - end do - -c --- Compute conversion rates (%/hr) for QA review - do i = 1,8 - rate(i) = 0.0 - end do - -c --- Compute these logs only if debug output is ON - if(ldb1) then - dt = .01*delt -c --- SOX: - if(ppbi(1).GT.0.0 .AND. ppb(1).GT.0.0) rate(1) = -ALOG(ppb(1)/ - & ppbi(1))/dt -c --- NOX: - ppbix = ppbi(4) + ppbi(3) - ppbx = ppb(4) + ppb(3) - if(ppbix.GT.0.0 .AND. ppbx.GT.0.0) rate(2) = -ALOG(ppbx/ - & ppbix)/dt -c --- TNO3: Conversion of NO2 after NO:NO2 process - ppbi4 = ppbi(4) + ppbi(3) - ppb(3) - if(ppbi4.GT.0.0 .AND. ppb(4).GT.0.0) rate(3) = -ALOG(ppb(4)/ - & ppbi4)/dt -c --- NO: - delno = ppb(3) - ppbi(3) - if(delno.LT.0.0) then - if(ppbi(3).GT.0.0 .AND. ppb(3).GT.0.0) rate(4) = - & ALOG(ppb(3)/ppbi(3))/dt - elseif(delno.GT.0.0) then - if(ppbi4.GT.0.0 .AND. ppb(4).GT.0.0) rate(4) = -ALOG(ppbi4/ - & ppbi(4))/dt -c --- TOL: - if(ppbi(8).GT.0.0 .AND. ppb(8).GT.0.0) rate(5) = -ALOG(ppb(8)/ - & ppbi(8))/dt -c --- XYL: - if(ppbi(13).GT.0.0 .AND. ppb(13).GT.0.0) rate(6) = - & -ALOG(ppb(13)/ppbi(13))/dt -c --- ALKH: - if(ppbi(18).GT.0.0 .AND. ppb(18).GT.0.0) rate(7) = - & -ALOG(ppb(18)/ppbi(18))/dt -c --- PAH: - if(ppbi(21).GT.0.0 .AND. ppb(21).GT.0.0) rate(8) = - & -ALOG(ppb(21)/ppbi(21))/dt - endif - endif - -c --- Inorganic aerosol equilibrium with ISORROPIA - if(q(5).gt.0.0)then -c -c --- concs in mols/m3 - -c --- 6.42_x1.1 -c --- Apply so4(g/m3) concentration constraint from control file - tso4=q(2)*pivol - tso4=MAX(tso4,so4_isrp)/rmwt(2) - - tso4 = MAX(tso4,1.E-12) - tno3 = q(5) * pivol / rmwt(6) - tnh3 = ctnh3 * rhoair / 28.97E6 - -c --- 6.42_x1.1 -c --- Apply RH(%) constraint from control file to compute RH fraction - rhfrac=0.01*MAX(rhum,rh_isrp) - - if(tno3.gt.1.E-10)then - if(ldb1) then - -c --- 6.42_x1.1 - write(io6,*)'ISODRIVER:tso4,tno3,tnh3,rhfrac,temp = ' - write(io6,*)'called: ',tso4,tno3,tnh3,rhfrac,temp - - endif - call isodriver(tso4,tno3,tnh3,rhfrac,temp,pno3) - if(ldb1) then - write(io6,*)'returned: ',tso4,tno3,tnh3,rhfrac,temp,pno3 - endif - - elseif(l_tno3floor) then - tno3floor=1.E-10 - if(ldb1) then - write(io6,*) - & 'ISODRIVER:tso4,tno3floor,tnh3,rhfrac,temp,pno3= ' - -c --- 6.42_x1.1 - write(io6,*)'called: ', - & tso4,tno3floor,tnh3,rhfrac,temp - - endif - call isodriver(tso4,tno3floor,tnh3,rhfrac,temp,pno3) - if(ldb1) then - write(io6,*)'returned: ', - & tso4,tno3floor,tnh3,rhfrac,temp,pno3 - endif - pno3=pno3*(tno3/tno3floor) - - else - pno3 = 0. - endif - q(6) = pno3 * rmwt(6) / pivol - -c --- 6.42_x1.1 -c --- Condition NO3 (q(6)) to be no smaller than zero - if(q(6).LT.0.0) then - write(io6,*)'CHEMRIV6 Warning: reset NO3(g) from ', - & q(6),' to ZERO' - q(6)=0.0 - endif -c --- Condition NO3 to be no larger than TNO3 (q(5)) -c --- (q(5)>0.0 in this block) - test=q(6)/q(5)-1.0 - if(test.GT.1.0e-06) then - write(io6,*)'CHEMRIV6 Warning: reset NO3(g) from ', - & q(6),' to ',q(5) - endif - q(6)=MIN(q(5),q(6)) - - endif -c -c --- SOA equilibrium -c --- 6.42_x1.1 - call soadriver(io6,q,temp,presur,pivol) -c -c --- Transfer revised mass data to original array - do is = 1,iss - qin(is) = q(is) - end do - - return - end - -c---------------------------------------------------------------------- - subroutine chmriv6(PM,TEMPER,PRESUR,RH,O3PUFF,RK1,ZCOEF, - & TSTP,CONFCT,RSHET) -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.1.0 Level: 100917 CHMRIV6 -c P. Karamchandani, AER (Adapted from chemriv) -c -c --- ADOPTED FROM ARM3 (see banner below) -c Sulfate & nitrate conversion uses exponential fcn -c Unused variables are deactivated -c -c --- UPDATE -c --- V5.8-V6.302 100917 (DGS): Restructure value**-n to value**(-n) -c to satisfy LF95 compiler -c 100917 (DGS): Add heterogeneous reaction rate for -c SO4 and pass RSHET(fraction/hr) -c --- V5.8 071025 (PK): Original -c -c---------------------------------------------------------------------- - IMPLICIT NONE - SAVE -C -CDECK.CHMRIV -C -C DATE: NOVEMBER 1987 -C VERSION: ARM3-1.0 -C -C CALCULATE TRANSFORMATION OF SO2 TO SO4 AND NO2 TO HNO3-NO3 -C FOR ONE TIME STEP, TSTP -C BASED ON RIVAD CHEMICAL MECHANISM -C ADPATED FROM THE RIVAD MODEL -C -C -C INPUT ARGUMENTS: -C PM R MASS OF SPECIES (I) IN PUFF (G) -C SO2, SO4, NO, NO2, HNO3-NO3, TSP -C TEMPER R TEMPERATURE AT PLUME HEIGHT (K) -C PRESUR R PRESSURE AT PLUME HEIGHT (MB) -C RH R RELATIVE HUMIDITY AT PLUME (%) -C O3PUFF R PUFF OZONE CONCENTRATION (PPM) -C RK1 R NO2 PHOTOLYSIS RATE CONSTANT (PPM/MIN) -C ZCOEF R COSINE OF SOLAR ZENITH ANGLE -C TSTP R TIME STEP (HOURS) -C CONFCT R CONVERSION FACTOR FOR UG/M3 TO PPM-MWT -c RSHET R SO2 heterogeneous loss rate (fraction/hr) -C -C OUTPUT ARGUMENTS: -C PM R NEW MASS OF PUFF DUE TO CHANGES BASED ON -C -C -C SUBROUTINES CALLED: -C -C CALLED BY: CHEMRIV6 -C - -! --- Constants - REAL COEF1 ! Molec/cc to ppm conv factor coefficient - PARAMETER ( COEF1 = 7.33981E+15 ) - - REAL CONSTC ! Constant for falloff type reaction - PARAMETER ( CONSTC = 0.6 ) - - REAL TI300 ! 1.0 / 300. - PARAMETER ( TI300 = 1.0 / 300.0 ) - -! --- Arguments - REAL PM(6) - REAL TEMPER, PRESUR, RH, O3PUFF, RK1, ZCOEF, TSTP, CONFCT, RSHET - -! --- Locals - REAL TFACT, R26, ROHM, QJ, PHIKK, RCONST - INTEGER L - REAL CNO, CNO2, CNOX, TAMB, PAMB, RH1, H2O, SUM - REAL XNO, XNOX, XO3, XOX, XNO2, RNO2X, XNO3, XN2O5 - REAL RSULF, RNITR, RKX, RNO3, RNITRN, RNITRD, SULFN - REAL XOHMAX, XOH - REAL A0, A, B, C - - REAL RK0 ! K0 in falloff rate expressions - REAL RKINF ! KINF in falloff rate expressions - REAL XEND ! Exponent in falloff rate expressions -C - REAL KSO2OH ! SO2 + OH rate constant - REAL KNO2OH ! NO2 + OH rate constant -C - REAL*8 TINV, CFACT, RFACT -C - REAL PPM(5),SMWT(5) - LOGICAL LFIRST - DATA LFIRST/.TRUE./ - DATA SMWT/64.0,96.0,30.0,46.0,63.0/ -C -C FIRST TIME THROUGH SET UP SOME GLOBAL RATE CONSTANTS -C - IF (LFIRST) THEN - TFACT = 1./273. - R26 = 1./26.4 - ROHM = 4.87E-7/1.32E-3 - LFIRST = .FALSE. - END IF -C - DO L = 1,5 - PPM(L) = 1.E6*CONFCT*PM(L)/SMWT(L) - END DO -C - CNO = PPM(3) - CNO2 = PPM(4) - CNOX = CNO + CNO2 -C - TAMB = TEMPER - PAMB = PRESUR/1013.0 - TINV = 1. / TAMB - CFACT = COEF1 * PAMB * TINV -C - IF (RK1.LE.0.0) THEN - QJ = 0.0 - PHIKK = 0.0 - ELSE - PHIKK = RK1*R26 - QJ = (1.338E-3)*ZCOEF**2.74 - ENDIF - IF (TAMB.GE.273.) THEN - RCONST = 18.02*(597.3-.566*(TAMB-273.))/1.9869 - ELSE - RCONST = 6133.17 - END IF - RH1 = MIN(RH,95.) - RH1 = MAX(RH1,0.) - H2O = (6030.*.01*RH1/PAMB)*EXP(RCONST*(TFACT-TINV)) -C -C DO SIMPLE CHEMISTRY -C - XNOX = CNOX - XOX = O3PUFF + CNO2 - SUM = XOX + XNOX + PHIKK - XNO2 = 0.5*(SUM-SQRT(ABS(SUM*SUM-4.*XNOX*XOX))) - XNO2 = MIN(XNO2,XNOX) - XNO2 = MAX(XNO2,0.) -c dgs XNO=XNOX-XNO2 -c dgs IF (XNO.LT.0.0) XNO=0.0 - RNO2X = 0. - IF (XNOX.GT.0.) RNO2X = XNO2/XNOX - -c dgs Use NO2/NOX ratio to test for zero NO (single precision) - xno = xnox - xno2 - if(rno2x.GE.0.999999) XNO=0.0 - - XO3 = XOX - XNO2 - XO3 = MAX(XO3,0.) - - IF (ZCOEF.LT.0.06975) THEN -C -C NIGHTTIME CHEMISTRY -C - RSULF = 0. -C -C IMPLEMENT NEW NIGHTTIME CHEMISTRY - 1/86 -C - RNITR = 0.0 - XO3 = MAX(XO3,0.) - IF (XO3.GT.0.) THEN - RKX = 1780./(1.9E-6*H2O + 3.12) - RNO3 = 0.086 - A0 = 0.59 + 1780. -3.12*RKX - A = 2.*RKX*RNO3-A0 - B = RNO3 + 0.0474*XO3 +XNO2*A0 - C = -0.0474*XNO2*XO3 -C - XNO3 = -2.*C/(B+SQRT(B*B-4.*A*C)) - XN2O5 = XNO3*XNO2*RKX - RNITRN = 2.*1.9E-6*H2O*XN2O5*60.*TSTP - RNITRN = MIN(XNO2,RNITRN) - PPM(5) = PPM(5) + RNITRN - XNO2 = XNO2 - RNITRN - END IF - ELSE -C -C DO DAYTIME CHEMISTRY -C - XOHMAX = ROHM*QJ - XOH = XOHMAX - IF (PPM(1).NE.0..OR.XNO2.NE.0.) - 1 XOH = 2.*QJ*3.4E5*H2O*XO3/((4.45E10+3.4E5*H2O)* - 1 (2000.*PPM(1) + 14000.*XNO2)) - XOH = MIN(XOH,XOHMAX) - -C --- SO2 + OH rate constant (falloff expression) - RK0 = 1.0E+06 * CFACT * 3.0E-31 * ( TAMB * TI300 )**(-3.3) - RKINF = 1.5E-12 - XEND = 1.0 / ( 1.0 + ( LOG10( RK0 / RKINF ) )**2 ) - KSO2OH = ( RK0 / ( 1.0 + RK0 / RKINF ) ) * CONSTC**XEND - -C --- NO2 + OH rate constant (falloff expression) - RK0 = 1.0E+06 * CFACT * 2.6E-30 * ( TAMB * TI300 )**(-3.2) - RKINF = 2.4E-11 * ( TAMB * TI300 )**(-1.3) - XEND = 1.0 / ( 1.0 + ( LOG10( RK0 / RKINF ) )**2 ) - KNO2OH = ( RK0 / ( 1.0 + RK0 / RKINF ) ) * CONSTC**XEND -C -C --- Convert rate constants from molec-cc-1 s-1 to ppm-1 hr-1 units - rfact = 2.64e19 * (pamb * tinv) - kso2oh = kso2oh * rfact - kno2oh = kno2oh * rfact - rsulf = 1. - EXP(-kso2oh*xoh*tstp) - rnitr = 1. - EXP(-kno2oh*xoh*tstp) - RNITRD = RNITR*XNO2 - RNITRD = MIN(XNOX,RNITRD) - PPM(5) = PPM(5)+RNITRD - XNOX = XNOX-RNITRD - XNOX = MAX(XNOX,0.) - XNO = XNOX*(1.-RNO2X) - XNO2 = XNOX*RNO2X - - END IF -C -c --- Add heterogeneous rate wso4=rshet*ppm(1)*tstp - SULFN = PPM(1)*RSULF + rshet*ppm(1)*tstp - SULFN = MIN(PPM(1),SULFN) - PPM(2) = PPM(2) + SULFN - PPM(1) = PPM(1) - SULFN -C -C UPDATE NEW STEADY-STATE NO AND NO2 VALUES -C - PPM(3) = XNO - PPM(4) = XNO2 -C -C UPDATE NEW O3 VALUE - O3PUFF = XO3 -C -C CONVERT BACK TO GRAMS OF SPECIES IN PUFF -C - DO L = 1,5 - PM(L) = 1.E-6*PPM(L)*SMWT(L)/CONFCT - END DO - RETURN - END - -c---------------------------------------------------------------------- - subroutine chmriv7(PM,TEMPER,PRESUR,RH,O3PUFF,RK1,ZCOEF, - & TSTP,CONFCT,RSHET) -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.1.0 Level: 100917 CHMRIV7 -c P. Karamchandani, AER (Adapted from chemriv) -c -c --- ADOPTED FROM ARM3 (see banner below) -c Sulfate & nitrate conversion uses exponential fcn -c Unused variables are deactivated -c -c --- UPDATE -c --- V5.8-V6.302 100917 (DGS): Restructure value**-n to value**(-n) -c to satisfy LF95 compiler -c (DGS): Add heterogeneous reaction rate for -c SO4 and pass RSHET(fraction/hr) -c --- V5.8 071025 (PK): Original -c -c---------------------------------------------------------------------- - IMPLICIT NONE - SAVE -C -CDECK.CHMRIV -C -C DATE: NOVEMBER 1987 -C VERSION: ARM3-1.0 -C -C CALCULATE TRANSFORMATION OF SO2 TO SO4 AND NO2 TO HNO3-NO3 -C FOR ONE TIME STEP, TSTP -C BASED ON RIVAD CHEMICAL MECHANISM -C ADPATED FROM THE RIVAD MODEL -C -C -C INPUT ARGUMENTS: -C PM R MASS OF SPECIES (I) IN PUFF (G) -C SO2, SO4, NO, NO2, HNO3-NO3, TSP -C TEMPER R TEMPERATURE AT PLUME HEIGHT (K) -C PRESUR R PRESSURE AT PLUME HEIGHT (MB) -C RH R RELATIVE HUMIDITY AT PLUME (%) -C O3PUFF R PUFF OZONE CONCENTRATION (PPM) -C RK1 R NO2 PHOTOLYSIS RATE CONSTANT (PPM/MIN) -C ZCOEF R COSINE OF SOLAR ZENITH ANGLE -C TSTP R TIME STEP (HOURS) -C CONFCT R CONVERSION FACTOR FOR UG/M3 TO PPM-MWT -c RSHET R SO2 heterogeneous loss rate (fraction/hr) -C -C OUTPUT ARGUMENTS: -C PM R NEW MASS OF PUFF DUE TO CHANGES BASED ON -C -C -C SUBROUTINES CALLED: -C -C CALLED BY: CHEMRIV7 -C - -! --- Constants - REAL COEF1 ! Molec/cc to ppm conv factor coefficient - PARAMETER ( COEF1 = 7.33981E+15 ) - - REAL CONSTC ! Constant for falloff type reaction - PARAMETER ( CONSTC = 0.6 ) - - REAL TI300 ! 1.0 / 300. - PARAMETER ( TI300 = 1.0 / 300.0 ) - -! --- Arguments - REAL PM(25) - REAL TEMPER, PRESUR, RH, O3PUFF, RK1, ZCOEF, TSTP, CONFCT, RSHET - -! --- Locals - REAL TFACT, R26, ROHM, QJ, PHIKK, RCONST - INTEGER L - REAL CNO, CNO2, CNOX, TAMB, PAMB, RH1, H2O, SUM - REAL XNO, XNOX, XO3, XOX, XNO2, RNO2X, XNO3, XN2O5 - REAL RSULF, RNITR, RKX, RNO3, RNITRN, RNITRD, SULFN - REAL XOHMAX, XOH - REAL A0, A, B, C - - REAL RK0 ! K0 in falloff rate expressions - REAL RKINF ! KINF in falloff rate expressions - REAL XEND ! Exponent in falloff rate expressions -C - REAL KSO2OH ! SO2 + OH rate constant - REAL KNO2OH ! NO2 + OH rate constant - REAL KTOLOH ! TOL + OH rate constant - REAL KXYLOH ! XYL + OH rate constant - REAL KALKHOH ! ALKH + OH rate constant - REAL KPAHOH ! PAH + OH rate constant -C - REAL DTOL, DXYL, DALKH, DPAH -C - REAL*8 TINV, CFACT, RFACT -C - REAL PPM(25),SMWT(25) - LOGICAL LFIRST - DATA LFIRST/.TRUE./ - DATA SMWT/64.0,96.0,30.0,46.0,63.0,62.0,180.0, - & 5*92.0,5*106.0,3*226.0,5*156.0/ - -C -C FIRST TIME THROUGH SET UP SOME GLOBAL RATE CONSTANTS -C - IF (LFIRST) THEN - TFACT = 1./273. - R26 = 1./26.4 - ROHM = 4.87E-7/1.32E-3 - LFIRST = .FALSE. - END IF -C - DO L = 1,5 - PPM(L) = 1.E6*CONFCT*PM(L)/SMWT(L) - END DO -C - DO L = 8,25 - PPM(L) = 1.E6*CONFCT*PM(L)/SMWT(L) - END DO -C - CNO = PPM(3) - CNO2 = PPM(4) - CNOX = CNO + CNO2 -C - TAMB = TEMPER - PAMB = PRESUR/1013.0 - TINV = 1. / TAMB - CFACT = COEF1 * PAMB * TINV -C - IF (RK1.LE.0.0) THEN - QJ = 0.0 - PHIKK = 0.0 - ELSE - PHIKK = RK1*R26 - QJ = (1.338E-3)*ZCOEF**2.74 - ENDIF - IF (TAMB.GE.273.) THEN - RCONST = 18.02*(597.3-.566*(TAMB-273.))/1.9869 - ELSE - RCONST = 6133.17 - END IF - RH1 = MIN(RH,95.) - RH1 = MAX(RH1,0.) - H2O = (6030.*.01*RH1/PAMB)*EXP(RCONST*(TFACT-TINV)) -C -C DO SIMPLE CHEMISTRY -C - XNOX = CNOX - XOX = O3PUFF + CNO2 - SUM = XOX + XNOX + PHIKK - XNO2 = 0.5*(SUM-SQRT(ABS(SUM*SUM-4.*XNOX*XOX))) - XNO2 = MIN(XNO2,XNOX) - XNO2 = MAX(XNO2,0.) -c dgs XNO=XNOX-XNO2 -c dgs IF (XNO.LT.0.0) XNO=0.0 - RNO2X = 0. - IF (XNOX.GT.0.) RNO2X = XNO2/XNOX - -c dgs Use NO2/NOX ratio to test for zero NO (single precision) - xno = xnox - xno2 - if(rno2x.GE.0.999999) XNO = 0.0 - - XO3 = XOX - XNO2 - XO3 = MAX(XO3,0.) - IF (ZCOEF.LT.0.06975) THEN -C -C NIGHTTIME CHEMISTRY -C - RSULF = 0. -C -C IMPLEMENT NEW NIGHTTIME CHEMISTRY - 1/86 -C - RNITR = 0.0 - XO3 = MAX(XO3,0.) - IF (XO3.GT.0.) THEN - RKX = 1780./(1.9E-6*H2O + 3.12) - RNO3 = 0.086 - A0 = 0.59 + 1780. -3.12*RKX - A = 2.*RKX*RNO3-A0 - B = RNO3 + 0.0474*XO3 +XNO2*A0 - C = -0.0474*XNO2*XO3 -C - XNO3 = -2.*C/(B+SQRT(B*B-4.*A*C)) - XN2O5 = XNO3*XNO2*RKX - RNITRN = 2.*1.9E-6*H2O*XN2O5*60.*TSTP - RNITRN = MIN(XNO2,RNITRN) - PPM(5) = PPM(5) + RNITRN - XNO2 = XNO2 - RNITRN - END IF - ELSE -C -C DO DAYTIME CHEMISTRY -C - XOHMAX = ROHM*QJ - XOH = XOHMAX - IF (PPM(1).NE.0..OR.XNO2.NE.0.) - 1 XOH = 2.*QJ*3.4E5*H2O*XO3/((4.45E10+3.4E5*H2O)* - 1 (2000.*PPM(1) + 14000.*XNO2)) - XOH = MIN(XOH,XOHMAX) - -C --- SO2 + OH rate constant (falloff expression) - RK0 = 1.0E+06 * CFACT * 3.0E-31 * ( TAMB * TI300 )**(-3.3) - RKINF = 1.5E-12 - XEND = 1.0 / ( 1.0 + ( LOG10( RK0 / RKINF ) )**2 ) - KSO2OH = ( RK0 / ( 1.0 + RK0 / RKINF ) ) * CONSTC**XEND -C -C --- NO2 + OH rate constant (falloff expression) - RK0 = 1.0E+06 * CFACT * 2.6E-30 * ( TAMB * TI300 )**(-3.2) - RKINF = 2.4E-11 * ( TAMB * TI300 )**(-1.3) - XEND = 1.0 / ( 1.0 + ( LOG10( RK0 / RKINF ) )**2 ) - KNO2OH = ( RK0 / ( 1.0 + RK0 / RKINF ) ) * CONSTC**XEND -C -C --- TOL + OH rate constant - ktoloh = 2.1e-12 * EXP(322.*tinv) -C -C --- XYL + OH rate constant - kxyloh = 1.7e-11 * EXP(116.*tinv) -C -C --- ALKH + OH rate constant - kalkhoh = 1.97e-11 -C -C --- PAH + OH rate constant - kpahoh = 7.7e-11 -C -C --- Convert rate constants from molec-cc-1 s-1 to ppm-1 hr-1 units - rfact = 2.64e19 * (pamb * tinv) - kso2oh = kso2oh * rfact - kno2oh = kno2oh * rfact - rsulf = 1. - EXP(-kso2oh*xoh*tstp) - rnitr = 1. - EXP(-kno2oh*xoh*tstp) - RNITRD = RNITR*XNO2 - RNITRD = MIN(XNOX,RNITRD) - PPM(5) = PPM(5) + RNITRD - XNOX = XNOX - RNITRD - XNOX = MAX(XNOX,0.) - XNO = XNOX*(1.-RNO2X) - XNO2 = XNOX*RNO2X - - ktoloh = ktoloh * rfact - kxyloh = kxyloh * rfact - kalkhoh = kalkhoh * rfact - kpahoh = kpahoh * rfact -C -C --- Change in SOA precursor concentrations - dtol = (1. - EXP(-ktoloh*xoh*tstp)) * ppm(8) - dxyl = (1. - EXP(-kxyloh*xoh*tstp)) * ppm(13) - dalkh = (1. - EXP(-kalkhoh*xoh*tstp)) * ppm(18) - dpah = (1. - EXP(-kpahoh*xoh*tstp)) * ppm(21) - - ppm(8) = ppm(8) - dtol ! TOL - ppm(9) = ppm(9) + 0.071*dtol ! TOLAER1 - ppm(10) = ppm(10) + 0.138*dtol ! TOLAER2 - - ppm(13) = ppm(13) - dxyl ! XYL - ppm(14) = ppm(14) + 0.038*dxyl ! XYLAER1 - ppm(15) = ppm(15) + 0.167*dxyl ! XYLAER2 - - ppm(18) = ppm(18) - dalkh ! ALKH - ppm(19) = ppm(19) + 1.173*dalkh ! ALKHAER - - ppm(21) = ppm(21) - dpah ! PAH - ppm(22) = ppm(22) + 0.156*dpah ! PAHAER1 - ppm(23) = ppm(23) + 0.777*dpah ! PAHAER2 - END IF - -c --- Add heterogeneous rate wso4=rshet*ppm(1)*tstp - SULFN = PPM(1)*RSULF + rshet*ppm(1)*tstp - SULFN = MIN(PPM(1),SULFN) - PPM(2) = PPM(2) + SULFN - PPM(1) = PPM(1) - SULFN -C -C UPDATE NEW STEADY-STATE NO AND NO2 VALUES -C - PPM(3) = XNO - PPM(4) = XNO2 -C -C UPDATE NEW O3 VALUE - O3PUFF = XO3 -C -C CONVERT BACK TO GRAMS OF SPECIES IN PUFF -C - DO L = 1,5 - PM(L) = 1.E-6*PPM(L)*SMWT(L)/CONFCT - END DO -C - DO L = 8,25 - PM(L) = 1.E-6*PPM(L)*SMWT(L)/CONFCT - END DO -C - RETURN - END - -c--------------------------------------------------------------------- - subroutine setbckoc(ndathr) -c--------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.1.0 Level: 071025 SETBCKOC -c P. Karamchandani, AER (Adapted from setsoa) -c -c --- PURPOSE: Background OC concentration (ug/m3) for current hour -c -c --- INPUTS: -c NDATHR - integer - YYJJJHH date-time for hour -c -c Common Block /CHEMDAT/ variables: -c BCKPMF(12),OFRAC(12) -c -c --- OUTPUT: -c -c Common Block /NEWSOA/ variables: bckoc -c -c --- SETBCKOC called by: COMP -c --- SETBCKOC calls: GRDAY -c---------------------------------------------------------------------- - include 'params.puf' - include 'chemdat.puf' - include 'newsoa.puf' - -c --- Extract month from date-time - iyr=ndathr/100000 - ijul=ndathr/100 - 1000*iyr - call GRDAY(io6,iyr,ijul,imo,iday) - -c --- Set background OC data for this month - bckoc=bckpmf(imo)*ofrac(imo) - - return - end - -c---------------------------------------------------------------------- - subroutine isodriver(so4,no3,nh3,nrh,ntempk,pno3c) -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.1.0 Level: 140521 ISODRIVER -c P. Karamchandani, AER -c -c --- PURPOSE: Driver routine to calculate gas/particle equilibrium -c using ISORROPIA aerosol equilibrium module -c This version uses double precision -c -c --- UPDATES: -c -c --- V6.4-V6.42_x1.1 140521 : Call ISOROPIA with METASTABLE ON -c -c --- V6.302-V6.4 101025 (DGS): Revise ISOROPIA arguments for V2.1 -c -c --- INPUTS: -c so4 - real - Total sulfate concentration (mole/m3) -c no3 - real - Total nitrate concentration (mole/m3) -c nh3 - real - Total ammonia concentration (mole/m3) -c nrh - real - Fractional relative humidity -c ntempk - real - Temperature (K) -c -c --- OUTPUT: -c pno3c - real - Particle-phase equilibrium NO3 -c concentration (mole/m3) -c -c --- ISODRIVER called by: CHEMRIV6, CHEMRIV7 -c --- ISODRIVER calls: ISOROPIA -c---------------------------------------------------------------------- - -C*********************************************************************** -C * -C REVISION HISTORY: * -C Version 1.0 developed November 2006 by PK, AER, Inc. for * -C CALPUFF for API Contract No. 2006-102376 * -C * -C*********************************************************************** -C -C........... INCLUDES - - INCLUDE 'isrpia.inc' - -C........... ARGUMENTS and their descriptions - - REAL SO4 ! Total sulfate (moles/m3) - REAL NO3 ! Total nitrate (moles/m3) - REAL NH3 ! Total ammonia (moles/m3) - REAL NRH ! Relative humidity as fraction - REAL NTEMPK ! Temperature in Kelvin - - REAL PNO3C ! Particle-phase NO3 concentration (mole/m**3) - -! --- Locals - REAL GNO3C ! Gas-phase concentration of HNO3 in mole/m**3 air - - INTEGER NCTRL, NOTHER -cV1.7 PARAMETER(NCTRL = 2,NOTHER = 6) -cV2.1 PARAMETER(NCTRL = 2,NOTHER = 9) - PARAMETER(NCTRL = 2,NOTHER = 9) - -! --- Gas-phase concentration array in moles/m**3 air - REAL*8 GAS(NGASAQ) - -! --- Aqueous-phase concentration array in moles/m**3 air - REAL*8 AERLIQ(NIONS+NGASAQ+2) - -! --- Solid-phase concentration array in moles/m**3 air - REAL*8 AERSLD(NSLDS) - -! --- Flag for different types of problems solved and -! --- different state of aerosols (deliquescent or metastable) - REAL*8 CNTRL(NCTRL) - -! Solution information array (see ISOCOM.f for details) - REAL*8 OTHER(NOTHER) - -! Total species concentrations in moles/m**3 air - REAL*8 WI(NCOMP) - -! Temperature and humidity - REAL*8 TEMPI, RHI -C*********************************************************************** -C begin body of subroutine -C -C *** Assign input total concentrations to WI - - WI(1) = 0. ! Na concentration - WI(2) = so4 - WI(3) = nh3 - WI(4) = no3 - WI(5) = 0. ! Cl concentration -cV2.1 Additional 3 are not used here - WI(6) = 0. ! total calcium concentration - WI(7) = 0. ! total potassium concentration - WI(8) = 0. ! total magnesium concentration - - RHI = NRH - TEMPI = NTEMPK -C -C *** CALL ISORROPIA -C - CNTRL(1) = 0. ! 0 = FORWARD PROBLEM, 1 = REVERSE PROBLEM - -c --- 6.42_x1.1 - CNTRL(2) = 1. ! 0 = SOLID + LIQUID AEROSOL, 1 = METASTABLE -C - CALL ISOROPIA (WI, RHI, TEMPI, CNTRL, - & W, GAS, AERLIQ, AERSLD, SCASE, OTHER) -C -C *** SAVE RESULTS - -! Gas-phase HNO3 (moles/m3) - GNO3C = GAS(2) - -! Particle-phase NO3 (moles/m3) - PNO3C = MAX(0.,NO3 - GNO3C) -C - RETURN - END - - -c---------------------------------------------------------------------- - subroutine soadriver(ilst,q,tempk,press,pivol) -c---------------------------------------------------------------------- - -C*********************************************************************** -C FUNCTION: Driver routine to calculate SOA gas-particle equilibrium * -C * -c -c --- UPDATES: -c -c --- V6.4-V6.42_x1.1 140521 : Iterate on CALTECH_SOA call to update -c absorbing organic mass -c -C INPUTS: * -C ilst - List-file unit * -C q - Mass of species in puff * -C tempk - Temperature (K) * -C press - Pressure at plume height (mb) * -C pivol - Reciprocal of puff volume (1/m**3) * -C * -C RETURN VALUES: * -C q - Adjusted mass of species in puff * -C * -C REVISION HISTORY: * -C Version 1.0 developed November 2006 by PK, AER, Inc. for * -C CALPUFF for API Contract No. 2006-102376 * -C*********************************************************************** - IMPLICIT NONE -C -C........... INCLUDES - - INCLUDE 'newsoa.puf' - INCLUDE 'soadat.puf' - -C........... ARGUMENTS and their descriptions - -c --- 6.42_x1.1 - integer ilst ! List-file unit - - REAL q(25) ! Puff masses (g) - REAL tempk ! Temperature in Kelvin - REAL press ! Pressure in mb - REAL pivol ! reciprocal of puff volume (1/m3) - -! Local variables - integer iorg ! loop index -! Secondary organic aerosol concentrations (ug/m3) -! --- Gas-phase compounds - REAL gasorg(NORG) -! --- Particle-phase compounds - REAL partorg(NORG) -! --- Total (gas-phase + particle-phase) - REAL worg(NORG+1) ! additional species at end for primary OC - -! --- Conversion factor - REAL cfact - -c --- 6.42_x1.1 -! --- OA mass iteration - integer iter, niter - real psum1, psum2, pdiff - -C*********************************************************************** -C begin body of subroutine -C -C *** Convert input puff masses (g) to puff concentrations (ug/m3) - - cfact = pivol * 1.E6 - -! Gases - gasorg(1) = q(9) * cfact ! TOLAER1 - gasorg(2) = q(10) * cfact ! TOLAER2 - gasorg(3) = q(14) * cfact ! XYLAER1 - gasorg(4) = q(15) * cfact ! XYLAER2 - gasorg(5) = q(19) * cfact ! ALKHAER - gasorg(6) = q(22) * cfact ! PAHAER1 - gasorg(7) = q(23) * cfact ! PAHAER2 - -! Particles - partorg(1) = q(11) * cfact ! ATOLA1 - partorg(2) = q(12) * cfact ! ATOLA2 - partorg(3) = q(16) * cfact ! AXYLA1 - partorg(4) = q(17) * cfact ! AXYLA2 - partorg(5) = q(20) * cfact ! AALKHA - partorg(6) = q(24) * cfact ! APAHA1 - partorg(7) = q(25) * cfact ! APAHA2 - -! Total - do iorg = 1, NORG - worg(iorg) = gasorg(iorg) + partorg(iorg) - end do - -! Organic absorbing mass - worg( NORG + 1 ) = MAX(q(7)*cfact + bckoc, 0.) - -! Calculate organic aerosol formation using Caltech SOA Module - -c --- 6.42_x1.1 -! --- Iterate on this call until difference in particulate OC total <1% -! --- PDIFF is 1% criterion for difference -! --- NITER is set large but finite to trap endless loop -! --- ITER is current loop counter - pdiff=0.01 - niter=10000 - iter=0 -10 psum1=0.0 - do iorg = 1, NORG - psum1=psum1+partorg(iorg) - end do - - call caltech_soa(worg, gasorg, partorg, tempk) - -c --- 6.42_x1.1 - iter=iter+1 - psum2=-psum1 - do iorg = 1, NORG - psum2=psum2+partorg(iorg) - end do - if(psum1.GT.0.0) then - if(iter.LE.niter) then - if(ABS(psum2/psum1) .GT. pdiff) goto 10 - else -! --- Report too many iterations warning and stop iterating - write(ilst,*)'SOADRIVER: Warning ...' - write(ilst,*)' Iterations exceed NITER = ',niter, - & ' when computing particulate SOA ' - write(ilst,*)' Target fractional SOA change = ',pdiff - write(ilst,*)' Last fractional SOA change = ',psum2/psum1 - endif - elseif(worg(norg+1).GT.0.0 .AND. iter.EQ.1) then - goto 10 - endif - -! --- Assign adjusted concentrations back to puff masses - - cfact = 1./cfact -! Gases - q(9) = gasorg(1) * cfact ! TOLAER1 - q(10) = gasorg(2) * cfact ! TOLAER2 - q(14) = gasorg(3) * cfact ! XYLAER1 - q(15) = gasorg(4) * cfact ! XYLAER2 - q(19) = gasorg(5) * cfact ! ALKHAER - q(22) = gasorg(6) * cfact ! PAHAER1 - q(23) = gasorg(7) * cfact ! PAHAER2 - -! Particles - q(11) = partorg(1) * cfact ! ATOLA1 - q(12) = partorg(2) * cfact ! ATOLA2 - q(16) = partorg(3) * cfact ! AXYLA1 - q(17) = partorg(4) * cfact ! AXYLA2 - q(20) = partorg(5) * cfact ! AALKHA - q(24) = partorg(6) * cfact ! APAHA1 - q(25) = partorg(7) * cfact ! APAHA2 -C - RETURN - END - -c---------------------------------------------------------------------- - SUBROUTINE CALTECH_SOA (WORG, GASORG, PARTORG, CURTEMP) -c---------------------------------------------------------------------- - -C*********************************************************************** -C FUNCTION: Program to simulate Secondary Organic Aerosols * -C Total no. of species = 4 + 34 = 38 * -C Partition equation * -C Kom, i = (Ai/Mo)/Gi * -C Ai = particle-phase concentration (ug/m**3 air) * -C Gi = gas-phase concentration (ug/m**3 air) * -C MSUM = sum Ai + primary organics * -C Kom, i has the units of m3/ug * -C PRECONDITION REQUIRED: called from subr. AEROEQ * -C RETURN VALUES: * -C PARTORG(I) - Particulate concentration of organic species i * -C GASORG(I) - Gas-phase concentration of organic species i * -C REVISION HISTORY: * -C Written by Betty K. Pun of AER, Inc. for EPRI's Aerosol * -C Module Implementation Project, May, 1999 * -C Revised by Yang Zhang of AER, Inc. for EPRI's Aerosol * -C Module Implementation Project based on Models3's * -C coding standard July, 1999 * -C Revised by Betty K. Pun of AER, Inc. November, 99 * -C for incorporation into 3-D model under EPRI. * -C To reduce computational requirement and to * -C facilitate numerical solution, simultaneous equations * -C are not solved in this version. Instead, the partition of * -C each organic aerosol at each time depends on the amount of * -C material in the organic phase at the step before the partition* -C Modified by Betty K. Pun, AER to include temperature dependence * -C based on generic Hvap, February/March 2002 * -c Revised by BKP March 2006, change reference temperature from * -C 310 to 298K * -c Updated by PK December 2006, for implementation in CALPUFF * -c for API Contract No. 2006-102376 * -C REFERENCES: * -C 1. Odum et al., 97. EST 31:1890 * -C 2. Griffin et al., 99. JGR 104:3555 * -C * -C*********************************************************************** - - IMPLICIT NONE - -C........... INCLUDES - INCLUDE 'soadat.puf' - -C........... ARGUMENTS and their descriptions and some other variables - - REAL WORG(NORG+1) ! Total organic species concentration - REAL PARTORG(NORG) ! Particulate concentration of organic species i - REAL GASORG(NORG) ! Gas-phase concentration of organic species i - REAL CURTEMP ! Puff temperature used in modifying parititon - ! constants - -C.......... Local Variables - - REAL MP ! Total organic species concentration - REAL MSUM ! Sum of particle-phase concentration (ug/m**3 air) - INTEGER I ! Organic species index - -C*********************************************************************** -C begin body of subroutine - - MP = WORG(NORG + 1) ! OC (primary+background) - MSUM = MP - - DO I = 1, NORG - IF (WORG(I) . LT . 0.0) THEN - WRITE (*, 95000) I -95000 FORMAT ('ERROR: Negative conc. read for species', I2) - WRITE (*, *) 'Negative Conc. = ',WORG(I) - call flush(6) - STOP - END IF - MSUM = MSUM + PARTORG(I) !add starting SOA to MSUM - END DO - - IF (MSUM . GT . 0.0) THEN - call SOASUB (MSUM, WORG, PARTORG, GASORG, CURTEMP) - ENDIF - - DO I = 1, NORG - IF (PARTORG(I) . LT . 0.0) THEN - PARTORG(I) = 0.0 - GASORG(I) = WORG(I) - END IF - END DO - - RETURN - END - -c---------------------------------------------------------------------- - SUBROUTINE SOASUB (MSUM, WORG, PARTORG, GASORG, CURTEMP) -c---------------------------------------------------------------------- - -C*********************************************************************** -C FUNCTION: Program to calculate the equilibria * -C PRECONDITION REQUIRED: called from subr. CALTECHSOA * -C RETURN VALUES: * -C PARTORG(J) - Particule-phase concentrations (microgram/m**3) * -C GASORG(J) - Gas-phase concentrations (microgram/m**3) * -C REVISION HISTORY: * -C Written by Betty K. Pun of AER, Inc. for EPRI's Aerosol * -C Module Implementation Project, May, 1999 * -C Revised by Yang Zhang of AER, Inc. for EPRI's Aerosol * -C Module Implementation Project based on Models3's * -C coding standard July, 1999 * -C Modified by Betty K. Pun of AER, Inc, for Models-3 application * -C Analytical solution calculated November, 99 * -C Modified by Betty K. Pun, AER to include temperature dependence * -C based on generic Hvap, February/March 2002 * -C*********************************************************************** - - IMPLICIT NONE - -C........... INCLUDES - - INCLUDE 'soadat.puf' - -C........... ARGUMENTS and their descriptions - - REAL MSUM ! Sum of particle-phase concentration (ug/m**3 air) - REAL WORG(NORG+1) ! Total organic species concentration - REAL PARTORG(NORG) ! Particulate concentration of organic species i - REAL GASORG(NORG) ! Gas-phase concentration of organic species i - REAL CURTEMP ! Grid cell temperature used in modifying parititon - ! constants -c........... Local variables - INTEGER J ! Organic species index - REAL KCORR(NORG) ! Partition coefficients, corrected for temperature - ! [m**3/ug] - REAL TEXPT ! temperature where KOM (experimental values) - ! are obtained - PARAMETER (TEXPT = 298.0) - -C .......... Other Variables - -C*********************************************************************** -C begin body of subroutine - - IF (MSUM . EQ . 0.0) THEN - WRITE(*, *) 'Error in SOA: MSUM = 0.0' - STOP - END IF -C -C *** Calculate the equilibrium concentration -C GASORG(J) = WORG(J) - PARTORG(J) -C G = C - A -C (A/M)/G = K is equal to A/(C-A) = KM is equal to A = CKM - AKM -C Therefore A = CKM / (1 + KM) - -C add code to correct for CURTEMPerature, assuming KOM is experimental -C values obtained at 310 K (changed to a ref temp of 298K) - DO J = 1, NORG - KCORR(J) = EXP(HVAP(J)*(1/CURTEMP - 1/TEXPT)/RKJMOLK) - & * KOM(J) * CURTEMP/TEXPT - PARTORG(J) = WORG(J) * KCORR(J)* MSUM / - & (1. + MSUM * KCORR(J)) - GASORG(J) = WORG (J) - PARTORG(J) - END DO - - RETURN - END - - -c---------------------------------------------------------------------- - subroutine aqradm ( temp, pres_atm, taucld, prcrate, wcavg, coz, - & ch2o2, ctnh3, conc, rhoair, len, scav ) -c---------------------------------------------------------------------- -C -C DESCRIPTION: -C Compute concentration changes in cloud due to aqueous chemistry -C Adapted from RADM Cloud implementation in CMAQ/SCICHEM for CALPUFF -C by PK, AER, January 2007 for API Contract No. 2006-102376 -C -C Reference: -C Walcek & Taylor, 1986, A theoretical Method for computing -C vertical distributions of acidity and sulfate within cumulus -C clouds, J. Atmos Sci., Vol. 43, no. 4 pp 339 - 355 -C -C Called by: CHEMRIV6, CHEMRIV7 -C -C Calls the following functions: HLCONST -C -C ARGUMENTS TYPE I/O DESCRIPTION -C --------- ---- ------------ -------------------------------- -C CONC(6) real input&output Concentration for species i=1,11 -C (1) = SO2 conc (mol/mol of SO2) -C (2) = SO4 conc (mol/mol of SO4) -C (3) = NO conc (mol/mol of NO) -C (4) = NO2 conc (mol/mol of NO2) -C (5) = HNO3 conc (mol/mol of HNO3) -C (6) = NO3 conc (mol/mol of NO3) -C----------------------------------------------------------------------- - - IMPLICIT NONE - -C...........PARAMETERS and their descriptions: -! include 'params.puf' -! temporarily set io6=2 here since params.puf variables are not declared, -! resulting in compile errors. - INTEGER IO6 - PARAMETER (IO6 = 2) ! from params.puf - -! number of oxidizing reactions - INTEGER NUMOX - PARAMETER (NUMOX = 3) ! H2O2, O3, and Fe-Mn catalyzed - -! minimum and maximum pH - REAL PHMIN, PHMAX - PARAMETER (PHMIN = 0.0001, PHMAX = 10.0) - -! minimum concentration - REAL CONCMIN - PARAMETER (CONCMIN = 1.0E-30) - -! convert seconds to hours - REAL SEC2HR - PARAMETER (SEC2HR = 1.0 / 3600.0) -C -! Molar volume at STP [ L/mol ] Non MKS units - REAL MOLVOL - PARAMETER (MOLVOL = 22.41410) - -! Standard Temperature [ K ] - REAL STDTEMP - PARAMETER (STDTEMP = 273.15) - -! density of water at 20 C and 1 ATM (kg/m3) - REAL H2ODENS - PARAMETER (H2ODENS = 1000.0) - -! Molecular weights of Fe and Mn - REAL MW_FE, MW_MN - PARAMETER (MW_FE = 55.8, MW_MN = 54.9) - -! CO2 background concentration (moles/mole air) - REAL CCO2 - PARAMETER (CCO2 = 3.4E-04) ! 340 ppm - -C...........ARGUMENTS and their descriptions - - REAL TEMP ! temperature (K) - REAL PRES_ATM ! pressure (atm) - REAL TAUCLD ! timestep for cloud (s) - REAL PRCRATE ! precip rate (mm/hr) - REAL WCAVG ! liquid water content (kg/m3) - REAL COZ ! ozone concentration (mol/mol) - REAL CH2O2 ! H2O2 concentration (mol/mol) - REAL CTNH3 ! total ammonium concentration (mol/mol) - REAL CONC ( 6 ) ! species concentrations (mol/molV) - real rhoair ! air density, moles/m3 - -! --- puff length scale (for scavenging coefficient calculations) (m) - real len - -! --- Scavenging coefficients (1/s) - real scav( 6 ) - -C...........LOCAL VARIABLES (scalars) and their descriptions: - - REAL RT ! gas const * temperature (liter atm/mol) - REAL RECIPAP1 ! one over pressure (/atm) - REAL ONE_OVER_TEMP ! 1.0 / TEMP - -! --- Gas liquid equilibria - - REAL PH2O20 ! total H2O2 partial pressure (atm) - REAL PH2O2F ! gas only H2O2 partial pressure (atm) - REAL H2O2H ! Henry's Law Constant for H2O2 - REAL H2O2L ! H2O2 conc in cloudwater (mol/liter) - - REAL PHNO30 ! total HNO3 partial pressure (atm) - REAL PHNO3F ! gas only HNO3 partial pressure (atm) - REAL HNO3H ! Henry's Law Constant for HNO3 - REAL HNO31 ! First dissociation constant for HNO3 - REAL HNO31H ! HNO31*HNO3H - REAL HNO3L ! HNO3 conc in cloudwater (mol/liter) - - REAL PNH30 ! total NH3 partial pressure (atm) - REAL PNH3F ! gas only NH3 partial pressure (atm) - REAL NH3H ! Henry's Law Constant for NH3 - REAL NH31 ! First dissociation constant for NH3 - REAL NH3DH2O ! - REAL NH31HDH ! - REAL NH3L ! NH3 conc in cloudwater (mol/liter) - - REAL PO30 ! total O3 partial pressure (atm) - REAL PO3F ! gas only O3 partial pressure (atm) - REAL O3H ! Henry's Law Constant for O3 - REAL O3L ! O3 conc in cloudwater (mol/liter) - - REAL PSO20 ! total SO2 partial pressure (atm) - REAL PSO2F ! gas only SO2 partial pressure (atm) - REAL SO2H ! Henry's Law Constant for SO2 - REAL SO21 ! First dissociation constant for SO2 - REAL SO22 ! Second dissociation constant for SO2 - REAL SO212 ! SO21*SO22 - REAL SO212H ! SO21*SO22*SO2H - REAL SO21H ! SO21*SO2H - REAL SO2L ! SO2 conc in cloudwater (mol/liter) - REAL SO3 ! SO3= conc in cloudwater (mol/liter) - - REAL PNO2 ! total NO2 partial pressure (atm) - REAL NO2H ! Henry's Law Constant for NO2 (M/atm) - REAL NO2L ! NO2 conc in cloudwater (mol/liter) - - REAL PNO ! total NO partial pressure (atm) - REAL NOH ! Henry's Law Constant for NO (M/atm) - REAL NOL ! NO conc in cloudwater (mol/liter) - - REAL PCO20 ! total CO2 partial pressure (atm) - REAL PCO2F ! gas only CO2 partial pressure (atm) - REAL CO2H ! Henry's Law constant for CO2 - REAL CO21 ! First dissociation constant for CO2 - REAL CO22 ! Second dissociation constant for CO2 - REAL CO212 ! CO21*CO22 - REAL CO212H ! CO2H*CO21*CO22 - REAL CO21H ! CO2H*CO21 - REAL CO2L ! CO2 conc in cloudwater (mol/liter) - - REAL XL ! conversion factor (liter-atm/mol) - REAL ONE_OVER_XL ! 1.0 / XL - REAL PRES_ATM_OVER_XL ! PRES_ATM / XL - REAL XLCO2 ! - REAL XLH2O2 ! - REAL XLHNO3 ! - REAL XLNH3 ! - REAL XLO3 ! - REAL XLSO2 ! - - REAL HCO3 ! HCO3 conc in cloudwater (mol/liter) - REAL HSO3 ! HSO3 conc in cloudwater (mol/liter) - REAL HSO4 ! HSO4 concn in cloudwater (mol/liter) - - REAL MN ! Mn++ conc in cloudwater (mol/liter) - REAL MNA ! initial Mn in cloudwater (mol/liter) - REAL NH4 ! NH4+ conc in cloudwater (mol/liter) - REAL NO3M ! NO3- conc in cloudwater (mol/liter) - REAL OHM ! OH- conc in cloudwater (mol/liter) - REAL SO4 ! SO4= conc in cloudwater (mol/liter) - REAL CO3 ! CO3= conc in cloudwater (mol/liter) - - REAL A ! iron's anion concentration - REAL B ! manganese's anion concentration - REAL FE ! Fe+++ conc in cloudwater (mol/liter) - REAL FEA ! initial Fe in cloudwater (mol/liter) - - INTEGER I20C ! loop counter for do loop 20 - INTEGER I30C ! loop counter for do loop 30 - INTEGER ITERAT ! # iterations of aqueous chemistry solver - INTEGER I7777C ! aqueous chem iteration counter - INTEGER ICNTAQ ! aqueous chem iteration counter - INTEGER IOX ! index over oxidation reactions - - REAL ACT1 ! activity correction factor!single ions - REAL ACT2 ! activity factor correction!double ions - REAL ACTB ! - - REAL FTST ! - REAL GM1 ! - REAL GM1LOG ! - REAL GM2 ! activity correction factor - REAL GM2LOG ! - - REAL FA ! functional value ?? - REAL FB ! functional value ?? - REAL AC ! H+ concentration in cloudwater (mol/liter) - REAL AE ! guess for H+ conc in cloudwater (mol/l) - REAL BB ! lower limit guess of cloudwater pH - REAL HA ! - REAL HB ! - REAL STION ! ionic strength - - REAL H2OW ! - REAL HTST ! - REAL RATE ! - REAL RECIPA1 ! - REAL RECIPA2 ! - - REAL RH2O2 ! - REAL RMHP ! - REAL RPAA ! - REAL SIV ! dissolved so2 in cloudwater (mol/liter) - REAL SK6 ! - REAL SK6TS6 ! - REAL DTS6 ! - REAL TAC ! - REAL TEMP1 ! - REAL TIMEW ! cloud chemistry clock (sec) - REAL TOTOX ! - REAL TS6 ! SO4 conc in cloudwater (mol/liter) - REAL TSIV ! - REAL TST ! - - REAL DSIVDT( 0:NUMOX ) ! rate of so2 oxid incloud (mol/liter/sec) - REAL DS4 ( 0:NUMOX ) ! S(IV) oxidized over timestep DTW(0) - real ds40old ! total s(iv) oxidized - REAL DTW ( 0:NUMOX ) ! cloud chemistry timestep (sec) - - real depfactor - -C -C --- Define background concs of iron and manganese (ug/m3) - real cfe, cmn - data cfe/0.01/, cmn/0.005/ - -C ... Specify fraction of activation for particles. - real fracma - data fracma/1.0 / - -C...........EXTERNAL FUNCTIONS and their descriptions: - - REAL HLCONST - EXTERNAL HLCONST - -C********************************************************************* -C begin body of subroutine AQRADM - -C...Check for bad temperature or pressure - if ( temp .LE. 0.0 .or. pres_atm .LE. 0.0 ) then - write(io6,*)'Invalid temp and/or pressure; T,P: ',temp,pres_atm - stop 'Halted in AQRADM -- see list file.' - end if - - one_over_temp = 1.0 / temp - -C...Compute several conversion factors - - icntaq = 0 - iterat = 0 - rt = ( MOLVOL / STDTEMP ) * temp ! r * t (liter atm / mol) - xl = wcavg * rt / H2ODENS ! conversion factor (l-atm/mol) - one_over_xl = 1.0 / xl - pres_atm_over_xl = pres_atm / xl - tst = 0.999 - act1 = 1.0 - act2 = 1.0 - gm2 = 1.0 - timew = 0.0 - recipap1 = 1.0 / pres_atm - -C...set equilibrium constants as a function of temperature -C...Henry's law constants - - so2h = HLCONST( 'SO2', temp, .false., 0.0 ) - co2h = HLCONST( 'CO2', temp, .false., 0.0 ) - nh3h = HLCONST( 'NH3', temp, .false., 0.0 ) - h2o2h = HLCONST( 'H2O2', temp, .false., 0.0 ) - o3h = HLCONST( 'O3', temp, .false., 0.0 ) - hno3h = HLCONST( 'HNO3', temp, .false., 0.0 ) - noh = HLCONST( 'NO', temp, .false., 0.0 ) - no2h = HLCONST( 'NO2', temp, .false., 0.0 ) - -C...Dissociation constants - - temp1 = one_over_temp - 1.0 / 298.0 - - sk6 = 1.02e-02 * EXP( 2.72e+03 * temp1 ) ! Smith and Martell (1976) - so21 = 1.30e-02 * EXP( 1.96e+03 * temp1 ) ! Smith and Martell (1976) - so22 = 6.60e-08 * EXP( 1.50e+03 * temp1 ) ! Smith and Martell (1976) - co21 = 4.30e-07 * EXP( -1.00e+03 * temp1 ) ! Smith and Martell (1976) - co22 = 4.68e-11 * EXP( -1.76e+03 * temp1 ) ! Smith and Martell (1976) - h2ow = 1.00e-14 * EXP( -6.71e+03 * temp1 ) ! Smith and Martell (1976) - nh31 = 1.70e-05 * EXP( -4.50e+02 * temp1 ) ! Smith and Martell (1976) - hno31 = 1.54e+01 * EXP( 8.70e+03 * temp1 ) ! Schwartz (1984) - -C...Kinetic oxidation rates -C... From Chamedies (1982) - - rh2o2 = 8.0e+04 * EXP( -3650.0 * temp1 ) - -C...Make initializations - - do iox = 0, NUMOX - dsivdt(iox) = 0.0 - dtw(iox) = 0.0 - ds4(iox) = 0.0 - end do - - fea = cfe * 1.E-6 * pres_atm_over_xl / (rhoair * MW_FE) - mna = cmn * 1.E-6 * pres_atm_over_xl / (rhoair * MW_MN) - -C...Set constant factors that will be used in later multiplications (moles/atm) - - xlh2o2 = h2o2h * xl - xlo3 = o3h * xl - xlso2 = so2h * xl - xlnh3 = nh3h * xl - xlhno3 = hno3h * xl - xlco2 = co2h * xl - - so212 = so21 * so22 - so21h = so21 * so2h - so212h = so212 * so2h - co212 = co21 * co22 - co21h = co21 * co2h - co212h = co22 * co21h - nh3dh2o = nh31 / h2ow - nh31hdh = nh3h * nh3dh2o - hno31h = hno31 * hno3h - -C...If kinetic calculations are made, return to this point - - i20c = 0 -20 continue - - i20c = i20c + 1 - if ( i20c >= 1000 ) then - write(io6,*) 'Excessive looping at I20C' - stop 'Halted in AQRADM -- see list file.' - end if - -C...Initial gas phase partial pressures (atm) - pnh30 = ctnh3 * pres_atm - phno30 = ( conc(5) + conc(6)*fracma ) * pres_atm - pco20 = cco2 * pres_atm - -! --- Reactive species - -! --- H2O2 - ph2o20 = ch2o2 * pres_atm + xl * ds4( 1 ) -! --- check if too much h2o2 has reacted (possible in plume with -! --- high SO2 concs) - if ( ph2o20 .LT. 0. ) then - ds4( 0 ) = ds4( 0 ) - ds4( 1 ) - ds4( 1 ) = -ch2o2 * pres_atm * one_over_xl - ds4( 0 ) = ds4( 0 ) + ds4( 1 ) - ph2o20 = 0. - end if - -! --- O3 - po30 = coz * pres_atm + xl * ds4( 2 ) -! --- check if too much o3 has reacted - if ( po30 .LT. 0. ) then - ds4( 0 ) = ds4( 0 ) - ds4( 2 ) - ds4( 2 ) = -coz * pres_atm * one_over_xl - ds4( 0 ) = ds4( 0 ) + ds4( 2 ) - po30 = 0. - end if - -! --- SO2 - pso20 = conc( 1 ) * pres_atm + ds4( 0 ) * xl -! --- check if too much SO2 has reacted - if ( pso20 .LT. 0. ) then - ds40old = ds4( 0 ) - ds4( 0 ) = -conc( 1 ) * pres_atm * one_over_xl - do iox = 1, NUMOX - ds4( iox ) = ds4( iox ) * ds4( 0 ) / ds40old - end do - pso20 = 0. - ph2o20 = ch2o2 * pres_atm + xl * ds4( 1 ) - po30 = coz * pres_atm + xl * ds4( 2 ) - end if - -C...Don't allow gas concentrations to go below zero - -! pso20 = MAX( pso20, 0.0 ) -! ph2o20 = MAX( ph2o20, 0.0 ) -! po30 = MAX( po30, 0.0 ) - pnh30 = MAX( pnh30, 0.0 ) - pco20 = MAX( pco20, 0.0 ) - phno30 = MAX( phno30, 0.0 ) - -C...Molar concentrations of soluble aerosols - ts6 = conc( 2 ) * fracma * pres_atm_over_xl - & - ds4( 0 ) ! Sulfate - - fe = fea - mn = mna - a = 3.0 * fe - b = 2.0 * mn - -C...Don't allow aerosol concentrations to go below zero - - ts6 = MAX( ts6, 0.0 ) - - sk6ts6 = sk6 * ts6 - -C...Find solution of the equation using a method of reiterative -C...bisections. Make initial guesses for pH between PHMIN to PHMAX. - - ha = PHMIN - hb = PHMAX - - i7777c = 0 -7777 continue - - i7777c = i7777c + 1 - if ( i7777c .GT. 1000 ) then - write(io6,*)'Excessive looping at I7777C' - stop 'Halted in AQRADM -- see list file.' - end if - -! ha = MAX( ha - 0.8, 0.1 ) -! hb = MIN( hb + 0.8, 9.9 ) - ha = MAX( ha - 0.8, PHMIN ) - hb = MIN( hb + 0.8, PHMAX ) - ae = 10.0**( -ha ) - - recipa1 = 1.0 / ( ae * act1 ) - recipa2 = 1.0 / ( ae * ae * act2 ) - -C...Calculate final gas phase partial pressure of SO2, NH3, HNO3 and -C...CO2 (atm) - - pso2f = pso20 / ( 1.0 + xlso2 * ( 1.0 + so21 * recipa1 - & + so212 * recipa2 ) ) - - pnh3f = pnh30 / ( 1.0 + xlnh3 * ( 1.0 + nh3dh2o * ae ) ) - - phno3f = phno30 / ( 1.0 + xlhno3 * ( 1.0 + hno31 * recipa1 ) ) - - pco2f = pco20 / ( 1.0 + xlco2 * ( 1.0 + co21 * recipa1 - & + co212 * recipa2 ) ) - -C...Calculate liquid phase concentrations (moles/liter) - - so4 = sk6ts6 / ( ae * gm2 + sk6 ) - hso4 = ts6 - so4 - so3 = so212h * pso2f * recipa2 - hso3 = so21h * pso2f * recipa1 - co3 = co212h * pco2f * recipa2 - hco3 = co21h * pco2f * recipa1 - ohm = h2ow * recipa1 - nh4 = nh31hdh * pnh3f * ae - no3m = hno31h * phno3f * recipa1 - -C...Compute functional value - - fa = ae + nh4 - 2.0 * (co3 + so3 + so4 ) - ohm - hco3 - & - hso3 - no3m - hso4 - -C...Start iteration and bisection ****************<<<<<<< - - i30c = 0 -30 continue - - i30c = i30c + 1 - if ( i30c .GT. 1000 ) then - write(io6,*)'Excessive looping at I30C' - stop 'Halted in AQRADM -- see list file.' - end if - - bb = 0.5 * ( ha + hb ) - ae = 10.0**( -bb ) - -! --- don't solve for H+ if fa < 0 at first try - if ( i7777c .EQ. 1 .and. fa .LT. 0. ) then - - bb = ha - hb = ha - ae = 10.0**( -bb ) - - end if - - recipa1 = 1.0 / ( ae * act1 ) - recipa2 = 1.0 / ( ae * ae * act2 ) - -C...Calculate final gas phase partial pressure of SO2, NH3, HNO3 and -C...CO2 (atm) - - pso2f = pso20 / ( 1.0 + xlso2 - & * ( 1.0 + so21 * recipa1 + so212 * recipa2 ) ) - - pnh3f = pnh30 / ( 1.0 + xlnh3 * ( 1.0 + nh3dh2o * ae ) ) - - phno3f = phno30 / ( 1.0 + xlhno3 * ( 1.0 + hno31 * recipa1 ) ) - - pco2f = pco20 / ( 1.0 + xlco2 * ( 1.0 + co21 * recipa1 - & + co212 * recipa2 ) ) - -C...Calculate liquid phase concentrations (moles/liter) - - so4 = sk6ts6 / ( ae * gm2 + sk6 ) - hso4 = ts6 - so4 - so3 = so212h * pso2f * recipa2 - hso3 = so21h * pso2f * recipa1 - co3 = co212h * pco2f * recipa2 - hco3 = co21h * pco2f * recipa1 - ohm = h2ow * recipa1 - nh4 = nh31hdh * pnh3f * ae - no3m = hno31h * phno3f * recipa1 - -C...compute functional value - - fb = ae + nh4 - 2.0 * ( co3 + so3 + so4 ) - ohm - hco3 - & - hso3 - no3m - hso4 - -C...Calculate and check the sign of the product of the two functional values - - ftst = fa * fb - if ( ftst .LE. 0.0 ) then - hb = bb - else - ha = bb - fa = fb - end if - -C...Check convergence of solutions - - htst = ha / hb - if ( htst .LE. tst ) go to 30 - -C...end of zero-finding routine ****************<<<<<<<<<<<< - -C...compute Ionic strength and activity coefficient by the Davies equation - - stion = 0.5 * (ae + nh4 + ohm + hco3 + hso3 - & + 4.0 * (so4 + co3 + so3) - & + no3m + hso4 + 9.0 * fe + a + b) - gm1log = -0.509 * ( SQRT( stion ) - & / ( 1.0 + SQRT( stion ) ) - 0.2 * stion ) - gm2log = gm1log * 4.0 - gm1 = 10.0**gm1log - gm2 = MAX( 10.0**gm2log, 1.0e-30 ) - actb = act1 - act1 = MAX( gm1 * gm1, 1.0e-30 ) - act2 = MAX( gm1 * gm1 * gm2, 1.0e-30 ) - -C...check for convergence and possibly go to 7777, to recompute -C... Gas and liquid phase concentrations - -! --- don't solve for H+ if fa < 0 at first try - if ( i7777c .EQ. 1 .and. fa .LT. 0. ) then - actb = act1 - end if - - tac = ABS( actb - act1 ) / actb - if ( tac >= 1.0e-2 ) then - - icntaq = icntaq + 1 - if ( icntaq .GT. 100 ) then - write(io6,*)'Maximum iterations for pH calculation exceeded' - write(io6,*)'Using last pH value' - else - go to 7777 - end if - - end if - -C...return an error if the pH is not in range - -ccc if ( ( ha .lt. 0.02 ) .or. ( ha .gt. 9.49 ) ) then - if ( ( ha .LT. PHMIN ) .or. ( ha .GT. PHMAX ) ) then - write(io6,*)'pH value out of range: ',ha - stop 'Halted in AQRADM -- see list file.' - end if - -C...Make those concentration calculations which can be made outside -C... of the function. - - so2l = so2h * pso2f - ac = 10.0**( -bb ) - siv = so3 + hso3 + so2l - -C...Calculate final gas phase concentrations of oxidants (atm) - - ph2o2f = ph2o20 / ( 1.0 + xlh2o2 ) - po3f = po30 / ( 1.0 + xlo3 ) - - ph2o2f = MAX( ph2o2f, 0.0 ) - po3f = MAX( po3f, 0.0 ) - -C...Calculate liquid phase concentrations (moles/liter) - - h2o2l = ph2o2f * h2o2h - o3l = po3f * o3h - nh3l = pnh3f * nh3h - co2l = pco2f * co2h - hno3l = phno3f * hno3h - -C...if the maximum cloud lifetime has not been reached, then compute -C...the next timestep. - - if ( timew .LT. taucld ) then - -C...make kinetics calculations -C... note: DS4(i) and DSIV(I) are negative numbers! - - iterat = iterat + 1 - -C...Define the total S(iv) available for oxidation - - tsiv = pso20 * one_over_xl - -C...Calculate sulfur iv oxidation rate due to H2O2 - - dsivdt( 1 ) = -rh2o2 * h2o2l * so2l / ( 0.1 + ac ) - totox = ph2o20 * one_over_xl - if ( ( dsivdt( 1 ) .EQ. 0.0 ) .or. - & ( tsiv .LE. CONCMIN ) .or. - & ( totox .LE. CONCMIN ) ) then - dtw(1) = taucld - else - dtw( 1 ) = -0.05 * MIN( totox, tsiv ) / dsivdt( 1 ) - end if - -C...Calculate sulfur iv oxidation rate due to O3 - - if ( bb .GE. 2.7 ) then - dsivdt( 2 ) = -4.19e5 * ( 1.0 + 2.39e-4 / ac ) * o3l * siv - else - dsivdt( 2 ) = -1.9e4 * siv * o3l / SQRT( ac ) - end if - totox = po30 * one_over_xl - if ( ( dsivdt( 2 ) .EQ. 0.0 ) .or. - & ( tsiv .LE. CONCMIN ) .or. - & ( totox .LE. CONCMIN ) ) then - dtw( 2 ) = taucld - else - dtw( 2 ) = -0.01 * MIN( totox, tsiv ) / dsivdt( 2 ) - end if - -C...Calculate sulfur iv oxidation rate due to O2 catalyzed by Mn++ -C... and Fe+++ See Table IV Walcek & Taylor ( 1986) - - if ( bb .GE. 4.0 ) then ! 4.0 < ph - - if ( siv .LE. 1.0e-5 ) then - dsivdt( 3 ) = -5000.0 * mn * hso3 - else - dsivdt( 3 ) = -( 4.7 * mn * mn / ac - & + 1.0e7 * fe * siv * siv ) - end if ! end of first pass through siv conc. - - else ! ph < 4.0 - - if ( siv .LE. 1.0e-5 ) then - dsivdt( 3 ) = -3.0 * ( 5000.0 * mn * hso3 - & + 0.82 * fe * siv / ac ) - else - dsivdt( 3 ) = -( 4.7 * mn * mn / ac - & + ( 0.82 * fe * siv / ac ) - & * ( 1.0 + 1.7e3 * mn**1.5 / ( 6.3e-6 + fe ) ) ) - end if ! end of second pass through siv conc. - end if ! end of pass through ph - - if ( ( dsivdt( 3 ) .EQ. 0.0 ) .or. ( tsiv .LE. CONCMIN ) ) then - dtw( 3 ) = taucld - else - dtw( 3 ) = -0.1 * tsiv / dsivdt( 3 ) - end if - -C...Calculate total sulfur iv oxidation rate - - dsivdt( 0 ) = 0.0 - do iox = 1, NUMOX - dsivdt( 0 ) = dsivdt( 0 ) + dsivdt( iox ) - end do - -C...Calculate a minimum time step required - - dtw( 0 ) = MIN( dtw( 1 ), dtw( 2 ), dtw( 3 ) ) - -C...check for large time step - - if ( dtw( 0 ) .GT. 8.0e+37 ) then - write(io6,1001) dsivdt(0), ts6, dtw(0) - else - -C...calculate the change in sulfur iv for this time step - -60 continue - dts6 = ABS( dtw( 0 ) * ( -dsivdt( 0 ) ) ) - -C...If DSIV(0), sulfur iv oxidized during this time step would be -C...less than 5% of sulfur oxidized since time 0, then double DT - - if ( dtw( 0 ) .LE. taucld ) then - if ( dts6 .LT. 0.05 * ts6 ) then - dtw( 0 ) = dtw( 0 ) * 2.0 - go to 60 - end if - end if - end if - dtw( 0 ) = MIN( dtw( 0 ), taucld ) - -C...If the total time after this time increment will be greater than -C... TAUCLD sec., then set DTW(0) so that total time will be TAUCLD - - if ( timew + dtw( 0 ) .GT. taucld ) dtw( 0 ) = taucld - timew - if ( ts6 .LT. 1.0e-11 ) dtw( 0 ) = taucld - timew - if ( iterat .GT. 100 ) dtw( 0 ) = taucld - timew - -C...Set DSIV(I), I = 0,NUMOX, the amount of S(IV) oxidized by each -C... individual oxidizing agent, as well as the total. - - do iox = 0, NUMOX - ds4( iox ) = ds4( iox ) + dtw( 0 ) * dsivdt( iox ) - end do - - timew = timew + dtw( 0 ) - -C...Return to make additional calculations - - go to 20 - end if - -C --- Calculate liquid-phase concentrations of other species - pno = conc(3) * pres_atm - pno2 = conc(4) * pres_atm - - nol = pno * noh / ( 1.0 + noh * xl ) - no2l = pno2 * no2h / ( 1.0 + no2h * xl ) - -C...Compute the output concentrations - -C...gas concentrations (mol/molV) (only for reactive species) - - conc(1) = (pso2f + xl * siv) * recipap1 - ch2o2 = (ph2o2f + xl * h2o2l) * recipap1 - coz = (po3f + xl * o3l) * recipap1 - -! --- calculate scavenging coefficients for gases - depfactor = prcrate * SEC2HR / ( rhoair * len ) - if ( conc( 1 ) > CONCMIN ) then - scav( 1 ) = siv * depfactor / conc( 1 ) - end if - if ( conc( 3 ) > CONCMIN ) then - scav( 3 ) = nol * depfactor / conc( 3 ) - end if - if ( conc( 4 ) > CONCMIN ) then - scav( 4 ) = no2l * depfactor / conc( 4 ) - end if - if ( conc( 5 ) > CONCMIN ) then - scav( 5 ) = hno3l * depfactor / conc( 5 ) - end if - -C...aerosol concentrations (mol/molV) (only reactive species-so4) - - conc( 2 ) = conc( 2 ) * ( 1.0 - fracma ) + ts6 * xl * recipap1 - -! --- calculate scavenging coefficients for aerosols - - if ( conc( 2 ) > CONCMIN ) then - scav( 2 ) = ts6 * depfactor / conc( 2 ) - end if - if ( conc( 6 ) > CONCMIN ) then - scav( 6 ) = no3m * depfactor / conc( 6 ) - end if - - return - -C...formats - -1001 format (1X,'DSIVDT(0) =', F10.5, - & 'TS6=', F10.5, 'DTW(0)=', F10.5) - - end - -c---------------------------------------------------------------------- - REAL FUNCTION HLCONST ( NAME, TEMP, EFFECTIVE, HPLUS ) -c---------------------------------------------------------------------- - -C -C FUNCTION: return the Henry's law constant for the specified substance -C at the given temperature -C Adapted for CALPUFF from CMAQ version, PK, AER, Feb 2007 - - IMPLICIT NONE - -C...........PARAMETERS and their descriptions: -! include 'params.puf' -! temporarily set io6=2 here since params.puf variables are not declared, -! resulting in compile errors. - INTEGER IO6 - PARAMETER (IO6 = 2) ! from params.puf - -! Number of species - INTEGER MXSPCS - PARAMETER (MXSPCS = 8) -! Number of dissociating species - INTEGER MXDSPCS - PARAMETER (MXDSPCS = 8) - -C...........ARGUMENTS and their descriptions - - CHARACTER*(*) NAME ! 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 SUBNAME(MXSPCS) - SAVE SUBNAME - - INTEGER SPC ! species index - INTEGER LSO2 ! SO2 pointer - INTEGER LHSO3 ! HSO3 pointer - INTEGER LHNO3 ! HNO3 pointer - INTEGER LCO2 ! CO2 pointer - INTEGER LHCO3 ! HCO3 pointer - INTEGER LH2O2 ! H2O2 pointer - INTEGER LHO2 ! HO2 pointer - INTEGER LNH4OH ! NH4OH pointer - INTEGER LH2O ! H2O pointer - - REAL HPLUSI ! 1 / HPLUS - REAL HPLUS2I ! 1 / HPLUS**2 - 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 - -! Henry's law constants at 298.15K (M/atm) (taken from Rolf Sanders' -! Compilation of Henry's Law Constants for Inorganic and Organic Species -! of Potential Importance in Environment Chemistry, 1999) - REAL A(MXSPCS) - SAVE A - -! Enthalpy (like activation energy) (K) (taken from Rolf Sanders' -! Compilation of Henry's Law Constants for Inorganic and Organic Species -! of Potential Importance in Environment Chemistry, 1999) - REAL E(MXSPCS) - SAVE E - -! Dissociation constants at 298.15K (M or M2) (taken from Table 6.A.1, -! Seinfeld and Pandis, Atmospheric Chemistry and Physics, 1997) - REAL B(MXDSPCS) - SAVE B - -! -dH/R (K) (taken from Table 6.A.1, -! Seinfeld and Pandis, Atmospheric Chemistry and Physics, 1997) - REAL D(MXDSPCS) - SAVE D - - DATA SUBNAME(1), A(1), E(1) / 'O3', 1.2E-02, 2.7E+03 / ! Chameides 1984 - DATA SUBNAME(2), A(2), E(2) / 'H2O2', 8.3E+04, 7.4E+03 / ! O'Sullivan et al. 1996 - DATA SUBNAME(3), A(3), E(3) / 'NH3', 6.1E+01, 4.2E+03 / ! Clegg and Brimblecombe 1989 - DATA SUBNAME(4), A(4), E(4) / 'NO', 1.9E-03, 1.4E+03 / ! Lide and Frederikse 1995 - DATA SUBNAME(5), A(5), E(5) / 'NO2', 1.2E-02, 2.5E+03 / ! Chameides 1984 - DATA SUBNAME(6), A(6), E(6) / 'HNO3', 2.1E+05, 8.7E+03 / ! Leieveld and Crutzen 1991 - DATA SUBNAME(7), A(7), E(7) / 'SO2', 1.4E+00, 2.9E+03 / ! Linde and Frederikse 1995 - DATA SUBNAME(8), A(8), E(8) / 'CO2', 3.6E-02, 2.2E+03 / ! Zheng et al. 1997 - - DATA LSO2, B(1), D(1) / 1, 1.30E-02, 1.96E+03 / ! SO2*H2O<=>HSO3+H : Smith and Martell (1976) - DATA LHSO3, B(2), D(2) / 2, 6.60E-08, 1.50E+03 / ! HSO3<=>SO3+H : Smith and Martell (1976) - DATA LHNO3, B(3), D(3) / 3, 1.54E+01, 8.70E+03 / ! HNO3(aq)<=>NO3+H : Schwartz (1984) - DATA LCO2, B(4), D(4) / 4, 4.30E-07, -1.00E+03 / ! CO2*H2O<=>HCO3+H : Smith and Martell (1976) - DATA LHCO3, B(5), D(5) / 5, 4.68E-11, -1.76E+03 / ! HCO3<=>CO3+H : Smith and Martell (1976) - DATA LH2O2, B( 6), D(6) / 6, 2.20E-12, -3.73E+03 / ! H2O2(aq)<=>HO2+H : Smith and Martell (1976) - DATA LNH4OH, B(7), D(7) / 7, 1.70E-05, -4.50E+02 / ! NH4*OH<=>NH4+OH : Smith and Martell (1976) - DATA LH2O, B(8), D(8) / 8, 1.00E-14, -6.71E+03 / ! H2O<=>H+OH : Smith and Martell (1976) - -C...........EXTERNAL FUNCTIONS and their descriptions: - -! Function to look up name in table - INTEGER INDEX1 - EXTERNAL INDEX1 - -C----------------------------------------------------------------------- -C begin body of subroutine HLCONST - - SPC = INDEX1( NAME, MXSPCS, SUBNAME ) - -C...error if species not found in table - - IF ( SPC <= 0 ) THEN - write(io6,*)TRIM(NAME) // - & ' not found in Henrys Law Constant table' - stop 'Halted in HLCONST -- see list file.' - 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 <= 0.0 ) THEN - write(io6,*)'Negative or Zero [H+] concentration specified ' - stop 'Halted in HLCONST -- see list file.' - END IF - - HPLUSI = 1.0 / HPLUS - HPLUS2I = HPLUSI * HPLUSI - - IF (TRIM(NAME) .EQ. 'SO2') THEN - - AKEQ1 = B(LSO2) * EXP(D(LSO2) * TFAC) !SO2H2O <=> HSO3- + H+ - AKEQ2 = B(LHSO3) * EXP(D(LHSO3) * TFAC) !HSO3- <=> SO3= + H+ - HLCONST = KH * (1.0 + AKEQ1*HPLUSI + AKEQ1*AKEQ2*HPLUS2I) - - ELSE IF (TRIM(NAME) .EQ. 'HNO3') THEN - - AKEQ1 = B(LHNO3) * EXP(D(LHNO3) * TFAC) !HNO3(aq) <=> NO3- + H+ - HLCONST = KH * (1.0 + AKEQ1*HPLUSI) - - ELSE IF (TRIM(NAME) .EQ. 'CO2') THEN - - AKEQ1 = B(LCO2) * EXP(D(LCO2) * TFAC) !CO2H2O <=> HCO3- + H+ - AKEQ2 = B(LHCO3) * EXP(D(LHCO3) * TFAC) !HCO3- <=> CO3= + H+ - HLCONST = KH * (1.0 + AKEQ1*HPLUSI + AKEQ1*AKEQ2*HPLUS2I) - - ELSE IF (TRIM(NAME) .EQ. 'H2O2') THEN - - AKEQ1 = B(LH2O2) * EXP(D(LH2O2) * TFAC) !H2O2(aq) <=> HO2- + H+ - HLCONST = KH * (1.0 + AKEQ1*HPLUSI) - - ELSE IF (TRIM(NAME) .EQ. 'NH3') THEN - - AKEQ1 = B(LNH4OH) * EXP(D(LNH4OH) * TFAC) !NH4OH <=> NH4+ + OH- - AKEQ2 = B(LH2O) * EXP(D(LH2O) * TFAC) - OHION = AKEQ2 * HPLUSI - HLCONST = KH * (1.0 + AKEQ1/OHION) - - END IF - - END IF - - RETURN - END - -c---------------------------------------------------------------------- - INTEGER FUNCTION INDEX1 (NAME, N, NLIST) -c---------------------------------------------------------------------- - -C*********************************************************************** -C subroutine body starts at line 39 -C -C FUNCTION: -C -C Searches for NAME in list NLIST and returns the subscript -C (1...N) at which it is found, or returns 0 when NAME not -C found in NLIST -C -C PRECONDITIONS REQUIRED: none -C -C SUBROUTINES AND FUNCTIONS CALLED: none -C -C Based on index1 routine from Models-3 I/O Library -C -C*********************************************************************** - - IMPLICIT NONE - -C....... Arguments and their descriptions: - - CHARACTER*(*) NAME ! Character string being searched for - INTEGER N ! Length of array to be searched - CHARACTER*(*) NLIST(*) ! array to be searched - -C....... Local variable: - - INTEGER I ! loop counter - -C..................................................................... -C....... begin body of INDEX1() - - DO 100 I = 1, N - - IF (TRIM(NAME) .EQ. TRIM(NLIST(I))) THEN ! Found NAME in NLIST - INDEX1 = I - RETURN - END IF - -100 CONTINUE - - INDEX1 = 0 ! not found - RETURN - - END diff --git a/CALPUFF_SRC/CALPUFF/aqueous.puf b/CALPUFF_SRC/CALPUFF/aqueous.puf deleted file mode 100644 index 191deea..0000000 --- a/CALPUFF_SRC/CALPUFF/aqueous.puf +++ /dev/null @@ -1,18 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /AQUEOUS/ -- Aqueous data CALPUFF -c---------------------------------------------------------------------- -c - common/AQUEOUS/scavu(mxspec),scavm(mxspec) -c -c --- COMMON BLOCK /AQUEOUS/ Variables: -c -c SCAVU(mxspec) - real - Array of scavenging coefficients -c (1/sec) for each pollutant -c calculated from aqueous chemistry -c module in the layer above the mixing -c height -c SCAVM(mxspec) - real - Array of scavenging coefficients -c (1/sec) for each pollutant -c calculated from aqueous chemistry -c module in the layer below the mixing -c height diff --git a/CALPUFF_SRC/CALPUFF/ar1.puf b/CALPUFF_SRC/CALPUFF/ar1.puf deleted file mode 100644 index ff47e69..0000000 --- a/CALPUFF_SRC/CALPUFF/ar1.puf +++ /dev/null @@ -1,63 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /AR1/ -- Constant Area source data CALPUFF -c -c---------------------------------------------------------------------- - character*16 cnamar1 - character*40 csfar1 -c - common/AR1/XAR1GRD(mxvertp1,mxarea),YAR1GRD(mxvertp1,mxarea), - 1 NVERT1(mxarea),HTAR1(mxarea),ELAR1(mxarea),SZ0AR1(mxarea), - 2 QAR1(mxspec,mxarea),NEWAR1(mxarea),NAR1,AREA1(mxarea), - 3 IARU,NSAR1, - 4 IDSFAR1(mxspec,mxarea),IXREFAR1(mxspar), - 5 CNAMAR1(mxarea),CSFAR1(mxspar) -c -c --- COMMON BLOCK /AR1/ Variables: -c -c ************* Discrete area source data *************************** -c -c XAR1GRD(mxvertp1,mxarea) - real - X coordinate of a vertex of a -c discrete area source in grid units -c (i.e., origin at (0.0,0.0)) -c YAR1GRD(mxvertp1,mxarea) - real - Y coordinate of a vertex of a -c discrete area source in grid units -c (i.e., origin at (0.0,0.0)) -c NVERT1(mxarea) - real - Number of sides bounding area -c -c (NOTE: The mean x,y for the polygon is computed as vertex NVERT+1) -c -c HTAR1(mxarea) - real - Effective release height (m) -c ELAR1(mxarea) - real - Ground elevation (m) above sea -c level -c SZ0AR1(mxarea) - real - Initial sigma z (m) -c -c (NOTE: The initial sigma-y is computed as function of wind direction) -c -c QAR1(mxspec,mxarea) - real - Emission rate (g/s) for each -c pollutant -c NEWAR1(mxarea) - integer - Number of puffs released by each -c source during the current step -c NAR1 - integer - Number of discrete area sources -c AREA1(mxarea) - real - Area of each source (m^2) -c IARU - integer - Units for emission rates in -c control file -c 1: g/s/m**2 -c 2: kg/hr/m**2 -c 3: lb/hr/m**2 -c 4: ton/yr/m**2 -c 5: Odour Unit * m/s -c 6: Odour Unit * m/min -c 7: metric tons/yr -c 8: Bq/s (Bq = becquerel = disintegrations/s) -c 9: GBq/yr -c NSAR1 - integer - Number of source-species pairs -c with emissions scaling factors -c IDSFAR1(mxspec,mxarea) - integer - Pointer to area-species pair -c index, 0 to NSAR1 -c (0 if no scaling) -c IXREFAR1(mxspar) - integer - Cross-reference pointer from -c area-species pairs to -c scale-factor tables -c CSFAR1(mxspar) - c*40 arr - List of scale-factor table names -c for area-species pairs -c CNAMAR1(mxarea) - c*16 arr - Source names diff --git a/CALPUFF_SRC/CALPUFF/ar2.puf b/CALPUFF_SRC/CALPUFF/ar2.puf deleted file mode 100644 index 9887272..0000000 --- a/CALPUFF_SRC/CALPUFF/ar2.puf +++ /dev/null @@ -1,162 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /AR2/ -- Variable Area source data CALPUFF -c -c---------------------------------------------------------------------- -c - character*12 cslst3 - character*16 cid3,baemunit - - logical*4 lutmar2,llccar2,lpsar2,lemar2,llazaar2,lttmar2 - character*4 utmhemar2,xyunitar2 - character*8 datumar2,pmapar2 - character*12 datenar2 - - common/AR2/NAR2,NSE3, - & IBSRC3(mxemdat),IESRC3(mxemdat),IUEM3(mxemdat), - 1 IBDATHR3(mxemdat),IBSEC3(mxemdat),IEDATHR3(mxemdat), - 2 IESEC3(mxemdat),XTZ3(mxemdat),T2BTZ3(mxemdat), - 3 XMWEM3(mxspec),IXREM3(mxspec), - 4 lutmar2(mxemdat),llccar2(mxemdat),lpsar2(mxemdat), - 5 lemar2(mxemdat),llazaar2(mxemdat),lttmar2(mxemdat), - 6 iutmznar2(mxemdat),feastar2(mxemdat),fnorthar2(mxemdat), - 7 rnlat0ar2(mxemdat),relon0ar2(mxemdat), - 8 rnlat1ar2(mxemdat),rnlat2ar2(mxemdat),NSTEP3(mxemdat), - 9 NDHRQB3(mxqstep,mxemdat),NSECQB3(mxqstep,mxemdat), - & NDHRQE3(mxqstep,mxemdat),NSECQE3(mxqstep,mxemdat), - 1 XAR2GRD(mxvertp1,mxqstep,mxarea), - 2 YAR2GRD(mxvertp1,mxqstep,mxarea),NVERT2(mxarea), - 3 HTAR2(mxqstep,mxarea),TKAR2(mxqstep,mxarea), - 4 ELAR2(mxqstep,mxarea),WEFAR2(mxqstep,mxarea), - 5 REFAR2(mxqstep,mxarea),SZ0AR2(mxqstep,mxarea), - 6 AREA2(mxqstep,mxarea),QAR2(mxspec,mxqstep,mxarea), - 7 NEWAR2(mxarea),NTR0, - 8 CSLST3(mxspec),CID3(mxarea),BAEMUNIT(mxarea), - 9 pmapar2(mxemdat),utmhemar2(mxemdat),datumar2(mxemdat), - & datenar2(mxemdat),xyunitar2(mxemdat) -c -c --- COMMON BLOCK /AR2/ Variables: -c -c NAR2 - integer - Number of discrete area sources -c NSE3 - integer - Number of emitted species in files -c IBSRC3(mxemdat) - integer - Index for first source in a -c BAEMARB.DAT file -c IESRC3(mxemdat) - integer - Index for last source in a -c BAEMARB.DAT file -c IUEM3(mxemdat) - integer - Emission rate units flag in MOD6 format -c 1 = g/s -c 2 = g/s/m2 -c IBDATHR3(mxemdat)- integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSEC3(mxemdat) - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHR3(mxemdat)- integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESEC3(mxemdat) - integer - Seconds of the last data record in the -c file (0000-3599) -c XTZ3(mxemdat) - real - Time zone (UTC=LST+XTZ3) -c T2BTZ3(mxemdat) - real - Hours to ADD to Local Time to obtain -c Base Time (xtz3-xbtz) -c XMWEM3(mxspec) - real - Molecular weight for each species -c IXREM3(mxspec) - integer - Cross referencing array of NSE3 -c values relating species ordering -c in the emissions file to the -c ordering in the main conc. array -c -c --- MAP Projection Variables --- -c -c LUTMAR2(mxemdat) - logical*4 - Flag for Universal Transverse Mercator -c LLCCAR2(mxemdat) - logical*4 - Flag for Lambert Conformal Conic -c LPSAR2(mxemdat) - logical*4 - Flag for Polar Stereographic -c LEMAR2(mxemdat) - logical*4 - Flag for Equatorial Mercator -c LLAZAAR2(mxemdat) - logical*4 - Flag for Lambert Azimuthal Equal Area -c LTTMAR2(mxemdat) - logical*4 - Flag for Tangential Transverse Mercator -c -c IUTMZNAR2(mxemdat) - integer - UTM zone for UTM projection -c FEASTAR2(mxemdat) - real - False Easting (km) at projection origin -c FNORTHAR2(mxemdat) - real - False Northing (km) at projection origin -c RNLAT0AR2(mxemdat),- real - N. latitude & E. longitude of x=0 and y=0 -c RELON0AR2(mxemdat) (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1AR2(mxemdat), - real - Matching N. latitude(s) for projection -c RNLAT2AR2(mxemdat) (deg) (Used only if PMAP3= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c -c --- Variable data --- -c -c NSTEP3(mxemdat) - integer - Number of emission steps in -c current timestep -c NDHRQB3(mxqstep,mxemdat) & NSECQB3(mxqstep,mxemdat) -c - integer - Starting time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c NDHRQE3(mxqstep,mxemdat) & NSECQE3(mxqstep,mxemdat) -c - integer - Ending time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c XAR2GRD(mxvertp1,mxqstep,mxarea) -c - real - X coordinate of a vertex of a -c discrete area source in grid units -c (i.e., origin at (0.0,0.0)) -c YAR2GRD(mxvertp1,mxqstep,mxarea) -c - real - Y coordinate of a vertex of a -c discrete area source in grid units -c (i.e., origin at (0.0,0.0)) -c NVERT2(mxarea) - real - Number of sides bounding area -c -c (NOTE: The mean x,y for the polygon is computed as vertex NVERT+1) -c -c HTAR2(mxqstep,mxarea) - real - Effective release height (m) -c ELAR2(mxqstep,mxarea) - real - Elevation of ground (m) -c TKAR2(mxqstep,mxarea) - real - Temperature of release (K) -c WEFAR2(mxqstep,mxarea) - real - Effective rise velocity (m/s) -c REFAR2(mxqstep,mxarea) - real - Effective radius of source (m) -c SZ0AR2(mxqstep,mxarea) - real - Initial sigma-z of source (m) -c QAR2(mxspec,mxqstep,mxarea) - real - Emission rate (g/s) for each -c pollutant -c AREA2(mxqstep,mxarea) - real - Area of each source (m^2) -c NEWAR2(mxarea) - integer - Number of puffs released by each -c source during the current step -c -c (NOTE: The initial sigma-y is computed as function of wind direction) -c -c -c --- Numerical Plume Rise Data --- -c -c NTR0 - integer - Default number of points in -c trajectory arrays -c -c -c --- Character data --- -c -c CSLST3(mxspec) - char*12 - Species identifiers -c CID3(mxarea) - char*16 - Source identifiers -c BAEMUNIT(mxarea) - char*16 - Emissions units for each source -c ('g/m2/s' OR 'g/s') -c -c -c PMAPAR2(mxemdat) - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMAR2(mxemdat)- character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMAR2(mxemdat) - character - Datum-Region for grid coordinates -c DATENAR2(mxemdat) - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITAR2(mxemdat)- character - Units for coordinates (e.g., KM) - diff --git a/CALPUFF_SRC/CALPUFF/auxdat.puf b/CALPUFF_SRC/CALPUFF/auxdat.puf deleted file mode 100644 index 6cd20e5..0000000 --- a/CALPUFF_SRC/CALPUFF/auxdat.puf +++ /dev/null @@ -1,42 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /AUXDAT/ -- Current data from the CALPUFF -c auxiliary meteorological data -c file(s) -c---------------------------------------------------------------------- - - real qcup(mxnx,mxny,mxmetdom) - real zuptop(mxnx,mxny,mxmetdom),zupbot(mxnx,mxny,mxmetdom) - real qc3d(mxnx,mxny,mxnz,mxmetdom) - integer icldmr2d(3,mxmetdom),icldmr3d(mxmetdom) - - common/AUXDAT/icldmr2d,icldmr3d,qcup,zuptop,zupbot,qc3d - -c --- COMMON BLOCK /AUXDAT/ Variables: -c ICLDMR2D(3,mxmetdom) - integer - Position of cloud water variables -c in list of 2D variables in -c auxiliary CALMET files -c (1,_): CLDMRUP -c (2,_): ZCLDBOT -c (3,_): ZCLDTOP -c ICLDMR3D(mxmetdom) - integer - Position of cloud water variable -c in list of 3D variables in -c auxiliary CALMET files -c (_): CLDMR3D -c QCUP(mxnx,mxny,mxmetdom) -c - real - CLDMRUP: Liquid cloud water -c mixing ratio averaged over all -c cloud layers above CALMET domain -c top (g/kg) -c ZUPBOT(mxnx,mxny,mxmetdom) -c - real - ZCLDBOT: Bottom of liquid cloud -c water layers above CALMET domain -c top (mAGL) -c (Zero if no water) -c ZUPTOP(mxnx,mxny,mxmetdom) -c - real - ZCLDTOP: Top of liquid cloud -c water layers above CALMET domain -c top (mAGL) -c (Zero if no water) -c QC3D(mxnx,mxny,mxnz,mxmetdom) -c - real - CLDMR3D: Liquid cloud water -c mixing ratio for 3D CALMET grid diff --git a/CALPUFF_SRC/CALPUFF/auxhd.puf b/CALPUFF_SRC/CALPUFF/auxhd.puf deleted file mode 100644 index 22a48c2..0000000 --- a/CALPUFF_SRC/CALPUFF/auxhd.puf +++ /dev/null @@ -1,108 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /AUXHD/ -- Header from the auxiliary CALPUFF -c meteorological data file(s) -c---------------------------------------------------------------------- - character*4 utmhemma - character*8 datumma,pmapma,axbtzma - character*12 datenma - - integer naux2d(mxmetdom),naux3d(mxmetdom) - character*8 auxnam2d(mxaux,mxmetdom), auxnam3d(mxaux,mxmetdom) - character*8 auxunit2d(mxaux,mxmetdom), auxunit3d(mxaux,mxmetdom) - character*4 auxtyp2d(mxaux,mxmetdom), auxtyp3d(mxaux,mxmetdom) - - common/AUXHD/nxma(mxmetdom),nyma(mxmetdom),nzma, - 1 xgridma(mxmetdom),xorigma(mxmetdom), - 2 yorigma(mxmetdom),axbtzma,xbtzma, - 3 rnlat0ma,relon0ma,xlat1ma,xlat2ma, - 4 zfacema(mxnzp1),itimesa, - 5 ibymeta(mxmetdom),ibmmeta(mxmetdom), - 6 ibdmeta(mxmetdom),ibjdmeta(mxmetdom), - 7 ibhmeta(mxmetdom),ibsmeta(mxmetdom), - 8 ieymeta(mxmetdom),iemmeta(mxmetdom), - 9 iedmeta(mxmetdom),iejdmeta(mxmetdom), - & iehmeta(mxmetdom),iesmeta(mxmetdom), - 1 iutmznma,feastma,fnorthma,pmapma, - 2 datumma,datenma,utmhemma, - 3 naux2d,naux3d,auxnam2d,auxnam3d, - 4 auxunit2d,auxunit3d,auxtyp2d,auxtyp3d -c -c --- COMMON BLOCK /AUXHD/ Variables: -c---------------------------------------------------------------------- -c --- Header (Trailing A denotes Auxilliary file) -c---------------------------------------------------------------------- -c NXMA(mxmetdom) - integer - Number of CALMET grid points in -c X direction -c NYMA(mxmetdom) - integer - Number of CALMET grid points in -c Y direction -c NZMA - integer - Number of CALMET vertical levels -c XGRIDMA(mxmetdom) - real - CALMET grid spacing (m) -c XORIGMA(mxmetdom) - real - Reference X coordinate (m) of -c southwest corner of CALMET grid -c YORIGMA(mxmetdom) - real - Reference Y coordinate (m) of -c southwest corner of CALMET grid -c XBTZMA - real - Base time zone of CALMET data -c RNLAT0MA, - real - N. Latitude, E. Longitude of (0,0) -c RELON0MA (deg) of map projection (Used only if -c PMAP =LCC, PS, EM, TTM or LAZA) -c XLAT1MA, - real - Matching N. Latitude(s) for map -c XLAT2MA (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC :Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS :Projection plane slices through -c Earth at XLAT1 -c EM :Projection cylinder slices through -c Earth at [+/-] XLAT1 -c ZFACEMA(mxnzp1) - real - CALMET cell face heights (m) -c (NZM+1 values) -c ITIMESA - integer - Flag for reading times -c 0: end-time (no seconds) -c 1: begin-time / end-time with seconds -c IBYMETA(mxmetdom)- integer - Beginning year of run (four digits) -c IBMMETA(mxmetdom)- integer - Beginning month of run -c IBDMETA(mxmetdom)- integer - Beginning day of run -c IBJDMETA(mxmetdom)- integer - Beginning Julian day of run -c IBHMETA(mxmetdom)- integer - Beginning hour of run (00-23) -c IBSMETA(mxmetdom)- integer - Beginning seconds of run (0000-3599) -c IEYMETA(mxmetdom)- integer - Ending year of run (four digits) -c IEMMETA(mxmetdom)- integer - Ending month of run -c IEDMETA(mxmetdom)- integer - Ending day of run -c IEJDMETA(mxmetdom)- integer - Ending Julian day of run -c IEHMETA(mxmetdom)- integer - Ending hour of run (00-23) -c IESMETA(mxmetdom)- integer - Ending seconds of run (0000-3599) -c IUTMZNMA - integer - UTM zone for UTM projection -c FEASTMA (km) - real - False Easting at projection origin -c FNORTHMA(km) - real - False Northing at projection origin -c PMAPMA - char*8 - Code for output map projection -c UTM :Universal Transverse Mercator -c LCC :Lambert Conformal Conic -c PS :Polar Stereographic -c EM :Equatorial Mercator -c LAZA:Lambert Azimuthal Equal Area -c TTM :Tangential Transverse Mercator -c UTMHEMMA - char*4 - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMMA - char*8 - Datum-Region for grid coordinates -c DATENMA - char*12 - NIMA date for datum parameters -c (MM-DD-YYYY ) -c NAUX2D(mxmetdom)- integer - Number of 2D variables -c NAUX3D(mxmetdom)- integer - Number of 3D variables -c AUXNAM2D(mxaux - C*8 array - 2D variable names in AUX output -c ,mxmetdom) -c AUXNAM3D(mxaux - C*8 array - 3D variable names in AUX output -c ,mxmetdom) -c AUXUNIT2D(mxaux - C*8 array - 2D variable units in AUX output -c ,mxmetdom) -c AUXUNIT3D(mxaux - C*8 array - 3D variable units in AUX output -c ,mxmetdom) -c AUXTYP2D(mxaux - C*4 array - 2D variable types in AUX output -c ,mxmetdom) -c AUXTYP3D(mxaux - C*4 array - 3D variable types in AUX output -c ,mxmetdom) -c---------------------------------------------------------------------- -c --- Notes: 1. AUX Variable names are upper case -c 2. AUX Variable units are upper case -c 'G/M3 ' for example -c 3. AUX Variable types allowed are -c 'R_4 ' for single-precision reals -c 'I_4 ' for 4-byte integers diff --git a/CALPUFF_SRC/CALPUFF/bcs.puf b/CALPUFF_SRC/CALPUFF/bcs.puf deleted file mode 100644 index f9b66a4..0000000 --- a/CALPUFF_SRC/CALPUFF/bcs.puf +++ /dev/null @@ -1,136 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /BCS/ -- Data for boundary condition CALPUFF -c sources -c---------------------------------------------------------------------- -c - character*12 fnamebc,lblbc,cspecbc,cunitsbc - character*16 cnamtyp - character*40 csfbc1,cqsfbcname - - common/BCS/VRSBC,NSPECBC,NTYPEBC1,NTYPEBC2,XLENBC,YLENBC, - 1 IBCU,FUNITSBC(4),NBC,HTMINBC,RSAMPBC,CONBC0, - 2 XBCGRD(mxbc),YBCGRD(mxbc),ITYPEBC(mxbc), - 2 IBC(mxbc),NEWBC(mxbc),IRECBC(mxbc),JRECBC(mxbc),D2RECBC(mxbc), - 3 HTBC(mxbc),CONBC(mxspec,mxbc), - 4 XMWTBC(mxspec),IXREMBC(mxspec), - 5 NSBC,IDSFBC1(mxspec,mxbc),IXREFBC1(mxspbc), - 6 NQSFBCTAB,IQSFBCTYPE(mxspbc),QSFBCTAB(mxqsf,mxspbc), - 8 IBYDBC,IBHBC,IEYDBC,IEHBC,IBEGBC,IENDBC, - 9 FNAMEBC,LBLBC,CNAMTYP(mxbc),CSPECBC(mxspec),CUNITSBC(4), - 7 CSFBC1(mxspbc),CQSFBCNAME(mxspbc) -c -c --- COMMON BLOCK /BCS/ Variables: -c -c VRSBC - real - Data set version -c NSPECBC - integer - Number of species in BCON file -c NTYPEBC1 - integer - Number of air mass types defined -c - constant or factored variation -c NTYPEBC2 - integer - Number of air mass types defined -c - (arbitrary time variation -c NSBC - integer - Number of airmass-species pairs -c with emissions scaling factors -c XLENBC - real - Length of each segment along X (m) -c YLENBC - real - Length of each segment along Y (m) -c IBCU - integer - Units for boundary concentrations -c 1: g/m**3 -c 2: ug/m**3 -c 3: ppm -c 4: ppb -c FUNITSBC(4) - real - Units conversion factor to g/m**3 -c NBC - integer - Number of boundary condition -c segments -c HTMINBC - real - Minimum layer depth (m) for BC -c puffs when released (MBCON=2) -c RSAMPBC - real - Search radius (km) for sampling -c BC puffs -c CONBC0 - real - Concentration (g/m3) of species -c 'BCON' imposed on all BC puffs -c emitted (always generate active -c BC puffs even when boundary air is -c clean) -c -c -------- Section for data for each boundary segment --------- -c -c XBCGRD(mxbc) - real - X coordinate of each segment (met. -c grid units w/ origin at (0.0,0.0)) -c YBCGRD(mxbc) - real - Y coordinate of each segment (met. -c grid units w/ origin at (0.0,0.0)) -c ITYPEBC(mxbc) - integer - Type of air mass associated with -c each segment -c IBC(mxbc) - integer - Boundary on which each segment is -c located -c 1 = North -c 2 = South -c 3 = East -c 4 = West -c NEWBC(mxbc) - integer - Number of puffs released by each -c segment during current time step -c -c -------- Section for MBCON=2 identifying CONC.DAT receptors --------- -c -c IRECBC(mxbc) - integer - receptor 'i' used for each segment -c JRECBC(mxbc) - integer - receptor 'j' used for each segment -c (j=0 for discrete receptors) -c D2RECBC(mxbc) - real - squared distance from segment to -c receptor (met grid units) -c -c -------- Section for data for each air-mass type and species --------- -c -c --- NOTE: Species order in CONBC, XMWTBC, IXREMBC is determined in -c BCON.DAT file (may not be same as control-file!) -c -c HTBC(mxbc) - real - 'Top' of air mass layer (m) -c CONBC(mxspec,mxbc) - real - Concentration of each modeled species -c in air mass (g/m**3) -c XMWTBC(mxspec) - real - Molecular weight for each species -c IXREMBC(mxspec) - integer - Cross referencing array of NSPECBC -c values relating species ordering -c in the BCON file to the -c ordering in the main conc. array -c -c --- NOTE: Species order in IDSFBC1() is determined in the control file -c and is the same as in the main conc. array -c -c IDSFBC1(mxspec,mxbc) - integer - Pointer to airmass-species pair -c index, (0 if no scaling) -c IXREFBC1(mxspbc) - integer - Cross-reference pointer from -c airmass-species pairs to -c scale-factor tables -c CSFBC1(mxspbc) - c*40 arr - List of scale-factor table names -c for airmass-species pairs -c -c --- Variables for defining emission-rate scaling factor tables -c NQSFBCTAB - integer - Number of tables of -c emissions scaling factors -c IQSFBCTYPE(mxspbc) - integer - Index of scale-factor type of -c each table -c CQSFBCNAME(mxspbc) - char*40 - Name of each scale-factor table -c QSFBCTAB(mxqsf,mxspbc) - real - Emission scale-factors -c -c -------- Section for date/time information in BCON file --------- -c -c IBYDBC - integer - Date of the first data record in -c file (YYYYJJJ, where YYYY=year, -c JJJ=Julian day) -c IBHBC - integer - Hour of the first data record in -c file (00-23 LST) -c IEYDBC - integer - Date of the last data record in -c file (YYYYJJJ, where YYYY=year, -c JJJ=Julian day) -c IEHBC - integer - Hour of the last data record in -c file (00-23 LST) -c IBEGBC - integer - Starting time for which emissions -c data in current set of -c records is valid (YYYYJJJHH) -c IENDBC - integer - Ending time for which emissions -c data in current set of -c records is valid (YYYYJJJHH) -c -c -------- Section for character data ----------- -c -c FNAMEBC - char*12 - Data set name "BCON" -c LBLBC - char*12 - Data set label -c CNAMTYP(mxbc) - char*16 - Air-mass names -c CSPECBC(mxspec) - char*12 - Species identifiers -c CUNITSBC(4) - char*12 - Species concentration units -c diff --git a/CALPUFF_SRC/CALPUFF/blockdat.crd b/CALPUFF_SRC/CALPUFF/blockdat.crd deleted file mode 100644 index c87c405..0000000 --- a/CALPUFF_SRC/CALPUFF/blockdat.crd +++ /dev/null @@ -1,1374 +0,0 @@ - BLOCK DATA DATUMS -c -c************************************************************ -c -c --- BUILD manufactored BLOCK DATA routine -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - INCLUDE 'nima.crd' - data kmax,nudat /234,132/ -c -c --- Set date-stamp for this BLOCK DATA file - data dateb /'02-21-2003 '/ -c --- Set checking date stamp here - data dstamp /'02-21-2003 '/ -c - data datum / - *'WGS-84 : WGS 84 ', - *'WGS-84 : EMG 96 ', - *'WGS-84 : GRS 80 ', - *'WGS-72 : WGS 72 ', - *'NWS : 6370KM Sphere ', - *'ESRI REFERENCE : Normal Sphere (6371) ', - *'ADINDAN : Clarke 1880 ', - *'AFGOOYE : Krassovsky 1940 ', - *'ARC 1950 : Clarke 1880 ', - *'ARC 1960 : Clarke 1880 ', - *'AYABELLE LIGHTHOUSE : Clarke 1880 ', - *'BISSAU : International 1924 ', - *'CAPE : Clarke 1880 ', - *'CARTHAGE : Clarke 1880 ', - *'DABOLA : Clarke 1880 ', - *'EUROPEAN 1950 : International 1924 ', - *'LEIGON : Clarke 1880 ', - *'LIBERIA 1964 : Clarke 1880 ', - *'MASSAWA : Bessel 1841 ', - *'MERCHICH : Clarke 1880 ', - *'MINNA : Clarke 1880 ', - *'M-PORALOKO : Clarke 1880 ', - *'NORTH SAHARA 1959 : Clarke 1880 ', - *'OLD EGYPTIAN 1907 : Helmert 1906 ', - *'POINT 58 : Clarke 1880 ', - *'POINTE NOIRE 1948 : Clarke 1880 ', - *'SCHWARZECK : Bessel 1841 ', - *'SIERRA LEONE 1960 : Clarke 1880 ', - *'TANANARIVE OBSERVATORY 1925 : International 1924 ', - *'VOIROL 1874 : Clarke 1880 ', - *'VOIROL 1960 : Clarke 1880 ', - *'AIN EL ABD 1970 : International 1924 ', - *'BUKIT RIMPAH : Bessel 1841 ', - *'DJAKARTA (BATAVIA) : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'GUNUNG SEGARA : Bessel 1841 ', - *'HERAT NORTH : International 1924 ', - *'HONG KONG 1963 : International 1924 ', - *'HU-TZU-SHAN : International 1924 ', - *'INDIAN : Everest (1830) ', - *'INDIAN : Everest (1956) ', - *'INDIAN : Everest ', - *'INDIAN 1954 : Everest (1830) ', - *'INDIAN 1960 : Everest (1830) ', - *'INDIAN 1975 : Everest (1830) ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'KANDAWALA : Everest (1830) ', - *'KERTAU 1948 : Everest (1948) ', - *'KOREAN GEODETIC SYSTEM 1995 : WGS 84 ', - *'NAHRWAN : Clarke 1880 ', - *'OMAN : Clarke 1880 ', - *'PULKOVO 1942 : Krassovsky 1940 ', - *'QATAR NATIONAL : International 1924 ', - *'SOUTH ASIA : Modified Fischer 1960', - *'TIMBALAI 1948 : Everest ', - *'TOKYO : Bessel 1841 ', - *'AUSTRALIAN GEODETIC 1966 : Australian National ', - *'AUSTRALIAN GEODETIC 1984 : Australian National ', - *'COORD SYSTEM 1937 OF ESTONIA : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'EUROPEAN 1979 : International 1924 ', - *'HERMANNSKOGEL : Bessel 1841 ', - *'IRELAND 1965 : Modified Airy ', - *'ORD SURV OF GREAT BRITAIN 36 : Airy ', - *'ROME 1940 : International 1924 ', - *'S-42 (PULKOVO 1942) : Krassovsky 1940 ', - *'S-JTSK : Bessel 1841 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'NORTH AMERICAN 1927 : Clarke 1866 ', - *'NORTH AMERICAN 1983 : GRS 80 ', - *'BOGOTA OBSERVATORY : International 1924 ', - *'CAMPO INCHAUSPE 1969 : International 1924 ', - *'CHUA ASTRO : International 1924 ', - *'CORREGO ALEGRE : International 1924 ', - *'PROVISIONAL S. AMERICAN 1956 : International 1924 ', - *'PROVISIONAL S. CHILEAN 1963 : International 1924 ', - *'SOUTH AMERICAN 1969 : South American 1969 ', - *'SIRGAS : GRS 80 ', - *'YACARE : International 1924 ', - *'ZANDERIJ : International 1924 ', - *'ANTIGUA ISLAND ASTRO 1943 : Clarke 1880 ', - *'ASCENSION ISLAND 1958 : International 1924 ', - *'ASTRO DOS 71/4 : International 1924 ', - *'BERMUDA 1957 : Clarke 1866 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'DECEPTION ISLAND : Clarke 1880 ', - *'FORT THOMAS 1955 : Clarke 1880 ', - *'GRACIOSA BASE SW 1948 : International 1924 ', - *'HJORSEY 1955 : International 1924 ', - *'ISTS 061 ASTRO 1968 : International 1924 ', - *'L. C. 5 ASTRO 1961 : Clarke 1866 ', - *'MONTSERRAT ISLAND ASTRO 1958 : Clarke 1880 ', - *'NAPARIMA, BWI : International 1924 ', - *'OBSERVAT. METEOROLOGICO 1939 : International 1924 ', - *'PICO DE LAS NIEVES : International 1924 ', - *'PORTO SANTO 1936 : International 1924 ', - *'PUERTO RICO : Clarke 1866 ', - *'QORNOQ : International 1924 ', - *'SAO BRAZ : International 1924 ', - *'SAPPER HILL 1943 : International 1924 ', - *'SELVAGEM GRANDE 1938 : International 1924 ', - *'TRISTAN ASTRO 1968 : International 1924 ', - *'ANNA 1 ASTRO 1965 : Australian National ', - *'GAN 1970 : International 1924 ', - *'ISTS 073 ASTRO 1969 : International 1924 ', - *'KERGUELEN ISLAND 1949 : International 1924 ', - *'MAHE 1971 : Clarke 1880 ', - *'REUNION : International 1924 ', - *'AMERICAN SAMOA 1962 : Clarke 1866 ', - *'ASTRO BEACON E 1945 : International 1924 ', - *'ASTRO TERN ISLAND (FRIG) 61 : International 1924 ', - *'ASTRONOMICAL STATION 1952 : International 1924 ', - *'BELLEVUE (IGN) : International 1924 ', - *'CAMP AREA ASTRO : International 1924 ', - *'CANTON ASTRO 1966 : International 1924 ', - *'CHATHAM ISLAND ASTRO 1971 : International 1924 ', - *'DOS 1968 : International 1924 ', - *'EASTER ISLAND 1967 : International 1924 ', - *'GEODETIC DATUM 1949 : International 1924 ', - *'GUAM 1963 : Clarke 1866 ', - *'GUX l ASTRO : International 1924 ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'JOHNSTON ISLAND 1961 : International 1924 ', - *'KUSAIE ASTRO 1951 : International 1924 ', - *'LUZON : Clarke 1866 ', - *'MIDWAY ASTRO 1961 : International 1924 ', - *'OLD HAWAIIAN : Clarke 1866 ', - *'PITCAIRN ASTRO 1967 : International 1924 ', - *'SANTO (DOS) 1965 : International 1924 ', - *'VITI LEVU 1916 : Clarke 1880 ', - *'WAKE-ENIWETOK 1960 : Hough ', - *'WAKE ISLAND ASTRO 1952 : International 1924 '/ - data datcod / - *'WGS-84 ','WGS-96 ','WGS-G ','WGS-72 ','NWS-84 ', - *'ESR-S ','ADI-M ','ADI-E ','ADI-F ','ADI-A ', - *'ADI-C ','ADI-D ','ADI-B ','AFG ','ARF-M ', - *'ARF-A ','ARF-H ','ARF-B ','ARF-C ','ARF-D ', - *'ARF-E ','ARF-F ','ARF-G ','ARS-M ','ARS-A ', - *'ARS-B ','PHA ','BID ','CAP ','CGE ', - *'DAL ','EUR-F ','EUR-T ','LEH ','LIB ', - *'MAS ','MER ','MIN-A ','MIN-B ','MPO ', - *'NSD ','OEG ','PTB ','PTN ','SCK ', - *'SRL ','TAN ','VOI ','VOR ','AIN-A ', - *'AIN-B ','BUR ','BAT ','EUR-H ','EUR-S ', - *'GSE ','HEN ','HKD ','HTN ','IND-B ', - *'IND-I ','IND-P ','INF-A ','ING-A ','ING-B ', - *'INH-A ','INH-A1 ','IDN ','KAN ','KEA ', - *'KGS ','NAH-A ','NAH-B ','NAH-C ','FAH ', - *'PUK ','QAT ','SOA ','TIL ','TOY-M ', - *'TOY-A ','TOY-C ','TOY-B ','TOY-B1 ','AUA ', - *'AUG ','EST ','EUR-M ','EUR-A ','EUR-E ', - *'EUR-G ','EUR-K ','EUR-B ','EUR-I ','EUR-J ', - *'EUR-L ','EUR-C ','EUR-D ','EUS ','HER ', - *'IRL ','OGB-M ','OGB-A ','OGB-B ','OGB-C ', - *'OGB-D ','MOD ','SPK-A ','SPK-B ','SPK-C ', - *'SPK-D ','SPK-E ','SPK-F ','SPK-G ','CCD ', - *'CAC ','NAS-C ','NAS-B ','NAS-A ','NAS-D ', - *'NAS-V ','NAS-W ','NAS-Q ','NAS-R ','NAS-E ', - *'NAS-F ','NAS-G ','NAS-H ','NAS-I ','NAS-J ', - *'NAS-O ','NAS-P ','NAS-N ','NAS-T ','NAS-U ', - *'NAS-L ','NAR-A ','NAR-E ','NAR-B ','NAR-C ', - *'NAR-H ','NAR-D ','BOO ','CAI ','CHU ', - *'COA ','PRP-M ','PRP-A ','PRP-B ','PRP-C ', - *'PRP-D ','PRP-E ','PRP-F ','PRP-G ','PRP-H ', - *'HIT ','SAN-M ','SAN-A ','SAN-B ','SAN-C ', - *'SAN-D ','SAN-E ','SAN-F ','SAN-J ','SAN-G ', - *'SAN-H ','SAN-I ','SAN-K ','SAN-L ','SIR ', - *'YAC ','ZAN ','AIA ','ASC ','SHB ', - *'BER ','CAC ','DID ','FOT ','GRA ', - *'HJO ','ISG ','LCF ','ASM ','NAP ', - *'FLO ','PLN ','POS ','PUR ','QUO ', - *'SAO ','SAP ','SGM ','TDC ','ANO ', - *'GAA ','IST ','KEG ','MIK ','REU ', - *'AMA ','ATF ','TRN ','ASQ ','IBE ', - *'CAZ ','CAO ','CHI ','GIZ ','EAS ', - *'GEO ','GUA ','DOB ','IDN ','JOH ', - *'KUS ','LUZ-A ','LUZ-B ','MID ','OHA-M ', - *'OHA-A ','OHA-B ','OHA-C ','OHA-D ','OHI-M ', - *'OHI-A ','OHI-B ','OHI-C ','OHI-D ','PIT ', - *'SAE ','MVS ','ENW ','WAK '/ - data atlas / - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'AUSTRALIA ', - *'AUSTRALIA ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN '/ - data geodat1 / - *'Global coverage [WGS-84 reference ellipsoid and geoid] ', - *'Global coverage [WGS-EGM96 geoid for the Earth Gravitational', - *'Global coverage [GRS-80 ITRF reference ellipsoid] ', - *'Global coverage [WGS-72 reference ellipsoid and geoid] ', - *'Global Sphere (WGS84) ', - *'Global Reference Sphere ', - *'MEAN FOR Ethiopia, Sudan ', - *'Burkina Faso ', - *'Cameroon ', - *'Ethiopia ', - *'Mali ', - *'Senegal ', - *'Sudan ', - *'Somalia ', - *'MEAN FOR Botswana, Lesotho, Malawi, Swaziland, Zaire, Zambia', - *'Botswana ', - *'Burundi ', - *'Lesotho ', - *'Malawi ', - *'Swaziland ', - *'Zaire ', - *'Zambia ', - *'Zimbabwe ', - *'MEAN FOR Kenya, Tanzania ', - *'Kenya ', - *'Tanzania ', - *'Djibouti ', - *'Guinea-Bissau ', - *'South Africa ', - *'Tunisia ', - *'Guinea ', - *'Egypt ', - *'Tunisia ', - *'Ghana ', - *'Liberia ', - *'Eritrea ', - *'Morocco ', - *'Cameroon ', - *'Nigeria ', - *'Gabon ', - *'Algeria ', - *'Egypt ', - *'Burkina Faso, Niger ', - *'Congo ', - *'Namibia ', - *'Sierra Leone ', - *'Madagascar ', - *'Tunisia, Algeria ', - *'Algeria ', - *'Bahrain Island ', - *'Saudi Arabia ', - *'Bangka and Belitung Islands (Indonesia) ', - *'Sumatra (Indonesia) ', - *'Iran ', - *'Iraq, Israel, Jordan, Kuwait, Lebanon, Saudi Arabia, Syria ', - *'Kalimantan (Indonesia) ', - *'Afghanistan ', - *'Hong Kong ', - *'Taiwan ', - *'Bangladesh ', - *'India, Nepal ', - *'Pakistan ', - *'Thailand ', - *'Vietnam (near 16N) ', - *'Con Son Island (Vietnam) ', - *'Thailand ', - *'Thailand ', - *'Indonesia ', - *'Sri Lanka ', - *'West Malaysia, Singapore ', - *'South Korea ', - *'Masirah Island (Oman) ', - *'United Arab Emirates ', - *'Saudi Arabia ', - *'Oman ', - *'Russia ', - *'Qatar ', - *'Singapore ', - *'Brunei, East Malaysia (Sarawak and Sabah) ', - *'MEAN FOR Japan, Okinawa, South Korea ', - *'Japan ', - *'Okinawa ', - *'South Korea ', - *'South Korea ', - *'Australia, Tasmania ', - *'Australia, Tasmania ', - *'Estonia ', - *'MEAN FOR Austria, Belgium, Denmark, Finland, France, Federal', - *'MEAN FOR Austria, Denmark, France, Federal Republic of Germa', - *'Cyprus ', - *'England, Channel Islands, Scotland, Shetland Islands ', - *'England, Ireland, Scotland, Shetland Islands ', - *'Greece ', - *'Sardinia (Italy) ', - *'Sicily (Italy) ', - *'Malta ', - *'Norway, Finland ', - *'Portugal, Spain ', - *'MEAN FOR Austria, Finland, Netherlands, Norway, Spain, Swede', - *'Yugoslavia (Prior to 1990), Slovenia, Croatia, Bosnia and He', - *'Ireland ', - *'MEAN FOR England, Isle of Man, Scotland, Shetland Islands, W', - *'England ', - *'England, Isle of Man, Wales ', - *'Scotland, Shetland Islands ', - *'Wales ', - *'Sardinia ', - *'Hungary ', - *'Poland ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Latvia ', - *'Kazakhstan ', - *'Albania ', - *'Romania ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Florida, Bahamas ', - *'MEAN FOR CONTIGUOUS US(CONUS) ', - *'MEAN FOR Arizona, Arkansas, California, Colorado, Idaho, Iow', - *'MEAN FOR Alabama, Connecticut, Delaware, District of Columbi', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands (East of 180W) ', - *'Aleutian Islands (West of 180W) ', - *'Bahamas (Excluding San Salvador Island) ', - *'San Salvador Island ', - *'MEAN FOR Canada (Including Newfoundland) ', - *'Alberta, British Columbia ', - *'MEAN FOR Newfoundland, New Brunswick, Nova Scotia, Quebec ', - *'Manitoba, Ontario ', - *'Northwest Territories, Saskatchewan ', - *'Yukon ', - *'Canal Zone ', - *'MEAN FOR Antigua Island, Barbados, Barbuda, Caicos Islands, ', - *'MEAN FOR Belize, Costa Rica, El Salvador, Guatemala, Hondura', - *'Cuba ', - *'Greenland (Hayes Peninsula) ', - *'Mexico ', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands ', - *'Canada ', - *'CONTIGUOUS US (CONUS) ', - *'Hawaii ', - *'Mexico, Central America ', - *'Colombia ', - *'Argentina ', - *'Paraguay ', - *'Brazil ', - *'MEAN FOR Bolivia, Chile, Colombia, Ecuador, Guyana, Peru, Ve', - *'Bolivia ', - *'Northern Chile (near 19S) ', - *'Southern Chile (near 43S) ', - *'Colombia ', - *'Ecuador ', - *'Guyana ', - *'Peru ', - *'Venezuela ', - *'Southern Chile (near 53S) ', - *'MEAN FOR Argentina, Bolivia, Brazil, Chile, Colombia, Ecuado', - *'Argentina ', - *'Bolivia ', - *'Brazil ', - *'Chile ', - *'Colombia ', - *'Ecuador (Excluding Galapagos Islands) ', - *'Baltra, Galapagos Islands ', - *'Guyana ', - *'Paraguay ', - *'Peru ', - *'Trinidad and Tobago ', - *'Venezuela ', - *'South America ', - *'Uruguay ', - *'Suriname ', - *'Antigua, Leeward Islands ', - *'Ascension Island ', - *'St. Helena Island ', - *'Bermuda Islands ', - *'Bahamas, Florida ', - *'Deception Island (Antarctica) ', - *'Nevis, St. Kitts, Leeward Islands ', - *'Faial, Graciosa, Pico, Sao Jorge, Terceira Islands (Azores) ', - *'Iceland ', - *'South Georgia Island ', - *'Cayman Brac Island ', - *'Montserrat, Leeward Islands ', - *'Trinidad and Tobago ', - *'Corvo and Flores Islands (Azores) ', - *'Canary Islands ', - *'Porto Santo, Madeira Islands ', - *'Puerto Rico, Virgin Islands ', - *'South Greenland ', - *'Sao Miguel, Santa Maria Islands (Azores) ', - *'East Falkland Island ', - *'Salvage Islands ', - *'Tristan da Cunha ', - *'Cocos Islands ', - *'Republic of Maldives ', - *'Diego Garcia ', - *'Kerguelen Island ', - *'Mahe Island ', - *'Mascarene Islands ', - *'American Samoa Islands ', - *'Iwo Jima ', - *'Tern Island ', - *'Marcus Island ', - *'Efate and Erromango Islands ', - *'Camp McMurdo Area (Antarctica) ', - *'Phoenix Islands ', - *'Chatham Island (New Zealand) ', - *'Gizo Island (New Georgia Islands) ', - *'Easter Island ', - *'New Zealand ', - *'Guam ', - *'Guadalcanal Island ', - *'Indonesia ', - *'Johnston Island ', - *'Caroline Islands, Federal States of Micronesia ', - *'Philippines (Excluding Mindanao Island) ', - *'Mindanao Island ', - *'Midway Islands ', - *'MEAN FOR Hawaiian Islands ', - *'Hawaii ', - *'Kauai ', - *'Maui ', - *'Oahu ', - *'Old Hawaiian (Mean) ', - *'Old Hawaiian Hawaii ', - *'Old Hawaiian Kauai ', - *'Old Hawaiian Maui ', - *'Old Hawaiian Oahu ', - *'Pitcairn Island ', - *'Espirito Santo Island ', - *'Viti Levu Island (Fiji Islands) ', - *'Marshall Islands ', - *'Wake Atoll '/ - data geodat2 / - *' ', - *' Model (EGM) vertical datum] ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *', Zimbabwe ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' Republic of Germany (Prior to 1 January 1993), Gibraltar, G', - *'ny (Prior to 1 January 1993), Netherlands, Switzerland ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'n, Switzerland ', - *'rzegovina, Serbia ', - *' ', - *'ales ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'a, Kansas, Montana, Nebraska, Nevada, New Mexico, North Dako', - *'a, Florida, Georgia, Illinois, Indiana, Kentucky, Louisiana,', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'Cuba, Dominican Republic, Grand Cayman, Jamaica, Turks Islan', - *'s, Nicaragua ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'nezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'r, Guyana, Paraguay, Peru, Trinidad and Tobago, Venezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data geodat3 / - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'reece, Italy, Luxembourg, Netherlands, Norway, Portugal, Spa', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ta, Oklahoma, Oregon, South Dakota, Texas, Utah, Washington,', - *' Maine, Maryland, Massachusetts, Michigan, Minnesota, Missis', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ds ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data dattyp / - * 1, 2, 3, 4, 5, - * 6, 7, 7, 7, 7, - * 7, 7, 7, 8, 9, - * 9, 9, 9, 9, 9, - * 9, 9, 9, 10, 10, - * 10, 11, 12, 13, 14, - * 15, 16, 16, 17, 18, - * 19, 20, 21, 21, 22, - * 23, 24, 25, 26, 27, - * 28, 29, 30, 31, 32, - * 32, 33, 34, 35, 35, - * 36, 37, 38, 39, 40, - * 41, 42, 43, 44, 44, - * 45, 45, 46, 47, 48, - * 49, 50, 50, 50, 51, - * 52, 53, 54, 55, 56, - * 56, 56, 56, 56, 57, - * 58, 59, 60, 60, 60, - * 60, 60, 60, 60, 60, - * 60, 60, 60, 61, 62, - * 63, 64, 64, 64, 64, - * 64, 65, 66, 66, 66, - * 66, 66, 66, 66, 67, - * 68, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 70, 70, 70, 70, - * 70, 70, 71, 72, 73, - * 74, 75, 75, 75, 75, - * 75, 75, 75, 75, 75, - * 76, 77, 77, 77, 77, - * 77, 77, 77, 77, 77, - * 77, 77, 77, 77, 78, - * 79, 80, 81, 82, 83, - * 84, 85, 86, 87, 88, - * 89, 90, 91, 92, 93, - * 94, 95, 96, 97, 98, - * 99, 100, 101, 102, 103, - * 104, 105, 106, 107, 108, - * 109, 110, 111, 112, 113, - * 114, 115, 116, 117, 118, - * 119, 120, 121, 122, 123, - * 124, 125, 125, 126, 127, - * 127, 127, 127, 127, 128, - * 128, 128, 128, 128, 128, - * 129, 130, 131, 132/ - data dradim / - *.6378137D+07,.6378137D+07,.6378137D+07,.6378135D+07,.6370000D+07, - *.6370997D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378245D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6377397D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378200D+07,.6378249D+07,.6378249D+07,.6377484D+07, - *.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6377397D+07,.6377397D+07,.6378388D+07,.6378388D+07, - *.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377276D+07, - *.6377301D+07,.6377310D+07,.6377276D+07,.6377276D+07,.6377276D+07, - *.6377276D+07,.6377276D+07,.6378160D+07,.6377276D+07,.6377304D+07, - *.6378137D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378245D+07,.6378388D+07,.6378155D+07,.6377299D+07,.6377397D+07, - *.6377397D+07,.6377397D+07,.6377397D+07,.6377397D+07,.6378160D+07, - *.6378160D+07,.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377397D+07, - *.6377340D+07,.6377563D+07,.6377563D+07,.6377563D+07,.6377563D+07, - *.6377563D+07,.6378388D+07,.6378245D+07,.6378245D+07,.6378245D+07, - *.6378245D+07,.6378245D+07,.6378245D+07,.6378245D+07,.6377397D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378137D+07,.6378137D+07,.6378137D+07,.6378137D+07, - *.6378137D+07,.6378137D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378137D+07, - *.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07,.6378388D+07, - *.6378206D+07,.6378206D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378206D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378160D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07, - *.6378206D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378388D+07,.6378160D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378206D+07,.6378388D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378249D+07,.6378270D+07,.6378388D+07/ - data dflat / - *.2982572D+03,.2982572D+03,.2982572D+03,.2982600D+03,.1000000D+21, - *.1000000D+21,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2983000D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2991528D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2983000D+03,.2934650D+03,.2934650D+03,.2991528D+03, - *.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2991528D+03,.2991528D+03,.2970000D+03,.2970000D+03, - *.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.2982470D+03,.3008017D+03,.3008017D+03, - *.2982572D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2983000D+03,.2970000D+03,.2983000D+03,.3008017D+03,.2991528D+03, - *.2991528D+03,.2991528D+03,.2991528D+03,.2991528D+03,.2982500D+03, - *.2982500D+03,.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2991528D+03, - *.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03, - *.2993250D+03,.2970000D+03,.2983000D+03,.2983000D+03,.2983000D+03, - *.2983000D+03,.2983000D+03,.2983000D+03,.2983000D+03,.2991528D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2982572D+03,.2982572D+03,.2982572D+03,.2982572D+03, - *.2982572D+03,.2982572D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982572D+03, - *.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03, - *.2949787D+03,.2949787D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2949787D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2982500D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03, - *.2949787D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2970000D+03,.2982470D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2949787D+03,.2970000D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03/ - data dec2 / - *.6694380D-02,.6694380D-02,.6694380D-02,.6694318D-02,.0000000D+00, - *.0000000D+00,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6693422D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6674372D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6693422D-02,.6803511D-02,.6803511D-02,.6674372D-02, - *.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6674372D-02,.6674372D-02,.6722670D-02,.6722670D-02, - *.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6694609D-02,.6637847D-02,.6637847D-02, - *.6694380D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6693422D-02,.6722670D-02,.6693422D-02,.6637847D-02,.6674372D-02, - *.6674372D-02,.6674372D-02,.6674372D-02,.6674372D-02,.6694542D-02, - *.6694542D-02,.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6674372D-02, - *.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02, - *.6670540D-02,.6722670D-02,.6693422D-02,.6693422D-02,.6693422D-02, - *.6693422D-02,.6693422D-02,.6693422D-02,.6693422D-02,.6674372D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6694380D-02,.6694380D-02,.6694380D-02,.6694380D-02, - *.6694380D-02,.6694380D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694380D-02, - *.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02, - *.6768658D-02,.6768658D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6768658D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6694542D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02, - *.6768658D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6722670D-02,.6694609D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6768658D-02,.6722670D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02/ - data dxmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -166.000, -118.000, -134.000, -165.000, - * -123.000, -128.000, -161.000, -43.000, -143.000, - * -138.000, -153.000, -125.000, -161.000, -134.000, - * -169.000, -147.000, -142.000, -160.000, -157.000, - * -175.000, -79.000, -173.000, -136.000, -263.000, - * -83.000, -130.000, -112.000, -130.000, -90.000, - * 639.000, 31.000, -81.000, -92.000, -74.000, - * -186.000, -130.000, -106.000, -148.000, 616.000, - * -88.000, -189.000, -73.000, -123.000, -150.000, - * -143.000, -384.000, -377.000, -117.000, -103.000, - * -403.000, -333.000, -156.000, -637.000, 282.000, - * 295.000, 283.000, 217.000, 198.000, 182.000, - * 209.000, 210.000, -24.000, -97.000, -11.000, - * 0.000, -247.000, -249.000, -243.000, -346.000, - * 28.000, -128.000, 7.000, -679.000, -148.000, - * -148.000, -158.000, -146.000, -147.000, -133.000, - * -134.000, 374.000, -87.000, -87.000, -104.000, - * -86.000, -86.000, -84.000, -97.000, -97.000, - * -107.000, -87.000, -84.000, -86.000, 682.000, - * 506.000, 375.000, 371.000, 371.000, 384.000, - * 370.000, -225.000, 28.000, 23.000, 26.000, - * 24.000, 15.000, 24.000, 28.000, 589.000, - * -2.000, -8.000, -8.000, -9.000, -5.000, - * -2.000, 2.000, -4.000, 1.000, -10.000, - * -7.000, -22.000, -9.000, 4.000, -7.000, - * 0.000, -3.000, 0.000, -9.000, 11.000, - * -12.000, 0.000, -2.000, 0.000, 0.000, - * 1.000, 0.000, 307.000, -148.000, -134.000, - * -206.000, -288.000, -270.000, -270.000, -305.000, - * -282.000, -278.000, -298.000, -279.000, -295.000, - * 16.000, -57.000, -62.000, -61.000, -60.000, - * -75.000, -44.000, -48.000, -47.000, -53.000, - * -61.000, -58.000, -45.000, -45.000, 0.000, - * -155.000, -265.000, -270.000, -205.000, -320.000, - * -73.000, -2.000, 260.000, -7.000, -104.000, - * -73.000, -794.000, 42.000, 174.000, -10.000, - * -425.000, -307.000, -499.000, 11.000, 164.000, - * -203.000, -355.000, -289.000, -632.000, -491.000, - * -133.000, 208.000, 145.000, 41.000, 94.000, - * -115.000, 145.000, 114.000, 124.000, -127.000, - * -104.000, 298.000, 175.000, 230.000, 211.000, - * 84.000, -100.000, 252.000, -24.000, 189.000, - * 647.000, -133.000, -133.000, 912.000, 61.000, - * 89.000, 45.000, 65.000, 58.000, 201.000, - * 229.000, 185.000, 205.000, 198.000, 185.000, - * 170.000, 51.000, 102.000, 276.000/ - data dymod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -15.000, -14.000, -2.000, -11.000, - * -20.000, -18.000, -14.000, -163.000, -90.000, - * -105.000, -5.000, -108.000, -73.000, -105.000, - * -19.000, -74.000, -96.000, -6.000, -2.000, - * -23.000, -129.000, 253.000, -108.000, 6.000, - * 37.000, -117.000, -77.000, 29.000, 40.000, - * 405.000, 146.000, -84.000, -93.000, -130.000, - * -93.000, 110.000, -129.000, 51.000, 97.000, - * 4.000, -242.000, -247.000, -206.000, -250.000, - * -236.000, 664.000, 681.000, -132.000, -106.000, - * 684.000, -222.000, -271.000, -549.000, 726.000, - * 736.000, 682.000, 823.000, 881.000, 915.000, - * 818.000, 814.000, -15.000, 787.000, 851.000, - * 0.000, -148.000, -156.000, -192.000, -1.000, - * -130.000, -283.000, -10.000, 669.000, 507.000, - * 507.000, 507.000, 507.000, 506.000, -48.000, - * -48.000, 150.000, -98.000, -96.000, -101.000, - * -96.000, -96.000, -95.000, -103.000, -88.000, - * -88.000, -95.000, -107.000, -98.000, -203.000, - * -122.000, -111.000, -112.000, -111.000, -111.000, - * -108.000, -65.000, -121.000, -124.000, -121.000, - * -124.000, -130.000, -130.000, -121.000, 76.000, - * 151.000, 160.000, 159.000, 161.000, 135.000, - * 152.000, 204.000, 154.000, 140.000, 158.000, - * 162.000, 160.000, 157.000, 159.000, 139.000, - * 125.000, 142.000, 125.000, 152.000, 114.000, - * 130.000, 0.000, 0.000, 0.000, 0.000, - * 1.000, 0.000, 304.000, 136.000, 229.000, - * 172.000, 175.000, 188.000, 183.000, 243.000, - * 169.000, 171.000, 159.000, 175.000, 173.000, - * 196.000, 1.000, -1.000, 2.000, -2.000, - * -1.000, 6.000, 3.000, 26.000, 3.000, - * 2.000, 0.000, 12.000, 8.000, 0.000, - * 171.000, 120.000, 13.000, 107.000, 550.000, - * 213.000, 151.000, 12.000, 215.000, 167.000, - * 46.000, 119.000, 124.000, 359.000, 375.000, - * -169.000, -92.000, -249.000, 72.000, 138.000, - * 141.000, 21.000, -124.000, 438.000, -22.000, - * -321.000, -435.000, -187.000, -220.000, -948.000, - * 118.000, 75.000, -116.000, -234.000, -769.000, - * -129.000, -304.000, -38.000, -199.000, 147.000, - * -22.000, -248.000, -209.000, -15.000, -79.000, - * 1777.000, -77.000, -79.000, -58.000, -285.000, - * -279.000, -290.000, -290.000, -283.000, -228.000, - * -222.000, -233.000, -233.000, -226.000, 165.000, - * 42.000, 391.000, 52.000, -57.000/ - data dzmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, 204.000, 218.000, 210.000, 206.000, - * 220.000, 224.000, 205.000, 45.000, -294.000, - * -289.000, -292.000, -295.000, -317.000, -295.000, - * -278.000, -283.000, -293.000, -302.000, -299.000, - * -303.000, 145.000, 27.000, -292.000, 431.000, - * 124.000, -151.000, -145.000, 364.000, 88.000, - * 60.000, 47.000, 115.000, 122.000, 42.000, - * 310.000, -13.000, 165.000, -291.000, -251.000, - * 101.000, -91.000, 227.000, 219.000, -1.000, - * 7.000, -48.000, -50.000, -164.000, -141.000, - * 41.000, 114.000, -189.000, -203.000, 254.000, - * 257.000, 231.000, 299.000, 317.000, 344.000, - * 290.000, 289.000, 5.000, 86.000, 5.000, - * 0.000, 369.000, 381.000, 477.000, 224.000, - * -95.000, 22.000, -26.000, -48.000, 685.000, - * 685.000, 676.000, 687.000, 687.000, 148.000, - * 149.000, 588.000, -121.000, -120.000, -140.000, - * -120.000, -120.000, -130.000, -120.000, -135.000, - * -149.000, -120.000, -120.000, -119.000, 480.000, - * 611.000, 431.000, 434.000, 434.000, 425.000, - * 434.000, 9.000, -77.000, -82.000, -78.000, - * -82.000, -84.000, -92.000, -77.000, 480.000, - * 181.000, 176.000, 175.000, 179.000, 172.000, - * 149.000, 105.000, 178.000, 165.000, 187.000, - * 188.000, 190.000, 184.000, 188.000, 181.000, - * 201.000, 183.000, 194.000, 178.000, 195.000, - * 190.000, 0.000, 4.000, 0.000, 0.000, - * -1.000, 0.000, -318.000, 90.000, -29.000, - * -6.000, -376.000, -388.000, -390.000, -442.000, - * -371.000, -367.000, -369.000, -379.000, -371.000, - * 93.000, -41.000, -37.000, -48.000, -41.000, - * -44.000, -36.000, -44.000, -42.000, -47.000, - * -33.000, -44.000, -33.000, -33.000, 0.000, - * 37.000, -358.000, 62.000, 53.000, -494.000, - * 296.000, 181.000, -147.000, 225.000, -38.000, - * -86.000, -298.000, 147.000, 365.000, 165.000, - * 81.000, 127.000, 314.000, -101.000, -189.000, - * 53.000, 72.000, 60.000, -609.000, 435.000, - * 50.000, -229.000, 103.000, -134.000, -1262.000, - * 426.000, -272.000, -333.000, -25.000, 472.000, - * 239.000, -375.000, 113.000, -752.000, 111.000, - * 209.000, 259.000, -751.000, 5.000, -202.000, - * -1124.000, -51.000, -72.000, 1227.000, -181.000, - * -183.000, -172.000, -190.000, -182.000, -346.000, - * -348.000, -337.000, -355.000, -347.000, 42.000, - * 84.000, -36.000, -38.000, 149.000/ - END diff --git a/CALPUFF_SRC/CALPUFF/calutils.for b/CALPUFF_SRC/CALPUFF/calutils.for deleted file mode 100644 index da778d3..0000000 --- a/CALPUFF_SRC/CALPUFF/calutils.for +++ /dev/null @@ -1,2953 +0,0 @@ -c------------------------------------------------------------------------------ -c --- CALUTILS -- CALPUFF SYSTEM UTILITIES -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 141010 -c -c Copyright (c) 2014 by Exponent, Inc. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c --- Coordinates -c subroutine xtractll -c --- Year 2000 -c subroutine yr4 -c subroutine yr4c -c subroutine qayr4 -c --- Date/Time -c subroutine julday -c subroutine grday -c subroutine dedat -c subroutine deltt -c subroutine incr -c subroutine indecr -c subroutine incrs -c subroutine deltsec -c subroutine midnite -c subroutine basrutc -c subroutine utcbasr -c --- Control file -c subroutine filcase -c subroutine readin -c subroutine altonu -c subroutine deblnk -c subroutine deplus -c subroutine tright -c subroutine tleft -c subroutine setvar -c subroutine allcap -c --- System -c subroutine datetm -c subroutine fmt_date -c subroutine etime -c subroutine undrflw -c subroutine comline -c --- Error -c subroutine open_err -c ----------------------------- -c -c --- UPDATE -c --- V2.6.0-V7.0.0 141010 :Add error-report for file-open -c New : OPEN_ERR -c --- V2.58-V2.6.0 140318(MBN):Use F95 intrinsic procedures for date and time. -c Modified: DATETM -c Removed obsolete Compaq, Microsoft, and HP -c compiler codes, and removed getcl -c Modified: COMLINE -c --- V2.571-V2.58 110225(DGS):Add variable type 5 to control file processor -c to allow character array variables -c Modified: READIN, ALTONU, SETVAR -c --- V2.57-V2.571 090511(DGS):Add routine to reformat a date string -c New : FMT_DATE -c --- V2.56-V2.57 090202(DGS): Increase control file line length to 200 -c characters -c Modified: PARAMS.CAL, READIN -c Activate CPU clock using F95 system routine -c Modified: DATETM -c --- V2.55-V2.56 080407(DGS): Exponential notation processing in ALTONU did -c not properly interpret an entry without a -c decimal point. -c --- V2.54-V2.55 070327(DGS): Format for output time zone stringin BASRUTC -c wrote zone zero as 'UTC+0 0' instead of -c 'UTC+0000' -c Add RETURN statement to BASRUTC and UTCBASR -c --- V2.53-V2.54 061020(DGS): Allow negative increments in INCRS -c --- V2.52-V2.53 060626(DGS): Remove routine GLOBE1 (move to COORDLIB) -c --- V2.51-V2.52 060519(DGS): Modify search for '=' in READIN to allow -c for blanks between c*12 variable name and -c the '=' sign (internal blanks are not removed -c after V2.2) -c --- V2.5-V2.51 051019 (KAM): Add Albers Conical Equal Area projection -c in GLOBE1 -c --- V2.4-V2.5 041123 (FRR): add subroutine BASRUTC to convert real -c base time zone to character UTC time zone -c and UTCBASR for the backward conversion -c --- V2.3-V2.4 041029 (DGS): Add routine INCRS to change time by a -c number of seconds -c Add routine MIDNITE - converts timestamp -c from day N, time 0000 -c to day N-1, time 2400 -c --- V2.2-V2.3 040330 (DGS): Replace filename strings c*70 with c*132 -c (FILCASE, COMLINE) -c Allow for spaces within pathnames by adding -c new TLEFT and TRIGHT trim subroutines -c --- V2.1-V2.2 030528 (DGS): Screen for valid UTM zone using -c absolute value (S. Hem. zones are -c negative) in GLOBE1 -c --- V2.0-V2.1 030402 (DGS): Remove routine GLOBE -c Split DEBLNK action (removes ' ', '+') -c into DEBLNK and DEPLUS -c Add routine UNDRFLW -c Add false Easting and Northing (GLOBE1) -c Add TYPE argument to XTRACTLL -c Change format XTRACTLL (f16) to (f16.0) -c --- V1.1-V2.0 021018 (DGS): Add routines for new COORDS -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input (YR4C) -c -c -c---------------------------------------------------------------------- - subroutine xtractll(io,type,clatlon,rlatlon) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 XTRACTLL -c D. Strimaitis EarthTech -c -c --- PURPOSE: Extract the real latitude or longitude from a character -c string that contains the N/S or E/W convention -c character, and express result as either North Latitude -c or East Longitude -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (010713) (DGS) -c - Add TYPE argument for QA -c - Change format (f16) to (f16.0) to satisfy different -c compilers -c -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c TYPE - char*4 - LAT or LON -c CLATLON - char*16 - Latitude or longitude (degrees), with -c 1 character that denotes convention -c (e.g. 'N 45.222' or '-35.999s') -c -c --- OUTPUT: -c RLATLON - real - North Latitude or East Longitude -c (degrees) -c -c --- XTRACTLL called by: (utility) -c --- XTRACTLL calls: DEBLNK, ALLCAP -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' - - character*1 cstor1(mxcol),cstor2(mxcol) - character*16 clatlon, clatlon2 - character*4 type - logical ltype - - ltype=.FALSE. - -c --- Initialize character variables for output - clatlon2=' ' - do i=1,20 - cstor2(i)=' ' - enddo - -c --- Was valid type provided? - if(type.NE.'LAT ' .AND. type.NE.'LON ') then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'Invalid type: ',type - write(io,*) 'Expected LAT or LON' - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Pass c*16 string into storage array 1 - do i=1,16 - cstor1(i)=clatlon(i:i) - enddo -c --- Pad out to position 20 - do i=17,20 - cstor1(i)=' ' - enddo - -c --- Remove blank characters from string, place in storage array 2 -c --- (Use a 20-character field here for a margin at end of string) - call DEBLNK(cstor1,1,20,cstor2,nlim) -c -c --- Convert lower case letters to upper case - call ALLCAP(cstor2,nlim) - -c --- Interpret valid convention character (N,S,E,W) - nchar=0 - ichar=0 - ilat=0 - ilon=0 - - do i=1,nlim - if(cstor2(i).EQ.'N') then - ilat=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'S') then - ilat=2 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'W') then - ilon=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'E') then - ilon=2 - ichar=i - nchar=nchar+1 - endif - enddo - -c --- Was 1 valid character found? - if(nchar.NE.1) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character is missing or repeated' - write(io,*) 'Lat/Lon = ',clatlon - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Was valid character the right type? - if(type.EQ.'LAT ' .AND. ilat.EQ.0) ltype=.TRUE. - if(type.EQ.'LON ' .AND. ilon.EQ.0) ltype=.TRUE. - if(LTYPE) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character does not match type' - write(io,*) 'Lat/Lon = ',clatlon - write(io,*) 'type = ',type - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Remove character from string - do i=ichar,nlim - cstor2(i)=cstor2(i+1) - enddo - -c --- Search for position of decimal point - ipt=0 - do i=1,nlim - if(cstor2(i).EQ.'.') ipt=i - enddo - -c --- Add a decimal point if needed - if(ipt.EQ.0) then - cstor2(nlim)='.' - endif - -c --- Pass resulting "number" back into c*16 variable - do i=1,nlim - clatlon2(i:i)=cstor2(i) - enddo - -c --- Get real part - read(clatlon2,'(f16.0)') rlatlon - -c --- Convert to either N. Lat. or E. Lon., if needed - if(ilat.EQ.2) then - rlatlon=-rlatlon - elseif(ilon.EQ.1) then - rlatlon=-rlatlon - endif - -c --- Condition longitude to be -180 to +180 - if(ilon.GT.0) then - if(rlatlon.GT.180.) then - rlatlon=rlatlon-360. - elseif(rlatlon.LT.-180.) then - rlatlon=rlatlon+360. - endif - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4(io,iyr,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 991104 YR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year (YYYY or YY) -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c --- YR4 called by: Input routines reading 'year' data -c --- YR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - - ierr=0 - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.iyylo) then - iyr=(icclo+1)*100+iyr - else - iyr=icclo*100+iyr - endif - else -c --- Year not recognized - ierr=1 - write(io,*)'ERROR in YR4 --- Year not recognized: ',iyr - write(*,*)'ERROR in YR4 --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4c(iyr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 020828 YR4C -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year (CURRENT) -c -c --- UPDATE -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input -c -c --- INPUTS: -c IYR - integer - Year (YYYY or YY) -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c -c --- YR4C called by: host subroutines -c --- YR4C calls: none -c---------------------------------------------------------------------- -c --- Set parameters for converting a current year (1999 - 2098) -c --- Use KCCLO as century digits for years GE KYYLO - data kyylo/99/, kcclo/19/ - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.kyylo) then - iyr=(kcclo+1)*100+iyr - else - iyr=kcclo*100+iyr - endif - else -c --- Year not recognized - write(*,*)'ERROR in YR4C --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine qayr4(io,iyr,metrun,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 991104 QAYR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Defines century and year markers to use in converting -c --- 2-digit year to 4-digit year -c --- The IBYR (YYYY) must be provided in the control file -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year provided for start of run -c METRUN - integer - Flag to run period in met file -c 0 = do not run period -c 1 = run period -c -c --- OUTPUT: -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- QAYR4 called by: host subroutines -c --- QAYR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - -c --- Sets parameters for the starting century marker (CC) and the -c --- 2-digit year (YY) used as the marker between the starting century -c --- and the next century. For example, if CC=19 and YY=30, then a -c --- year less than 30 (say 15) is assumed to be 2015. Any year -c --- greater than or equal to 30 (say 56) is assumed to be 1956. - -c --- Set number of years prior to start of simulation that must not -c --- be placed in the next century - data ibackyr/50/ - - ierr=0 - -c --- Expect explicit starting year (YYYY) -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) -c --- Back up IBACKYR years to set IYYLO - kyr=iyr-ibackyr -c --- Extract starting 2-digit century and 2-digit year - icclo=kyr/100 - iyylo=kyr-icclo*100 - -c --- Warn user that control file input is used to convert to YYYY - iyr1=icclo*100+iyylo - iyr2=(icclo+1)*100+iyylo-1 - write(io,*) - write(io,*)'-------------------------------------------------' - write(io,*)'NOTICE: Starting year in control file sets the' - write(io,*)' expected century for the simulation. All' - write(io,*)' YY years are converted to YYYY years in' - write(io,*)' the range: ',iyr1,iyr2 - write(io,*)'-------------------------------------------------' - write(io,*) - else - ierr=1 - write(*,*) - write(*,*)'--------------------------------------------' - write(*,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(*,*)' and must always be provided' - endif - write(*,*)'--------------------------------------------' - write(*,*) - write(io,*) - write(io,*)'-------------------------------------------' - write(io,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(io,*)' and must always be provided' - endif - write(io,*)'-------------------------------------------' - write(io,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine julday(io,iyr,imo,iday,ijuldy) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 000602 JULDAY -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the Julian day number from the Gregorian -c date (month, day) -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c -c --- OUTPUT: -c IJUL - integer - Julian day -c -c --- JULDAY called by: host subroutines -c --- JULDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12) - data kday/0,31,59,90,120,151,181,212,243,273,304,334/ -c -c --- Check for valid input data - ierr=0 -c --- Check for valid month - if(imo.lt.1.or.imo.gt.12)ierr=1 -c --- Check for valid day in 30-day months - if(imo.eq.4.or.imo.eq.6.or.imo.eq.9.or.imo.eq.11)then - if(iday.gt.30)ierr=1 - else if(imo.eq.2)then - if(mod(iyr,4).eq.0)then -c --- February in a leap year - if(iday.gt.29)ierr=1 - else -c --- February in a non-leap year - if(iday.gt.28)ierr=1 - endif - else -c --- Check for valid day in 31-day months - if(iday.gt.31)ierr=1 - endif -c - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. JULDAY' - write(io,*)'Invalid date - IYR = ',iyr,' IMO = ', - 1 imo,' IDAY = ',iday - write(*,*) - stop 'Halted in JULDAY -- see list file.' - endif -c -c --- Compute the Julian day - ijuldy=kday(imo)+iday - if(imo.le.2)return - if(mod(iyr,4).EQ.0)ijuldy=ijuldy+1 -c - return - end -c---------------------------------------------------------------------- - subroutine grday(io,iyr,ijul,imo,iday) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 000602 GRDAY -c J. Scire, SRC -c -c --- PURPOSE: Compute the Gregorian date (month, day) from the -c Julian day -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IJUL - integer - Julian day -c -c --- OUTPUT: -c IMO - integer - Month -c IDAY - integer - Day -c -c --- GRDAY called by: host subroutines -c --- GRDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12,2) - data kday/31,59,90,120,151,181,212,243,273,304,334,365, - 1 31,60,91,121,152,182,213,244,274,305,335,366/ -c -c - ileap=1 - if(mod(iyr,4).eq.0)ileap=2 - if(ijul.lt.1.or.ijul.gt.kday(12,ileap))go to 11 -c - do 10 i=1,12 - if(ijul.gt.kday(i,ileap))go to 10 - imo=i - iday=ijul - if(imo.ne.1)iday=ijul-kday(imo-1,ileap) - return -10 continue -c -11 continue - write(io,12)iyr,ijul -12 format(//2x,'ERROR in SUBR. GRDAY -- invalid Julian day '//2x, - 1 'iyr = ',i5,3x,'ijul = ',i5) - write(*,*) - stop 'Halted in GRDAY -- see list file.' - end -c------------------------------------------------------------------------------ - subroutine dedat(idathr,iyr,ijul,ihr) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 941215 DEDAT -c --- J. Scire, SRC -c -c --- Decode a date-time variable -c -c --- INPUTS: -c IDATHR - integer - Date-time variable (YYYYJJJHH) -c -c --- OUTPUT: -c IYR - integer - Year of precip. data (4 digits) -c IJUL - integer - Julian day number of precip. data -c IHR - integer - Ending hour (1-24) of precip. data -c -c --- DEDAT called by: host subroutines -c --- DEDAT calls: none -c------------------------------------------------------------------------------ -c -c --- decode date and time - iyr=idathr/100000 - ijul=idathr/100-iyr*1000 - ihr=idathr-iyr*100000-ijul*100 -c - return - end -c------------------------------------------------------------------------------ - subroutine deltt(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jleng) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 941215 DELTT -c --- J. Scire, SRC -c -c --- Compute the difference (in hours) between two dates & times -c --- (time #2 - time #1) -c -c --- INPUTS: -c J1YR - integer - Year of date/time #1 -c J1JUL - integer - Julian day of date/time #1 -c J1HR - integer - Hour of date/time #1 -c J2YR - integer - Year of date/time #2 -c J2JUL - integer - Julian day of date/time #2 -c J2HR - integer - Hour of date/time #2 -c -c --- OUTPUT: -c JLENG - integer - Difference (#2 - #1) in hours -c -c --- DELTT called by: host subroutines -c --- DELTT calls: none -c------------------------------------------------------------------------------ -c - jmin=min0(j1yr,j2yr) -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the first date/hour - if(j1yr.eq.jmin)then - j1=0 - else - j1=0 - j1yrm1=j1yr-1 - do 10 i=jmin,j1yrm1 - if(mod(i,4).eq.0)then - j1=j1+8784 - else - j1=j1+8760 - endif -10 continue - endif - j1=j1+(j1jul-1)*24+j1hr -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the second date/hour - if(j2yr.eq.jmin)then - j2=0 - else - j2=0 - j2yrm1=j2yr-1 - do 20 i=jmin,j2yrm1 - if(mod(i,4).eq.0)then - j2=j2+8784 - else - j2=j2+8760 - endif -20 continue - endif - j2=j2+(j2jul-1)*24+j2hr -c -c --- compute the time difference (in hours) - jleng=j2-j1 -c - return - end -c---------------------------------------------------------------------- - subroutine incr(io,iyr,ijul,ihr,nhrinc) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 000602 INCR -c J. Scire, SRC -c -c --- PURPOSE: Increment the time and date by "NHRINC" hours -c -c --- UPDATE -c --- 000602 (DGS): add message to "stop" -c --- 980304 (DGS): Allow for a negative "increment" of -c up to 24 hours -c --- 980304 (DGS): Allow for arbitrarily large nhrinc -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year -c IJUL - integer - Current Julian day -c IHR - integer - Current hour (00-23) -c NHRINC - integer - Time increment (hours) -c -c NOTE: "NHRINC" must >= -24 -c Hour is between 00-23 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c -c --- INCR called by: host subroutines -c --- INCR calls: none -c---------------------------------------------------------------------- -c -c --- Check nhrinc - if(nhrinc.lt.-24) then - write(io,*)'ERROR IN SUBR. INCR -- Invalid value of NHRINC ', - 1 '-- NHRINC = ',nhrinc - write(*,*) - stop 'Halted in INCR -- see list file.' - endif - -c --- Save increment remaining (needed if nhrinc > 8760) - nleft=nhrinc -c -c --- Process change in hour - if(nhrinc.gt.0)then -c -10 ninc=MIN0(nleft,8760) - nleft=nleft-ninc -c -c --- Increment time - ihr=ihr+ninc - if(ihr.le.23)return -c -c --- Increment day - ijul=ijul+ihr/24 - ihr=mod(ihr,24) -c -c --- ILEAP = 0 (non-leap year) or 1 (leap year) - if(mod(iyr,4).eq.0)then - ileap=1 - else - ileap=0 - endif -c - if(ijul.gt.365+ileap) then -c --- Update year - iyr=iyr+1 - ijul=ijul-(365+ileap) - endif -c -c --- Repeat if more hours need to be added - if(nleft.GT.0) goto 10 -c - elseif(nhrinc.lt.0)then -c --- Decrement time - ihr=ihr+nhrinc - if(ihr.lt.0)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - endif -c - return - end -c------------------------------------------------------------------------------ - subroutine indecr(io,iyr,ijul,ihr,idelt,ihrmin,ihrmax) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 961014 INDECR -c --- J. Scire, SRC -c -c --- Increment or decrement a date/time by "IDELT" hours -c --- (-24 <= IDELT <= 24) -c --- Allows specification of 0-23 or 1-24 hour clock -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Input Year -c IJUL - integer - Input Julian day -c IHR - integer - Input hour (ihrmin <= IHR <= ihrmax) -c IDELT - integer - Change in time (hours) -- must be -c between -24 to +24, inclusive -c IHRMIN - integer - Minimum hour (i.e., either 0 or 1) -c IHRMAX - integer - Maximum hour (i.e., either 23 or 24) -c -c --- OUTPUT: -c IYR - integer - Year after change of "IDELT" hours -c IJUL - integer - Julian day after change of "IDELT" hours -c IHR - integer - Hour after change of "IDELT" hours -c -c --- INDECR called by: host subroutines -c --- INDECR calls: none -c------------------------------------------------------------------------------ -c - if(iabs(idelt).gt.24)then - write(io,10)'IDELT',iyr,ijul,ihr,idelt,ihrmin,ihrmax -10 format(/1x,'ERROR in subr. INDECR -- invalid "',a,'" -- ', - 1 ' iyr,ijul,ihr,idelt,ihrmin,ihrmax = ',6i10) - write(*,987) -987 format(1x,'ERROR in run - see the .LST file') - stop - endif - if(ihr.lt.ihrmin.or.ihr.gt.ihrmax)then - write(io,10)'IHR',iyr,ijul,ihr,idelt,ihrmin,ihrmax - write(*,987) - stop - endif -c - if(idelt.lt.0)then -c --- idelt is negative - ihr=ihr+idelt - if(ihr.lt.ihrmin)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - else -c --- idelt is positive or zero - ihr=ihr+idelt - if(ihr.gt.ihrmax)then - ihr=ihr-24 - ijul=ijul+1 - if(mod(iyr,4).eq.0)then - ndays=366 - else - ndays=365 - endif - if(ijul.gt.ndays)then - ijul=1 - iyr=iyr+1 - endif - endif - endif -c - return - end -c---------------------------------------------------------------------- - subroutine incrs(io,iyr,ijul,ihr,isec,nsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 061020 INCRS -c D. Strimaitis, EARTH TECH -c -c --- PURPOSE: Increment the time and date by "NSEC" seconds -c -c --- UPDATE -c --- V2.54 (061020) from V2.4 (041029) (DGS) -c - Allow negative increment -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year (YYYY) -c IJUL - integer - Current Julian day (JJJ) -c IHR - integer - Current hour (00-23) -c ISEC - integer - Current second (0000-3599) -c NSEC - integer - Time increment (seconds) -c Parameters: IO6 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c ISEC - integer - Updated seconds (0000-3599) -c -c --- INCRS called by: host subroutines -c --- INCRS calls: INCR -c---------------------------------------------------------------------- - - if(nsec.GE.0) then -c --- Increment seconds - isec=isec+nsec - if(isec.GE.3600) then - nhrinc=isec/3600 - isec=MOD(isec,3600) - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - - else -c --- Decrement seconds - isec=isec+nsec - if(isec.LT.0) then -c --- Earlier hour - ksec=-isec - if(ksec.GE.3600) then -c --- Back up at least 1 hour - nhrinc=ksec/3600 - ksec=MOD(ksec,3600) - nhrinc=-nhrinc - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - isec=-ksec - if(isec.LT.0) then -c --- Back up 1 more hour - nhrinc=-1 - isec=3600+isec - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - endif - - endif - - return - end -c---------------------------------------------------------------------- - subroutine deltsec(ndhrb,nsecb,ndhre,nsece,ndelsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 041029 DELTSEC -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Compute the difference (in seconds) between two dates & -c times (timeE - timeB) -c -c --- INPUTS: -c NDHRB - integer - Beginning year & hour (YYYYJJJHH) -c NSECB - integer - Beginning second (SSSS) -c NDHRE - integer - Ending year & hour (YYYYJJJHH) -c NSECE - integer - Ending second (SSSS) -c -c --- OUTPUT: -c NDELSEC - integer - Length of interval (seconds) -c -c --- DELTSEC called by: host subroutines -c --- DELTSEC calls: DELTT -c---------------------------------------------------------------------- -c -c --- Extract year, Julian day, and hour from date-time variables -c --- Beginning - j1yr=ndhrb/100000 - iyyjjj=ndhrb/100 - j1jul=iyyjjj-j1yr*1000 - j1hr=ndhrb-iyyjjj*100 -c --- Ending - j2yr=ndhre/100000 - iyyjjj=ndhre/100 - j2jul=iyyjjj-j2yr*1000 - j2hr=ndhre-iyyjjj*100 - -c --- Find difference between hours (in seconds) - call DELTT(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jdelhr) - ndelsec=jdelhr*3600 - -c --- Add difference between seconds - ndelsec=ndelsec+(nsece-nsecb) - - return - end -c---------------------------------------------------------------------- - subroutine midnite(io,ctrans,iyr,imo,iday,ijul, - & kyr,kmo,kday,kjul) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 041029 MIDNITE -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Converts date/time at midnight between day N, 0000 -c and day N-1, 2400. Direction is determined by the -c CTRANS instruction. -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c CTRANS - character - Instruction 'TO 24h' or 'TO 00h' -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c IJUL - integer - Julian day -c -c --- OUTPUT: -c KYR - integer - Year -c KMO - integer - Month -c KDAY - integer - Day -c KJUL - integer - Julian day -c -c --- MIDNITE called by: host subroutines -c --- MIDNITE calls: JULDAY, INCR, GRDAY -c---------------------------------------------------------------------- - character*6 ctrans - - ierr =0 - -c --- Get Julian day from month/day if needed - if(ijul.LE.0) call JULDAY(io,iyr,imo,iday,ijul) - - kyr=iyr - kmo=imo - kday=iday - kjul=ijul - - if(ctrans.EQ.'TO 24h') then -c --- Convert from 0000 on ijul to 2400 on kjul - ihr=0 - nhr=-1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - elseif(ctrans.EQ.'TO 00h') then -c --- Convert from 2400 on ijul to 0000 on kjul - ihr=23 - nhr=1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - else - ierr=1 - endif - - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. MIDNITE' - write(io,*)'Invalid instruction: ',ctrans - write(io,*)' Expected: TO 24h' - write(io,*)' OR : TO 00h' - write(*,*) - stop 'Halted in MIDNITE -- see list file.' - endif - - return - end -c---------------------------------------------------------------------- - subroutine utcbasr(axtz,xbtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 070327 UTCBASR -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts character string UTC time zone -c to real base time zone -c -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Add RETURN statement -c -c --- INPUT: -c AXTZ - char*8 - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c --- OUTPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) -c -c --- UTCBASR called by: host subroutines -c --- UTCBASR calls: none -c---------------------------------------------------------------------- - character*8 axtz - - read(axtz(4:6),'(i3)')ihr - read(axtz(7:8),'(i2)')imin - if(ihr.lt.0)imin=-imin - - xbtz=ihr+imin/60. - -c --- Flip sign as base time convention is opposite UTC/GMT - xbtz=-xbtz - - return - end -c---------------------------------------------------------------------- - subroutine basrutc(xbtz,axtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 070327 BASRUTC -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts real base time zone to character string -c UTC time zone -c -c --- UPDATE -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Fix output format of time zone string for zone=0 -c - Add RETURN statement -c -c --- INPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) - -c --- OUTPUT: -c AXTZ - real - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c -c --- BASRUTC called by: host subroutines -c --- BASRUTC calls: none -c---------------------------------------------------------------------- - character*8 axtz - - ixbtz=int(xbtz) -c convert fractional real to minutes - imin=(xbtz-ixbtz)*60 - ixbtz=ixbtz*100+imin - -c --- Define time as "UTC-HHMM" (hours/minutes) - axtz(1:3)="UTC" - -c --- Flip sign as base time zone is minus UTC zone - if (xbtz.gt.0.) then - axtz(4:4)="-" - else - axtz(4:4)="+" - endif -c --- Make sure time zone is written as 4 digits - write(axtz(5:8),'(i4.4)')abs(ixbtz) - - return - end -c---------------------------------------------------------------------- - subroutine filcase(lcfiles,cfile) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 FILCASE -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all characters within a file name to lower -c case (if LCFILES=T) or UPPER CASE (if LCFILES=F). -c -c --- UPDATE -c --- V2.2 (950610) to V2.3 (040330) DGS -c - Replace filename strings c*70 with c*132 -c -c --- INPUTS: -c -c LCFILES - logical - Switch indicating if all characters in the -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c CASE letters (LCFILES=F). -c CFILE - char*132- Input character string -c -c --- OUTPUT: -c -c CFILE - char*132- Output character string with -c letters converted -c -c --- FILCASE called by: READFN -c --- FILCASE calls: none -c---------------------------------------------------------------------- -c - character*132 cfile - character*1 cchar,clc(29),cuc(29) - logical lcfiles -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - if(lcfiles)then -c -c --- Convert file name to lower case letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.cuc(j))then - cfile(i:i)=clc(j) - go to 52 - endif - enddo -52 continue - enddo - else -c -c --- Convert file name to UPPER CASE letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.clc(j))then - cfile(i:i)=cuc(j) - go to 62 - endif - enddo -62 continue - enddo - endif -c - return - end -c---------------------------------------------------------------------- - subroutine readin(cvdic,ivleng,ivtype,ioin,ioout,lecho, - 1 i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15,i16,i17,i18, - 2 i19,i20,i21,i22,i23,i24,i25,i26,i27,i28,i29,i30,i31,i32,i33,i34, - 3 i35,i36,i37,i38,i39,i40,i41,i42,i43,i44,i45,i46,i47,i48,i49,i50, - 4 i51,i52,i53,i54,i55,i56,i57,i58,i59,i60) -c---------------------------------------------------------------------- -c *** Change number of characters in line from 150 to 200 *** -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 110225 READIN -c J. Scire -c -c --- PURPOSE: Read one input group of the free formatted control -c file -- allows comments within the input file -- -c ignores all text except that within delimiters -c -c --- NOTE: All variables (real, integer, logical, -c or character) must be 4 bytes -c --- NOTE: Character*4 array uses only one character -c per word -- it must be dimensioned large -c enough to accommodate the number of characters -c in the variable field -c -c --- UPDATE -c --- V2.58 (110225) from V2.57 (090202) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.57 (090202) from V2.52 (060519) (DGS) -c - Increase max line length from 150 to 200 -c (requires MXCOL=200) -c --- V2.52 (060519) from V2.3 (040330) (DGS) -c - Search for '=' beyond position 14 because blanks are -c not automatically removed within string -c --- V2.3 (040330) from V2.1 (030402) (DGS) -c - Preserve spaces within character variables -c --- V2.1 (030402) from V2.0 (000602) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c -c --- INPUTS: -c -c CVDIC(mxvar) - character*12 array - Variable dictionary -c containing up to "MXVAR" -c variable names -c IVLENG(mxvar) - integer array - Dimension of each variable -c (dim. of scalars = 1) -c IVTYPE(mxvar) - integer array - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c IOIN - integer - Fortran unit of control file -c input -c IOOUT - integer - Fortran unit of list file -c output -c LECHO - logical - Control variable determining -c if input data are echoed to -c list file (IOOUT) -c Parameters: MXVAR, MXCOL -c -c --- OUTPUT: -c -c I1, I2, ... - integer arrays - Variables being read -c (integer array locally, but can be a real, -c integer, logical, or character*4 array in -c the calling routine) -c -c --- READIN called by: host subroutines -c --- READIN calls: DEBLNK, ALTONU, SETVAR, ALLCAP, DEPLUS, -c TRIGHT, TLEFT -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - integer*4 i1(*),i2(*),i3(*),i4(*),i5(*),i6(*),i7(*),i8(*),i9(*), - 1 i10(*),i11(*),i12(*),i13(*),i14(*),i15(*),i16(*),i17(*),i18(*), - 2 i19(*),i20(*),i21(*),i22(*),i23(*),i24(*),i25(*),i26(*),i27(*), - 3 i28(*),i29(*),i30(*),i31(*),i32(*),i33(*),i34(*),i35(*),i36(*), - 4 i37(*),i38(*),i39(*),i40(*),i41(*),i42(*),i43(*),i44(*),i45(*), - 5 i46(*),i47(*),i48(*),i49(*),i50(*),i51(*),i52(*),i53(*),i54(*), - 6 i55(*),i56(*),i57(*),i58(*),i59(*),i60(*) - integer*4 ivleng(mxvar),jdex(mxvar),ivtype(mxvar) -c - logical*4 lv - logical lecho -c - character*12 cvdic(mxvar),cvar,cblank - character*4 cv(mxcol) - character*1 cstor1(mxcol),cstor2(mxcol) -c --- Intermediate scratch arrays - character*1 cstor3(mxcol),cstor4(mxcol) - character*1 cdelim,ceqls,ce,cn,cd,comma,cblnk -c - data cblank/' '/ - data cdelim/'!'/,ceqls/'='/,ce/'E'/,cn/'N'/,cd/'D'/,comma/','/ - data cblnk/' '/ -c - ilim2=99 - do 2 i=1,mxvar - jdex(i)=1 -2 continue -c -c --- begin loop over lines -c -c --- read a line of input -5 continue - read(ioin,10)cstor1 -10 format(200a1) - if(lecho)write(ioout,7)cstor1 -7 format(1x,200a1) -c -c --- check if this is a continuation line - if(ilim2.gt.0)go to 16 -c -c --- continuation line -- find the second delimiter - do 12 i=1,mxcol - if(cstor1(i).eq.cdelim)then - ilim2=i - go to 14 - endif -12 continue -14 continue - il2=ilim2 - if(il2.eq.0)il2=mxcol -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blank characters from string within delimiters -c call deblnk(cstor1,1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- -c --- Remove blank characters on right side - call TRIGHT(cstor1,1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- - icom=0 -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) - go to 55 -c -16 continue - ibs=1 -c -c --- begin loop over delimiter pairs -17 continue - if(ibs.ge.mxcol)go to 5 -c -c --- find location of delimiters - do 20 i=ibs,mxcol - if(cstor1(i).eq.cdelim)then - ilim1=i - if(ilim1.eq.mxcol)go to 22 - ip1=ilim1+1 - do 18 j=ip1,mxcol - if(cstor1(j).eq.cdelim)then - ilim2=j - go to 22 - endif -18 continue -c -c --- second delimiter not on this line - ilim2=0 - go to 22 - endif -20 continue -c -c --- no delimiters found -- skip line and read next line of text - go to 5 -22 continue - ibs=ilim2+1 - if(ilim2.eq.0)ibs=mxcol+1 -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blanks from string within delimiters -c il2=ilim2 -c if(il2.eq.0)il2=mxcol -c call deblnk(cstor1,ilim1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- - il2=ilim2 - if(il2.eq.0)il2=mxcol -c --- Remove blank characters on right side - call TRIGHT(cstor1,ilim1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) -c -c --- search for equals sign (cstor2(1) is delimiter; cstor2(2) is -c --- first letter of variable; cstor2(3) is earliest '=' can occur) -c --- (060519) Search entire string as now there may be blanks before '=' -c do 30 i=3,14 - do 30 i=3,nlim - if(cstor2(i).eq.ceqls)then - ieq=i - go to 32 - endif -30 continue -c -c --- "END" within delimiters signifies the end of the read for -c --- this input group - if(cstor2(2).eq.ce.and.cstor2(3).eq.cn.and.cstor2(4).eq.cd)return - write(ioout,31)(cstor2(n),n=1,nlim) -31 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable too long (Equals sign not found in string) -- ', - 2 'CSTOR2 = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- CVAR is character*12 variable name -32 continue - cvar=cblank - ieqm1=ieq-1 -c --- Grab string to left of '=', and remove blanks - call deblnk(cstor2,1,ieqm1,cstor3,keqm1) -c --- Pass string to variable name - do 40 i=2,keqm1 - il=i-1 - cvar(il:il)=cstor3(i) -40 continue -c -c --- find the variable name in the variable dictionary - do 50 i=1,mxvar - if(cvar.eq.cvdic(i))then - nvar=i - go to 52 - endif -50 continue - write(ioout,51)cvar,(cvdic(n),n=1,mxvar) -51 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable not found in variable dictionary'/ - 2 1x,'Variable: ',a12/ - 3 1x,'Variable Dictionary: ',9(a12,1x)/ - 4 10(22x,9(a12,1x)/)) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -52 continue -c --- Assign current variable type - itype=ivtype(nvar) -c -c --- Check for invalid value of variable type - if(itype.le.0.or.itype.ge.6)then - write(ioout,53)itype,nvar,ivtype(nvar),cvdic(nvar) -53 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Invalid value of variable type -- ITYPE must be 1, 2, 3, ', - 2 '4, or 5'/1x,'ITYPE = ',i10/1x,'NVAR = ',i10/1x, - 3 'IVTYPE(nvar) = ',i10/1x,'CVDIC(nvar) = ',a12) - write(*,*) - stop 'Halted in READIN -- see list file.' - endif -c -c --- search for comma - icom=ieq -c -c --- beginning of loop over values within delimiters -55 continue - ivb=icom+1 -c -c --- if reaches end of line, read next line - if(ivb.gt.nlim)go to 5 - do 60 i=ivb,nlim - if(cstor2(i).eq.comma)then - icom=i - go to 64 - endif -60 continue -c -c --- no comma found - icom=0 - ive=nlim-1 -c -c --- comma between last value and delimiter is allowed - if(cstor2(ivb).eq.cdelim.and.cstor2(ive).eq.comma)go to 17 -c -c --- if no comma & last non-blank character is not a delimiter, -c --- then the input is in error - if(cstor2(nlim).eq.cdelim)go to 66 - write(ioout,63)cstor1 -63 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'If a string within delimiters covers more than one line, ', - 2 'the last character in the line must be a comma'/ - 3 1x,'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -64 continue -c -c --- value of variable is contained in elements IVB to IVE of -c --- CSTOR2 array -c --- Include comma for variable type 5 (character array) so that it -c --- can be used outside of READIN to parse the array values from the -c --- single string that is returned - if(itype.EQ.5) then - ive=icom - else - ive=icom-1 - endif -66 continue -c ncar=ive-ivb+1 - index=jdex(nvar) -c -c --- Convert character string to numeric or logical value -c (if ITYPE = 1,2, or 3) -- If 4 or 5 transfer characters to the -c work array CV) - -c --- Remove all blanks from variable string if type is numeric or -c --- logical; otherwise, trim left and right side of string - if(itype.LT.4) then - call deblnk(cstor2,ivb,ive,cstor4,nv) -c --- Remove '+' characters as well (is this needed?) - if(nv.gt.0) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call deplus(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - else -c --- Pass variable string into cstor4 - nv=ive-ivb+1 - do k=1,nv - cstor4(k)=cstor2(ivb+k-1) - enddo - do k=nv+1,mxcol - cstor4(k)=cblnk - enddo -c --- Remove blank characters on right side of character variable -c --- if last character is either a blank or comma - if(cstor4(nv).EQ.cblnk .OR. - & cstor4(nv).EQ.comma) call TRIGHT(cstor2,ivb,ive,cstor4,nv) -c --- Remove blank characters on left side of character variable - if(nv.GT.0 .AND. cstor4(1).EQ.cblnk) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call TLEFT(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - endif -c -c --- check that array bounds are not exceeded - if(index+irep-1.gt.ivleng(nvar))go to 201 -c - go to (101,102,103,104,105,106,107,108,109,110,111,112,113,114, - 1 115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130, - 2 131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146, - 3 147,148,149,150,151,152,153,154,155,156,157,158,159,160),nvar -c -c --- code currently set up to handle up to 60 variables/source group - write(ioout,71)nvar,(cstor2(n),n=1,nlim) -71 format(/1x,'ERROR IN SUBR. READIN -- Current code ', - 1 'configuration allows up to 60 variables per source group'/ - 2 1x,'No. variables (NVAR) = ',i10/ - 3 1x,'Input data (CSTOR2) = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- transfer value into output variable -101 continue - call setvar(itype,irep,rlno,ino,lv,cv,i1(index),i1(index), - 1 i1(index),i1(index)) - go to 161 -102 continue - call setvar(itype,irep,rlno,ino,lv,cv,i2(index),i2(index), - 1 i2(index),i2(index)) - go to 161 -103 continue - call setvar(itype,irep,rlno,ino,lv,cv,i3(index),i3(index), - 1 i3(index),i3(index)) - go to 161 -104 continue - call setvar(itype,irep,rlno,ino,lv,cv,i4(index),i4(index), - 1 i4(index),i4(index)) - go to 161 -105 continue - call setvar(itype,irep,rlno,ino,lv,cv,i5(index),i5(index), - 1 i5(index),i5(index)) - go to 161 -106 continue - call setvar(itype,irep,rlno,ino,lv,cv,i6(index),i6(index), - 1 i6(index),i6(index)) - go to 161 -107 continue - call setvar(itype,irep,rlno,ino,lv,cv,i7(index),i7(index), - 1 i7(index),i7(index)) - go to 161 -108 continue - call setvar(itype,irep,rlno,ino,lv,cv,i8(index),i8(index), - 1 i8(index),i8(index)) - go to 161 -109 continue - call setvar(itype,irep,rlno,ino,lv,cv,i9(index),i9(index), - 1 i9(index),i9(index)) - go to 161 -110 continue - call setvar(itype,irep,rlno,ino,lv,cv,i10(index),i10(index), - 1 i10(index),i10(index)) - go to 161 -111 continue - call setvar(itype,irep,rlno,ino,lv,cv,i11(index),i11(index), - 1 i11(index),i11(index)) - go to 161 -112 continue - call setvar(itype,irep,rlno,ino,lv,cv,i12(index),i12(index), - 1 i12(index),i12(index)) - go to 161 -113 continue - call setvar(itype,irep,rlno,ino,lv,cv,i13(index),i13(index), - 1 i13(index),i13(index)) - go to 161 -114 continue - call setvar(itype,irep,rlno,ino,lv,cv,i14(index),i14(index), - 1 i14(index),i14(index)) - go to 161 -115 continue - call setvar(itype,irep,rlno,ino,lv,cv,i15(index),i15(index), - 1 i15(index),i15(index)) - go to 161 -116 continue - call setvar(itype,irep,rlno,ino,lv,cv,i16(index),i16(index), - 1 i16(index),i16(index)) - go to 161 -117 continue - call setvar(itype,irep,rlno,ino,lv,cv,i17(index),i17(index), - 1 i17(index),i17(index)) - go to 161 -118 continue - call setvar(itype,irep,rlno,ino,lv,cv,i18(index),i18(index), - 1 i18(index),i18(index)) - go to 161 -119 continue - call setvar(itype,irep,rlno,ino,lv,cv,i19(index),i19(index), - 1 i19(index),i19(index)) - go to 161 -120 continue - call setvar(itype,irep,rlno,ino,lv,cv,i20(index),i20(index), - 1 i20(index),i20(index)) - go to 161 -121 continue - call setvar(itype,irep,rlno,ino,lv,cv,i21(index),i21(index), - 1 i21(index),i21(index)) - go to 161 -122 continue - call setvar(itype,irep,rlno,ino,lv,cv,i22(index),i22(index), - 1 i22(index),i22(index)) - go to 161 -123 continue - call setvar(itype,irep,rlno,ino,lv,cv,i23(index),i23(index), - 1 i23(index),i23(index)) - go to 161 -124 continue - call setvar(itype,irep,rlno,ino,lv,cv,i24(index),i24(index), - 1 i24(index),i24(index)) - go to 161 -125 continue - call setvar(itype,irep,rlno,ino,lv,cv,i25(index),i25(index), - 1 i25(index),i25(index)) - go to 161 -126 continue - call setvar(itype,irep,rlno,ino,lv,cv,i26(index),i26(index), - 1 i26(index),i26(index)) - go to 161 -127 continue - call setvar(itype,irep,rlno,ino,lv,cv,i27(index),i27(index), - 1 i27(index),i27(index)) - go to 161 -128 continue - call setvar(itype,irep,rlno,ino,lv,cv,i28(index),i28(index), - 1 i28(index),i28(index)) - go to 161 -129 continue - call setvar(itype,irep,rlno,ino,lv,cv,i29(index),i29(index), - 1 i29(index),i29(index)) - go to 161 -130 continue - call setvar(itype,irep,rlno,ino,lv,cv,i30(index),i30(index), - 1 i30(index),i30(index)) - go to 161 -131 continue - call setvar(itype,irep,rlno,ino,lv,cv,i31(index),i31(index), - 1 i31(index),i31(index)) - go to 161 -132 continue - call setvar(itype,irep,rlno,ino,lv,cv,i32(index),i32(index), - 1 i32(index),i32(index)) - go to 161 -133 continue - call setvar(itype,irep,rlno,ino,lv,cv,i33(index),i33(index), - 1 i33(index),i33(index)) - go to 161 -134 continue - call setvar(itype,irep,rlno,ino,lv,cv,i34(index),i34(index), - 1 i34(index),i34(index)) - go to 161 -135 continue - call setvar(itype,irep,rlno,ino,lv,cv,i35(index),i35(index), - 1 i35(index),i35(index)) - go to 161 -136 continue - call setvar(itype,irep,rlno,ino,lv,cv,i36(index),i36(index), - 1 i36(index),i36(index)) - go to 161 -137 continue - call setvar(itype,irep,rlno,ino,lv,cv,i37(index),i37(index), - 1 i37(index),i37(index)) - go to 161 -138 continue - call setvar(itype,irep,rlno,ino,lv,cv,i38(index),i38(index), - 1 i38(index),i38(index)) - go to 161 -139 continue - call setvar(itype,irep,rlno,ino,lv,cv,i39(index),i39(index), - 1 i39(index),i39(index)) - go to 161 -140 continue - call setvar(itype,irep,rlno,ino,lv,cv,i40(index),i40(index), - 1 i40(index),i40(index)) - go to 161 -141 continue - call setvar(itype,irep,rlno,ino,lv,cv,i41(index),i41(index), - 1 i41(index),i41(index)) - go to 161 -142 continue - call setvar(itype,irep,rlno,ino,lv,cv,i42(index),i42(index), - 1 i42(index),i42(index)) - go to 161 -143 continue - call setvar(itype,irep,rlno,ino,lv,cv,i43(index),i43(index), - 1 i43(index),i43(index)) - go to 161 -144 continue - call setvar(itype,irep,rlno,ino,lv,cv,i44(index),i44(index), - 1 i44(index),i44(index)) - go to 161 -145 continue - call setvar(itype,irep,rlno,ino,lv,cv,i45(index),i45(index), - 1 i45(index),i45(index)) - go to 161 -146 continue - call setvar(itype,irep,rlno,ino,lv,cv,i46(index),i46(index), - 1 i46(index),i46(index)) - go to 161 -147 continue - call setvar(itype,irep,rlno,ino,lv,cv,i47(index),i47(index), - 1 i47(index),i47(index)) - go to 161 -148 continue - call setvar(itype,irep,rlno,ino,lv,cv,i48(index),i48(index), - 1 i48(index),i48(index)) - go to 161 -149 continue - call setvar(itype,irep,rlno,ino,lv,cv,i49(index),i49(index), - 1 i49(index),i49(index)) - go to 161 -150 continue - call setvar(itype,irep,rlno,ino,lv,cv,i50(index),i50(index), - 1 i50(index),i50(index)) - go to 161 -151 continue - call setvar(itype,irep,rlno,ino,lv,cv,i51(index),i51(index), - 1 i51(index),i51(index)) - go to 161 -152 continue - call setvar(itype,irep,rlno,ino,lv,cv,i52(index),i52(index), - 1 i52(index),i52(index)) - go to 161 -153 continue - call setvar(itype,irep,rlno,ino,lv,cv,i53(index),i53(index), - 1 i53(index),i53(index)) - go to 161 -154 continue - call setvar(itype,irep,rlno,ino,lv,cv,i54(index),i54(index), - 1 i54(index),i54(index)) - go to 161 -155 continue - call setvar(itype,irep,rlno,ino,lv,cv,i55(index),i55(index), - 1 i55(index),i55(index)) - go to 161 -156 continue - call setvar(itype,irep,rlno,ino,lv,cv,i56(index),i56(index), - 1 i56(index),i56(index)) - go to 161 -157 continue - call setvar(itype,irep,rlno,ino,lv,cv,i57(index),i57(index), - 1 i57(index),i57(index)) - go to 161 -158 continue - call setvar(itype,irep,rlno,ino,lv,cv,i58(index),i58(index), - 1 i58(index),i58(index)) - go to 161 -159 continue - call setvar(itype,irep,rlno,ino,lv,cv,i59(index),i59(index), - 1 i59(index),i59(index)) - go to 161 -160 continue - call setvar(itype,irep,rlno,ino,lv,cv,i60(index),i60(index), - 1 i60(index),i60(index)) -c -161 continue - jdex(nvar)=jdex(nvar)+irep -c -c --- continue reading values for this array until array is filled -c --- or delimiter is reached - if(icom.ne.0.and.jdex(nvar).le.ivleng(nvar))go to 55 - go to 17 -201 continue - iatt=index+irep-1 - write(ioout,202)cvdic(nvar),ivleng(nvar),iatt,cstor1 -202 format(/1x,'ERROR IN SUBR. READIN -- Error in input data', - 1 1x,'Array bounds exceeded -- Variable: ',a12,3x,' Declared ', - 2 'dimension = ',i8/1x,'Input attempted to element ',i8/1x, - 3 'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' - end -c---------------------------------------------------------------------- - subroutine altonu(ioout,alp,ncar,itype,irep,rlno,ino,lv,cv) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 110225 ALTONU -c --- J. Scire -c -c --- PURPOSE: Convert a character string into a real, integer or -c logical variable -- also compute the repetition factor -c for the variable -c -c --- UPDATES -c --- V2.58 (110225) from V2.56 (080407) (DGS) -c - Add ITYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.56 (080407) from V1.0 (000602) (DGS) -c - Treat case in which exponential notation is used -c without a decimal point. Pointer had been left at -c 'zero' which placed the decimal location in front of -c a number so that 2e02 became 0.2e02 instead of 2.0e02 -c - Trap case where no number appears in front the E or D -c in exponential notation -c -c --- 000602 (DGS): add message to "stop" -c -c --- INPUTS: -c IOOUT - integer - Fortran unit of list file -c output -c ALP(ncar) - character*1 array - Characters to be converted -c NCAR - integer - Number of characters -c ITYPE - integer - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c -c Parameter: MXCOL -c -c --- OUTPUT: -c IREP - integer - Repetition factor for value -c RLNO - real - Real variable produced from -c character string -c INO - integer - Integer variable produced from -c character string -c LV - logical*4 - Logical variable produced from -c character string -c CV(mxcol) - character*4 - Character*4 variable produced -c from character string -c (NOTE: Only 1 (NOT 4) -c character(s) per word) -c -c --- ALTONU called by: READIN -c --- ALTONU calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real*8 rno,xmult,ten - integer num2(mxcol) - logical*4 lv - character*4 cv(mxcol) - character*1 alp(ncar),alpsv,ad(17),astar,adec -c - data ad/'0','1','2','3','4','5','6','7','8','9','-', -c --- num2 = 0 1 2 3 4 5 6 7 8 9 11 - 1 '*','.','E','D','T','F'/ -c --- num2 = 12 13 14 15 16 17 - data astar/'*'/,adec/'.'/,ten/10.0d0/ -c -c --- If dealing with a character*4 variable, transfer characters -c into the work array CV (ONE character per 4-byte word) - if(itype.eq.4 .OR. itype.eq.5)then - do 5 i=1,ncar - cv(i)(1:1)=alp(i) -5 continue -c -c --- NOTE: Repetition factor refers to the number of -c characters in the field, if ITYPE = 4, 5 - irep=ncar - return - endif -c -c --- Convert character array elements into numeric codes - do 30 i=1,ncar - alpsv=alp(i) - do 20 j=1,17 - if(alpsv.eq.ad(j))then - num2(i)=j - if(j.lt.11)num2(i)=j-1 - go to 30 - endif -20 continue - write(ioout,21)(alp(n),n=1,ncar) -21 format(/1x,'ERROR IN SUBR. ALTONU -- Unrecognizable character ', - 1 'in input -- Character string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -30 continue -c -c --- Locally classify variable type (1=real, 2=integer, 3=logical) - do 40 i=1,ncar - if(num2(i).le.12)go to 40 - if(num2(i).ge.16)then -c -c --- logical variable ("T", "F") - jtype=3 - go to 41 - else -c -c --- real variable (".", "E", "D") - jtype=1 - go to 41 - endif -40 continue -c -c --- integer variable - jtype=2 -41 continue -c -c --- determine if repetition factor "*" is used - do 50 i=1,ncar - if(alp(i).eq.astar)then - istar=i - go to 51 - endif -50 continue - istar=0 -51 continue - if(istar.ne.0)go to 400 - irep=1 - go to (101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) -55 format(/1x,'ERROR IN SUBR. ALTONU -- JTYPE must be 1, 2, or 3 ', - 1 '-- JTYPE = ',i3/3x,'Text string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- REAL number w/o "*" -c -------------------------------------------------------------------- -c --- Determine sign -- ISTAR is position of array containing "*" -c (ISTAR = 0 if no repetition factor) -101 continue - if(num2(1+istar).eq.11)then - isgn=-1 - istart=istar+2 - else - isgn=1 - istart=istar+1 - endif -c -c --- Locate decimal point - idec=0 - do 109 i=istart,ncar - if(alp(i).eq.adec)then - if(idec.eq.0)then - idec=i - go to 109 - endif -c -c --- More than one decimal point found - write(ioout,120)(alp(n),n=1,ncar) -120 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid real variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif -109 continue -c -c --- Search for E or D - do 110 i=istart,ncar - if(num2(i).eq.14.or.num2(i).eq.15)then - istop=i-1 - go to 111 - endif -110 continue - istop=ncar -111 continue - -c --- 080407 Update: -c --- Correct for missing decimal point before decoding - if(idec.EQ.0) idec=istop+1 -c --- Trap missing number in front of E,D - if(istop.LT.1 .OR. istart.GT.istop) then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - write(*,*)'Missing number!' - stop 'Halted in ALTONU -- see list file.' - endif -c -c --- Convert integer numerics to real number - rno=0.0 - do 130 i=istart,istop - if(i.eq.idec)go to 130 - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=idec-i - if(iexp.gt.0)iexp=iexp-1 - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rno=rno+xmult*num2(i) - -130 continue -c -c --- Account for minus sign (if present) - rno=isgn*rno - rlno=rno -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - if(istop.eq.ncar)return -c -c --- Find exponent (istop+1 is position in array containing E or D) - isgn=1 - istart=istop+2 - if(num2(istart).ne.11)go to 135 - isgn=-1 - istart=istart+1 -135 continue - if(istart.gt.ncar)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - rexp=0.0 - do 140 i=istart,ncar - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=ncar-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rexp=rexp+xmult*num2(i) -140 continue - xmult=1.0 - if(rexp.ne.0.0)xmult=ten**(isgn*rexp) - rno=rno*xmult - rlno=rno -c -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - return -c -c -------------------------------------------------------------------- -c --- INTEGER variables -c -------------------------------------------------------------------- -201 continue - if(num2(1+istar).ne.11)go to 228 - isgn=-1 - istart=istar+2 - go to 229 -228 continue - isgn=1 - istart=istar+1 -229 continue - ino=0 - do 230 i=istart,ncar - if(num2(i).ge.10)go to 208 - iexp=ncar-i - xmult=1.0 - if(iexp.ne.10)xmult=ten**iexp - ino=ino+xmult*num2(i)+0.5 -230 continue - ino=isgn*ino -c -c --- Also set real variable in case of improper input - rlno=ino - return -208 continue - write(ioout,220)(alp(n),n=1,ncar) -220 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid integer variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- LOGICAL variables -c -------------------------------------------------------------------- -301 continue - if(ncar-istar.ne.1)go to 308 - if(num2(istar+1).eq.16)then -c -c --- Variable = T - lv=.true. - return - else if(num2(istar+1).eq.17)then -c -c --- Variable = F - lv=.false. - return - endif -308 continue - write(ioout,320)(alp(n),n=1,ncar) -320 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid logical variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c --- Determine repetition factor -400 continue - irep=0 -c -c --- ISTAR is the position of array containing "*" - istrm1=istar-1 - do 430 i=1,istrm1 - if(num2(i).ge.10)go to 408 - iexp=istrm1-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - irep=irep+xmult*num2(i)+0.5 -430 continue - go to(101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -408 continue - write(ioout,420)(alp(n),n=1,ncar) -420 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid repetition factor ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - end -c---------------------------------------------------------------------- - subroutine deblnk(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 DEBLNK -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank or "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (980918) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without blanks within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEBLNK called by: (utility) -c --- DEBLNK calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cblnk)go to 10 -c -c --- transfer non-blank character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine deplus(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 DEPLUS -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for plus begins -c IL2 - integer - Array element at which search -c for plus ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without plus within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEPLUS called by: (utility) -c --- DEPLUS calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk,cplus - data cblnk/' '/,cplus/'+'/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cplus)go to 10 -c -c --- transfer non-plus character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine tright(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 TRIGHT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the RIGHT of the last non-blank character -c in the string before il2. Also remove the character -c at il2 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=3, il2=21 -c CSTOR1 : 2 for this run ! -c Position : 000000000111111111122 -c 123456789012345678901 -c CSTOR2 : for this run! -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with right-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TRIGHT called by: (utility) -c --- TRIGHT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of last non-blank character - klast=0 - il2m1=il2-1 - do k=ilim1,il2m1 - if(cstor1(k).NE.cblnk) klast=k - enddo - -c --- Transfer all characters in range up to klast - ind=0 - if(klast.GT.0) then - do k=ilim1,klast - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif -c --- Add last character in range if non-blank - if(cstor1(il2).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(il2) - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine tleft(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 TLEFT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the LEFT of the first non-blank character -c in the string after ilim1. Also remove the character -c at ilim1 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=2, il2=19 -c CSTOR1 : 2 for this run ! -c Position : 123456789111111111122 -c 012345678901 -c CSTOR2 : 2for this run -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with left-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TLEFT called by: (utility) -c --- TLEFT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of first non-blank character - kfrst=0 - ilim1p1=ilim1+1 - do k=il2,ilim1p1,-1 - if(cstor1(k).NE.cblnk) kfrst=k - enddo - - ind=0 -c --- Pass first character in range if non-blank - if(cstor1(ilim1).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(ilim1) - endif - -c --- Transfer all characters in range from kfrst - if(kfrst.GT.0) then - do k=kfrst,il2 - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine setvar(itype,irep,xx,jj,ll,cv,xarr,jarr,larr,carr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 110225 SETVAR -c --- J. Scire -c -c --- PURPOSE: Fill the output variable or array with the value read -c from the input file -c -c --- UPDATE -c --- V2.58 (110225) from V1.0 (950122) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c -c --- INPUTS: -c -c ITYPE - integer - Variable type (1=real, 2=integer, -c 3=logical, 4=character*4, -c 5=character*4 includes commas) -c IREP - integer - Repetition factor -c If ITYPE = 4, IREP refers to the -c number of characters in the field) -c XX - real - Real value read from input -c file (Used only if ITYPE=1) -c JJ - integer - Integer value read from input -c file (Used only if ITYPE=2) -c LL - logical*4 - Logical value read from input -c file (Used only if ITYPE=3) -c CV(mxcol) - character*4 - Character*4 values read from input -c file (Used only if ITYPE=4) -c -c PARAMETER: MXCOL -c -c --- OUTPUT: -c -c XARR(*) - real array - Output real array (or scalar if -c IREP=1) -- Used only if ITYPE=1 -c JARR(*) - integer array - Output integer array (or scalar if -c IREP=1) -- Used only if ITYPE=2 -c LARR(*) - logical array - Output logical array (or scalar if -c IREP=1) -- Used only if ITYPE=3 -c CARR(*) - character*4 - Output character*4 array (or -c scalar if IREP=1) -- Used only if -c ITYPE=4 -c -c --- SETVAR called by: READIN -c --- SETVAR calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real xarr(*) - integer jarr(*) - logical*4 larr(*),ll - character*4 carr(*),cv(mxcol) -c - go to(10,20,30,40,50),itype -c -c --- real variable -10 continue - do 15 i=1,irep - xarr(i)=xx -15 continue - return -c -c --- integer variable -20 continue - do 25 i=1,irep - jarr(i)=jj -25 continue - return -c -c --- logical variable -30 continue - do 35 i=1,irep - larr(i)=ll -35 continue - return -c -c --- character*4 variable string -40 continue - do 45 i=1,irep - carr(i)=cv(i) -45 continue - return -c -c --- character*4 variable string -50 continue - do 55 i=1,irep - carr(i)=cv(i) -55 continue - return - - end -c---------------------------------------------------------------------- - subroutine allcap(cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 950122 ALLCAP -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all lower case letters within a character -c string to upper case -c -c --- INPUTS: -c -c CSTOR2(mxcol) - character*1 array - Input character string -c NLIM - integer - Length of string (characters) -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string with -c lower case letters converted -c to upper case -c -c --- ALLCAP called by: READIN -c --- ALLCAP calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor2(mxcol),cchar,clc(29),cuc(29) -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - do 100 i=1,nlim - cchar=cstor2(i) -c - do 50 j=1,29 - if(cchar.eq.clc(j))then - cstor2(i)=cuc(j) - go to 52 - endif -50 continue -52 continue -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine datetm(rdate,rtime,rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 140318 DATETM -c --- J. Scire -c -c --- PURPOSE: Get system date and time from system clock, and -c elapsed CPU time -c --- UPDATES -c --- V2.57-V2.6.0 140318(MBN):Remove obsolete Lahey F77L code, -c and etime calls. -c --- V1.0-V2.57 090202 (DGS): Activate CPU time (F95 call) -c -c --- INPUTS: none -c -c --- OUTPUT: rdate - C*10 - Current system date (MM-DD-YYYY) -c rtime - C*8 - Current system time (HH:MM:SS) -c rcpu - real - CPU time (sec) from system utility -c -c --- DATETM called by: SETUP, FIN -c --- DATETM calls: DATE_AND_TIME (F95) -c CPU_TIME (F95) -c YR4C -c---------------------------------------------------------------------- - character*8 rtime - character*10 rdate - -c --- Local store - character*11 stime - character*8 sdate - -c --- Set initial base CPU time to -1. - data rcpu0/-1./ - SAVE rcpu0 - -c --- System date in CCYYMMDD -c --- System clock in HHMMSS.sss, where sss = thousandths of seconds - call DATE_AND_TIME(sdate,stime) -c --- Pass to output formats (MM-DD-YYYY) and (HH:MM:SS) - rdate=' - - ' - rdate(1:2)=sdate(5:6) - rdate(4:5)=sdate(7:8) - rdate(7:10)=sdate(1:4) - rtime=' : : ' - rtime(1:2)=stime(1:2) - rtime(4:5)=stime(3:4) - rtime(7:8)=stime(5:6) -c --- Get CPU time from F95 intrinsic procedure - call CPU_TIME(rcpu1) - -c --- Construct 4-digit year from current 2-digit year (if found) - read(rdate(7:10),'(i4)') iyr - call YR4C(iyr) - write(rdate(7:10),'(i4)') iyr - -c --- Update base CPU time on first call - if(rcpu0.LT.0.0) rcpu0=rcpu1 - -c --- Return CPU time difference from base - rcpu=rcpu1-rcpu0 - -cc --- DEBUG -c write(*,*)'DATETM: stime,rcpu0,rcpu1,rcpu = ', -c & stime,rcpu0,rcpu1,rcpu - - return - end -c---------------------------------------------------------------------- - subroutine fmt_date(io,fmt1,fmt2,sdate) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 090511 FMT_DATE -c D. Strimaitis -c -c --- PURPOSE: Change the format of a date string -c -c --- INPUTS: -c io - integer - Listfile output unit number -c fmt1 - character*12 - Input date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c sdate - character*12 - Date string to convert -c fmt2 - character*12 - Output date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c -c --- OUTPUT: -c sdate - character*12 - Converted date string -c -c --- FMT_DATE called by: (any) -c --- FMT_DATE calls: ALLCAP -c---------------------------------------------------------------------- - character*12 fmt1,fmt2,sdate - character*3 month3(12),month3uc(12),amon3 - character*1 amon(3) - integer io - -c --- Set abbreviation names for months - data month3/'Jan','Feb','Mar','Apr','May','Jun', - & 'Jul','Aug','Sep','Oct','Nov','Dec'/ - data month3uc/'JAN','FEB','MAR','APR','MAY','JUN', - & 'JUL','AUG','SEP','OCT','NOV','DEC'/ - -c --- Extract input month, day and year - if(fmt1(1:10).EQ.'MM-DD-YYYY') then - read(sdate(1:2),'(i2)') imon - read(sdate(4:5),'(i2)') iday - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'DD-MM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:5),'(i2)') imon - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'YYYY-MM-DD') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') imon - read(sdate(9:10),'(i4)') iday - elseif(fmt1(1:10).EQ.'YYYY-DD-MM') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') iday - read(sdate(9:10),'(i4)') imon - elseif(fmt1(1:11).EQ.'DD-MMM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:6),'(3a1)') amon - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - elseif(fmt1(1:11).EQ.'MMM-DD-YYYY') then - read(sdate(1:3),'(3a1)') amon - read(sdate(5:6),'(i2)') iday - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - else - write(io,*)'FMT_DATE: Invalid input format = ',fmt1 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Check for valid month index - if(imon.LT.1 .OR. imon.GT.12) then - write(io,*)'FMT_DATE: Invalid month in date = ',sdate - write(io,*)' for input format = ',fmt1 - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Create output date string - if(fmt2(1:10).EQ.'MM-DD-YYYY') then - sdate='MM-DD-YYYY ' - write(sdate(1:2),'(i2.2)') imon - write(sdate(4:5),'(i2.2)') iday - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'DD-MM-YYYY') then - sdate='DD-MM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - write(sdate(4:5),'(i2.2)') imon - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'YYYY-MM-DD') then - sdate='YYYY-MM-DD ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') imon - write(sdate(9:10),'(i2.2)') iday - elseif(fmt2(1:10).EQ.'YYYY-DD-MM') then - sdate='YYYY-DD-MM ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') iday - write(sdate(9:10),'(i2.2)') imon - elseif(fmt2(1:11).EQ.'DD-MMM-YYYY') then - sdate='DD-MMM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - sdate(4:6)=month3(imon) - write(sdate(8:11),'(i4.4)') iyear - elseif(fmt2(1:11).EQ.'MMM-DD-YYYY') then - sdate='MMM-DD-YYYY ' - sdate(1:3)=month3(imon) - write(sdate(5:6),'(i2.2)') iday - write(sdate(8:11),'(i4.4)') iyear - else - write(io,*)'FMT_DATE: Invalid output format = ',fmt2 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - - return - end -c---------------------------------------------------------------------- - subroutine etime(rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 941215 ETIME -c --- J. Scire, SRC -c -c --- PURPOSE: Dummy system CPU time routine for PC -c DO NOT USE THIS ROUTINE ON SUNs -c -c --- INPUTS: none -c -c --- OUTPUT: RCPU - real - CPU time (sec) -- set to zero for PC -c -c --- ETIME called by: DATETM -c --- ETIME calls: none -c---------------------------------------------------------------------- - rcpu=0.0 -c - return - end -c---------------------------------------------------------------------- - subroutine undrflw(lflag) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 UNDRFLW -c D. Strimaitis, Earth Tech Inc. -c -c --- PURPOSE: This routine takes advantage of the Lahey F77L routine -c UNDER0 to set underflows to zero. When other compilers -c are used, there may be a similar routine. If none -c exists, place a dummy statement here and use compiler -c switches to configure the NDP response to an underflow. -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c---------------------------------------------------------------------- - logical lflag - -cc --- Lahey F77L Compiler (begin) -cc ------------------------------- -cc --- Lahey F77 compiler -- set underflows ( < 10**-38 ) to zero -c call UNDER0(lflag) -cc --- Lahey F77L Compiler (end) - -c --- Dummy (no action on underflows) -c ----------------------------------- - lflag=.TRUE. -c --- Dummy (end) - - return - end -c---------------------------------------------------------------------- - subroutine comline(ctext) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 COMLINE -c J. Scire, SRC -c -c --- PURPOSE: Call the compiler-specific system routine that will -c pass back the command line argument after the text -c that executed the program -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c --- UPDATE -c --- V2.3 (040330) to V2.6.0 (040330) MBN -c - Removed obsolete Compaq, Microsoft, and HP compiler codes -c - Removed getcl (Lahey-only function not needed) -c --- V2.2 (960521) to V2.3 (040330) DGS -c - Replace strings c*70 with c*132 -c -c --- INPUTS: -c -c CTEXT - character*132 - Default command line argument #1 -c -c --- OUTPUT: -c -c CTEXT - character*132 - Command line argument #1 -c If command line argument is -c missing, CTEXT is not changed -c -c --- COMLINE called by: SETUP -c --- COMLINE calls: IARGC, GETARG - compiler routines -c -c---------------------------------------------------------------------- -c - character*132 ctext,cdeflt -c -c --- The following is for any system without a command line routine -c --- and is also used as a default - cdeflt=ctext -c -c ---------------- -c --- Intel ifort, Lahey lf95, and GNU gfortran compilers: -c ---------------- - numargs=IARGC() - if(numargs.ge.1)then - call GETARG(1,ctext) - endif -c -c --- If no command line arguments, use default - if(ctext(1:1).eq.' ')ctext=cdeflt - - return - end - -c---------------------------------------------------------------------- - subroutine open_err(iolst,cfrom,cftype,cfname,iunit) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 141010 OPEN_ERR -c D. Strimaitis, Exponent Inc. -c -c --- PURPOSE: Report error in opening a file -c -c --- INPUTS: -c IOLST - integer - Unit number of output list file -c (<0 if not available) -c CFROM - char* - Called-From string to report error -c CFTYPE - char* - File-type string -c CFNAME - char* - File-name string -c IUNIT - integer - File unit number -c -c --- OUTPUT: -c -c --- OPEN_ERR called by: () -c --- OPEN_ERR calls: -c---------------------------------------------------------------------- - implicit none - -c --- Declare arguments - character(len=*) :: cfrom,cftype,cfname - integer :: iolst, iunit - - if(iolst.GT.0) then - write(iolst,*) - write(iolst,*)'ERROR opening '//TRIM(cftype) - write(iolst,*)' File Name: '//TRIM(cfname) - write(iolst,*)' File Unit: ',iunit - write(iolst,*)'Problem reported from '//TRIM(cfrom) - write(iolst,*) - write(iolst,*)'The file may not exist in this location' - write(iolst,*)'Check the spelling of the name and the location' - write(*,*) - stop 'ERROR: File not found -- see list file' - else - write(*,*) - write(*,*)'ERROR opening '//TRIM(cftype) - write(*,*)' File Name: '//TRIM(cfname) - write(*,*)' File Unit: ',iunit - write(*,*)'Problem reported from '//TRIM(cfrom) - write(*,*) - write(*,*)'The file may not exist in this location' - write(*,*)'Check the spelling of the name, and the location' - stop - endif - - end - diff --git a/CALPUFF_SRC/CALPUFF/chemdat.puf b/CALPUFF_SRC/CALPUFF/chemdat.puf deleted file mode 100644 index fa1d913..0000000 --- a/CALPUFF_SRC/CALPUFF/chemdat.puf +++ /dev/null @@ -1,214 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /CHEMDAT/ -- Chemistry data CALPUFF -c -c---------------------------------------------------------------------- -c - character*16 cidoz - character*4 utmhemoz,xyunitoz - character*8 datumoz,pmapoz - character*12 datenoz -c - character*16 cidhp - character*4 utmhemhp,xyunithp - character*8 datumhp,pmaphp - character*12 datenhp - - - common/CHEMDAT/MOZ,BCKO3,BCKO3M(12),MNH3,MAVGNH3,BCKNH3, - 1 BCKNH3M(12),BCKNH3Z(mxnz),BCKNH3ZM(12,mxnz),RNITE1,RNITE2, - 2 RNITE3,RSHET,MH2O2,BCKH2O2,BCKH2O2M(12),BCKPMF(12), - 3 OFRAC(12),VCNX(12),CHEMT(24,3),NDECAY,DKYIELD(mxspec,mxspec), - 4 DKRATE(mxspec),NOZSTA,IBDATHRO,IBSECO,IEDATHRO,IESECO,T2BTZOZ, - 5 IUTMOZ,XOZM(mxoz),YOZM(mxoz),OZCONC(mxoz), - 6 NEAROZ(mxnx,mxny,mxmetdom),FEASTOZ,FNORTHOZ,RNLAT0OZ,RELON0OZ, - 7 RNLAT1OZ,RNLAT2OZ,NH2O2STA,IBDATHRH,IBSECH,IEDATHRH,IESECH, - 8 T2BTZHP,IUTMHP,XH2O2M(mxaq),YH2O2M(mxaq),H2O2CONC(mxaq), - 9 NEARH2O2(mxnx,mxny,mxmetdom), - & FEASTHP,FNORTHHP,RNLAT0HP,RELON0HP,RNLAT1HP,RNLAT2HP, - 1 CIDOZ(mxoz),pmapoz,utmhemoz,datumoz,datenoz,xyunitoz, - 2 CIDHP(mxaq),pmaphp,utmhemhp,datumhp,datenhp,xyunithp - 3 ,RH_ISRP,SO4_ISRP -c -c --- COMMON BLOCK /CHEMDAT/ Variables: -c -c MOZ - integer - Ozone data input flag -c 0 = use a monthly background O3 value -c 1 = read hourly O3 data -c BCKO3 - real - Current background ozone conc (ppb) -c BCKO3M(12) - real - Monthly background ozone concs (ppb) -c MNH3 - integer - Ammonia data input flag -c 0 = use 1 monthly background NH3 for -c all layers -c 1 = read monthly background NH3 for -c each layer from the NH3Z.DAT file -c MAVGNH3 - integer - Ammonia vertical averaging option -c 0 = use NH3 at puff center height -c (no averaging is done) -c 1 = average NH3 values over vertical -c extent of puff -c BCKNH3 - real - Current background ammonia conc (ppb) -c BCKNH3M(12) - real - Monthly background ammonia concs (ppb) -c BCKNH3Z(NZ) - real - Current background ammonia profile (ppb) -c BCKNH3ZM(12,NZ) - real - Monthly background ammonia profile (ppb) -c RNITE1 - real - Nighttime SO2 loss rate (percent/hr) -c RNITE2 - real - Nighttime NOx loss rate (percent/hr) -c RNITE3 - real - Nighttime HNO3 formation rate (percent/hr) -c RSHET - real - Heterogeneous SO2 loss rate (fraction/hr) -c MH2O2 - integer - H2O2 data input flag -c 0 = use constant background H2O2 value -c 1 = read hourly H2O2 data -c BCKH2O2 - real - Current background H2O2 conc (ppb) -c BCKH2O2M(12) - real - Monthly background H2O2 concs (ppb) -c CHEMT(24,3) - real - User-specified chemical transformation -c rates (percent/hr) -c (-,1) -- (k1) SO2 --> SO4 -c (-,2) -- (k2) NOx --> All products -c (-,3) -- (k3) NOx --> HNO3 -c -c --- ISORROPIA (MCHEM=6,7) input constraints -c RH_ISRP - real - Minimum relative humidity in % -c SO4_ISRP - real - Minimum SO4 concentration in g/m^3 -c -c --- SOA (MCHEM=4) monthly background data -c BCKPMF(12) - real - Fine particulate concentration in ug/m^3 -c OFRAC(12) - real - Organic fraction of fine particulates -c VCNX(12) - real - VOC / NOX ratio (after reaction) -c -c --- Decay option (MCHEM=5) data -c NDECAY - integer - Number of species provided decay rates -c DKRATE(mxspec) - real - User-specified mass decay rate expressed -c as a reciprocal Half-Life (1/sec) [1/Tau_half] -c DKYIELD(mxspec,mxspec) - real - User-specified Yield Factors for -c each child species that gains mass as a -c parent species decays; the array order is -c (child_ID,parent_ID) -c All yield factors are positive or 0.0 -c -c --- Data from OZONE.DAT data file -c ---------------------------------- -c NOZSTA - integer - Number of ozone stations in the OZONE.DAT -c file -c IBDATHRO - integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSECO - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHRO - integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESECO - integer - Seconds of the last data record in the -c file (0000-3599) -c CIDOZ(mxoz) - C*16 - Station identifier -c XOZM(mxoz) - real - X coordinate (m) of the ozone station -c relative to the origin of the met. grid -c YOZM(mxoz) - real - Y coordinate (m) of the ozone station -c relative to the origin of the met. grid -c OZCONC(mxoz) - real - Ozone concentration (ppb) at each station -c -c --- Computed from data in OZONE.DAT --- -c -c NEAROZ(mxnx,mxny,mxmetdom) -c - integer - Station number of closest ozone station -c to each point in each MET grid domain -c each grid point -c -c --- MAP Projection Variables --- -c -c PMAPOZ - char - Character code for input map projection -c LL : Latitude/longitude -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMOZ - char - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMOZ - char - Datum-Region for grid coordinates -c DATENOZ - char - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITOZ - char - Units for coordinates (e.g., KM) -c IUTMOZ - integer - UTM zone for UTM projection -c UTMHEMOZ - char - Base hemisphere for UTM projection -c (S=southern, N=northern) -c FEASTOZ - real - False Easting (km) at projection origin -c FNORTHOZ - real - False Northing (km) at projection origin -c RNLAT0OZ, - real - N. latitude & E. longitude of x=0 and y=0 -c RELON0OZ (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1OZ, - real - Matching N. latitude(s) for projection -c RNLAT2OZ (deg) (Used only if PMAP3= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c -c --- Data from H2O2.DAT data file -c ---------------------------------- -c NH2O2STA - integer - Number of H2O2 stations in the H2O2.DAT -c file -c IUTMHP - integer - UTM zone in which the H2O2 station -c coordinates are specified -c IBDATHRH - integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSECH - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHRH - integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESECH - integer - Seconds of the last data record in the -c file (0000-3599) -c CIDHP(mxaq) - C*16 - Station identifier -c XH2O2M(mxaq) - real - X coordinate (m) of the H2O2 station -c relative to the origin of the met. grid -c YH2O2M(mxaq) - real - Y coordinate (m) of the H2O2 station -c relative to the origin of the met. grid -c H2O2CONC(mxaq) - real - H2O2 concentration (ppb) at each station -c -c --- Computed from data in H2O2.DAT --- -c -c NEARH2O2(mxnx,mxny,mxmetdom) -c - integer - Station number of closest H2O2 station -c to each point in each MET grid domain -c -c --- MAP Projection Variables --- -c -c PMAPHP - char - Character code for input map projection -c LL : Latitude/longitude -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMHP - char - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMHP - char - Datum-Region for grid coordinates -c DATENHP - char - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITHP - char - Units for coordinates (e.g., KM) -c IUTMHP - integer - UTM zone for UTM projection -c UTMHEMHP - char - Base hemisphere for UTM projection -c (S=southern, N=northern) -c FEASTHP - real - False Easting (km) at projection origin -c FNORTHHP - real - False Northing (km) at projection origin -c RNLAT0HP, - real - N. latitude & E. longitude of x=0 and y=0 -c RELON0HP (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1HP, - real - Matching N. latitude(s) for projection -c RNLAT2HP (deg) (Used only if PMAP3= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 diff --git a/CALPUFF_SRC/CALPUFF/chiflx.puf b/CALPUFF_SRC/CALPUFF/chiflx.puf deleted file mode 100644 index 0ca8c2b..0000000 --- a/CALPUFF_SRC/CALPUFF/chiflx.puf +++ /dev/null @@ -1,88 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /CHIFLX/ -- Concentration & flux arrays CALPUFF -c---------------------------------------------------------------------- -c - common/CHIFLX/chisam(mxnxg,mxnyg,mxspec),chirec(mxrec,mxspec), - 1 chict(mxrect,mxspec), - 2 dfsam(mxnxg,mxnyg,mxspec),dfrec(mxrec,mxspec), - 3 wfsam(mxnxg,mxnyg,mxspec),wfrec(mxrec,mxspec), - 4 tchisam(mxnxg,mxnyg,mxspec),tchirec(mxrec,mxspec), - 5 tchict(mxrect,mxspec), - 6 tdfsam(mxnxg,mxnyg,mxspec),tdfrec(mxrec,mxspec), - 7 twfsam(mxnxg,mxnyg,mxspec),twfrec(mxrec,mxspec), - 8 cbcsam(mxnxg,mxnyg,mxspec),cbcrec(mxrec,mxspec), - 9 cbcct(mxrect,mxspec), - & dbcsam(mxnxg,mxnyg,mxspec),dbcrec(mxrec,mxspec), - 1 wbcsam(mxnxg,mxnyg,mxspec),wbcrec(mxrec,mxspec), - 2 rbcsam(mxnxg,mxnyg),rbcrec(mxrec),rbcct(mxrect) -c -c --- COMMON BLOCK /CHIFLX/ Variables: -c -c CHISAM(mxnxg,mxnyg,mxspec) - real - Concentrations (g/m**3) at -c gridded receptors -c CHIREC(mxrec,mxspec) - real - Concentrations (g/m**3) at -c non-gridded receptors -c CHICT(mxrect,mxspec) - real - Concentrations (g/m**3) at -c complex terrain (CTSG) -c receptors -c -c DFSAM(mxnxg,mxnyg,mxspec) - real - Dry fluxes (g/m**2/s) at -c gridded receptors -c DFREC(mxrec,mxspec) - real - Dry fluxes (g/m**2/s) at -c non-gridded receptors -c -c WFSAM(mxnxg,mxnyg,mxspec) - real - Wet fluxes (g/m**2/s) at -c gridded receptors -c WFREC(mxrec,mxspec) - real - Wet fluxes (g/m**2/s) at -c non-gridded receptors -c -c --- Additional arrays to hold total contribution from all sources -c -c TCHISAM(mxnxg,mxnyg,mxspec) - real - Concentrations (g/m**3) at -c gridded receptors -c TCHIREC(mxrec,mxspec) - real - Concentrations (g/m**3) at -c non-gridded receptors -c TCHICT(mxrect,mxspec) - real - Concentrations (g/m**3) at -c complex terrain (CTSG) -c receptors -c -c TDFSAM(mxnxg,mxnyg,mxspec) - real - Dry fluxes (g/m**2/s) at -c gridded receptors -c TDFREC(mxrec,mxspec) - real - Dry fluxes (g/m**2/s) at -c non-gridded receptors -c -c TWFSAM(mxnxg,mxnyg,mxspec) - real - Wet fluxes (g/m**2/s) at -c gridded receptors -c TWFREC(mxrec,mxspec) - real - Wet fluxes (g/m**2/s) at -c non-gridded receptors -c -c --- Additional arrays to hold contribution from BC puff -c -c CBCSAM(mxnxg,mxnyg,mxspec) - real - Concentrations (g/m**3) at -c gridded receptors -c CBCREC(mxrec,mxspec) - real - Concentrations (g/m**3) at -c non-gridded receptors -c CBCCT(mxrect,mxspec) - real - Concentrations (g/m**3) at -c complex terrain (CTSG) -c receptors -c -c DBCSAM(mxnxg,mxnyg,mxspec) - real - Dry fluxes (g/m**2/s) at -c gridded receptors -c DBCREC(mxrec,mxspec) - real - Dry fluxes (g/m**2/s) at -c non-gridded receptors -c -c WBCSAM(mxnxg,mxnyg,mxspec) - real - Wet fluxes (g/m**2/s) at -c gridded receptors -c WBCREC(mxrec,mxspec) - real - Wet fluxes (g/m**2/s) at -c non-gridded receptors -c RBCSAM(mxnxg,mxnyg) - real - Nearest approach distance of -c a BC puff to each gridded -c receptor (grid cell units) -c RBCREC(mxrec) - real - Nearest approach distance of -c a BC puff to each discrete -c receptor (grid cell units) -c RBCCT(mxrect) - real - Nearest approach distance of -c a BC puff to each complex -c terrain (CTSG) receptor -c (grid cell units) -c diff --git a/CALPUFF_SRC/CALPUFF/coastln.puf b/CALPUFF_SRC/CALPUFF/coastln.puf deleted file mode 100644 index 4aa9cf0..0000000 --- a/CALPUFF_SRC/CALPUFF/coastln.puf +++ /dev/null @@ -1,49 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /COASTLN/ -- User-Supplied Coast Line Data CALPUFF -c---------------------------------------------------------------------- -c - logical*1 lcoast - integer*1 lwmdom - integer ncoast,npcoast,lwcell - real coastgrd,ymxpb - - common/COASTLN/ncoast,npcoast(2,mxcoast),coastgrd(2,mxptcst), - & ymxpb(2,mxptcst),lwcell(2,mxptcst), - & lwmdom(2,mxptcst),lcoast(mxnx,mxny,mxmetdom) -c -c --- COMMON BLOCK /COASTLN/ Variables: -c -c NCOAST - integer - Number of coasts defined -c NPCOAST(2,mxcoast) - integer - Pointer to locations in COASTGRD -c array containing data for each coast -c where element 1 is the start and -c element 2 is the end -c COASTGRD(2,mxptcst) - real - x,y coordinates (MET GRID UNITS) of -c points along each coast line, where -c element 1 is x, element 2 is y -c YMXPB(2,mxptcst) - real - slope 'm' and intercept 'b' for line -c defined by each coastline segment -c element 1 is 'm', element 2 is 'b' -c LWCELL(2,mxptcst) - integer - Cell index for nearest land cell and -c and water cell to each point in -c coast line, where element 1 is LAND, -c and element 2 is WATER -c LWMDOM(2,mxptcst) - integer - MET grid domain for the cells -c referenced in LWCELL, where element -c 1 is LAND, and element 2 is WATER -c LCOAST(mxnx,mxny,mxmetdom) -c - logical - Logical marker indicating if a MET -c GRID cell contains a coastline -c---------------------------------------------------------------------- -c NOTE:1.More than 1 coast can be defined, but all are appended in the -c COASTGRD array. The NPCOAST provides the index for the start -c and the end of each coast line. Also, the ordering of the -c points follows the convention that the water is to the RIGHT -c of the line traced out by these points. -c 2.Cell index pointer LWCELL assumes that the nx*ny possible -c locations correspond to 1D list in which ny rows of nx values -c each are appended, where the first nx values are for iy=1. -c The nx*ny depend on the met grid as indicated by the -c corresponding entry in LWMDOM (e.g., if LWMDOM(1,423)=3 and -c LWCELL(1,423)= 1309 the 1309 is computed for the grid that is -c nxm(3) by nym(3). \ No newline at end of file diff --git a/CALPUFF_SRC/CALPUFF/comparm.puf b/CALPUFF_SRC/CALPUFF/comparm.puf deleted file mode 100644 index 04c68b6..0000000 --- a/CALPUFF_SRC/CALPUFF/comparm.puf +++ /dev/null @@ -1,149 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /COMPARM/ -- Computational variables CALPUFF -c---------------------------------------------------------------------- -c - real wscat(5),tkcat(11),plx0(6),ptg0(2),ppc(6) - real svmin(6,2),swmin(6,2),cdiv(2),tibldist(3) - real sysplith(mxmetdom), shsplith(mxmetdom), cnsplith(mxspec) - real fclip - integer iresplit(24),iqnum(5),iqnext - logical lage - common/COMPARM/xmxlen,mxnew,xsamlen,mxsam,ncount,sl2pf,cdiv, - 1 wscalm,wscat,tkcat, - 2 svmin,swmin,symin,szmin,szcap_m,xminzi,xmaxzi, - 3 plx0,ptg0,ppc,tbd,tibldist,nlutibl, - 4 nsplit,iresplit,zisplit,roldmax,nsplith,cnsplith, - 5 sysplithgrd,shsplithgrd,sysplith,shsplith, - 6 epsslug,epsarea,dsrise,trajincl, - 7 mxagehr,tsecmax,lage,fclip -c -c --- COMMON BLOCK /COMPARM/ Variables: -c XMXLEN - real - Maximum length of a newly-released slug/ -c puff (in grid cells). Used to determine -c the puff release rate. -c MXNEW - integer - Maximum number of puffs that can be -c released from a single source during one -c time step. -c XSAMLEN - real - Maximum travel distance of a puff/slug -c (in grid cells) during one sampling step -c MXSAM - integer - Maximum number of sampling steps per -c time step -c NCOUNT - integer - Number of iterations used in RISEWIND to -c obtain mean wind for sampling step that -c includes gradual rise -c SL2PF - real - Ratio of minimum slug sigma-y to slug -c length at which transition from slug -c sampling to puff sampling takes place -c CDIV(2) - real - Threshold criterion for adjusting for -c significant vertical divergence (horiz. -c convergence) across puff (1/s) -c Partial adjustment begins at CDIV(1), -c and reaches full strength at CDIV(2) -c WSCALM - real - Wind speed threshold between "calm" and -c non-"calm" conditions. Also used as -c lower limit on wind speed returned from -c power-law extrapolation (m/s) -c WSCAT(5) - real - Upper value (m/s) for first 5 wind speed -c classes (class 6 has no upper limit) -c TKCAT(11) - real - Upper value (K) for first 11 temperature -c classes (class 12 has no upper limit) -c SVMIN(6,2) - real - Minimum Turbulence Sigma-v (m/s) for -c stability classes 1-6 over land (1-6,1) -c and over water (1-6,2) -c SWMIN(6,2) - real - Minimum Turbulence Sigma-w (m/s) for -c stability classes 1-6 over land (1-6,1) -c and over water (1-6,2) -c SYMIN - real - Minimum Sigma y (m) applied to newly- -c released puffs -c SZMIN - real - Minimum Sigma z (m) applied to newly- -c released puffs -c SZCAP_M - real - Maximum Sigma z (m) allowed to avoid -c floating-point trap when virtuals are -c computed -c XMINZI - real - Minimum mixing height (m) -c XMAXZI - real - Maxmimum mixing height (m) -c PLX0(6) - real - Wind profile power law exponents used as -c defaults (read from control file, or -c filled with ISC values for either rural -c or urban land use). Power law is used -c to extrapolate winds in the vertical only -c when "single-point" met. data are used -c (ISCMET.DAT or PLMMET.DAT) -c PTG0(2) - real - Potential temperature gradient default -c values obtained from control file for -c stability classes E and F (degK/m) -c PPC(6) - real - Plume path coefficient values from -c file for use with partial plume height -c height correction option, MCTADJ = 3 -c TBD - real - Variable determining switch-over pt. from -c Schulman-Scire scheme to Huber-Snyder -c scheme (SS used for Hs < Hb + TBD * HL, -c TBD < 0 ==> always use Huber-Synder -c TBD = 1.5 ==> always use Schulman-Scire -c TBD = 0.5 ==> ISC switch-point -c TIBLDIST(3) - real - Sub-grid TIBL distance (km) parameters: -c Pure TIBL growth from coast to dist.(1) -c Transition to CALMET Zi from (1) to (2) -c Search dist. for locating nearest coast -c NLUTIBL - integer - Search radius (cells) for locating the -c nearest land and water cells -c FCLIP - real - Number of Sigma-y (m) upwind at the -c start of a step or downwind at the end -c of a step that receptor-specific puff or -c slug properties are extrapolated -c---------------------------------------------------------------------- -c ----- Puff Splitting Information ----- -c---------------------------------------------------------------------- -c --- Vertical --- -c NSPLIT - integer - Number of puffs/slugs that result -c (puff is sectioned NSPLIT-1 times) -c IRESPLIT(24) - integer - Reset flag for puff-splitting (hourly) -c 0: Do not change current ISPLIT values -c 1: Reset all ISPLIT values to 1 -c ZISPLIT - real - Split allowed if "ziold" mixing height -c exceeds ZISPLIT (m) -c ROLDMAX - real - Split allowed if ratio "ziold/zimax" -c is not greater than ROLDMAX -c --- Horizontal --- -c NSPLITH - integer - Number of puffs that result -c CNSPLITH(mxspec) - real - Minimum average concentration (g/m^3) -c of each species in puff before -c it may be split -c SYSPLITHGRD - real - Minimum sigma-y (grid cells) of a puff -c before it may be split -c SHSPLITHGRD - real - Minimum puff elongation rate -c (SYSPLITHGRD grid cells / hour) due to -c wind shear before puff may be split. -c This is the radial wind speed -c difference between the puff center and -c a point located 1.2 SYSPLITH away -c (currently set as fd/2 in SPLIT). -c SYSPLITH(mxmetdom)- real - SYSPLITHGRD converted to meters, for -c each met grid domain -c SHSPLITH(mxmetdom)- real - SHSPLITHGRD converted to m/s, for -c each met grid domain -c---------------------------------------------------------------------- -c ----- Integral Convergence Information ----- -c---------------------------------------------------------------------- -c EPSSLUG - real - Fractional convergence criterion for -c numerical SLUG sampling integral -c EPSAREA - real - Fractional convergence criterion for -c numerical AREA-source integral -c DSRISE - real - Along-trajectory distance step used -c when marching in numerical plume rise -c solver -c---------------------------------------------------------------------- -c ----- PRIME Downwash Information ----- -c---------------------------------------------------------------------- -c TRAJINCL - real - Trajectory inclination angle (deg), -c ignoring streamline descent, at which -c check is made for wake influence -c---------------------------------------------------------------------- -c ----- Puff Age Limit Information ----- -c---------------------------------------------------------------------- -c MXAGEHR - integer - Maximum puff age allowed in run (hours) -c TSECMAX - real - Maximum puff age allowed in run (sec) -c LAGE - logical - Control flag for applying the puff age -c limit -c F: if MXAGEHR <= 0 -c T: if MXAGEHR > 0 diff --git a/CALPUFF_SRC/CALPUFF/const.puf b/CALPUFF_SRC/CALPUFF/const.puf deleted file mode 100644 index cd915b0..0000000 --- a/CALPUFF_SRC/CALPUFF/const.puf +++ /dev/null @@ -1,33 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /CONST/ --- CTSG constants CALPUFF -c----------------------------------------------------------------------- - - common/const/ zero,one,two,three,four,half,twoby3,rt2, - * pi,pii,piby2,twopi,rtpi,rtpii,rt2pi,dtor, - * alphai,small,expmax,hslfac,epsint, - * epsrefl,mxrefl -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [a]=array -c----------------------------------------------------------------------- -c rt2 square root of 2 [r] -c pi (3.14159) [r] -c pii 1/pi [r] -c piby2 pi/2 [r] -c twopi 2*pi [r] -c rtpi square root pi [r] -c rtpii 1/rtpi [r] -c rt2pi square root 2*pi [r] -c dtor degrees-to-radians factor [r] -c alphai factor for converting length scale at half the hill [r] -c height to length scale of the hill-shape function -c small used to signify when a computed difference is [r] -c considered "zero" -c expmax maximum argument allowed for EXP function [r] -c hslfac fraction of cut-off hill height used as a minimum [r] -c streamline height for obtaining distortion factors -c epsint fractional convergence criterion used in integration [r] -c subroutine QATR -c epsrefl fractional convergence criterion used to exit loop [r] -c over reflection terms in vertical distribution factor -c mxrefl maximum number of reflections allowed from mixing lid[i] -c---------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/coordlib.for b/CALPUFF_SRC/CALPUFF/coordlib.for deleted file mode 100644 index fae8945..0000000 --- a/CALPUFF_SRC/CALPUFF/coordlib.for +++ /dev/null @@ -1,8190 +0,0 @@ -c---------------------------------------------------------------------- -c --- COORDLIB -- COORDINATE SYSTEM UTILITIES -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 070921 -c -c Copyright (c) 2003-2007 by Exponent, Inc. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c -c --- Interface routines -c subroutine GLOBE1 -c subroutine GLOBE -c subroutine NIMADATE -c subroutine COORDSVER -c -c --- Coordinate transformation engine -c subroutine COORDS -c (and subroutines) -c ----------------------------- -c -c --- UPDATE -c -c --- V1.98-V1.99 070921 (DGS): Modify UTM section of PJINIT in -c COORDS to fix erroneous non-zero -c false Northing when converting S. -c hemisphere locations to UTM-N -c coordinates -c Initialize full work arrays DWRK, -c DWRK2, TDUM to zero -c Initialize UTMOUT to zero -c -c --- V1.97-V1.98 060911 (DGS): Changes in COORDS that allow a higher -c level of FORTRAN error checking. -c -c --- V1.96-V1.97 060626 (DGS): Add subroutine GLOBE1 (from CALUTILS) -c after removing link to CALUTILS -c components -c -c --- V1.95-V1.96 051010 (KAM): ADD ALBERS CONICAL EQUAL AREA (ACEA) -c PROJECTION AS ONE OF THE SUPPORTED -c PROJECTIONS IN SUBROUTINE COORDS. -c -c --- V1.94-V1.95 050126 (GEM): FORBID UTM CONVERSION TO BE DONE -c FOR A NON-USGS SPHEROID. ADDED AN ERROR -c STRING TO THE COORDS CALL BETWEEN IRET -c AND DSTAMPIN. ADDED THE IRET CODE 99 -c FOR THE CASE WHEN THE FORBIDDEN UTM -c CONVERSION IS ENCOUNTERED. ALSO FIXED -c THE UTM TO UTM CASE WHEN THE OUTPUT UTM -c ZONE IS NOT SPECIFIED. USES THE INPUT -c (OR NATURAL) ZONE TO AVOID ZEROES. -C (GEM): Added IRET=98 error code for a LAZA -c projection with a datum that is not a -c sphere (e.g. not NWS-84 or ESR-S). -c (GEM): LAZA Projection: removed assignment -c of 6370 km earth radius (NWS-84 datum) -c when a value less than 6000 km is -c found. This assignment can override -c a requested radius of 6371 (ESR-S -c datum) if the NWS-84 datum is used -c with any valid projection prior to the -c request for ESR-S. LAZA(NWS-84) -c coordinate distances from the -c projection origin are about 0.016% -c smaller than LAZA(ESR-S). -c (DGS): Introduce subroutine COORDSVER -c --- V1.93-V1.94 041007 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY WHEN -c MOVING FROM ONE DATUM TO ANOTHER - A -c CONTINUATION OF THE FIX IN THE -c PREVIOUS VERSION. -c --- V1.92-V1.93 040713 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY AND -c FIXED THE CASE WHERE NWS-84 UNDER -c UTM USE DID NOT HAVE A VALID ELLIPSE -c MODEL INPUT -c --- V1.91-V1.92 031201 (GEM): CORRECTED CASE WHERE ONLY A CHANGE -C IN THE SAME PROJECTION IS DESIRED -c --- V1.9-V1.91 031017 (GEM): CORRECTED WGS 72 AND FIXED ELLIPSOID -c INITIALIZATION -c --- V1.15-V1.9 030905 (GEM): MAPLIB VERSION 1.9 030905 -c Rename MAPLIB system to COORDLIB -c --- V1.14-V1.15 030528 (DGS): MAPLIB VERSION 1.85 030528 -c --- V1.13-V1.14 030402 (DGS): MAPLIB VERSION 1.84 030402 -c --- V1.12-V1.13 030307 (DGS): MAPLIB VERSION 1.83 030307 -c NIMA Date now C*12 (MM-DD-YYYY ) -c --- V1.11-V1.12 030221 (DGS): Add routine to pass NIMA date -c --- V1.1-V1.11 030217 (DGS): Revise COORDS error message -c --- V1.0-V1.1 030117 (DGS): Add date stamp to COORDS call -c MAPLIB VERSION 1.8A 011403 -c -c---------------------------------------------------------------------- - subroutine globe1(cmapi,iutmzni,tmsfi,xlat1i,xlat2i,rlati,rloni, - & feasti,fnorti, - & cmapo,iutmzno,tmsfo,xlat1o,xlat2o,rlato,rlono, - & feasto,fnorto, - & caction,vecti,vecto) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 060626 GLOBE1 -c D. Strimaitis -c -c --- PURPOSE: Setup for coordinate transformation routine COORDS -c -c --- UPDATE -c --- V1.97(060626) (DGS) -c - Transferred from CALUTILS -c - Remove calls to DEBLNK and ALLCAP to isolate -c --- ...CALUTILS... -c --- V2.3 (051019) from V2.2 (030528) (KAM) -c - Add Albers Conical Equal Area projection -c --- V2.2 (030528) from V2.1 (030402) (DGS) -c - Screen for valid UTM zone using absolute value -c (S. Hem. zones are negative) -c --- V2.1 (030402) from V2.0 (021018) (DGS) -c - Add False Easting & Northing inputs -c -c --- INPUTS: -c CMAPI - char*8 - Map projection of input coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNI - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFI - real - Scale Factor for TM projection -c XLAT1I - real - Matching Equator-ward N.Latitude -c XLAT2I - real - Matching Pole-ward N.Latitude -c RLATI - real - Map origin N.Latitude -c RLONI - real - Map origin E.Longitude -c FEASTI - real - False Easting (km) at proj. origin -c FNORTI - real - False Northing (km) at proj. origin -c CMAPO - char*8 - Map projection of output coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNO - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFO - real - Scale Factor for TM projection -c XLAT1O - real - Matching Equator-ward N.Latitude -c XLAT2O - real - Matching Pole-ward N.Latitude -c RLATO - real - Map origin N.Latitude -c RLONO - real - Map origin E.Longitude -c FEASTO - real - False Easting (km) at proj. origin -c FNORTO - real - False Northing (km) at proj. origin -c -c -c --- OUTPUT: -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c -c -c --- GLOBE1 called by: (utility) -c --- GLOBE1 calls: none -c---------------------------------------------------------------------- - - character*1 cstor1(20),cstor2(20),clc(26),cuc(26) - - real*8 vecti(9),vecto(9) - character*12 caction - character*8 cmapi,cmapo - - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - & 'j','k','l','m','p','q','r','s','t','v','w','y','z'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - & 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z'/ - -c --- Set action string for conversion -c ------------------------------------ -c --- Initialize character variables for output - do i=1,20 - cstor1(i)=' ' - cstor2(i)=' ' - enddo - do i=1,8 - j=i+9 - cstor1(i)=cmapi(i:i) - cstor1(j)=cmapo(i:i) - enddo - cstor1(9)='2' -c --- Remove blank characters from string, place in storage array 2 - nlim=0 - do i=1,17 - if(cstor1(i).NE.' ') then -c --- Transfer non-blank character into array 2 - nlim=nlim+1 - cstor2(nlim)=cstor1(i) - endif - enddo -c --- Convert lower case letters to upper case - do i=1,nlim - do j=1,26 - if(cstor2(i).EQ.clc(j)) then - cstor2(i)=cuc(j) - go to 52 - endif - enddo -52 continue - enddo -c --- Transfer characters to action string - do i=1,12 - caction(i:i)=cstor2(i) - enddo - -c --- Set transformation vectors -c ------------------------------ -c --- Initialize transformation vectors - vecti(1)=999.0D0 - vecto(1)=999.0D0 - do i=2,9 - vecti(i)=0.0D0 - vecto(i)=0.0D0 - enddo - -c --- Input coords - if(cmapi.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzni).GT.0 .AND. - & IABS(iutmzni).LT.61) vecti(1)=DBLE(iutmzni) - else -c --- Matching points / origin - vecti(4)=DBLE(xlat1i) - vecti(5)=DBLE(xlat2i) - vecti(6)=DBLE(rloni) - vecti(7)=DBLE(rlati) - endif - if(cmapi.EQ.'TM') then -c --- TM Scale Factor - vecti(1)=DBLE(tmsfi) - endif - if(cmapi.EQ.'TM'.or.cmapi.EQ.'LCC'.or.cmapi.EQ.'LAZA'.or. - & cmapi.EQ.'ACEA') then - vecti(8)=DBLE(feasti) - vecti(9)=DBLE(fnorti) - endif - -c --- Output coords - if(cmapo.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzno).GT.0 .AND. - & IABS(iutmzno).LT.61) vecto(1)=DBLE(iutmzno) - else -c --- Matching points / origin - vecto(4)=DBLE(xlat1o) - vecto(5)=DBLE(xlat2o) - vecto(6)=DBLE(rlono) - vecto(7)=DBLE(rlato) - endif - if(cmapo.EQ.'TM') then -c --- TM Scale Factor - vecto(1)=DBLE(tmsfo) - endif - if(cmapo.EQ.'TM'.or.cmapo.EQ.'LCC'.or.cmapo.EQ.'LAZA'.or. - & cmapo.EQ.'ACEA') then - vecto(8)=DBLE(feasto) - vecto(9)=DBLE(fnorto) - endif - - return - end -c---------------------------------------------------------------------- - subroutine globe(iolst,caction,cdatumi,vecti,cdatumo,vecto, - & xinp4,yinp4,xout4,yout4,izone,utmhem) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 050126 GLOBE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Driver for coordinate transformation routine COORDS -c translates CALPUFF system information and provides -c fixed inputs -c -c --- UPDATE -c -c --- V1.13 (030307) to V1.95 (050126) -c - Added ESTRNG string to COORDS call for error message -c text. (GEM) -c - Added VERDOC string to COORDS call for identification -c text (DGS) -c --- V1.12 (030217) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c --- V1.1 (030117) to V1.11 (030217) (DGS) -c - Revise return error message -c --- V1.0 () to V1.1 (030117) (DGS) -c - Add date stamp to COORDS calls -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c CDATUMI - char*8 - Datum-region code for input coords -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CDATUMO - char*8 - Datum-region code for output coords -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c XINP4 - real*4 - Input Easting(km) (or E.Longitude deg) -c YINP4 - real*4 - Input Northing(km) (or N.Latitude deg) -c -c -c --- OUTPUT: -c XOUT4 - real*4 - Output Easting(km) (or E.Longitude deg) -c YOUT4 - real*4 - Output Northing(km) (or N.Latitude deg) -c IZONE - integer - UTM zone of output -c UTMHEM - char*4 - Hemisphere for UTM projection (N or S) -c -c --- GLOBE called by: (utility) -c --- GLOBE calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - logical ldb - - character*4 utmhem - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set debug output logical - ldb=.FALSE. - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - -c --- Convert output coordinates to single precision - xout4=SNGL(xyzio(1)) - yout4=SNGL(xyzio(2)) - utmzn=SNGL(utmout) - izone=NINT(utmzn) - -c --- Format UTM zone to CALPUFF convention - utmhem='N' - if(izone.LT.0) then - utmhem='S' - izone=-izone - endif - - if(LDB) then - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine nimadate(date) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 030905 NIMADATE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Passes the NIMA date from common to calling program -c -c --- UPDATE -c --- V1.13 (030307) to V1.9 (030905) (GEM) -c - Change to NIMA.CRD for MAPLIB VERSION 1.9 -c --- V1.12 (030221) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c -c --- INPUTS: -c none -c -c --- OUTPUT: -c DATE - char*12 - NIMA database date -c -c --- NIMADATE called by: (utility) -c --- NIMADATE calls: none -c---------------------------------------------------------------------- - include 'nima.crd' - character*12 date - - date=daten - - return - end -c---------------------------------------------------------------------- - subroutine coordsver(iolst,verdoc) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 050126 COORDSVER -c D. Strimaitis EarthTech -c -c --- PURPOSE: Accesses the COORDS version information by making one -c generic call to COORDS (like GLOBE) -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c -c --- OUTPUT: -c VERDOC - char*50 - COORDS version information -c -c --- COORDSVER called by: (utility) -c --- COORDSVER calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecti/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecto/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Set up converter for a null translation of lat/lon - xinp4= -90.0 - yinp4=45.0 - caction='LL2LL ' - cdatumi='WGS-84 ' - cdatumo='WGS-84 ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - - return - end -C---------------------------------------------------------------------- - SUBROUTINE COORDS(IO,IUNIT,IMODE,IPROJ,IDATMI,IDATMO,IPREC, - 1 CVECTI,CVECTO,NVEC,XYZIN,NC,XDATUM,NDAT,XYZIO,UTMOUT,IRET, - 2 ESTRNG,DSTAMPIN,VERDOC) -C---------------------------------------------------------------------- -C -C --- COORDLIB Version: 1.99 Level: 070921 COORDS -C -C --- Program was written by Gary Moore -C -C --- PROGRAM NOTES FOLLOW: -C -C --- Version 1.1 argument change -C -C --- IDATMI(O) - FULL CHARACTER STRING FOR GUI SUPPLIED (IRANK REMOVED) -C --- XDATUM,NDAT - PASS FULL ARRAY OF USER DEFINED DATUM INFO (DP) -C -C --- (1) - MAJOR RADIUS -C --- (2) - INVERSE FLATTENING -C --- (3) - ECCENTRICITY SQUARED -C --- (4) - DX -C --- (5) - DY -C --- (6) - DZ -C -C --- Version 1.2 argument change -C -C --- UTMOUT a double precision output UTM zone is used in the convert -C --- program as output to tell what UTM each point has been translated -C --- TO. -C -C --- Version 1.3 changes -C -C --- Addition of LL2ZONE subroutine for extracting the natural UTM zone -C --- when going FROM LCC TO UTMS - otherwise there is no way of knowing -C --- added extra projection calls in places to retrieve the geodetic -C --- coordinates. -C -C --- Version 1.4 changes -C -C --- Fixed the use of the FROM ellipsoid model for the final projection -C --- and changed to it to the TO ellipsoid model. Fixed the DAT2DAT and -C --- DATSHFT routines so that the proper reverse transformation proceedure -C --- is done (note - changed presentation figures) -C -C --- Version 1.5 changes -C -C --- Added more options for transformation - PS = Polar Stereographic -C --- and EM = Equatorial Mercator. Note - both of these will generally -C --- be used on a spherical earth represented by Datum 220, but can -C --- be projected to an ellipical surface - unlike the azimuthal -C --- projections that can only be done on a sphere. The LAZA was hardwired -C --- to do only a sphere with a radius of 6370 km (before it could float -C --- incorrectly). -C -C --- The block data variables were modified to accomodate the new NIMA -C --- data base. Block data call was moved to the INIT subroutine which -C --- sets up variables for COORDS and outputs several arrays for use with -C --- GUI's -C -C --- The NIMA data base use resulted in a considerable set of code -C --- revisions including (1) 8 Character Datum ID use for selecting the -C --- Datum (2) use of a 21 character ellipsoid string check (3) use of -C --- a revised 118 character region string. -C -C --- An INCLUDE file 'NIMA.CRD' was used to insert the NIMA common -C --- blocks into routines. -C -C --- version 1.6 changes -C -C --- Made several upgrades including: -C -C --- (1) adds a date check to make sure the block data is the right -C --- version. This requires adding an extra argument to COORDS -C -C --- (2) adds the Tranverse Mercator projection (TM) -C -C --- (3) add error codes for projections -C -C --- (4) allows the user input 'to' (output) utm zone to work -c -c --- Changed the ordering of CVECTI/CVECTO elements 4-7 to be consistent -c --- across all transformations, rather than following the USGS element -c --- definitions. Lat/Lon of origin of EM and PS projections is accepted -c --- and the corresponding false Easting/Northing values are computed -c --- and applied. The elements of the transformation vector are: -c (1) UTM Zone (for UTM), or Scale Factor (for TM) -c (2) radius of major axis of earth - (used for Azimuthal projections) -c (3) not currently used -c (4) True N. Latitude #1 (where applicable) -c (5) True N. Latitude #2 (where applicable) -c (6) E. Longitude of projection origin (where applicable) -c (7) N. Latitude of projection origin (where applicable) -c (8) False Easting (where applicable) -c (9) False Northing (where applicable) -C -C --- Version 1.7 changes -C -C --- Moved false northing determination of TO projections to a point -C --- where they occur AFTER a datum shift -C -C --- Added dummy arrays to keep longitude/latitudes from being written -C --- over. -C -C --- Removed writes to standard output so DLL's can be directly made -C -C --- Removed external date check changes to an internal one -C -C --- Further revisions to PS and EM cases the user cannot input a -C --- false northing and easting - and error is returned if they do -C -C --- Fixed PS2PS and EM2EM cases -C -C --- Version 1.8 changes -C -C --- Dealt with a major issue of projection initialization that is done -C --- with INZONE. Initialization is done when the UTM zone changes. Software -C --- was added to make sure this happens. -C -C --- The PS/EM projections had consistency problems when the offset is -C --- calculated with a 0.0 rather than a true longitude - the true longitude -C --- was used. -C -C --- An error in the PS/EM projection was corrected when the input -C --- parameter vector was found to be using an incorrect latitude of -C --- true scale. -C -C --- Error warnings were included to make sure that no false eastings -C --- or northings are input by the user of the PS and EM projections. -C -C --- Version 1.81 changes -C -C --- Modified USGS routines to force initialization every time by -C --- setting the switch array to zero for all projections on each call -C -C --- Added DGS approach to checking date stamp using DATEN and DATEB -C -C --- Added include for the block data (blockdat.crd) -C -C --- Version 1.82 changes -C -C --- Fixed the TM insertion of scaling factor - moved it from the USGS -C --- Element # 3 (CVECT element #4) to the CVECT element #1 normally -C --- (UTM ZONE) - the UTM zone is now set to 999. There is a mapping -C --- of the UTM ZONE to the USGS element 3 and a resetting of the -C --- UTM zone to 999 before entering the USGS subroutines. -C -C --- Scale false Easting/Northing to METERS -C --- Correct false Easting/Northing assignments after processing -C -C --- Convert main program to the CALPUFF Version/Level designation -C --- where Level is YYMMDD -C -C --- Added date-stamp argument DSTAMPIN to re-assign DSTAMP if the -C --- argument is non-blank -C -C --- Version 1.83 changes -C -C --- NIMA date variables changed from C*10 to C*12 -C --- DAT2DAT does not transform to/from WGS84 if input/output datum -C is for a sphere -C -C --- Version 1.84 changes -C -C --- Recast UTM-to-UTM conversions to properly handle zone overrides -C by adding IOVUTM: -C 0) finds native output UTM zone for output UTMs -C 1) no change to input coordinates when inzone=iozone -C 2) uses zone override for output UTMs -C -C --- Version 1.85 Level: 030528 changes -C -C --- Fix Polar Stereographic (PS) dummy array initialization which -C did not include the Earth Radius for spherical datum, and clarify -C code (remove unneeded dummy arrays) -c -c --- Take absolute value of UTM zone when testing for valid values -c (UTM is negative in S. Hemisphere) -c -C -C --- Version 1.9 Level: 030905 changes -C -C --- NEW BLOCK DATA!!!! The new block data was created by version 1.3 -C of BUILD.FOR which utilizes new data sources for DATUMs. These new -C files include: -C -C --- (1) New HEADER.TXT which defines two new global datum and removes -C one spherical earth datum (based on NAD 27). The two new datums -C are functionally equivalent and they serve as a placeholder to -C assure users they have the proper DATUM -C -C --- (2) New Datum data files GEOTRANS_02-21-2003.dat and ellips.dat -C These new data files are required since the DATUM listing text -C file produced by NIMA is not available for the latest changes -C in datum definitions. Instead the user is referred to the data -C files used by the NIMA GEOTRANS geocalculator. The ellips.dat -C file contains the parameters defining 23 ellipsoid models used -C to define the datums. These are matched by two character codes -C to the differences in geocentric coordinates of each datum -C relative to WGS-84 found in GEOTRANS_02-21-2003. The -C GEOTRANS_02-21-2003.dat file contains five new local datums - -C all which are Hawaian Island local variants. -C -C --- (3) NEWDATUM.TXT is a new file that has been added to allow insertion -C of new datums into the proper place in the master list of local -C datums. This file also allows one to add descriptive text (3 lines) -C describing the valid region or conditions of the datum. -C -C --- (4) Introduced the WGS72 global data and added formulas -C to deal with the coordinate transformations between WGS84. -C -C --- Version 1.91 Level: 031017 changes -C -C --- Made a change to TPARIN and TPARIO - Placed ellipsoid -C --- parameters in locations 14 (major radius) and 15 (eccentricity -C --- squared). Also forces the first pass initialization of GZTP0 -C --- to use the parameters rather than default to a CLARKE 1866. -C --- Also fixed a typo so that the USGS WGS 72 ellipsoid model in -C --- the USGS programs is used. -C -C --- Version 1.93 Level: 041307 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere). Also fixed a problem with NWS-84 and -C --- UTM combination where there is no difference in the results when -C --- going to and from this DATUM from other DATUMS. For UTM the 6371 km -C --- spherical ellipse model must be used when the 6370Km sphere is used -C --- because of USGS program input array conflicts. -C -C --- Version 1.94 Level: 041007 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere) when going from one DATUM to another. This -C --- is a continuation of the change made in version 1.93. -C -C --- Version 1.95 Level: 050126 changes -C -C --- Made it impossible to use a non-USGS earth spheroid when using UTM's -C --- Essentially reversed an attempted fix under version 1.93. -C --- EMG-96 is aliased to GRS 80 ellipsoid model. -C -C--------------- -C *** ALERT *** -C--------------- -C - COORDS versions prior to 1.93 used the Clark 1866 spheroid for -C - UTM conversions when a datum with a non-USGS earth spheroid is -C - specified. An example of this is the NWS-84 datum. -C - The UTM/NWS-84 fix implemented in version 1.93 and present in -C - version 1.94 whould have used a mixture of ESRI and Clarke 1866 -C - owing to the fix being applied only to one side of the -C - transformation. One should never mix versions 1.93 and 1.94 -C - with prior versions. ONE SHOULD NOT USE VERSIONS 1.93 and 1.94 -C - owing to the inconsistent nature of the transformation!!!! -C -C --- Added another IRET error code (IRET = 99) for this case. Added an -C --- error string (50 characters) between IRET and DSTAMPIN to the call -C --- to COORDS to return the error message text. -C -C --- Added yet another IRET error code (IRET = 98) for the case when -C --- one tries to use LAZA with a datum that is not a sphere (e.g. not -C --- (NWS-84 or ESR-S). -c -c --- Added VERDOC string to argument list for COORDS identification -c --- text. -c -c --- LAZA Projection: removed assignment of 6370 km earth radius -c --- (NWS-84 datum) when a value less than 6000 km is found. This -c --- assignment can override a requested radius of 6371 (ESR-S datum) -c --- if the NWS-84 datum is used with any valid projection prior to the -c --- request for ESR-S. LAZA(NWS-84) coordinate distances from the -c --- projection origin are about 0.016% smaller than LAZA(ESR-S). -c --- This undoes a change made in version 1.5. -C -C --- Fixed the case for a UTM to UTM transformation when the output UTM -C --- zone is not specified by the user. The UTM zone is set to the -C --- input UTM zone (or the natural UTM if it estimated) in order that -C --- the proper UTM zone is presented in the output rather than zero. -C --- This fix addresses a situation that arises in the coordinate -C --- conversion GUI. -C -C --- Version 1.96 Level: 051010 changes -C -C --- Add Albers Conical Equal Area projection as one of the supported -C --- projections. -C -C --- Version 1.98 Level: 060911 changes -C -c --- Changes that allow a higher level of FORTRAN error checking: -c --- Replace the constant 4 with an I*4 variable (IUNIT4) in -c calls to GTPZ0 from COORDS (to/from lat-lon). -c --- Set GTPZ0 argument LENGTH=100 (for direct access files that -c are not used). -c --- Replace constant 0 with I*4 variable (INSPHZERO) in argument 1 -c of SPHDZ0 call in GTPZ0 -c --- Change FUNCTION ADJLZ0 argument name and reassign to LON within -c (sub is called with a computed argument that should not be -c changed within subroutine) -c --- SAVE9 is undefined first time in PJINIT; set to zero in DATA - -C -C --- Version 1.99 Level: 070921 changes -C -c --- Modify UTM section of PJINIT to fix erroneous non-zero false -c --- Northing when converting S. hemisphere locations to UTM-N -c --- coordinates. Main subroutine also changed to remove patches -c --- that had corrected this problem when converting from lat/lon to -c --- UTM-N. The bug only affected conversions to N. hemisphere UTM -c --- coordinates when the location was in the S. hemisphere. The -c --- coordinates returned were actually in UTM-S. -c -c --- Initialize full real*8 work arrays DWRK, DWRK2, TDUM to zero. -c -c --- Initialize UTMOUT to zero. -C -C---------------------------------------------------------------------- -C -C --- PROGRAM FUNCTION: -C -C --- THIS IS THE MAIN DRIVER PROGRAM FOR THE MOLODENSKY DATUM -C --- CONVERSION AND THE USGS GCTP PROJECTION CONVERSION SOFTWARE. -C -C --- INPUT VARIABLES -C -C --- IO = LOGICAL FORTRAN UNIT FOR OUTPUT -C --- IUNIT = 10 CHARACTER UNITS STRING - 'METERS ' OR 'KILOMETERS' -C --- IMODE = 0 - USES DATA IN BLOCK DATA -C --- 1 - USER DEFINED DATUM INFORMATION (FROM) -C --- 2 - USER DEFINED DATUM INFORMATION (TO) -C --- 3 - USER DEFINED DATUM INFORMATION (FROM-TO) -C --- IPROJ = 12 CHARACTER PROJECTION ACTION STRING EG 'LL2UTM ' -C --- IDATMI = 8 CHARACTER INPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IDATMO = 8 CHARACTER OUTPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IPREC = 0 - SINGLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- 1 - DOUBLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- CVECTI = 1-D VECTOR OF INPUT PROJECTION PARAMETERS (DP) -C --- CVECTO = 1-D VECTOR OF OUTPUT PROJECTION PARAMETERS (DP) -C --- NVEC = NUMBER OF PARAMETERS IN THE CVECT ARRAYS -C --- XYZIN = 1-D ARRAY OF INPUT COORDINATES (X,Y,Z) (DP) -C --- NC = NUMBER OF VALID ELEMENTS IN XYZIN(O) (2 OR 3) (X,Y) OR (X,Y,Z) -C --- XDATUM = 1-D VECTOR OF DATUM DEFINITION PARAMETERS -C --- NDAT = NUMBER OF DATUM DEFINITION PARAMETERS (NORMALLY = 6) -C --- DSTAMPIN = 12 CHARACTER DATE STRING (MM-DD-YYYY ) FOR CHECKING -C --- NIMA PARAMS AND BLOCKDATA (Leave blank for default) - -C -C --- OUTPUT VARIABLES -C -C --- XYZIO = 1-D ARRAY OF OUTPUT COORDINATES (X,Y,Z) (DP) -C --- UTMOUT = UTM ZONE OF THE OUTPUT TO TRANSFORMATION (DP) -C --- IRET = RETURN FLAG (0) - SUCCESSFUL -C --- ESTRNG = 50 CHARACTER STRNG CONTAINING ERROR MESSAGE -C --- VERDOC = 50 character string containing COORDS version and level -C -C --- THIS PROGRAM CALLS: -C -C --- GTPZ0 - USGS GCTP MAIN SUBROUTINE -C --- ERRFLG - ERROR PRINTS FOR GTPZ0 -C --- DAT2DAT - MOLODENSKY DATUM SHIFT -C -C --- All NIMA BASED COMMON BLOCKS AND SUPPORTIVE DECLARATIVE -C --- STATEMENTS HAVE BEEN LUMPED INTO A SINGLE INCLUDE FILE -C --- CALLED 'NIMA.CRD' -C -c---------------------------------------------------------------------- -C - PARAMETER (MP = 64) -C - CHARACTER*128 FN27,FN83 - CHARACTER*50 IERR(12) - CHARACTER*50 ESTRNG, VERDOC - CHARACTER*12 JPROJ(MP),IPROJ - CHARACTER*8 IDATMI,IDATMO - CHARACTER*7 IPATH1,IPATH2 - CHARACTER*10 IUNIT - CHARACTER*21 ELIPSI,ELIPSO - CHARACTER*52 IDSTRNG - CHARACTER*12 DSTAMPIN -C - INTEGER*4 INSYS,INZONE,INUNIT,INSPH,IPR,JPR,LEMSG,LPARM,LN27, - 1 LN83,LENGTH,IOSYS,IOZONE,IOUNIT,IFLG - -c --- V1.98 (060911) - INTEGER*4 IUNIT4 - - INTEGER*4 SYSFLG(2,MP) - Integer*4 irnkin,irnkio - Integer*4 io,lpr, iret -C - Real*4 xdum,dxshft,dyshft,dzshft -C - REAL*8 CRDIN(2),TPARIN(15),CRDIO(2),TPARIO(15),DWRK(15), - 1 DWRK2(15) - REAL*8 XYZIN(NC), XYZIO(NC), CVECTI(NVEC), CVECTO(NVEC) - REAL*8 TDUM(15),XDATUM(NDAT) - Real*8 xlonin,xlatin,xlonio,xlatio - Real*8 flonin,flatin,flonio,flatio - Real*8 dd,dms,drad,dflt - Real*8 utmout - Real*8 TCRDIN(2),TCRDIO(2) -C -C --- Include the NIMA database - INCLUDE 'nima.crd' -C - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -C -C --- DEFAULT CONTROL SETTINGS AND ALLOWED PROJECTIONS - DATA IPATH1,IPATH2 /'NAD27SP','NAD83SP'/ - DATA LEMSG,LPARM,LN27,LN83 /16,17,18,19/ -c DATA IPR,JPR /0,0/ - DATA IPR,JPR /1,1/ - DATA JPROJ/ - * 'LL2LL ','LL2UTM ','LL2LCC ','LL2LAZA ', - * 'LL2PS ','LL2EM ','LL2TM ','LL2ACEA ', - * 'UTM2LL ','UTM2UTM ','UTM2LCC ','UTM2LAZA ', - * 'UTM2PS ','UTM2EM ','UTM2TM ','UTM2ACEA ', - * 'LCC2LL ','LCC2UTM ','LCC2LCC ','LCC2LAZA ', - * 'LCC2PS ','LCC2EM ','LCC2TM ','LCC2ACEA ', - * 'LAZA2LL ','LAZA2UTM ','LAZA2LCC ','LAZA2LAZA ', - * 'LAZA2PS ','LAZA2EM ','LAZA2TM ','LAZA2ACEA ', - * 'PS2LL ','PS2UTM ','PS2LCC ','PS2LAZA ', - * 'PS2PS ','PS2EM ','PS2TM ','PS2ACEA ', - * 'EM2LL ','EM2UTM ','EM2LCC ','EM2LAZA ', - * 'EM2PS ','EM2EM ','EM2TM ','EM2ACEA ', - * 'TM2LL ','TM2UTM ','TM2LCC ','TM2LAZA ', - * 'TM2PS ','TM2EM ','TM2TM ','TM2ACEA ', - * 'ACEA2LL ','ACEA2UTM ','ACEA2LCC ','ACEA2LAZA ', - * 'ACEA2PS ','ACEA2EM ','ACEA2TM ','ACEA2ACEA '/ - DATA SYSFLG/0,0,0,1,0,4,0,11,0,6,0,5,0,9,0,3, - * 1,0,1,1,1,4,1,11,1,6,1,5,1,9,1,3, - * 4,0,4,1,4,4,4,11,4,6,4,5,4,9,4,3, - * 11,0,11,1,11,4,11,11,11,6,11,5,11,9,11,3, - * 6,0,6,1,6,4,6,11,6,6,6,5,6,9,6,3, - * 5,0,5,1,5,4,5,11,5,6,5,5,5,9,5,3, - * 9,0,9,1,9,4,9,11,9,6,9,5,9,9,9,3, - * 3,0,3,1,3,4,3,11,3,6,3,5,3,9,3,3/ - DATA TDUM /15*1.0D0/ -C - FN27(1:7) = IPATH1 - FN83(1:7) = IPATH2 - LPR = IO - -c --- V1.98 (060911) -c --- Set units variable for steps with conversion to/from lat-lon - iunit4=4 -c --- Define record-length argument for GTPZ0 - length=100 - -c---------------------------------------------------------------------- -c --- Set the COORDS version and level string - - verdoc=' --- COORDLIB Version: 1.99 Level: 070921 ' - -c---------------------------------------------------------------------- - -C -C --- SET IRET TO ZERO - IRET = 0 -C -C --- PROPERLY INITIALIZE ESTRNG to BLANKS (NOT NULLS) - DO K = 1,50 - ESTRNG(K:K) = ' ' - ENDDO -C -C --- SPECIAL CHECK FOR NWS-84 SPHERE JUST IN CASE A LAZA PROJECTION -C --- IS DESIRED. A SPHERE FLAG IS INITIALIZED HERE (TO ZERO). IT IS -C --- SET TO 1 IF THE ELLIPSOID MODEL IS A SPHERE. - IBALLI = 0 - IBALLO = 0 - IF(IDATMI.EQ.'NWS-84')IBALLI = 1 - IF(IDATMO.EQ.'NWS-84')IBALLO = 1 -C -C --- Establish the date-stamp value - if(dstampin(1:1).NE.' ') dstamp=dstampin -C -C --- NOW FINDS OUT IF THE USER EXPECTED DATE STRING MATCHES THE -C --- ONE FOUND IN THE NIMA TEXT FILE - IF(DSTAMP.NE.DATEN)THEN - IRET = 10 - IERR(1)='DATE STAMP FAILURE FOR NIMA.CRD! ' - ESTRNG = IERR(1) - RETURN - ENDIF -C -C --- NOW FINDS OUT IF WE HAVE THE RIGHT BLOCK DATA FILE - IF(DSTAMP.NE.DATEB)THEN - IRET = 20 - IERR(2)='DATE STAMP FAILURE FOR BLOCKDATA! ' - ESTRNG = IERR(2) - RETURN - ENDIF -C -C --- IMMEDIATELY FINDS THE PROPER DATUM FROM THE PRESTORED SET - IRNKIN = 0 - IRNKIO = 0 - IF(IMODE.EQ.0)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 222 - ENDIF - ENDDO -222 CONTINUE - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 232 - ENDIF - ENDDO -232 CONTINUE - ENDIF - IF(IMODE.EQ.1)THEN - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 332 - ENDIF - ENDDO -332 CONTINUE - ENDIF - IF(IMODE.EQ.2)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 322 - ENDIF - ENDDO -322 CONTINUE - ENDIF -C -C --- IMMEDIATE CHECK FOR ILLEGAL DATUM POINTER - IF(IMODE.EQ.0)THEN - IF(IRNKIN.LT.1.OR.IRNKIN.GT.ND)THEN - IRET = 60 - IERR(6)='INPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(6) - RETURN - ENDIF - IF(IRNKIO.LT.1.OR.IRNKIO.GT.ND)THEN - IRET = 70 - IERR(7)='OUTPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(7) - RETURN - ENDIF - ENDIF -C -C --- CHECKS OPERATION MODE - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C --- NOW ESTABLISHES THE TRANSFORMATION TYPE - DO K = 1,MP - IF(JPROJ(K).EQ.IPROJ)THEN - INSYS = SYSFLG(1,K) - IOSYS = SYSFLG(2,K) - GOTO 101 - ENDIF - ENDDO - IRET = 40 - IERR(4) = 'THE PROJECTION PAIR IS UNDEFINED OR NOT ALLOWED! ' - ESTRNG = IERR(4) - RETURN - 101 CONTINUE -C -C --- NOW CHECKS FOR IMPROPER EASTING AND NORTHING OFFSETS FOR PS AND EM -C --- PROJECTIONS - IF((INSYS.EQ.5.OR.INSYS.EQ.6).AND.CVECTI(9).NE.0.0D+00)THEN - IRET = 80 - IERR(8) = 'ILLEGAL INPUT OF (FROM) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(8) - ENDIF - IF((IOSYS.EQ.5.OR.IOSYS.EQ.6).AND.CVECTO(9).NE.0.0D+00)THEN - IRET = 90 - IERR(9) = 'ILLEGAL INPUT OF (TO) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(9) - ENDIF -C -C --- NOW ESTABLISHES THE PROPER UNITS -C --- LL = DECIMAL DEGREES -C --- UTM,LCC,LAZA,PS,MC,ACEA = METERS OR KILOMETERS - XMULTI = 1.0 - IF(INSYS.EQ.0)THEN - INUNIT = 4 - ELSE - INUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTI = 1000.0 - ELSE - XMULTI = 1.0 - ENDIF - ENDIF - XMULTO = 1.0 - IF(IOSYS.EQ.0)THEN - IOUNIT = 4 - ELSE - IOUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTO = 0.001 - ELSE - XMULTO = 1.0 - ENDIF - ENDIF -C -C --- SINGLE PRECISION CHECK - SINGLE PRECISION IS NOT YET SUPPORTED - IF(IPREC.EQ.0)THEN - IRET = 50 - IERR(5) = 'NICE TRY - SINGLE PRECISION COORDS ARE ILLEGAL! ' - ESTRNG = IERR(5) - RETURN - ENDIF -c -c --- Store the ELon and NLat of the projection origin (DD) - FLONIN=CVECTI(6) - FLONIO=CVECTO(6) - FLATIN=CVECTI(7) - FLATIO=CVECTO(7) -C -C --- FILLS THE INPUT COORDINATES ARRAY CRDIN AND THE TPARIN ARRAY - CRDIN(1) = XYZIN(1)*DBLE(XMULTI) - CRDIN(2) = XYZIN(2)*DBLE(XMULTI) - IF(NVEC.GT.16)THEN - IRET = 60 - IERR(6) = 'TRUNCATED PROJECTION PARAMETER VECTOR! ' - ESTRNG = IERR(6) - NVEC = 16 - ENDIF - DO K = 1,15 - TPARIN(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTI(1)) - INZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIN(K-1) = CVECTI(K)*DBLE(XMULTI) - ELSE -C --- ASSIGN DIRECTLY FROM INPUT VECTOR - TPARIN(K-1) = CVECTI(K) - ENDIF - ENDDO -C -C --- FILLS THE TPARIO ARRAY (ALSO NEEDED) - DO K = 1,15 - TPARIO(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTO(1)) - IOZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIO(K-1) = CVECTO(K)/DBLE(XMULTO) - ELSE -C --- ASSIGN DIRECTLY FROM OUTPUT VECTOR - TPARIO(K-1) = CVECTO(K) - ENDIF - ENDDO - -c --- Initialize full work arrays - do k = 1,15 - dwrk(k) = 0.0D+00 - dwrk2(k) = 0.0D+00 - tdum(k) = 0.0D+00 - enddo - -c --- Initialize output variable UTMOUT - utmout = 0.0D+00 -C -C --- Now converts the TPARIN, TPARIO FROM DD to DDDMMMSSS.SS -C --- UTM's - IF(INSYS.EQ.1)THEN - DD = TPARIN(1) - CALL DD2DMS(DD,DMS) - TPARIN(1) = DMS - DD = TPARIN(2) - CALL DD2DMS(DD,DMS) - TPARIN(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(INSYS.EQ.4.OR.INSYS.EQ.3)THEN - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(3) = DMS - DD = TPARIN(4) - CALL DD2DMS(DD,DMS) - TPARIN(4) = DMS - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- EM & PS's (Note shift of arguments) - IF(INSYS.EQ.5.OR.INSYS.EQ.6)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - TPARIN(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(INSYS.EQ.9)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS -C --- NOW SWAP FROM CVECTI ELEMENT 1 TO USGS ELEMENT 3 - TPARIN(3) = CVECTI(1) - INZONE = 999 - ENDIF -C --- LAZA's - IF(INSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIN(1).LT.6000000.0D+00)THEN -C TPARIN(1) = 6370000.0D+00 -C ENDIF - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- UTM's - IF(IOSYS.EQ.1)THEN - DD = TPARIO(1) - CALL DD2DMS(DD,DMS) - TPARIO(1) = DMS - DD = TPARIO(2) - CALL DD2DMS(DD,DMS) - TPARIO(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(IOSYS.EQ.4.OR.IOSYS.EQ.3)THEN - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(3) = DMS - DD = TPARIO(4) - CALL DD2DMS(DD,DMS) - TPARIO(4) = DMS - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C --- EM AND PS's (Note shift of arguments) - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - TPARIO(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(IOSYS.EQ.9)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS -C --- NOW SWAP FROM CVECTO ELEMENT 1 TO USGS ELEMENT 3 - TPARIO(3) = CVECTO(1) - IOZONE = 999 - ENDIF -C --- LAZA's - IF(IOSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIO(1).LT.6000000.0D+00)THEN -C TPARIO(1) = 6370000.0D+00 -C ENDIF - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C -C --- NOW ESTABLISHES THE PROPER ELLIPSOID MODEL PARAMETERS - IF(IMODE.EQ.0.OR.IMODE.EQ.2)THEN - IDSTRNG = DATUM(DATTYP(IRNKIN)) - ELIPSI = IDSTRNG(32:52) - INSPH = -1 -c -c --- Special alias for EMG 96 - if(elipsi.eq.'EMG 96 ')INSPH = 8 - IF(ELIPSI.EQ.'Clarke 1866 ')INSPH = 0 - IF(ELIPSI.EQ.'Clarke 1880 ')INSPH = 1 - IF(ELIPSI.EQ.'Bessel 1841 ')INSPH = 2 - IF(ELIPSI.EQ.'International 1967 ')INSPH = 3 - IF(ELIPSI.EQ.'International 1909 ')INSPH = 4 - IF(ELIPSI.EQ.'WGS 72 ')INSPH = 5 - IF(ELIPSI.EQ.'Everest (1830) ')INSPH = 6 - IF(ELIPSI.EQ.'WGS 66 ')INSPH = 7 - IF(ELIPSI.EQ.'GRS 80 ')INSPH = 8 - IF(ELIPSI.EQ.'Airy ')INSPH = 9 - IF(ELIPSI.EQ.'Everest (1956) ')INSPH = 10 - IF(ELIPSI.EQ.'Modified Airy ')INSPH = 11 - IF(ELIPSI.EQ.'WGS 84 ')INSPH = 12 - IF(ELIPSI.EQ.'Modified Fischer 1960')INSPH = 13 - IF(ELIPSI.EQ.'Australian National ')INSPH = 14 - IF(ELIPSI.EQ.'Krassovsky 1940 ')INSPH = 15 - IF(ELIPSI.EQ.'Hough ')INSPH = 16 - IF(ELIPSI.EQ.'Mercury 1960 ')INSPH = 17 - IF(ELIPSI.EQ.'Modified Mercury 1968')INSPH = 18 - IF(ELIPSI.EQ.'Normal Sphere (6371) ')INSPH = 19 - IF(ELIPSI.EQ.'International 1924 ')INSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(INSPH.LT.0.AND.INSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmi -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(INSPH.EQ.19)IBALLI = 1 - IF(INSYS.EQ.11.AND.IBALLI.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmi -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF - IF(IMODE.EQ.0.OR.IMODE.EQ.1)THEN - IDSTRNG = DATUM(DATTYP(IRNKIO)) - ELIPSO = IDSTRNG(32:52) - IOSPH = -1 -c -c --- Special alias for EMG 96 - if(elipso.eq.'EMG 96 ')IOSPH = 8 - IF(ELIPSO.EQ.'Clarke 1866 ')IOSPH = 0 - IF(ELIPSO.EQ.'Clarke 1880 ')IOSPH = 1 - IF(ELIPSO.EQ.'Bessel 1841 ')IOSPH = 2 - IF(ELIPSO.EQ.'International 1967 ')IOSPH = 3 - IF(ELIPSO.EQ.'International 1909 ')IOSPH = 4 - IF(ELIPSO.EQ.'WGS 72 ')IOSPH = 5 - IF(ELIPSO.EQ.'Everest (1830) ')IOSPH = 6 - IF(ELIPSO.EQ.'WGS 66 ')IOSPH = 7 - IF(ELIPSO.EQ.'GRS 80 ')IOSPH = 8 - IF(ELIPSO.EQ.'Airy ')IOSPH = 9 - IF(ELIPSO.EQ.'Everest (1956) ')IOSPH = 10 - IF(ELIPSO.EQ.'Modified Airy ')IOSPH = 11 - IF(ELIPSO.EQ.'WGS 84 ')IOSPH = 12 - IF(ELIPSO.EQ.'Modified Fischer 1960')IOSPH = 13 - IF(ELIPSO.EQ.'Australian National ')IOSPH = 14 - IF(ELIPSO.EQ.'Krassovsky 1940 ')IOSPH = 15 - IF(ELIPSO.EQ.'Hough ')IOSPH = 16 - IF(ELIPSO.EQ.'Mercury 1960 ')IOSPH = 17 - IF(ELIPSO.EQ.'Modified Mercury 1968')IOSPH = 18 - IF(ELIPSO.EQ.'Normal Sphere (6371) ')IOSPH = 19 - IF(ELIPSO.EQ.'International 1924 ')IOSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(IOSPH.LT.0.AND.IOSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmo -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(IOSPH.EQ.19)IBALLO = 1 - IF(IOSYS.EQ.11.AND.IBALLO.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmo -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF -C -C --- STICKS THE ELLIPSOID PARAMETERS INTO ELEMENTS 1,2 OF -C --- TPARIN, TPARIO - IF(INSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIN(1) = DRADIM(IRNKIN) - TPARIN(2) = DEC2(IRNKIN) - ENDIF - IF(IOSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIO(1) = DRADIM(IRNKIO) - TPARIO(2) = DEC2(IRNKIO) - ENDIF -C -C --- SPECIAL SET FOR ELLIPSOID PARAMETERS IN TPARIN AND TPARIO ELEMENTS 14,15 - TPARIN(14) = DRADIM(IRNKIN) - TPARIN(15) = DEC2(IRNKIN) - TPARIO(14) = DRADIM(IRNKIO) - TPARIO(15) = DEC2(IRNKIO) -C -C-------------------------------------------------------------------- -C --- CRDIN = COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C --- INSYS = CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C --- INZONE = CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C --- TPARIN = PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C --- INUNIT = CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I* -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C -C --- INSPH = INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C --- 0 = CLARKE 1866 1 = CLARKE 1880 -C --- 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C --- 4 = INTERNATIONAL 1909 5 = WGS 72 -C --- 6 = EVEREST 7 = WGS 66 -C --- 8 = GRS 1980 9 = AIRY -C --- 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C --- 12 = WGS 84 13 = SOUTHEAST ASIA -C --- 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C --- 16 = HOUGH 17 = MERCURY 1960 -C --- 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C --- 20 = INTERNATIONAL 1924 -C -C --- IPR = PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C --- JPR = PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C --- LEMSG = LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C --- LPARM = LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C --- LN27 = LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C --- FN27 = FILE NAME OF NAD 1927 SPCS PARAMETERS -C --- LN83 = LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C --- FN83 = FILE NAME OF NAD 1983 SPCS PARAMETERS -C --- LENGTH = RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C -C--------------------------------------------------------------------- -C -C --- SETS IN NEW DATUM PARAMETERS AND CHECK FOR BAD MODE FLAG - IF(IMODE.EQ.1)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.2)THEN - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.3)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C********************************************************************** -C -C --- Now converts TLAT1 for EM,PS to LATITUDE OF TRUE SCALE -C --- and takes the Latitude of origin of projection and changes -C --- it to a false northing -C -C********************************************************************** -C -C --- (FROM) INPUT DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(INSYS.EQ.6.OR.INSYS.EQ.5)THEN -C -C --- SET COORDINATE ORIGIN AS THE PS POINT DESIRED - TCRDIN(1) = FLONIN - TCRDIN(2) = FLATIN -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIN(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE ADDED TO THE -C --- PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,INSYS,INZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) -C -C --- ERROR PROCESSING - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF -C -C --- NOW SHIFTS THE INPUT COORDS FROM DOMAIN CENTER TO THE POLE -C --- ASSUMES SINCE ONE IS NOT PUTTING IN OFFSETS THAT THE DATA -C --- COMING IN IS ALREADY OFFSET AND MUST BE SET TO THE POLE - CRDIN(1) = CRDIN(1) + TCRDIO(1) - CRDIN(2) = CRDIN(2) + TCRDIO(2) - ENDIF -C********************************************************************** -C -C --- OUTPUT (TO) DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(IOSYS.EQ.6.OR.IOSYS.EQ.5)THEN -C -C --- SET DOMAIN CENTER AS THE PS POINT DESIRED - TCRDIN(1) = FLONIO - TCRDIN(2) = FLATIO -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIO(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE SUBTRACTED -C --- FROM THE PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,IOSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,IOSYS,IOZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) -C -C --- ERROR PROCESSING - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - ENDIF -C********************************************************************** -C -C --- DOES A COMPLETE CYCLE PROJ/DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,0,TDUM,4,IOSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,0,TDUM,IUNIT4,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES ONLY A DATUM SHIFT - IF(INSYS.EQ.0.AND.IOSYS.EQ.0)THEN - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - UTMOUT = DBLE(INZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - FROM PROJ/DATUM TO LL (GEODETIC) - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.EQ.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE FROM LL (GEODETIC) TO DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.EQ.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 DATUM TRANSFORMATION - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IABS(IOZONE).GT.60)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 2 PROJECTION FROM LAT-LON - CALL GTPZ0(CRDIN,0,INZONE,TPARIN,INUNIT,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (070921) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - PROJ ONLY - NO DATUM CHANGE - IF(IRNKIN.EQ.IRNKIO)THEN -C -C --- GOES TO LL (GEODETIC IF IOSYS = 1) TO GET UTM ZONE FOR OUTPUT - IF(IOSYS.EQ.1)THEN - IF(INSYS.NE.0)THEN - DO KK = 1,NVEC - DWRK(KK) = 0.0D0 - DWRK2(KK) = TPARIN(KK) - ENDDO - CRDIO(1) = 0.0D0 - CRDIO(2) = 0.0D0 - IDUM = INZONE - JDUM = IOZONE - JOUNIT = 4 - JOSYS = 0 - CALL GTPZ0(CRDIN,INSYS,IDUM,DWRK2,INUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,CRDIO,JOSYS,JDUM,DWRK,JOUNIT,LN27, - . LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XLONIO = CRDIO(1) - XLATIO = CRDIO(2) - ELSE - XLONIO = CRDIN(1) - XLATIO = CRDIN(2) - ENDIF -C -C --- DETERMINE IF A VALID OUTPUT ZONE IS GIVEN - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -C --- MAKE SURE WE GET A DECENT ZONE IF WE ENTERED A BOGUS ONE INITIALLY - IF(IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -c PRINT *,'HEY - LATITUDE - UTM OUT: ',XLATIO,IOZONE - ENDIF -C -C --- SPECIAL CASE UTM2UTM WHERE OVERRIDE IS DESIRED - IF(INSYS.EQ.1.AND.IOSYS.EQ.1)THEN - CRDIN(1) = CRDIO(1) - CRDIN(2) = CRDIO(2) - JNUNIT = 4 - JNSYS = 0 - IF(IOVUTM.EQ.0)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE - IF(IOVUTM.EQ.2)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT, - 2 LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE -C -C --- DO NOTHING EXCEPT UNITS CHANGE - XYZIO(1) = XYZIN(1) - XYZIO(2) = XYZIN(2) - RETURN - ENDIF - ENDIF - -C -C --- SPECIAL CASE WHERE INZONE IS PROVIDED BUT IOZONE IS NOT - IF(IABS(INZONE).GT.0.AND.IABS(INZONE).LT.61)THEN - IOZONE = INZONE - ENDIF - UTMOUT = DBLE(IOZONE) - ELSE -C -C --- REGULAR CASES - IF(INSYS.NE.IOSYS)THEN - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (070921) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - ELSE ! CASE FROM ONE PROJECTION SETTING TO ANOTHER -C -C --- STEP 1 PROJECTION TO LAT-LON -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, -c 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,4,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,IUNIT4,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 FEED CHANGE BACK TO PROJECTION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - CRDIN(1) = XLONIN - CRDIN(2) = XLATIN -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,IOZONE,TDUM,4,IOSPH,IPR,JPR, -c 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,IOZONE,TDUM,IUNIT4,IOSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - ENDIF - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XYZIO(3) = XYZIN(3) - UTMOUT = DBLE(IOZONE) - ENDIF - ENDIF -C -C--------------------------------------------------------------------- -C -C --- IOSYS = CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C --- IOZONE = CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C --- TPARIO = PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY) -C --- IOUNIT = CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I -C --- CRDIO = COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY) -C --- IFLG = RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C -C---------------------------------------------------------------------- -C -C --- PUTS THE OUTPUT INFORMATION INTO XYZIO AND SCALES -C --- NOTE THAT TCRDIO ARRAY HAS BEEN FILLED APPROPRIATELY WHEN AN -C --- OFFSET IS COMPUTED FOR PS AND EM - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - XYZIO(1) = (CRDIO(1) - TCRDIO(1))*DBLE(XMULTO) - XYZIO(2) = (CRDIO(2) - TCRDIO(2))*DBLE(XMULTO) - ELSE - XYZIO(1) = CRDIO(1)*DBLE(XMULTO) - XYZIO(2) = CRDIO(2)*DBLE(XMULTO) - ENDIF -C -C --- NOW DOES A 'TO' (OUTPUT) PROJECTION CHECK - JFLG = 1 -C IF(FLONIO.NE.0.0.AND.FLATIO.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIO,FLATIO,JFLG,IRET) -C ELSE -C IF(FLONIN.NE.0.0.AND.FLATIN.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIN,FLATIN,JFLG,IRET) -C ENDIF -C ENDIF -C - 999 CONTINUE -C 999 PRINT *,'FINISHED NORMALLY' - RETURN - END -c -c----------------------------------------------------------------------- -c --- Bring in BLOCK DATA as an include file -c----------------------------------------------------------------------- - include 'blockdat.crd' -c -c---------------------------------------------------------------------- - SUBROUTINE PRJCHK(IO,INSYS,XLON,XLAT,IFLG,IRET) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 021024 PRJCHK -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the mapping -c --- to various projections when the longitude and latitude are set to -c --- some values that are outside the bounds of the various projections. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- insys = projection type -c --- xlon = double precision longitude -c --- xlat = double precision latitude -c --- iflg = error print flag -c -c --- Program outputs are: -c -c --- iret = error number -c -c---------------------------------------------------------------------- -c - Real*8 xlon, xlat -c - Real*4 xlono,xlato -c - Integer*4 iflg,io,iret,ichk -c - ichk = 0 - xlato = sngl(xlat) - xlono = sngl(xlon) -c -c --- Test for polar stereographic mapping - if(insys.eq.6.and.abs(xlato).le.45.0)iret = iret + 100 -c -c --- Test for mercator mapping - if(insys.eq.5.and.abs(xlato).ge.45.0)iret = iret + 200 -c -c --- Test for utm mapping - if(insys.eq.1.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret - 1 + 300 -c -c --- Test for transverse mercator mapping - if(insys.eq.9.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret+ - 1 400 -c -c --- Print out - IF(ICHK.GT.0)THEN -c PRINT *,' WARNING INAPPROPIATE LATITUDE ' - WRITE(IO,'(A29)')'WARNING INAPPROPIATE LATITUDE' - ENDIF - Return - End -c---------------------------------------------------------------------- - SUBROUTINE ERRPRT(IFLG,IO,IAPP) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020623 ERRPRT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the USGS GCTP -c --- software. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- iflg = error flag -c --- iapp = application number -c---------------------------------------------------------------------- -C -C --- PRINT ERROR MESSAGES - IF(IFLG.NE.0)THEN -c PRINT *,' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - WRITE(IO,'(A35,I5)')' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - IF(IFLG.EQ.1)THEN -c PRINT *,' ILLEGAL INPUT SYSTEM CODE.' - WRITE(IO,'(A25)')'ILLEGAL INPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.2)THEN -c PRINT *,' ILLEGAL OUTPUT SYSTEM CODE.' - WRITE(IO,'(A26)')'ILLEGAL OUTPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.3)THEN -c PRINT *,' ILLEGAL INPUT UNIT CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.4)THEN -c PRINT *,' ILLEGAL OUTPUT UNIT CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.5)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR INPUT.' - WRITE(IO,'(A40)')'INCONSISTENT UNIT/SYSTEM CODES FOR INPUT' - ENDIF - IF(IFLG.EQ.6)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT.' - WRITE(IO,'(A41)')'INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT' - ENDIF - IF(IFLG.EQ.7)THEN -c PRINT *,' ILLEGAL INPUT ZONE CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT ZONE CODE' - ENDIF - IF(IFLG.EQ.8)THEN -c PRINT *,' ILLEGAL OUTPUT ZONE CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT ZONE CODE' - ENDIF - IF(IFLG.GT.8)THEN -c PRINT *,' REALLY BAD UNDETERMINED ERROR! ' - WRITE(IO,'(A30)')'REALLY BAD UNDETERMINED ERROR!' - STOP - ENDIF -c PRINT *,' WILL TRY NEXT COORDINATE SET: ' - ENDIF - RETURN - END -c---------------------------------------------------------------------- - Subroutine ll2zon(dxlon,dxlat,izone,iret) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020710 LL2ZON -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in to UTM zone for use -c --- in estimating the UTM zone of any given latitude and longitude. -c -c --- Program inputs are: -c -c --- dxlon = longitude in decimal degrees (DP) -c --- dxlat = latitude in decimal degrees (DP) -c -c --- Program outputs are: -c -c --- izone = utm zone in the range -60 < -1 and 1 < 60 -c --- iret = a return code = 100 if the longitude is funky -c -c---------------------------------------------------------------------- -c - Real*8 dxlon,dxlat -c - iret = 0 - if(dabs(dxlon).gt.180.0D0)then - iret = 100 -c Print *,'magnitude of longitude is > 180 degrees!!!!' - Return - Endif -c -c --- NH E Quad - If(dxlon.ge.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 30 + izone - endif -c -c --- NH W Quad - If(dxlon.le.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 31 - izone - endif -c -c --- SH E Quad - If(dxlon.ge.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(30 + izone) - endif -c -c --- SH W Quad - If(dxlon.le.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(31 - izone) - endif - if(izone.gt.60)izone = 60 - if(izone.lt.-60)izone = -60 - Return - End -c---------------------------------------------------------------------- - Subroutine dd2dms(dd,dms) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020624 DD2DMS -c -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- PROGRAM NOTES FOLLOW: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- Convert decimal degrees to packed degrees,mintues,econds format -c -c --- dd.ddddd to dddmmmsss.ss -c -c --- Program Inputs -c -c --- dd = decimal degrees (dp) -c -c --- Program Outputs -c -c --- dms = packed degrees minutes seconds format (dp) -c -c---------------------------------------------------------------------- -c - real*8 dd,dms - real*4 sdd -c - sdd = sngl(dd) - ideg = int(sdd) - xminit = (sdd - ideg)*60.0 - iminit = int(xminit) - xsec = (xminit - iminit)*60.0 - dms = 1000000.D0*ideg + 1000.D0*iminit + 1.0D0*xsec - return - end - -c---------------------------------------------------------------------- - Subroutine dat2dat(lpr,ipr,xlonin,xlatin,zlevin,irnkin, - 1 irnkio,xlonio,xlatio,zlevio) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 030905 DAT2DAT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c --- Added a 9999 datum designamtion to do a manual datum trasformation -c --- using user input information in the common block XDATM (version 1.1 -c --- 062002) -c -c --- Version 1.2 (071102) -c -c --- Changed calls to DATSHFT by adding IFLG so that a proper paired -c --- set of FROM-TO transformations could be made. -c -c --- Added the NIMA.CRD include. Use the new strings and pointers for -c --- handling the NIMA dataset. -c -c --- Version 1.3 102802 -c -c --- Corrected the ao,fo - ai,fi used (switched order) on from ref to -c --- output datum -c -c --- Version 1.4 030703 -c -c --- Blocked datum conversion to/from WGS84 lat-lon for sphere datums -c -c --- Version 1.9 Level: 030905 -c -c --- Add iflg values 2 and 3 to datshft calls to go to and from WGS-72 -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in one datum to the -c --- longitude,latitude in another. The program also does a shift in -c --- elevation due to a change in the geoid. -c -c --- Program inputs are: -c -c --- lpr = FORTRAN logical unit for output -c --- ipr = print flag => 0 to avoid printing -c --- xlonin = input longitude in decimal degrees (dp) -c --- xlatin = input latitude in decimal degrees (dp) -c --- zlevin = elevation of the input point of interest in meters -c --- irnkin = input datum pointer -c --- irnkio = output datum pointer -c -c --- Program outputs are: -c -c --- xlonio = output longitude in decimal degrees (dp) -c --- xlatio = output latitude in decimal degrees (dp) -c --- zlevio = revised elevation output of the input point in meters -c -c --- subroutine calls: -c -c --- DATSHFT -c -c---------------------------------------------------------------------- -c - Real*8 ai, ao, fi, fo, dx, dy, dz, xlonin, xlatin, zhti, - 1 xlonio, xlatio, zhto - Real*8 xlato,xlono,drad,dflt -c - Integer*4 iposi,iposo -c - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -c -c --- NIMA data base include - Include 'nima.crd' -c -c --- reference definition - the convention will be it is always 1! - iref = 1 -c -c --- asigns the positions - if(irnkin.ne.9999)then - iposi = irnkin - else - iposi = 0 - endif - if(irnkio.ne.9999)then - iposo = irnkio - else - iposo = 0 - endif -c -c --- Print out information - if(ipr.ne.1.and.iposi.ne.0)then - Write(lpr,'(a12,a8,1x,a50,1x,a60)')'From datum: ', - 1 datcod(iposi),datum(dattyp(iposi)),geodat1(iposi) - endif - if(ipr.ne.1.and.iposo.ne.0)then - Write(lpr,'(a10,a8,1x,a50,1x,a60)')'To datum: ', - 1 datcod(iposo),datum(dattyp(iposo)),geodat1(iposo) - endif -c -c --- datum to reference shift (i= input o = output) - if(iposi.ne.0)then - ai = dradim(iposi) - fi = 1.0/dflat(iposi) - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxmod(iposi)) - dy = dble(dymod(iposi)) - dz = dble(dzmod(iposi)) - zhti = dble(zlevin) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - zhti = dble(zlevin) - endif -c --- Transform to WGS84 only if input datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposi).eq.'WGS-72 ')then - iiflag = 2 - else - iiflag = 0 - endif - Call datshft(xlonin,xlatin,zhti,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlono,xlato,zhto) - else - xlono=xlonin - xlato=xlatin - zhto=zhti - endif -c -c --- reference to datum shift (i = input o = output) note same diffierence -c --- but a negative sign is used - this insures we get back to where -c --- we started!!!! - if(iposo.ne.0)then - ao = dradim(iref) - fo = 1.0/dflat(iref) - ai = dradim(iposo) - fi = 1.0/dflat(iposo) - dx = dble(dxmod(iposo)) - dy = dble(dymod(iposo)) - dz = dble(dzmod(iposo)) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - endif -c --- Transform from WGS84 only if output datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposo).eq.'WGS-72 ')then - iiflag = 3 - else - iiflag = 1 - endif - Call datshft(xlono,xlato,zhto,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlonio,xlatio,zhti) - else - xlonio=xlono - xlatio=xlato - zhti=zhto - endif - zlevio = sngl(zhti) -c - Return - End -c--------------------------------------------------------------------- - subroutine datshft(xloni,xlati,zhti,ai,fi,fo,ao,dx,dy,dz,iflg, - 1 xlono,xlato,zhto) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 030905 DATSHFT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Standard Modolensky Datum Transformation -c -c -c---------------------------------------------------------------------- -c -c --- Program notes -c --- Added the IFLG argument for proper FROM - TO conversions -c -c -c --- Version 1.1 -c --- Modified code constants to insure everything is DP -c --- Modified calculation of the reverse transformation. The reverse -c --- is done by subtracting the geodetics rather than inputing negative -c --- delta X,Y,Z. -c -c --- Version 1.9 Level: 030905 -c -c --- Add equations and special option to go to and from WGS-72 -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts the lat/lon/height of one datum to another -c --- assuming an earth center shift of dx,dy,dz (geoid specific) and the -c --- ellipsoid major axis and flattening of each datum. -c -c --- Input arguments - double precision -c -c --- xlati = input latitude in decimal dgrees -c --- xloni = input longitude in decimal degrees -c --- zhti = input elevation in meters -c --- ai = input major radius in meters -c --- fi = input flattening factor -c --- fo = output flattening factor -c --- ao = output major radius -c --- dx = datum to reference earth center shift in meters -c --- dy = datum to reference earth center shift in meters -c --- dz = datum to reference earth center shift in meters -c --- iflg = 0 FROM datum A TO WGS84 = 1 TO datum B FROM WGS84 -c --- iflg = 2 FROM datum A to WGS72 = 3 TO datum B FROM WGS72 -c -c --- Output arguments - double precision -c -c --- xlato = output longitude in decimal degrees -c --- xlono = output longitude in decimal degrees -c --- zhto = output elevation in meters -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - real*8 xlati,xloni,zhti,ai,fi,fo,ao,dx,dy,dz,xlato,xlono,zhto - real*8 deg2rad,rad2deg,da,df,sithet,siphi,cithet,ciphi,siphi2 - real*8 rn,rm,dlat,dlon,dh,one,two,dlat72,dh72 - real*8 es,bda,c1,c2,c3,c4,d1,d2,e1,e2,e3,e4,e5 -c -c --- compute some double precision constants - deg2rad = 0.01745329252D0 - rad2deg = 57.295779513D0 - one = 1.0D0 - two = 2.0D0 -c -c --- compute delta radius/flattening - double precision - da = ao - ai - df = fo - fi - es = two*fi - fi*fi ! eccentricity squared - bda = one - fi !pole/equator radius ratio -c -c --- compute sin,cos of theta and phi - double precision - siphi = dsin(xlati*deg2rad) - siphi2 = dsin(xlati*2.0*deg2rad) - ciphi = dcos(xlati*deg2rad) - sithet = dsin(xloni*deg2rad) - cithet = dcos(xloni*deg2rad) -c -c --- radius of curvature - prime vertical - rn = ai/dsqrt(one - es*siphi**2) -c -c --- radius of curvature - prime meridian - rm = ai*(one - es)/(one - es*siphi**2)**1.5 -c -c --- shift in latitude - c1 = -dx*siphi*cithet - dy*siphi*sithet + dz*ciphi - c2 = da*(rn*es*siphi*ciphi)/ai - c3 = df*(rm/bda + rn*bda)*siphi*ciphi - c4 = rm + zhti - dlat = (c1 + c2 + c3)/c4 - dlat72 = 4.5D0*ciphi/(ai*sin(1.0*deg2rad/3600.0)) + - 1 df*siphi2/(sin(1.0*deg2rad/3600.0)) -c -c --- shift in longitude - d1 = -dx*sithet + dy*cithet - d2 = (rn + zhti)*ciphi - dlon = d1/d2 -c -c --- shift in height - e1 = dx*ciphi*cithet - e2 = dy*ciphi*sithet - e3 = dz*siphi - e4 = da*ai/rn - e5 = df*bda*rn*siphi*siphi - dh = e1 + e2 + e3 - e4 + e5 - dh72 = 4.5D0*siphi + ai*df*siphi*siphi - da + 1.4D0 -c -c --- estimate the output arguments - if(iflg.eq.0)then - xlato = xlati + dlat*rad2deg - xlono = xloni + dlon*rad2deg - zhto = zhti + dh - endif - if(iflg.eq.1)then - xlato = xlati - dlat*rad2deg - xlono = xloni - dlon*rad2deg - zhto = zhti - dh - endif -c -c --- Special WGS-72 change 030905 - if(iflg.eq.2)then - xlato = xlati + dlat72/3600.0D0 - xlono = xloni + 0.554D0/3600.0D0 - zhto = zhti + dh72 - endif - if(iflg.eq.3)then - xlato = xlati - dlat72/3600.0D0 - xlono = xloni - 0.554D0/3600.0D0 - zhto = zhti - dh72 - endif -c - return - end -c---------------------------------------------------------------------- - Subroutine init(datloc,datnam,datid,datreg1,datreg2,datreg3, - 1 max,maxd) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 021016 INIT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Initializes the NIMA data label arrays -c -c---------------------------------------------------------------------- -c -c --- Program notes -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program does some string housekeeping and outputs the strings -c --- for use by a GUI or some other management routines. It starts -c --- with the NIMA common blocks that are input via the NIMA.CRD include -c --- block. -c -c --- Input arguments: -c -c --- MAX = maximum number of datums in the data base -c -c --- Output arguments - double precision -c -c --- DATID = 8 character ID code array for each datum -c --- DATLOC = 20 character Atlas location string array -c --- DATNAM = 50 character Datum name string array -c --- DATREG1 = 60 character Region descriptor string array - line 1 -c --- DATREG2 = 60 character Region descriptor string array - line 2 -c --- DATREG3 = 60 character Region descriptor string array - line 3 -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - CHARACTER*8 DATID(MAX) - CHARACTER*20 DATLOC(MAX) - CHARACTER*50 ISTRNG, DATNAM(MAX) - CHARACTER*60 DATREG1(MAX), DATREG2(MAX), DATREG3(MAX) -c -c --- Calls the include - Include 'nima.crd' -c -c --- First maps the DATLOC and DATNAM arrays - maxd = kmax - Do i = 1,kmax - DATLOC(i) = Atlas(dattyp(i)) - DATNAM(i) = Datum(dattyp(i)) - DATID(i) = Datcod(i) - DATREG1(i) = Geodat1(i) - DATREG2(i) = Geodat2(i) - DATREG3(i) = Geodat3(i) - Enddo -c -c --- Now compresses the Datum name string - Do k = 1,kmax - istrng = datnam(k) - Do j = 1,29 - jj = 29 - j + 1 - if(istrng(jj:jj).ne.' ')then - jbeg = jj + 2 - go to 444 - endif - Enddo -444 continue - jend = jbeg + 20 - if(jend.gt.50)jend = 50 - istrng(jbeg:jend) = istrng(30:50) - if(jend.lt.50)then - Do j = jend+1,50 - istrng(j:j) = ' ' - Enddo - endif - datnam(k) = istrng - Enddo - Return - End -C----------------------------------------------------------------------- -C GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE - VERSION 2.0.2 -C FORTRAN 77 LANGUAGE FOR IBM, AMDAHL, ENCORE, VAX, CONCURRENT, AND -C DATA GENERAL COMPUTERS -C ADJLZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ADJLZ0 (LONIN) - -c --- V1.98 (060911) -c --- Change argument name and reassign (sub is called with a computed -c --- argument that should not be changed within subroutine) - -C -C FUNCTION TO ADJUST LONGITUDE ANGLE TO MODULO 180 DEGREES. -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,PI /2.0D0,3.14159265358979323846D0/ - -c --- V1.98 (060911) - LON=LONIN -C - 020 ADJLZ0 = LON - IF (DABS(LON) .LE. PI) RETURN - TWOPI = TWO * PI - LON = LON - DSIGN (TWOPI,LON) - GO TO 020 -C - END -C ASINZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ASINZ0 (CON) -C -C THIS FUNCTION ADJUSTS FOR ROUND-OFF ERRORS IN COMPUTING ARCSINE -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - IF (DABS(CON) .GT. ONE) THEN - CON = DSIGN (ONE,CON) - ENDIF - ASINZ0 = DASIN (CON) - RETURN -C - END -C DMSPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION DMSPZ0 (SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT UNPACKED DMS TO PACKED DMS ANGLE -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,NEG - DATA CON1,CON2 /1000000.0D0,1000.0D0/ - DATA NEG /'-'/ -C - CON = DBLE (DEGS) * CON1 + DBLE (MINS) * CON2 + DBLE (SECS) - IF (SGNA .EQ. NEG) CON = - CON - DMSPZ0 = CON - RETURN -C - END -C E0FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E0FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E0). -C - IMPLICIT REAL*8 (A-Z) - DATA QUART,ONE,ONEQ,THREE,SIXT /0.25D0,1.0D0,1.25D0,3.0D0,16.0D0/ -C - E0FNZ0 = ONE - QUART * ECCNTS * (ONE + ECCNTS / SIXT * - . (THREE + ONEQ * ECCNTS)) -C - RETURN - END -C E1FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E1FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E1). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2,CON3 /0.375D0,0.25D0,0.46875D0/ - DATA ONE /1.0D0/ -C - E1FNZ0 = CON1 * ECCNTS * (ONE + CON2 * ECCNTS * - . (ONE + CON3 * ECCNTS)) -C - RETURN - END -C E2FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E2FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E2). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2 /0.05859375D0,0.75D0/ - DATA ONE /1.0D0/ -C - E2FNZ0 = CON1 * ECCNTS * ECCNTS * (ONE + CON2 * ECCNTS) -C - RETURN - END -C E3FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E3FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E3). -C - IMPLICIT REAL*8 (A-Z) -C - E3FNZ0 = ECCNTS*ECCNTS*ECCNTS*(35.D0/3072.D0) -C - RETURN - END -C E4FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E4FNZ0 (ECCENT) -C -C FUNCTION TO COMPUTE CONSTANT (E4). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ONE + ECCENT - COM = ONE - ECCENT - E4FNZ0 = DSQRT ((CON ** CON) * (COM ** COM)) -C - RETURN - END -C GTPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) -C -C ********************************************************************** -C -C INPUT **************************************************************** -C CRDIN : COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C INSYS : CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C INZONE : CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C TPARIN : PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C INUNIT : CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I*4) -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C INSPH : INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C IPR : PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C JPR : PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C LEMSG : LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C LPARM : LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C LN27 : LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C FN27 : FILE NAME OF NAD 1927 SPCS PARAMETERS -C LN83 : LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C FN83 : FILE NAME OF NAD 1983 SPCS PARAMETERS -C LENGTH : RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C OUTPUT *** ***** -C IOSYS : CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C IOZONE : CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C TPARIO : PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C IOUNIT : CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I*4) -C CRDIO : COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY). -C IFLG : RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C OTHERWISE , ERROR CODE FROM PROJECTION COMPUTATIONAL MODULE. -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 NAD27(134), NAD83(134), NADUT(54), SPTYPE(134) - INTEGER*4 SYSUNT(24), SWITCH(23), ITER - -c --- V1.98 (060911) - INTEGER*4 INSPHZERO - - INTEGER*2 INMOD, IOMOD, FWD, INV - CHARACTER*128 FN27, FN83, FILE27, FILE83 - DIMENSION CRDIN(2),CRDIO(2),TPARIN(15),TPARIO(15),COORD(2) - DIMENSION DUMMY(15), PDIN(15), PDIO(15) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /PROJZ0/ IPROJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /TOGGLE/ SWITCH -C - PARAMETER (MAXUNT=6, MAXSYS=23) - PARAMETER (FWD=0, INV=1) - DATA SYSUNT / 0 , 23*2 / - DATA PDIN/15*0.0D0/, PDIO/15*0.0D0/ - DATA INSP/999/, INPJ/999/, INZN/99999/ - DATA IOSP/999/, IOPJ/999/, IOZN/99999/ - DATA ITER /0/ - DATA JFLAG/0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C -C TABLE OF UNIT CODES AS SPECIFIED BY STATE LAWS AS OF 2/1/92 -C FOR NAD 1983 SPCS - 1 = U.S. SURVEY FEET, 2 = METERS, -C 5 = INTERNATIONAL FEET -C -C NADUT - UNIT CODES FOR THE STATES ARRANGED IN STATE NUMBER ORDER -C (FIRST TWO DIGITS OF ZONE NUMBER) -C - DATA NADUT /1, 5, 1, 1, 5, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 2, - . 1, 1, 5, 2, 1, 2, 5, 1, 2, 2, 2, 1, 1, 1, 5, 2, 1, 5, - . 2, 2, 5, 2, 1, 1, 5, 2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 2/ -C -C TABLE OF STATE PLANE ZONE TYPES: 4 = LAMBERT, 7 = POLYCONIC, -C 9 = TRANSVERSE MERCATOR, AND 20 = OBLIQUE MERCATOR -C - DATA SPTYPE / 9, 9, 4, 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - . 9, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 9, 4, 4, - . 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 9, 9, 9, 9, 9, 4, 4, - . 4, 4, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, - . 9, 9, 9,20, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 7/ -C -C SETUP -C - IOSPH = INSPH - IPEMSG = IPR - IPPARM = JPR - IPELUN = LEMSG - IPPLUN = LPARM - IPROJ = INSYS - LU27 = LN27 - FILE27 = FN27 - LU83 = LN83 - FILE83 = FN83 - LEN = LENGTH -C -C INITIALIZE SWITCH FOR EACH PROJECTION TO ZERO -C - ITER = ITER + 1 - IF (ITER .LE. 1) THEN - DO 5 I=1,15 - DUMMY(I) = 0.0D0 - 5 CONTINUE - MSYS = 2 - END IF - INSPCS = 2 - IOSPCS = 2 - IF (JFLAG.NE.0) GO TO 10 - EZ = 0.0D0 - ESZ = 0.0D0 - -c --- V1.98 (060911) -c CALL SPHDZ0(0,DUMMY) -c --- Set sphere as a variable instead of a constant - insphzero=0 - CALL SPHDZ0(insphzero,DUMMY) -C -C --- SPECIAL TREATMENT FOR STARTUP - IF(TPARIO(14).NE.0D0.AND.TPARIO(15).NE.0D0)THEN - DUMMY(1) = TPARIO(14) - DUMMY(2) = TPARIO(15) - ENDIF - JFLAG = 1 -C -C CHECK VALIDITY OF CODES FOR REFERENCE SYSTEMS. -C - 10 IF (INSYS.LT.0 .OR. INSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INSYS - 2000 FORMAT (' ILLEGAL SOURCE REFERENCE SYSTEM CODE = ',I6) - IFLG = 1 - RETURN - END IF -C - IF (IOSYS.LT.0 .OR. IOSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOSYS - 2010 FORMAT (' ILLEGAL TARGET REFERENCE SYSTEM CODE = ',I6) - IFLG = 2 - RETURN - END IF -C -C FORCE INITIALIZATION OF PROJECTIONS IF SPHEROID OR PROJECTION -C HAS CHANGED FROM PREVIOUS INPUT - OUTPUT SET -C -C -C---------------------------------------------------------------------- -C -C --- THIS SECTION IS TO BE PLACED IN ALL VERSIONS OF USGS CODE TO FORCE -C --- REINITIALIZATION EACH TIME. -C -C---------------------------------------------------------------------- - DO I = 1,MAXSYS - SWITCH(I) = 0 - ENDDO -C---------------------------------------------------------------------- -C - IF (INSPH .NE. INSP) THEN - DO 11 I = 1,MAXSYS - SWITCH(I) = 0 - 11 CONTINUE - END IF -C - IF (INSYS .GT. 0) THEN - IF (INSYS .NE. INPJ .AND. INSYS .NE. IOPJ) SWITCH(INSYS) = 0 - IF (SWITCH(INSYS) .NE. INZONE .AND. SWITCH(INSYS) .NE. IOZONE) - . SWITCH(INSYS) = 0 - END IF -C - IF (IOSYS .GT. 0) THEN - IF (IOSYS .NE. INPJ .AND. IOSYS .NE. IOPJ) SWITCH(IOSYS) = 0 - IF (SWITCH(IOSYS) .NE. INZONE .AND. SWITCH(IOSYS) .NE. IOZONE) - . SWITCH(IOSYS) = 0 - END IF -C -C CHECK FOR REPEAT OF INPUT SYSTEM -C - INMOD = 1 - IF (INSYS .EQ. 2) THEN - IF (INZONE .GT. 0) THEN - ID = 0 - IF (INSPH .EQ. 0) THEN - DO 12 I = 1,134 - IF (INZONE .EQ. NAD27(I)) ID = I - 12 CONTINUE - END IF - IF (INSPH .EQ. 8) THEN - DO 13 I = 1,134 - IF (INZONE .EQ. NAD83(I)) ID = I - 13 CONTINUE - END IF - IF (ID .NE. 0) INSPCS = SPTYPE(ID) - IF (INZONE .NE. SWITCH(INSPCS)) GO TO 15 - END IF - END IF - IF (INSP .NE. INSPH) GO TO 15 - IF (INPJ .NE. INSYS) GO TO 15 - IF (INZN .NE. INZONE) GO TO 15 - IF (INSYS .GE. 3) THEN - DO 14 I=1,15 - IF (TPARIN(I) .NE. PDIN(I)) GO TO 15 - 14 CONTINUE - END IF - INMOD = 0 - GO TO 30 -C -C SAVE INPUT SYSTEM PARAMETERS -C - 15 INSP = INSPH - INPJ = INSYS - INZN = INZONE - DO 16 I=1,15 - 16 PDIN(I) = TPARIN(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (INUNIT.LT.0 .OR. INUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2020) INUNIT - 2020 FORMAT (' ILLEGAL SOURCE UNIT CODE = ',I6) - IFLG = 3 - RETURN - END IF -C -C CHECK FOR REPEAT OF OUTPUT SYSTEM -C - 30 IOMOD = 1 - IF (IOSYS .EQ. 2) THEN - IF (IOZONE .GT. 0) THEN - ID = 0 - IF (IOSPH .EQ. 0) THEN - DO 32 I = 1,134 - IF (IOZONE .EQ. NAD27(I)) ID = I - 32 CONTINUE - END IF - IF (IOSPH .EQ. 8) THEN - DO 33 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) ID = I - 33 CONTINUE - END IF - IF (ID .NE. 0) IOSPCS = SPTYPE(ID) - IF (IOZONE .NE. SWITCH(INSPCS)) GO TO 35 - END IF - END IF - IF (IOSP .NE. INSPH) GO TO 35 - IF (IOSP .NE. IOSPH) GO TO 35 - IF (IOPJ .NE. IOSYS) GO TO 35 - IF (IOZN .NE. IOZONE) GO TO 35 - IF (IOSYS .GE. 3) THEN - DO 34 I=1,15 - IF (TPARIO(I) .NE. PDIO(I)) GO TO 35 - 34 CONTINUE - END IF - IOMOD = 0 - GO TO 80 -C -C SAVE OUTPUT SYSTEM PARAMETERS -C - 35 IOSP = INSPH - IOPJ = IOSYS - IOZN = IOZONE - DO 36 I=1,15 - 36 PDIO(I) = TPARIO(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (IOUNIT.LT.0 .OR. IOUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2030) IOUNIT - 2030 FORMAT (' ILLEGAL TARGET UNIT CODE = ',I6) - IFLG = 4 - RETURN - END IF -C - 80 IUNIT = SYSUNT(INSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) INUNIT=1 - IF (INSPH .EQ. 8 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) THEN - IND = 0 - DO 90 I = 1,134 - IF (INZONE .EQ. NAD83(I)) IND = I - 90 CONTINUE - IF (IND .NE. 0) INUNIT = NADUT( INT(INZONE/100)) - END IF - CALL UNTFZ0 (INUNIT,IUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 100 - IFLG = 5 - RETURN - 100 COORD(1) = FACTOR * CRDIN(1) - COORD(2) = FACTOR * CRDIN(2) - IUNIT = SYSUNT(IOSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) IOUNIT=1 - IF (INSPH .EQ. 8 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) THEN - IND = 0 - DO 110 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) IND = I - 110 CONTINUE - IF (IND .NE. 0) IOUNIT = NADUT( INT(IOZONE/100)) - END IF - CALL UNTFZ0 (IUNIT,IOUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 120 - IFLG = 6 - RETURN - 120 IF (INSYS.NE.IOSYS.OR.INZONE.NE.IOZONE.OR.INZONE.LE.0) GO TO 140 - CRDIO(1) = FACTOR * COORD(1) - CRDIO(2) = FACTOR * COORD(2) - RETURN -C -C COMPUTE TRANSFORMED COORDINATES AND ADJUST THEIR UNITS. -C - 140 IF (INSYS .EQ. 0) GO TO 520 - IF (INZONE.GT.60 .OR. INSYS.EQ.1) GO TO 200 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2040) INZONE - 2040 FORMAT (' ILLEGAL SOURCE ZONE NUMBER = ',I6) - IFLG = 7 - RETURN -C -C INVERSE TRANSFORMATION. -C - 200 IPROJ=INSYS - ISPHER = INSPH - IF (INSYS.GE.3) CALL SPHDZ0(INSPH,TPARIN) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE INPUT PROJECTION -C - IF (INSYS .EQ. 1 .AND. INZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - INMOD = 1 - END IF - IF (INSYS .EQ. 2 .AND. INZONE .NE. SWITCH(INSPCS)) THEN - SWITCH(2) = 0 - INMOD = 1 - END IF - IF (INZONE .NE. SWITCH(INSYS)) THEN - SWITCH(INSYS) = 0 - INMOD = 1 - END IF -C - IF (INSYS .EQ. 1) THEN - IF (INZONE.EQ.0.AND.TPARIN(1).NE.0.0D0) GO TO 211 - TPARIN(1) = 1.0D6*DBLE(6*INZONE-183) - TPARIN(2) = DSIGN(4.0D7,DBLE(INZONE)) - 211 CALL SPHDZ0(INSPH,DUMMY) - TPARIN(14) = DUMMY(1) - TPARIN(15) = DUMMY(2) - IF (INMOD .NE. 0) THEN - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - CALL PJ01Z0 (COORD,CRDIO,INV) - END IF -C - IF (INSYS .GT. 1) THEN - IF (INMOD .NE. 0) THEN - MSYS = INSPCS - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - IF (INSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,INV) - END IF -C - 500 IFLG = IERROR - DO 510 I = 1,15 - 510 TPARIN(I) = PDIN(I) - IF (IFLG .NE. 0) RETURN - CRDIO(1) = ADJLZ0(CRDIO(1)) - IF (IOSYS .EQ. 0) GO TO 920 - COORD(1) = CRDIO(1) - COORD(2) = CRDIO(2) - 520 IF (INSYS .EQ. 0 .AND. IOSYS .EQ. 0) THEN - CRDIO(1) = COORD(1) - CRDIO(2) = COORD(2) - GO TO 920 - END IF - IF (IOZONE.GT.60 .OR. IOSYS.EQ.1) GO TO 540 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2050) IOSYS - 2050 FORMAT (' ILLEGAL TARGET ZONE NUMBER = ',I6) - IFLG = 8 - RETURN -C -C FORWARD TRANSFORMATION. -C - 540 IPROJ=IOSYS - ISPHER = INSPH - IF (IOSYS.GE.3) CALL SPHDZ0(INSPH,TPARIO) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE OUTPUT PROJECTION -C - IF (IOSYS .EQ. 1 .AND. IOZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - IOMOD = 1 - END IF - IF (IOSYS .EQ. 2 .AND. IOZONE .NE. SWITCH(IOSPCS)) THEN - SWITCH(2) = 0 - IOMOD = 1 - END IF - IF (IOZONE .NE. SWITCH(IOSYS)) THEN - SWITCH(IOSYS) = 0 - IOMOD = 1 - END IF -C - IF (IOSYS .EQ. 1) THEN - TPARIO(1) = COORD(1) - TPARIO(2) = COORD(2) - CALL SPHDZ0(INSPH,DUMMY) - TPARIO(14) = DUMMY(1) - TPARIO(15) = DUMMY(2) - IF (IOMOD .NE. 0) THEN - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - CALL PJ01Z0 (COORD,CRDIO,FWD) - END IF -C - IF (IOSYS .GT. 1) THEN - IF (IOMOD .NE. 0) THEN - MSYS = IOSPCS - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - IF (IOSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,FWD) - END IF -C - 900 IFLG = IERROR - DO 910 I = 1,15 - 910 TPARIO(I) = PDIO(I) - 920 CRDIO(1) = FACTOR * CRDIO(1) - CRDIO(2) = FACTOR * CRDIO(2) - RETURN -C - END -C MLFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MLFNZ0 (E0,E1,E2,E3,PHI) -C -C FUNCTION TO COMPUTE CONSTANT (M). -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ -C - MLFNZ0 = E0 * PHI - E1 * DSIN (TWO * PHI) + E2 * DSIN (FOUR * PHI) - * - E3 * DSIN (SIX * PHI) -C - RETURN - END -C MSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL M). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ECCENT * SINPHI - MSFNZ0 = COSPHI / DSQRT (ONE - CON * CON) -C - RETURN - END -C PAKCZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKCZ0 (PAK) -C -C SUBROUTINE TO CONVERT 2 DIGIT PACKED DMS TO 3 DIGIT PACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,10000.0D0,100.0D0/ - DATA CON3,CON4 /1000000.0D0,1000.0D0/ - DATA TOL /1.0D-3/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = DMOD (CON , CON2) -C - CON = DBLE (DEGS) * CON3 + DBLE (MINS) * CON4 + SECS - IF (SGNA .EQ. NEG) CON = - CON - PAKCZ0 = CON - RETURN -C - END -C PAKDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PAKDZ0 (PAK,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT PACKED DMS TO UNPACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,1000000.0D0,1000.0D0/ - DATA TOL /1.0D-4/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = SNGL ( DMOD (CON , CON2)) - RETURN -C - END -C PAKRZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKRZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO RADIANS. -C - IMPLICIT REAL*8 (A-H,O-Z) - DATA SECRAD /0.4848136811095359D-5/ -C -C CONVERT ANGLE TO SECONDS OF ARC -C - SEC = PAKSZ0 (ANG) -C -C CONVERT ANGLE TO RADIANS. -C - PAKRZ0 = SEC * SECRAD -C - RETURN - END -C PAKSZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKSZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO SECONDS OF ARC. -C - IMPLICIT REAL*8 (A-H,M-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - DIMENSION CODE(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA CODE /1000000.0D0,1000.0D0/ - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA C1,C2 /3600.0D0,60.0D0/ - DATA TOL /1.0D-4/ -C -C SEPARATE DEGREE FIELD. -C - FACTOR = ONE - IF (ANG .LT. ZERO) FACTOR = - ONE - SEC = DABS(ANG) - TMP = CODE(1) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 360) GO TO 020 - DEG = DBLE (I) -C -C SEPARATE MINUTES FIELD. -C - SEC = SEC - DEG * TMP - TMP = CODE(2) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 60) GO TO 020 - MIN = DBLE (I) -C -C SEPARATE SECONDS FIELD. -C - SEC = SEC - MIN * TMP - IF (SEC .GT. C2) GO TO 020 - SEC = FACTOR * (DEG * C1 + MIN * C2 + SEC) - GO TO 040 -C -C ERROR DETECTED IN DMS FORM. -C - 020 WRITE (IPELUN,2000) ANG - 2000 FORMAT ('0ERROR PAKSZ0'/ - . ' ILLEGAL DMS FIELD =',F15.3) - STOP 16 -C - 040 PAKSZ0 = SEC -C - RETURN - END -C PHI1Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI1Z0 (ECCENT,QS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-1). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE /0.5D0,1.0D0/ - DATA EPSLN,TOL,NIT /1.0D-7,1.0D-10,15/ -C - PHI1Z0 = ASINZ0 (HALF * QS) - IF (ECCENT .LT. EPSLN) RETURN -C - ECCNTS = ECCENT * ECCENT - PHI = PHI1Z0 - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - COSPI = DCOS (PHI) - CON = ECCENT * SINPI - COM = ONE - CON * CON - DPHI = HALF * COM * COM / COSPI * (QS / (ONE - ECCNTS) - - . SINPI / COM + HALF / ECCENT * DLOG ((ONE - CON) / - . (ONE + CON))) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI1Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,QS - 2000 FORMAT ('0ERROR PHI1Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' QS =',D25.16) - IERROR = 001 - RETURN -C - END -C PHI2Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI2Z0 (ECCENT,TS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-2). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA TOL,NIT /1.0D-10,15/ - DATA HALFPI /1.5707963267948966D0/ -C - ECCNTH = HALF * ECCENT - PHI = HALFPI - TWO * DATAN (TS) - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - CON = ECCENT * SINPI - DPHI = HALFPI - TWO * DATAN (TS * ((ONE - CON) / - . (ONE + CON)) ** ECCNTH) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI2Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,TS - 2000 FORMAT ('0ERROR PHI2Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' TS =',D25.16) - IERROR = 002 - RETURN -C - END -C PHI3Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI3Z0 (ML,E0,E1,E2,E3) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-3). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = ML - DO 020 II = 1,NIT - DPHI = (ML + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0 - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI3Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ML,E0,E1,E2,E3 - 2000 FORMAT ('0ERROR PHI3Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ML =',D25.16,' E0 =',D25.16/ - . ' E1 =',D25.16,' E2 =',D25.16,' E3=',D25.16) - IERROR = 003 - RETURN -C - END -C PHI4Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PHI4Z0 (ECCNTS,E0,E1,E2,E3,A,B,C,PHI) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-4). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA ONE,TWO,FOUR,SIX /1.0D0,2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = A - DO 020 II = 1,NIT - SINPHI = DSIN (PHI) - TANPHI = DTAN (PHI) - C = TANPHI * DSQRT (ONE - ECCNTS * SINPHI * SINPHI) - SIN2PH = DSIN (TWO * PHI) - ML = E0 * PHI - E1 * SIN2PH + E2 * DSIN (FOUR * PHI) - . - E3 * DSIN (SIX * PHI) - MLP = E0 - TWO * E1 * DCOS (TWO * PHI) + FOUR * E2 * - . DCOS (FOUR * PHI) - SIX * E3 * DCOS (SIX * PHI) - CON1 = TWO * ML + C * (ML * ML + B) - TWO * A * - . (C * ML + ONE) - CON2 = ECCNTS * SIN2PH * (ML * ML + B - TWO * A * ML) / (TWO * C) - CON3 = TWO * (A - ML) * (C * MLP - TWO / SIN2PH) - TWO * MLP - DPHI = CON1 / (CON2 + CON3) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,E0,E1,E2,E3,A,B,C, - . ECCNTS - 2000 FORMAT ('0ERROR PHI4Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' E0 =',D25.16,' E1 =',D25.16/ - . ' E2 =',D25.16,' E3 =',D25.16/ - . ' A =',D25.16,' B =',D25.16/ - . ' C =',D25.16/ - . ' ECCENTRICITY SQUARE =',D25.16) - IERROR = 004 - RETURN -C - END -C PJINIT -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PJINIT (ISYS,ZONE,DATA) -cc ---------------------------------------------------------------------- -c --- UPDATE (for use in COORDS) -c -c --- V1.98-V1.99 070921 (DGS) -c Modify UTM section of PJINIT in to fix erroneous non-zero -c false Northing when converting S. hemisphere locations to UTM-N -c coordinates. Calls from COORDS to GTPZ0 manage the UTM zone -c (negative for S. hemisphere) so the zone alone should be used to -c set the false Northing for UTM in the S. hemisphere. Calls made -c with a positive zone MUST result in UTM-N coordinates, which are -c negative in the S. hemisphere. -c ---------------------------------------------------------------------- -C - IMPLICIT REAL*8 (A-Z) - REAL*4 SECS(5) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,ITEMP - INTEGER*4 LAND, PATH, LIMIT, IND02, IND06, IND09, ISYS, KEEPZN - INTEGER*4 SWITCH(23),I,ZONE,DEGS(5),MINS(5) - INTEGER*4 ID, IND, ITEM, ITYPE, MODE, N, MSYS - INTEGER*4 ISPHER, LUNIT, LU27, LU83, LEN, NAD27(134), NAD83(134) - CHARACTER*128 DATUM, FILE27, FILE83 - CHARACTER*32 PNAME - CHARACTER*1 SGNA(5) -C - DIMENSION DATA(15),BUFFL(15) - DIMENSION TABLE(9) - DIMENSION PR(20),XLR(20) - DIMENSION ACOEF(6),BCOEF(6) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /NORM/ Q,T,U,W,ES22,P22,SA,CA,XJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /PJ02/ ITYPE - COMMON /PJ03/ A03,LON003,X003,Y003,C,E03,ES03,NS03,RH003 - COMMON /PJ04/ A04,LON004,X004,Y004,E04,F04,NS04,RH004 - COMMON /PJ05/ A05,LON005,X005,Y005,E05,M1 - COMMON /PJ06/ A06,LON006,X006,Y006,E06,E4,FAC,MCS,TCS,IND06 - COMMON /PJ07/ A07,LON007,X007,Y007,E07,E007,E107,E207,E307,ES07, - . ML007 - COMMON /PJ08/ A08,LON008,X008,Y008,E008,E108,E208,E308,GL,NS08, - . RH008 - COMMON /PJ09/ A09,LON009,X009,Y009,ES09,ESP,E009,E109,E209,E309, - . KS009,LAT009,ML009,IND09 - COMMON /PJ10/ A10,LON010,X010,Y010,COSP10,LAT010,SINP10 - COMMON /PJ11/ A11,LON011,X011,Y011,COSP11,LAT011,SINP11 - COMMON /PJ12/ A12,LON012,X012,Y012,COSP12,LAT012,SINP12 - COMMON /PJ13/ A13,LON013,X013,Y013,COSP13,LAT013,SINP13 - COMMON /PJ14/ A14,LON014,X014,Y014,COSP14,LAT014,SINP14 - COMMON /PJ15/ A15,LON015,X015,Y015,COSP15,LAT015,P,SINP15 - COMMON /PJ16/ A16,LON016,X016,Y016 - COMMON /PJ17/ A17,LON017,X017,Y017,LAT1 - COMMON /PJ18/ A18,LON018,X018,Y018 - COMMON /PJ19/ A19,LON019,X019,Y019 - COMMON /PJ20/ LON020,X020,Y020,AL,BL,COSALF,COSGAM,E20,EL,SINALF, - . SINGAM,U0 - COMMON /PJ21/ A21,LON021,X021,Y021,PR,XLR - COMMON /PJ22/ A22,X022,Y022,A2,A4,B,C1,C3,LAND,PATH - COMMON /PJ23/ A23,LON023,X023,Y023,ACOEF,BCOEF,EC,LAT023, - . CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH -C - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE,TWO /0.0D0,0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-10/ - DATA TOL /1.0D-7/ - DATA TOL09 /1.0D-5/ - DATA NINTYD /90000000.0D0/ - DATA DG1 /0.01745329252D0/ - -c --- V1.98 (060911) -c --- Set initial value of SAVE9 - data SAVE9/0.0D0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C .................................................................... -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . U T M . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 1) THEN -C - IERROR = 0 - IF (SWITCH(1).NE.0 .AND. SWITCH(1).EQ.ZONE) RETURN - SWITCH(1) = ZONE - IF (SWITCH(9).NE.0.AND.SWITCH(9).EQ.ZONE.AND.DATA(14).EQ.SAVE) - . RETURN - KEEPZN = ZONE - ZONE = IABS(ZONE) - SAVE = DATA(1) - IF (ZONE .EQ. 0) THEN - ZONE = IDINT( ( (DATA(1) * 180.0D0 / PI) - . + (TOL09 / 3600.D0) ) / 6.D0 ) - IND = 1 - IF (DATA(1) .LT. ZERO) IND = 0 - ZONE = MOD ((ZONE + 30), 60) + IND - KEEPZN = ZONE - IF (DATA(2) .LT. ZERO) KEEPZN = -ZONE - ENDIF - IF (ZONE.LT.1 .OR. ZONE.GT.60) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,140) KEEPZN - 140 FORMAT ('0ERROR PJ01Z0'/ - . ' ILLEGAL ZONE NO. : ',I10) - IERROR = 011 - RETURN - ENDIF - BUFFL(1) = DATA(14) - BUFFL(2) = DATA(15) - BUFFL(3) = 0.9996D0 - BUFFL(4) = ZERO - BUFFL(5) = DBLE (6 * ZONE - 183) * 1.0D6 - BUFFL(6) = ZERO - BUFFL(7) = 500000.0D0 - BUFFL(8) = ZERO - -c --- COORDS -c --- Use just the ZONE provided when setting the false Northing -c IF (DATA(2) .LT. ZERO) BUFFL(8) = 10000000.0D0 - - IF (KEEPZN .LT. 0) BUFFL(8) = 10000000.0D0 - IF (BUFFL(1).NE.0.0D0.AND.BUFFL(1).NE.SAVE9) SWITCH(9) = 0 - SAVE9 = BUFFL(1) - ITEMP = IPPARM - IPPARM = 1 - DO 145 I=1,8 - DATA(I) = BUFFL(I) - 145 CONTINUE - AZ = DATA(14) - EZ = DATA(15) - SWITCH(9) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STATE PLANE . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 2) THEN -C - IERROR = 0 - IF (SWITCH(2).NE.0 .AND. SWITCH(2).EQ.ZONE) RETURN - IF (ISPHER .NE. 0 .AND. ISPHER .NE. 8) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,205) ISPHER - 205 FORMAT('0ERROR PJ02Z0'/ - . ' SPHEROID NO. ',I4,' IS INVALID FOR STATE PLANE', - . ' TRANSFORMATIONS') - IERROR = 020 - RETURN - ENDIF - IF (ZONE .GT. 0) THEN - IND02 = 0 - IF (ISPHER .EQ. 0) THEN - DO 210 I = 1,134 - IF (ZONE .EQ. NAD27(I)) IND02 = I - 210 CONTINUE - ENDIF - IF (ISPHER .EQ. 8) THEN - DO 220 I = 1,134 - IF (ZONE .EQ. NAD83(I)) IND02 = I - 220 CONTINUE - ENDIF - IF (IND02 .EQ. 0) THEN - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - ELSE - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - IF (ISPHER .EQ. 0) THEN - LUNIT = LU27 - DATUM = FILE27 - ENDIF - IF (ISPHER .EQ. 8) THEN - LUNIT = LU83 - DATUM = FILE83 - ENDIF - OPEN (UNIT=LUNIT,FILE=DATUM,STATUS='OLD',ACCESS='DIRECT', - . RECL=LEN) - READ (UNIT=LUNIT,REC=IND02) PNAME,ID,TABLE - CLOSE (UNIT=LUNIT,STATUS='KEEP') - IF (ID .LE. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,240) ZONE, ISPHER - 240 FORMAT('0ERROR PJ02Z0'/ - . ' ILLEGAL ZONE NO. : ',I8,' FOR SPHEROID NO. : ',I4) - IERROR = 021 - RETURN - ENDIF - ITYPE = ID - AZ = TABLE(1) - ES = TABLE(2) - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - ITEMP = IPPARM - IPPARM = 1 -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - DATA(3) = TABLE(4) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 9 - SWITCH(MSYS) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - DATA(3) = PAKCZ0(TABLE(6)) - DATA(4) = PAKCZ0(TABLE(5)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 4 - SWITCH(MSYS) = 0 - KSYS = 4 - GO TO 400 - ENDIF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(4)) - DATA(7) = TABLE(5) - DATA(8) = TABLE(6) - MSYS = 7 - SWITCH(MSYS) = 0 - KSYS = 7 - GO TO 700 - ENDIF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - DATA(3) = TABLE(4) - DATA(4) = PAKCZ0(TABLE(6)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - DATA(13) = ONE - MSYS = 20 - SWITCH(MSYS) = 0 - KSYS = 20 - GO TO 2000 - ENDIF -C - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ALBERS CONICAL EQUAL AREA . -C ...................................................................... -C - IF (ISYS .EQ. 3) THEN -C - IERROR = 0 - IF (SWITCH(3).NE.0 .AND. SWITCH(3).EQ.ZONE) RETURN - SWITCH(3) = 0 - A03 = AZ - E03 = EZ - ES03 = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,340) - 340 FORMAT ('0ERROR PJ03Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 031 - RETURN - END IF - LON003 = PAKRZ0 (DATA(5)) - LAT003 = PAKRZ0 (DATA(6)) - X003 = DATA(7) - Y003 = DATA(8) - SINP03 = DSIN (LAT1) - CON = SINP03 - COSP03 = DCOS (LAT1) - MS1 = MSFNZ0 (E03,SINP03,COSP03) - QS1 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT2) - COSP03 = DCOS (LAT2) - MS2 = MSFNZ0 (E03,SINP03,COSP03) - QS2 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT003) - COSP03 = DCOS (LAT003) - QS0 = QSFNZ0 (E03,SINP03,COSP03) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS03 = (MS1 * MS1 - MS2 * MS2) / (QS2 - QS1) - ELSE - NS03 = CON - END IF - C = MS1 * MS1 + NS03 * QS1 - RH003 = A03 * DSQRT (C - NS03 * QS0) / NS03 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON003,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT003,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,350) A03,ES03, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X003,Y003 - 350 FORMAT ('0INITIALIZATION PARAMETERS (ALBERS CONICAL EQUAL-AREA', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A03 - DATA(2) = ES03 - SWITCH(3) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT CONFORMAL CONIC . -C ...................................................................... -C -400 CONTINUE - IF (KSYS.EQ.4.OR.ISYS .EQ. 4) THEN -C - IERROR = 0 - IF (SWITCH(4).NE.0 .AND. SWITCH(4).EQ.ZONE) RETURN - SWITCH(4) = 0 - A04 = AZ - E04 = EZ - ES = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,440) - 440 FORMAT ('0ERROR PJ04Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 041 - RETURN - END IF - LON004 = PAKRZ0 (DATA(5)) - LAT004 = PAKRZ0 (DATA(6)) - X004 = DATA(7) - Y004 = DATA(8) - SINP04 = DSIN (LAT1) - CON = SINP04 - COSP04 = DCOS (LAT1) - MS1 = MSFNZ0 (E04,SINP04,COSP04) - TS1 = TSFNZ0 (E04,LAT1,SINP04) - SINP04 = DSIN (LAT2) - COSP04 = DCOS (LAT2) - MS2 = MSFNZ0 (E04,SINP04,COSP04) - TS2 = TSFNZ0 (E04,LAT2,SINP04) - SINP04 = DSIN (LAT004) - TS0 = TSFNZ0 (E04,LAT004,SINP04) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS04 = DLOG (MS1 / MS2) / DLOG (TS1 / TS2) - ELSE - NS04 = CON - END IF - F04 = MS1 / (NS04 * TS1 ** NS04) - RH004 = A04 * F04 * TS0 ** NS04 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON004,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT004,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,450) A04,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X004,Y004 - 450 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT CONFORMAL CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A04 - DATA(2) = ES - SWITCH(4) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - 470 FORMAT (' INITIALIZATION PARAMETERS (STATE PLANE PROJECTION)'/ - . ' ZONE NUMBER = ',I4,5X,' ZONE NAME = ',A32) - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 5) THEN -C - IERROR = 0 - IF (SWITCH(5).NE.0 .AND. SWITCH(5).EQ.ZONE) RETURN - SWITCH(5) = 0 - A05 = AZ - E05 = EZ - ES = ESZ - LON005 = PAKRZ0 (DATA(5)) - LAT1 = PAKRZ0 (DATA(6)) - M1 = DCOS(LAT1) / (DSQRT( ONE - ES * DSIN(LAT1) **2)) - X005 = DATA(7) - Y005 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON005,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,550) A05,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X005,Y005 - 550 FORMAT ('0INITIALIZATION PARAMETERS (MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' CENTRAL LONGITUDE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A05 - DATA(2) = ES - SWITCH(5) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLAR STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 6) THEN -C - IERROR = 0 - IF (SWITCH(6).NE.0 .AND. SWITCH(6).EQ.ZONE) RETURN - SWITCH(6) = 0 - A06 = AZ - E06 = EZ - ES = ESZ - E4 = E4Z - LON006 = PAKRZ0 (DATA(5)) - SAVE = DATA(6) - LATC = PAKRZ0 (SAVE) - X006 = DATA(7) - Y006 = DATA(8) - FAC = ONE - IF (SAVE .LT. ZERO) FAC =-ONE - IND06 = 0 - IF (DABS(SAVE) .NE. NINTYD) THEN - IND06 = 1 - CON1 = FAC * LATC - SINPHI = DSIN (CON1) - COSPHI = DCOS (CON1) - MCS = MSFNZ0 (E06,SINPHI,COSPHI) - TCS = TSFNZ0 (E06,CON1,SINPHI) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON006,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LATC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,650) A06,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X006,Y006 - 650 FORMAT ('0INITIALIZATION PARAMETERS (POLAR STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF Y-AXIS = ',A1,2I3,F7.3/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A06 - DATA(2) = ES - SWITCH(6) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLYCONIC . -C ...................................................................... -C - 700 CONTINUE - IF (KSYS.EQ.7.OR.ISYS .EQ. 7) THEN -C - IERROR = 0 - IF (SWITCH(7).NE.0 .AND. SWITCH(7).EQ.ZONE) RETURN - SWITCH(7) = 0 - A07 = AZ - E07 = EZ - ES07 = ESZ - E007 = E0Z - E107 = E1Z - E207 = E2Z - E307 = E3Z - LON007 = PAKRZ0 (DATA(5)) - LAT007 = PAKRZ0 (DATA(6)) - X007 = DATA(7) - Y007 = DATA(8) - ML007 = MLFNZ0 (E007,E107,E207,E307,LAT007) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON007,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT007,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,750) A07,ES07, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X007,Y007 - 750 FORMAT ('0INITIALIZATION PARAMETERS (POLYCONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A07 - DATA(2) = ES07 - SWITCH(7) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIDISTANT CONIC . -C ...................................................................... -C - IF (ISYS .EQ. 8) THEN -C - IERROR = 0 - IF (SWITCH(8).NE.0 .AND. SWITCH(8).EQ.ZONE) RETURN - SWITCH(8) = 0 - A08 = AZ - E = EZ - ES = ESZ - E008 = E0Z - E108 = E1Z - E208 = E2Z - E308 = E3Z - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,840) - 840 FORMAT ('0ERROR PJ08Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 081 - RETURN - END IF - LON008 = PAKRZ0 (DATA(5)) - LAT0 = PAKRZ0 (DATA(6)) - X008 = DATA(7) - Y008 = DATA(8) - SINPHI = DSIN (LAT1) - COSPHI = DCOS (LAT1) - MS1 = MSFNZ0 (E,SINPHI,COSPHI) - ML1 = MLFNZ0 (E008,E108,E208,E308,LAT1) - IND = 0 - IF (DATA(9) .NE. ZERO) THEN - IND = 1 - SINPHI = DSIN (LAT2) - COSPHI = DCOS (LAT2) - MS2 = MSFNZ0 (E,SINPHI,COSPHI) - ML2 = MLFNZ0 (E008,E108,E208,E308,LAT2) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS08 = (MS1 - MS2) / (ML2 - ML1) - ELSE - NS08 = SINPHI - END IF - ELSE - NS08 = SINPHI - END IF - GL = ML1 + MS1 / NS08 - ML0 = MLFNZ0 (E008,E108,E208,E308,LAT0) - RH008 = A08 * (GL - ML0) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON008,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT0,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IND .NE. 0) THEN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,850) A08,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X008,Y008 - 850 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - ELSE - IF (IPPARM .EQ. 0) WRITE (IPPLUN,860) A08,ES, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=3,4), - . X008,Y008 - 860 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - END IF - DATA(1) = A08 - DATA(2) = ES - SWITCH(8) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . TRANSVERSE MERCATOR . -C ...................................................................... -C - 900 CONTINUE - IF (KSYS.EQ.9.OR.ISYS .EQ. 9) THEN -C - IERROR = 0 - IF (DATA(1).NE.0.0D0.AND.DATA(1).NE.SAVE) SWITCH(9) = 0 - IF (SWITCH(9).NE.0 .AND. SWITCH(9).EQ.ZONE) RETURN - SWITCH(9) = 0 - SAVE = DATA(1) - A09 = AZ - E09 = EZ - ES09 = ESZ - E009 = E0Z - E109 = E1Z - E209 = E2Z - E309 = E3Z - KS009 = DATA(3) - LON009 = PAKRZ0 (DATA(5)) - LAT009 = PAKRZ0 (DATA(6)) - X009 = DATA(7) - Y009 = DATA(8) - ML009 = A09 * MLFNZ0 (E009,E109,E209,E309,LAT009) - IND09 = 1 - ESP = ES09 - IF (E09 .GE. TOL09) THEN - IND09 = 0 - ESP = ES09 / (ONE - ES09) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON009,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT009,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,950) A09,ES09,KS009, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X009,Y009 - 950 FORMAT ('0INITIALIZATION PARAMETERS (TRANSVERSE MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE FACTOR AT C. MERIDIAN =',F9.6/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A09 - DATA(2) = ES09 - SWITCH(9) = ZONE -C -C LIST UTM PROJECTION INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 1) THEN - IPPARM = ITEMP - BUFFL(1) = A09 - BUFFL(2) = ES09 - ZONE = KEEPZN - SWITCH(9) = ZONE - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,960) ZONE,BUFFL(1), - . BUFFL(2),BUFFL(3), - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . BUFFL(7),BUFFL(8) - 960 FORMAT ('0INITIALIZATION PARAMETERS (U T M PROJECTION)'/ - . ' ZONE = ',I3/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID = ',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED = ',F18.15/ - . ' SCALE FACTOR AT C. MERIDIAN = ',F9.6/ - . ' LONGITUDE OF CENTRAL MERIDIAN= ',A1,2I3,F7.3/ - . ' FALSE EASTING = ',F12.2,' METERS'/ - . ' FALSE NORTHING = ',F12.2,' METERS') - SWITCH(1) = ZONE - RETURN - END IF -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 10) THEN -C - IERROR = 0 - IF (SWITCH(10).NE.0 .AND. SWITCH(10).EQ.ZONE) RETURN - SWITCH(10) = 0 - A10 = AZZ - LON010 = PAKRZ0 (DATA(5)) - LAT010 = PAKRZ0 (DATA(6)) - X010 = DATA(7) - Y010 = DATA(8) - SINP10 = DSIN (LAT010) - COSP10 = DCOS (LAT010) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON010,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT010,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1050) A10, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X010,Y010 - 1050 FORMAT ('0INITIALIZATION PARAMETERS (STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A10 - SWITCH(10) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT AZIMUTHAL EQUAL-AREA . -C ...................................................................... -C - IF (ISYS .EQ. 11) THEN -C - IERROR = 0 - IF (SWITCH(11).NE.0 .AND. SWITCH(11).EQ.ZONE) RETURN - SWITCH(11) = 0 - A11 = AZZ - LON011 = PAKRZ0 (DATA(5)) - LAT011 = PAKRZ0 (DATA(6)) - X011 = DATA(7) - Y011 = DATA(8) - SINP11 = DSIN (LAT011) - COSP11 = DCOS (LAT011) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON011,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT011,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1150) A11, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X011,Y011 - 1150 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT AZIMUTHAL EQUAL-AREA' - . ,' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A11 - SWITCH(11) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . AZIMUTHAL EQUIDISTANT . -C ...................................................................... -C - IF (ISYS .EQ. 12) THEN -C - IERROR = 0 - IF (SWITCH(12).NE.0 .AND. SWITCH(12).EQ.ZONE) RETURN - SWITCH(12) = 0 - A12 = AZZ - LON012 = PAKRZ0 (DATA(5)) - LAT012 = PAKRZ0 (DATA(6)) - X012 = DATA(7) - Y012 = DATA(8) - SINP12 = DSIN (LAT012) - COSP12 = DCOS (LAT012) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON012,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT012,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1250) A12, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X012,Y012 - 1250 FORMAT ('0INITIALIZATION PARAMETERS (AZIMUTHAL EQUIDISTANT', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A12 - SWITCH(12) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GNOMONIC . -C ...................................................................... -C - IF (ISYS .EQ. 13) THEN -C - IERROR = 0 - IF (SWITCH(13).NE.0 .AND. SWITCH(13).EQ.ZONE) RETURN - SWITCH(13) = 0 - A13 = AZZ - LON013 = PAKRZ0 (DATA(5)) - LAT013 = PAKRZ0 (DATA(6)) - X013 = DATA(7) - Y013 = DATA(8) - SINP13 = DSIN (LAT013) - COSP13 = DCOS (LAT013) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON013,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT013,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1350) A13, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X013,Y013 - 1350 FORMAT ('0INITIALIZATION PARAMETERS (GNOMONIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A13 - SWITCH(13) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ORTHOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 14) THEN -C - IERROR = 0 - IF (SWITCH(14).NE.0 .AND. SWITCH(14).EQ.ZONE) RETURN - SWITCH(14) = 0 - A14 = AZZ - LON014 = PAKRZ0 (DATA(5)) - LAT014 = PAKRZ0 (DATA(6)) - X014 = DATA(7) - Y014 = DATA(8) - SINP14 = DSIN (LAT014) - COSP14 = DCOS (LAT014) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON014,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT014,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1450) A14, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X014,Y014 - 1450 FORMAT ('0INITIALIZATION PARAMETERS (ORTHOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A14 - SWITCH(14) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GENERAL VERTICAL NEAR-SIDE PERSPECTIVE . -C ...................................................................... -C - IF (ISYS .EQ. 15) THEN -C - IERROR = 0 - IF (SWITCH(15).NE.0 .AND. SWITCH(15).EQ.ZONE) RETURN - SWITCH(15) = 0 - A15 = AZZ - P = ONE + DATA(3) / A15 - LON015 = PAKRZ0 (DATA(5)) - LAT015 = PAKRZ0 (DATA(6)) - X015 = DATA(7) - Y015 = DATA(8) - SINP15 = DSIN (LAT015) - COSP15 = DCOS (LAT015) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON015,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT015,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1550) A15,DATA(3), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X015,Y015 - 1550 FORMAT ('0INITIALIZATION PARAMETERS (GENERAL VERTICAL NEAR-SIDE', - . ' PERSPECTIVE PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' HEIGHT OF PERSPECTIVE POINT'/ - . ' ABOVE SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A15 - SWITCH(15) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SINUSOIDAL . -C ...................................................................... -C - IF (ISYS .EQ. 16) THEN -C - IERROR = 0 - IF (SWITCH(16).NE.0 .AND. SWITCH(16).EQ.ZONE) RETURN - SWITCH(16) = 0 - A16 = AZZ - LON016 = PAKRZ0 (DATA(5)) - X016 = DATA(7) - Y016 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON016,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1650) A16, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X016,Y016 - 1650 FORMAT ('0INITIALIZATION PARAMETERS (SINUSOIDAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A16 - SWITCH(16) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIRECTANGULAR . -C ...................................................................... -C - IF (ISYS .EQ. 17) THEN -C - IERROR = 0 - IF (SWITCH(17).NE.0 .AND. SWITCH(17).EQ.ZONE) RETURN - SWITCH(17) = 0 - A17 = AZZ - LAT1 = PAKRZ0 (DATA(6)) - LON017 = PAKRZ0 (DATA(5)) - X017 = DATA(7) - Y017 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON017,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1750) A17, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X017,Y017 - 1750 FORMAT ('0INITIALIZATION PARAMETERS (EQUIRECTANGULAR PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I2,F7.3/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A17 - SWITCH(17) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MILLER CYLINDRICAL . -C ...................................................................... -C - IF (ISYS .EQ. 18) THEN -C - IERROR = 0 - IF (SWITCH(18).NE.0 .AND. SWITCH(18).EQ.ZONE) RETURN - SWITCH(18) = 0 - A18 = AZZ - LON018 = PAKRZ0 (DATA(5)) - X018 = DATA(7) - Y018 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON018,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1850) A18, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X018,Y018 - 1850 FORMAT ('0INITIALIZATION PARAMETERS (MILLER CYLINDRICAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A18 - SWITCH(18) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . VAN DER GRINTEN I . -C ...................................................................... -C - IF (ISYS .EQ. 19) THEN -C - IERROR = 0 - IF (SWITCH(19).NE.0 .AND. SWITCH(19).EQ.ZONE) RETURN - SWITCH(19) = 0 - A19 = AZZ - LON019 = PAKRZ0 (DATA(5)) - X019 = DATA(7) - Y019 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON019,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1950) A19, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X019,Y019 - 1950 FORMAT ('0INITIALIZATION PARAMETERS (VAN DER GRINTEN I', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A19 - SWITCH(19) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . OBLIQUE MERCATOR (HOTINE) . -C ...................................................................... -C - 2000 CONTINUE - IF (KSYS.EQ.20.OR.ISYS .EQ. 20) THEN -C - IERROR = 0 - IF (SWITCH(20).NE.0 .AND. SWITCH(20).EQ.ZONE) RETURN - SWITCH(20) = 0 - MODE = 0 - IF (DATA(13) .NE. ZERO) MODE = 1 - A = AZ - E20 = EZ - ES = ESZ - KS0 = DATA(3) - LAT0 = PAKRZ0 (DATA(6)) - X020 = DATA(7) - Y020 = DATA(8) - SINPH0 = DSIN (LAT0) - COSPH0 = DCOS (LAT0) - CON = ONE - ES * SINPH0 * SINPH0 - COM = DSQRT (ONE - ES) - BL = DSQRT (ONE + ES * COSPH0 ** 4 / (ONE - ES)) - AL = A * BL * KS0 * COM / CON - IF (DABS(LAT0).LT.EPSLN) TS0 = 1.0D0 - IF (DABS(LAT0).LT.EPSLN) D=1.0D0 - IF (DABS(LAT0).LT.EPSLN) EL=1.0D0 - IF (DABS(LAT0).GE.EPSLN) THEN - TS0 = TSFNZ0 (E20,LAT0,SINPH0) - CON = DSQRT (CON) - D = BL * COM / (COSPH0 * CON) - F = D + DSIGN (DSQRT (DMAX1 ((D * D - ONE), 0.0D0)) , LAT0) - EL = F * TS0 ** BL - END IF - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2050) A,ES,KS0 - 2050 FORMAT ('0INITIALIZATION PARAMETERS (OBLIQUE MERCATOR ''HOTINE''', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE AT CENTER =',F12.9) - IF (MODE .NE. 0) THEN - ALPHA = PAKRZ0 (DATA(4)) - LONC = PAKRZ0 (DATA(5)) - G = HALF * (F - ONE / F) - GAMMA = ASINZ0 (DSIN (ALPHA) / D) - LON020 = LONC - ASINZ0 (G * DTAN (GAMMA)) / BL -C -C LIST INITIALIZATION PARAMETERS (CASE B). -C - CALL RADDZ0 (ALPHA,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LONC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT0,SGNA(3),DEGS(3),MINS(3),SECS(3)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2060) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,3) - 2060 FORMAT (' AZIMUTH OF CENTRAL LINE = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - CON = DABS (LAT0) - IF (CON.GT.EPSLN .AND. DABS(CON - HALFPI).GT.EPSLN) THEN - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - 2040 FORMAT ('0ERROR PJ20Z0'/ - . ' INPUT DATA ERROR') - IERROR = 201 - RETURN - END IF - END IF - LON1 = PAKRZ0 (DATA(9)) - LAT1 = PAKRZ0 (DATA(10)) - LON2 = PAKRZ0 (DATA(11)) - LAT2 = PAKRZ0 (DATA(12)) - SINPHI = DSIN (LAT1) - TS1 = TSFNZ0 (E20,LAT1,SINPHI) - SINPHI = DSIN (LAT2) - TS2 = TSFNZ0 (E20,LAT2,SINPHI) - H = TS1 ** BL - L = TS2 ** BL - F = EL / H - G = HALF * (F - ONE / F) - J = (EL * EL - L * H) / (EL * EL + L * H) - P = (L - H) / (L + H) - CALL RADDZ0 (LON2,SGNA(3),DEGS(3),MINS(3),SECS(3)) - DLON = LON1 - LON2 - IF (DLON .LT. -PI) LON2 = LON2 - 2.D0 * PI - IF (DLON .GT. PI) LON2 = LON2 + 2.D0 * PI - DLON = LON1 - LON2 - LON020 = HALF * (LON1 + LON2) - DATAN (J * DTAN (HALF * BL * - . DLON) / P) / BL - DLON = ADJLZ0 (LON1 - LON020) - GAMMA = DATAN (DSIN (BL * DLON) / G) - ALPHA = ASINZ0 (D * DSIN (GAMMA)) - CALL RADDZ0 (LON1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT1,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT2,SGNA(4),DEGS(4),MINS(4),SECS(4)) - CALL RADDZ0 (LAT0,SGNA(5),DEGS(5),MINS(5),SECS(5)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2070) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,5) - 2070 FORMAT (' LONGITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LONGITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - IF (DABS(LAT1 - LAT2) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - CON = DABS (LAT1) - END IF - IF (CON.LE.EPSLN .OR. DABS(CON - HALFPI).LE.EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - IF (DABS(DABS(LAT0) - HALFPI) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - END IF - END IF - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - 2080 FORMAT (' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ROBINSON . -C ...................................................................... -C - IF (ISYS .EQ. 21) THEN -C - IERROR = 0 - IF (SWITCH(21).NE.0 .AND. SWITCH(21).EQ.ZONE) RETURN - SWITCH(21) = 0 - A21 = AZZ - LON021 = PAKRZ0 (DATA(5)) - X021 = DATA(7) - Y021 = DATA(8) - PR(1)=-0.062D0 - XLR(1)=0.9986D0 - PR(2)=0.D0 - XLR(2)=1.D0 - PR(3)=0.062D0 - XLR(3)=0.9986D0 - PR(4)=0.124D0 - XLR(4)=0.9954D0 - PR(5)=0.186D0 - XLR(5)=0.99D0 - PR(6)=0.248D0 - XLR(6)=0.9822D0 - PR(7)=0.31D0 - XLR(7)=0.973D0 - PR(8)=0.372D0 - XLR(8)=0.96D0 - PR(9)=0.434D0 - XLR(9)=0.9427D0 - PR(10)=0.4958D0 - XLR(10)=0.9216D0 - PR(11)=0.5571D0 - XLR(11)=0.8962D0 - PR(12)=0.6176D0 - XLR(12)=0.8679D0 - PR(13)=0.6769D0 - XLR(13)=0.835D0 - PR(14)=0.7346D0 - XLR(14)=0.7986D0 - PR(15)=0.7903D0 - XLR(15)=0.7597D0 - PR(16)=0.8435D0 - XLR(16)=0.7186D0 - PR(17)=0.8936D0 - XLR(17)=0.6732D0 - PR(18)=0.9394D0 - XLR(18)=0.6213D0 - PR(19)=0.9761D0 - XLR(19)=0.5722D0 - PR(20)=1.0D0 - XLR(20)=0.5322D0 - DO 2110 I=1,20 - 2110 XLR(I)=XLR(I) * 0.9858D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON021,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2150) A21, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X021,Y021 - 2150 FORMAT ('0INITIALIZATION PARAMETERS (ROBINSON', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A21 - SWITCH(21) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SPACE OBLIQUE MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 22) THEN -C - IERROR = 0 - IF (SWITCH(22).NE.0 .AND. SWITCH(22).EQ.ZONE) RETURN - SWITCH(22) = 0 - A22 = AZ - E = EZ - ES22 = ESZ - X022 = DATA(7) - Y022 = DATA(8) - LAND = IDINT(DATA(3)+TOL) - PATH = IDINT(DATA(4)+TOL) -C -C CHECK IF LANDSAT NUMBER IS WITHIN RANGE 1 - 5 -C - IF (LAND .GT. 0 .AND. LAND .LE. 5) THEN - IF (LAND .LE. 3) LIMIT = 251 - IF (LAND .GE. 4) LIMIT = 233 - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - IERROR = 221 - RETURN - END IF -C -C CHECK IF PATH NUMBER IS WITHIN RANGE 1 - 251 FOR LANDSATS 1 - 3 -C OR RANGE 1 - 233 FOR LANDSATS 4 - 5 -C - IF (PATH .LE. 0 .OR. PATH .GT. LIMIT) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - 2240 FORMAT ('0ERROR PJ22Z0'/ - . ' LANDSAT NUMBER ',I2,' AND / OR PATH NUMBER ',I4, - . ' ARE OUT OF RANGE') - IERROR = 221 - RETURN - END IF - P1=1440.0D0 - IF (LAND.LE.3) THEN - P2=103.2669323D0 - ALF=99.092D0*DG1 - ELSE - P2=98.8841202D0 - ALF=98.20D0*DG1 - END IF - SA=DSIN(ALF) - CA=DCOS(ALF) - IF (DABS(CA).LT.1.D-9) CA=1.D-9 - ESC=ES22*CA*CA - ESS=ES22*SA*SA - W=((ONE-ESC)/(ONE-ES22))**TWO-ONE - Q=ESS/(ONE-ES22) - T=(ESS*(TWO-ES22))/(ONE-ES22)**TWO - U=ESC/(ONE-ES22) - XJ=(ONE-ES22)**3 - P22=P2/P1 -C -C COMPUTE FOURIER COEFFICIENTS. LAM IS CURRENT VALUE OF -C LAMBDA DOUBLE-PRIME. -C - LAM=0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=FA2 - SUMA4=FA4 - SUMB=FB - SUMC1=FC1 - SUMC3=FC3 - DO 2210 I=9,81,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+4.0D0*FA2 - SUMA4=SUMA4+4.0D0*FA4 - SUMB=SUMB+4.0D0*FB - SUMC1=SUMC1+4.0D0*FC1 - SUMC3=SUMC3+4.0D0*FC3 - 2210 CONTINUE - DO 2220 I=18,72,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+TWO*FA2 - SUMA4=SUMA4+TWO*FA4 - SUMB=SUMB+TWO*FB - SUMC1=SUMC1+TWO*FC1 - SUMC3=SUMC3+TWO*FC3 - 2220 CONTINUE - LAM=90.0D0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+FA2 - SUMA4=SUMA4+FA4 - SUMB=SUMB+FB - SUMC1=SUMC1+FC1 - SUMC3=SUMC3+FC3 -C -C THESE ARE THE VALUES OF FOURIER CONSTANTS. -C - A2=SUMA2/30.D0 - A4=SUMA4/60.D0 - B=SUMB/30.D0 - C1=SUMC1/15.D0 - C3=SUMC3/45.D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2250) A22,ES22,LAND,PATH, - . X022,Y022 - 2250 FORMAT ('0INITIALIZATION PARAMETERS (SPACE OBL. MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LANDSAT NO. = ',I3/ - . ' PATH = ',I5/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS'/) - DATA(1) = A22 - DATA(2) = ES22 - SWITCH(22) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) . -C ...................................................................... -C - IF (ISYS .EQ. 23) THEN -C - IERROR = 0 - IF (SWITCH(23).NE.0 .AND. SWITCH(23).EQ.ZONE) RETURN - SWITCH(23) = 0 - A23 = AZ - EC2 = 0.6768657997291094D-02 - EC = DSQRT (EC2) - N=6 - LON023 = -152.0D0*DG1 - LAT023 = 64.0D0*DG1 - X023 = DATA(7) - Y023 = DATA(8) - ACOEF(1)=0.9945303D0 - ACOEF(2)=0.0052083D0 - ACOEF(3)=0.0072721D0 - ACOEF(4)=-0.0151089D0 - ACOEF(5)=0.0642675D0 - ACOEF(6)=0.3582802D0 - BCOEF(1)=0.0D0 - BCOEF(2)=-.0027404D0 - BCOEF(3)=0.0048181D0 - BCOEF(4)=-0.1932526D0 - BCOEF(5)=-0.1381226D0 - BCOEF(6)=-0.2884586D0 - ESPHI=EC*DSIN(LAT023) - CHIO=TWO*DATAN(DTAN((HALFPI+LAT023)/TWO)*((ONE-ESPHI)/ - . (ONE+ESPHI))**(EC/TWO)) - HALFPI - SCHIO=DSIN(CHIO) - CCHIO=DCOS(CHIO) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON023,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT023,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2350) A23,EC2, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X023,Y023 - 2350 FORMAT ('0INITIALIZATION PARAMETERS (MOD. STEREOGRAPHIC', - . ' CONFORMAL PROJECTION, ALASKA)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A23 - SWITCH(23) = ZONE - RETURN - END IF -C -C INITIALIZATION OF PROJECTION COMPLETED -C - END -C PJ01Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * U T M * -C ********************************************************************** -C - SUBROUTINE PJ01Z0 (COORD,CRDIO,INDIC) -C -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /TOGGLE/ SWITCH - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ01Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 013 - RETURN - 140 CALL PJ09Z0 (GEOG,PROJ,FWD) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 160 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 014 - RETURN - 160 CALL PJ09Z0 (PROJ,GEOG,INV) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ02Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * STATE PLANE * -C ********************************************************************** -C - SUBROUTINE PJ02Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23), ITYPE - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ02/ ITYPE - COMMON /TOGGLE/ SWITCH -C - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - 250 FORMAT ('0ERROR PJ02Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 023 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (GEOG,PROJ,FWD) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (GEOG,PROJ,FWD) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (GEOG,PROJ,FWD) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (GEOG,PROJ,FWD) - END IF -C - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - IERROR = 025 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (PROJ,GEOG,INV) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (PROJ,GEOG,INV) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (PROJ,GEOG,INV) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (PROJ,GEOG,INV) - END IF -C - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ03Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ALBERS CONICAL EQUAL AREA * -C ********************************************************************** -C - SUBROUTINE PJ03Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,C,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ03/ A,LON0,X0,Y0,C,E,ES,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ03Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 033 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - QS = QSFNZ0 (E,SINPHI,COSPHI) - RH = A * DSQRT (C - NS * QS) / NS - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 034 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - CON = RH * NS / A - QS = (C - CON * CON) / NS - IF (E .LT. TOL) GO TO 260 - CON = ONE - HALF * (ONE - ES) * DLOG ((ONE - E) / - . (ONE + E)) / E - IF ((DABS(CON) - DABS(QS)) .GT. TOL) GO TO 260 - GEOG(2) = DSIGN (HALFPI , QS) - GO TO 280 - 260 GEOG(2) = PHI1Z0 (E,QS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 035 - RETURN - 280 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ04Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT CONFORMAL CONIC * -C ********************************************************************** -C - SUBROUTINE PJ04Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,F,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ04/ A,LON0,X0,Y0,E,F,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 200 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ04Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 043 - RETURN - 200 CON = DABS (DABS (GEOG(2)) - HALFPI) - IF (CON .GT. EPSLN) GO TO 220 - CON = GEOG(2) * NS - IF (CON .GT. ZERO) GO TO 210 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ04Z0'/ - . ' POINT CANNOT BE PROJECTED') - IERROR = 044 - RETURN - 210 RH = ZERO - GO TO 230 - 220 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - RH = A * F * TS ** NS - 230 THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 045 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X*X + Y*Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - IF (RH.NE.ZERO .OR. NS.GT.ZERO) GO TO 250 - GEOG(2) = - HALFPI - GO TO 260 - 250 CON = ONE / NS - TS = (RH / (A * F)) ** CON - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 260 - IERROR = 046 - RETURN - 260 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ05Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ05Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,X0,Y0,NS,F,RH0,LAT1,M1 ************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ05/ A,LON0,X0,Y0,E,M1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ05Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 052 - RETURN - 220 IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ05Z0'/ - . ' TRANSFORMATION CANNOT BE COMPUTED AT THE POLES') - IERROR = 053 - RETURN - 240 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - PROJ(1) = X0 + A * M1 * ADJLZ0 (GEOG(1) - LON0) - PROJ(2) = Y0 - A * M1 * DLOG (TS) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 260 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 054 - RETURN - 260 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - TS = DEXP (- Y / (A * M1)) - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 055 - RETURN - 280 GEOG(1) = ADJLZ0 (LON0 + X / (A * M1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ06Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLAR STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ06Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),IND - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,E4,MCS,TCS,FAC,IND ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ06/ A,LON0,X0,Y0,E,E4,FAC,MCS,TCS,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ06Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 062 - RETURN - 220 CON1 = FAC * ADJLZ0 (GEOG(1) - LON0) - CON2 = FAC * GEOG(2) - SINPHI = DSIN (CON2) - TS = TSFNZ0 (E,CON2,SINPHI) - IF (IND .EQ. 0) GO TO 240 - RH = A * MCS * TS / TCS - GO TO 260 - 240 RH = TWO * A * TS / E4 - 260 PROJ(1) = X0 + FAC * RH * DSIN (CON1) - PROJ(2) = Y0 - FAC * RH * DCOS (CON1) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 063 - RETURN - 320 X = FAC * (PROJ(1) - X0) - Y = FAC * (PROJ(2) - Y0) - RH = DSQRT (X * X + Y * Y) - IF (IND .EQ. 0) GO TO 340 - TS = RH * TCS / (A * MCS) - GO TO 360 - 340 TS = RH * E4 / (TWO * A) - 360 GEOG(2) = FAC * PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 380 - IERROR = 064 - RETURN - 380 IF (RH .NE. ZERO) GO TO 400 - GEOG(1) = FAC * LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 GEOG(1) = ADJLZ0 (FAC * DATAN2 (X , -Y) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ07Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLYCONIC * -C ********************************************************************** -C - SUBROUTINE PJ07Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,E0,E1,E2,ML0 ************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ07/ A,LON0,X0,Y0,E,E0,E1,E2,E3,ES,ML0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ07Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 072 - RETURN - 220 CON = ADJLZ0 (GEOG(1) - LON0) - IF (DABS(GEOG(2)) .GT. TOL) GO TO 240 - PROJ(1) = X0 + A * CON - PROJ(2) = Y0 - A * ML0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 240 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - MS = MSFNZ0 (E,SINPHI,COSPHI) - CON = CON * SINPHI - PROJ(1) = X0 + A * MS * DSIN (CON) / SINPHI - PROJ(2) = Y0 + A * (ML - ML0 + MS * (ONE - DCOS(CON)) / SINPHI) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 073 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - AL = ML0 + Y / A - IF (DABS (AL) .GT. TOL) GO TO 340 - GEOG(1) = X / A + LON0 - GEOG(2) = ZERO - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 340 B = AL * AL + (X / A) ** 2 - CALL PHI4Z0 (ES,E0,E1,E2,E3,AL,B,C,GEOG(2)) - IF (IERROR .EQ. 0) GO TO 360 - IERROR = 074 - RETURN - 360 GEOG(1) = ADJLZ0 (ASINZ0 (X * C / A) / DSIN (GEOG(2)) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ08Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIDISTANT CONIC * -C ********************************************************************** -C - SUBROUTINE PJ08Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C ** PARAMETERS * A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,E0,E1,E2,E3,NS,GL,RH0 - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ08/ A,LON0,X0,Y0,E0,E1,E2,E3,GL,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 300 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ08Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 083 - RETURN - 300 ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - RH = A * (GL - ML) - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - IERROR = 084 - RETURN - 320 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - ML = GL - RH / A - GEOG(2) = PHI3Z0 (ML,E0,E1,E2,E3) - IF (IERROR .EQ. 0) GO TO 340 - IERROR = 085 - RETURN - 340 GEOG(1) = ADJLZ0 (LON0 + THETA / NS) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ09Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * TRANSVERSE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ09Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),I,IND,NIT - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS ** A,E,ES,KS0,LON0,LAT0,X0,Y0,E0,E1,E2,E3,ESP,ML0,IND - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ09/ A,LON0,X0,Y0,ES,ESP,E0,E1,E2,E3,KS0,LAT0,ML0,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,HALF,ONE,TWO,THREE /0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ - DATA FOUR,FIVE,SIX,EIGHT,NINE /4.0D0,5.0D0,6.0D0,8.0D0,9.0D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TEN /10.0D0/ - DATA EPSLN,NIT /1.0D-10,6/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ09Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 092 - RETURN - 220 DLON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (IND .EQ. 0) GO TO 240 - COSPHI = DCOS (LAT) - B = COSPHI * DSIN (DLON) - IF (DABS(DABS(B) - ONE) .GT. EPSLN) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ09Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 093 - RETURN - 230 PROJ(1) = HALF * A * KS0 * DLOG ((ONE + B) / (ONE - B)) + X0 - CON = DACOS (COSPHI * DCOS (DLON) / DSQRT (ONE - B * B)) - IF (LAT .LT. ZERO) CON =-CON - PROJ(2) = A * KS0 * (CON - LAT0) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN -C - 240 SINPHI = DSIN (LAT) - COSPHI = DCOS (LAT) - AL = COSPHI * DLON - ALS = AL * AL - C = ESP * COSPHI * COSPHI - TQ = DTAN (LAT) - T = TQ * TQ - N = A / DSQRT (ONE - ES * SINPHI * SINPHI) - ML = A * MLFNZ0 (E0,E1,E2,E3,LAT) - PROJ(1) = KS0 * N * AL * (ONE + ALS / SIX * (ONE - T + C + - . ALS / 20.0D0 * (FIVE - 18.0D0 * T + T * T + 72.0D0 * - . C - 58.0D0 * ESP))) + X0 - PROJ(2) = KS0 *(ML - ML0 + N * TQ *(ALS *(HALF + ALS / 24.0D0 * - . (FIVE - T + NINE * C + FOUR * C * C + ALS / 30.0D0 * - . (61.0D0 - 58.0D0 * T + T * T + 600.0D0 * C - - . 330.0D0 * ESP))))) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 094 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - IF (IND .EQ. 0) GO TO 340 - F = DEXP (X / (A * KS0)) - G = HALF * (F - ONE / F) - TEMP = LAT0 + Y / (A * KS0) - H = DCOS (TEMP) - CON = DSQRT ((ONE - H * H) / (ONE + G * G)) - GEOG(2) = ASINZ0 (CON) - IF (TEMP .LT. ZERO) GEOG(2) =-GEOG(2) - IF (G.NE.ZERO .OR. H.NE.ZERO) GO TO 330 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 330 GEOG(1) = ADJLZ0 (DATAN2 (G,H) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN -C - 340 CON = (ML0 + Y / KS0) / A - PHI = CON - DO 360 I = 1,NIT - DPHI = ((CON + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .LE. EPSLN) GO TO 380 - 360 CONTINUE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) NIT - 2030 FORMAT ('0ERROR PI09Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS') - IERROR = 095 - RETURN - 380 IF (DABS(PHI) .LT. HALFPI) GO TO 400 - GEOG(2) = DSIGN (HALFPI , Y) - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 SINPHI = DSIN (PHI) - COSPHI = DCOS (PHI) - TANPHI = DTAN (PHI) - C = ESP * COSPHI * COSPHI - CS = C * C - T = TANPHI * TANPHI - TS = T * T - CON = ONE - ES * SINPHI * SINPHI - N = A / DSQRT (CON) - R = N * (ONE - ES) / CON - D = X / (N * KS0) - DS = D * D - GEOG(2) = PHI - (N * TANPHI * DS / R) * (HALF - DS / 24.0D0 * - . (FIVE + THREE * T + TEN * C - FOUR * CS - NINE * ESP - . - DS / 30.0D0 * (61.0D0 + 90.0D0 * T + 298.0D0 * C + - . 45.0D0 * TS - 252.0D0 * ESP - THREE * CS))) - GEOG(1) = ADJLZ0 (LON0 + (D * (ONE - DS / SIX * (ONE + TWO * - . T + C - DS / 20.0D0 * (FIVE - TWO * C + 28.0D0 * T - - . THREE * CS + EIGHT * ESP + 24.0D0 * TS))) / COSPHI)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ10Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ10Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ10/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ10Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 102 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(G + ONE) .GT. EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ10Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 103 - RETURN - 140 KSP = TWO / (ONE + G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 104 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = TWO * DATAN (RH / (TWO * A)) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ11Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT AZIMUTHAL EQUAL-AREA * -C ********************************************************************** -C - SUBROUTINE PJ11Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ11/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ11Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 112 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .NE. -ONE) GO TO 140 - CON = TWO * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO A CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 113 - RETURN - 140 KSP = DSQRT (TWO / (ONE + G)) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 114 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - CON = RH / (TWO * A) - IF (CON .LE. ONE) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ11Z0'/ - . ' INPUT DATA ERROR') - IERROR = 115 - RETURN - 230 Z = TWO * ASINZ0 (CON) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (CON .EQ. ZERO) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ12Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * AZIMUTHAL EQUIDISTANT * -C ********************************************************************** -C - SUBROUTINE PJ12Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ12/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ12Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 122 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(DABS(G) - ONE) .GE. EPSLN) GO TO 140 - KSP = ONE - IF (G .GE. ZERO) GO TO 160 - CON = TWO * HALFPI * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 123 - RETURN - 140 Z = DACOS (G) - KSP = Z / DSIN (Z) - 160 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 124 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. (TWO * HALFPI * A)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ12Z0'/ - . ' INPUT DATA ERROR') - IERROR = 125 - RETURN - 230 Z = RH / A - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ13Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GNOMONIC * -C ********************************************************************** -C - SUBROUTINE PJ13Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ13/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ13Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 132 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GT. ZERO) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT PROJECTS INTO INFINITY') - IERROR = 133 - RETURN - 140 KSP = ONE / G - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 134 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = DATAN (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ14Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ORTHOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ14Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ14/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ14Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 142 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - KSP = ONE - IF (G.GT.ZERO .OR. DABS(G).LE.EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 143 - RETURN - 140 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 144 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. A) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ14Z0'/ - . ' INPUT DATA ERROR') - IERROR = 145 - RETURN - 230 Z = ASINZ0 (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ15Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GENERAL VERTICAL NEAR-SIDE PERSPECTIVE * -C ********************************************************************** -C - SUBROUTINE PJ15Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,P,LON0,LAT0,X0,Y0,SINPH0,COSPH0 *************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ15/ A,LON0,X0,Y0,COSPH0,LAT0,P,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ15Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 152 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GE. (ONE / P)) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 153 - RETURN - 140 KSP = (P - ONE) / (P - G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 154 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - R = RH / A - CON = P - ONE - COM = P + ONE - IF (R .LE. DSQRT (CON / COM)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ15Z0'/ - . ' INPUT DATA ERROR') - IERROR = 155 - RETURN - 230 SINZ = (P - DSQRT (ONE - R * R * COM / CON)) / - . (CON / R + R / CON) - Z = ASINZ0 (SINZ) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ16Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SINUSOIDAL * -C ********************************************************************** -C - SUBROUTINE PJ16Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ16/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ16Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 162 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS (GEOG(2)) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 163 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ16Z0'/ - . ' INPUT DATA ERROR') - IERROR = 164 - RETURN - 230 CON = DABS (GEOG(2)) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 240 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS (GEOG(2)))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ17Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIRECTANGULAR * -C ********************************************************************** -C - SUBROUTINE PJ17Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0,LAT1 ******************************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ17/ A,LON0,X0,Y0,LAT1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ17Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 172 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS(LAT1) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 173 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ17Z0'/ - . ' INPUT DATA ERROR') - IERROR = 174 - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS(LAT1) )) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ18Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MILLER CYLINDRICAL * -C ********************************************************************** -C - SUBROUTINE PJ18Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ18/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA FORTPI /0.78539816339744833D0/ - DATA ZERO,ONEQ,TWOH /0.0D0,1.25D0,2.5D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ18Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 182 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 + A * DLOG (DTAN (FORTPI + GEOG(2) / TWOH)) * ONEQ - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 183 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(1) = ADJLZ0 (LON0 + X / A) - GEOG(2) = TWOH * DATAN (DEXP (Y / A / ONEQ)) - FORTPI * TWOH - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ19Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * VAN DER GRINTEN I * -C ********************************************************************** -C - SUBROUTINE PJ19Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ19/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN/1.0D-10/ - DATA ZERO,HALF,ONE,TWO,THREE/0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ19Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 192 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (DABS(LAT) .GT. EPSLN) GO TO 140 - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 140 THETA = ASINZ0 (DMIN1(DABS (LAT /HALFPI),ONE)) - IF (DABS(LON).GT.EPSLN.AND.DABS(DABS(LAT)-HALFPI).GT.EPSLN) - . GO TO 160 - PROJ(1) = X0 - PROJ(2) = Y0 + PI * A * DSIGN( DTAN (HALF * THETA), LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 160 AL = HALF * DABS (PI / LON - LON / PI) - ASQ = AL * AL - SINTHT = DSIN (THETA) - COSTHT = DCOS (THETA) - G = COSTHT / (SINTHT + COSTHT - ONE) - GSQ = G * G - M = G * (TWO / SINTHT - ONE) - MSQ = M * M - CON = PI * A * (AL * (G - MSQ) + DSQRT (ASQ * (G - MSQ)**2 - - . (MSQ + ASQ) * (GSQ - MSQ))) / (MSQ + ASQ) - CON = DSIGN (CON , LON) - PROJ(1) = X0 + CON - CON = DABS (CON / (PI * A)) - PROJ(2) = Y0 + DSIGN (PI * A * DSQRT (ONE - CON * CON - - . TWO * AL * CON) , LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ALGORITHM DEVELOPED BY D.P. RUBINCAM, THE AMERICAN CARTOGRAPHER, -C 1981, V. 8, NO. 2, P. 177-180. -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 193 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - CON = PI * A - XX = X / CON - YY = Y / CON - XYS = XX * XX + YY * YY - C1 = -DABS(YY) * (ONE + XYS) - C2 = C1 - TWO * YY * YY + XX * XX - C3 = -TWO * C1 + ONE + TWO * YY * YY + XYS*XYS - D = YY * YY / C3 + (TWO * C2 * C2 * C2/ C3/ C3/ C3 - 9.0D0 * C1 - . * C2/ C3/ C3) / 27.0D0 - A1 = (C1 - C2 * C2/ THREE/ C3)/ C3 - M1 = TWO * DSQRT(-A1/ THREE) - CON = ((THREE * D) / A1) / M1 - IF (DABS(CON).GT.ONE) CON = DSIGN(ONE,CON) - TH1 = DACOS(CON)/THREE - GEOG(2) = (-M1 * DCOS(TH1 + PI/ THREE) - C2/ THREE/ C3) - . * DSIGN(PI,Y) - IF (DABS(XX).GE.EPSLN) GO TO 230 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 230 CONTINUE - GEOG(1) = LON0 + PI * (XYS - ONE + DSQRT(ONE + TWO * (XX * XX - . - YY * YY) + XYS * XYS))/ TWO/ XX - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ20Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * OBLIQUE MERCATOR (HOTINE) * -C ********************************************************************** -C - SUBROUTINE PJ20Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,KS0,ALPHA,LONC,LON1,LAT1,LON2,LAT2,LAT0 ** -C ********************** X0,Y0,GAMMA,LON0,AL,BL,EL ********************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ20/ LON0,X0,Y0,AL,BL,COSALF,COSGAM,E,EL,SINALF,SINGAM,U0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TOL,EPSLN /1.0D-7,1.0D-10/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - 2050 FORMAT ('0ERROR PJ20Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 204 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - DLON = ADJLZ0 (GEOG(1) - LON0) - VL = DSIN (BL * DLON) - IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 230 - UL = SINGAM * DSIGN (ONE , GEOG(2)) - US = AL * GEOG(2) / BL - GO TO 250 - 230 TS = TSFNZ0 (E,GEOG(2),SINPHI) - Q = EL / TS ** BL - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - UL = (S * SINGAM - VL * COSGAM) / T - CON = DCOS (BL * DLON) - IF (DABS(CON) .LT. TOL) GO TO 240 - US = AL * DATAN ((S * COSGAM + VL * SINGAM) / CON) / BL - IF (CON .LT. ZERO) US = US + PI * AL / BL - GO TO 250 - 240 US = AL * BL * DLON - 250 IF (DABS(DABS(UL) - ONE) .GT. EPSLN) GO TO 255 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2060) - 2060 FORMAT ('0ERROR PJ20Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 205 - RETURN - 255 VS = HALF * AL * DLOG ((ONE - UL) / (ONE + UL)) / BL - US = US - U0 - PROJ(1) = X0 + VS * COSALF + US * SINALF - PROJ(2) = Y0 + US * COSALF - VS * SINALF - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 280 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - IERROR = 206 - RETURN - 280 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - VS = X * COSALF - Y * SINALF - US = Y * COSALF + X * SINALF - US = US + U0 - Q = DEXP (- BL * VS / AL) - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - VL = DSIN (BL * US / AL) - UL = (VL * COSGAM + S * SINGAM) / T - IF (DABS (DABS (UL) - ONE) .GE. EPSLN) GO TO 300 - GEOG(1) = LON0 - GEOG(2) = DSIGN (HALFPI , UL) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 300 CON = ONE / BL - TS = (EL / DSQRT ((ONE + UL) / (ONE - UL))) ** CON - GEOG(2) = PHI2Z0 (E,TS) - CON = DCOS (BL * US / AL) - LON = LON0 - DATAN2 ((S * COSGAM - VL * SINGAM) , CON) / BL - GEOG(1) = ADJLZ0 (LON) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ21Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ROBINSON * -C ********************************************************************** -C - SUBROUTINE PJ21Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,IP1,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . PR(20),XLR(20) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ21/ A,LON0,X0,Y0,PR,XLR - COMMON /TOGGLE/ SWITCH - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ21Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 212 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - P2=DABS(GEOG(2)/5.0D0/DG1) - IP1=IDINT(P2-EPSLN) -C -C STIRLING'S INTERPOLATION FORMULA (USING 2ND DIFF.) -C USED WITH LOOKUP TABLE TO COMPUTE RECTANGULAR COORDINATES -C FROM LAT/LONG. -C - P2=P2-DBLE(IP1) - X=A*(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0)*LON - Y=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . *DSIGN(1.0D0,GEOG(2)) - PROJ(1) = X0 + X - PROJ(2) = Y0 + Y - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 213 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - YY = 2.0D0 * Y / PI / A - PHID = YY * 90.0D0 - P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - IF (IP1.EQ.0) IP1 = 1 - NN = 0 -C -C STIRLING'S INTERPOLATION FORMULA AS USED IN FORWARD TRANSFORMATION -C IS REVERSED FOR FIRST ESTIMATION OF LAT. FROM RECTANGULAR -C COORDINATES. LAT. IS THEN ADJUSTED BY ITERATION UNTIL USE OF -C FORWARD SERIES PROVIDES CORRECT VALUE OF Y WITHIN TOLERANCE. -C - 230 U = PR(IP1 + 3) - PR(IP1 + 1) - V = PR(IP1 + 3) - 2.0D0 * PR(IP1 + 2) + PR(IP1 + 1) - T = 2.0D0 * (DABS(YY) - PR(IP1 + 2))/ U - C = V / U - P2 = T * (1.0D0 - C * T * (1.0D0 - 2.0D0 * C * T)) - IF (P2.LT.0.0D0.AND.IP1.NE.1) GO TO 240 - PHID = DSIGN((P2 + DBLE(IP1)) * 5.0D0, Y) - 235 P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - P2 = P2 - DBLE(IP1) - Y1=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . * DSIGN(1.0D0,Y) - PHID = PHID - 180.0D0* (Y1 - Y) / PI / A - NN = NN + 1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,245) - IERROR = 214 - RETURN - 237 IF (DABS(Y1 - Y).GT.0.00001D0) GO TO 235 - GO TO 250 - 240 IP1 = IP1 - 1 - GO TO 230 - 245 FORMAT ('0ERROR PJ21Z0'/ - . ' TOO MANY ITERATIONS FOR INVERSE ROBINSON') - 250 GEOG(2) = PHID * DG1 -C -C CALCULATE LONG. USING FINAL LAT. WITH TRANSPOSED FORWARD -C STIRLING'S INTERPOLATION FORMULA. -C - GEOG(1)=LON0+X/A/(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0) - GEOG(1) = ADJLZ0(GEOG(1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ22Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SPACE OBLIQUE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ22Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,PATH,LAND,NN,L - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,MCS,TCS,FAC,IND ********** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - COMMON /PJ22/ A,X0,Y0,A2,A4,B,C1,C3,LAND,PATH - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ22Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 222 - RETURN - 220 IF (LAND.GE.4) GO TO 225 - LON=GEOG(1)-128.87D0*DG1+PI*TWO/251.D0*DBLE(PATH) - GO TO 230 - 225 LON=GEOG(1)-129.30D0*DG1+PI*TWO/233.D0*DBLE(PATH) - 230 LAT=GEOG(2) -C -C TEST FOR LAT. AND LONG. APPROACHING 90 DEGREES. -C - IF (LAT.GT.1.570796D0) LAT=1.570796D0 - IF (LAT.LT.-1.570796D0) LAT =-1.570796D0 - IF (LAT.GE.0) LAMPP=PI/TWO - IF (LAT.LT.0) LAMPP=1.5D0*PI - NN=0 - 231 SAV=LAMPP - L=0 - LAMTP=LON+P22*LAMPP - CL=DCOS(LAMTP) - IF (DABS(CL).LT.TOL) LAMTP=LAMTP-TOL - FAC=LAMPP-(DSIGN(ONE,CL))*DSIN(LAMPP)*PI/TWO - 232 LAMT=LON+P22*SAV - C=DCOS(LAMT) - IF (DABS(C).LT.TOL) THEN - LAMDP = SAV - GO TO 233 - END IF - XLAM=((ONE-ES)*DTAN(LAT)*SA+DSIN(LAMT)*CA)/C - LAMDP=DATAN(XLAM) - LAMDP=LAMDP+FAC - DIF=DABS(SAV)-DABS(LAMDP) - IF (DABS(DIF).LT.TOL) GO TO 233 - SAV=LAMDP - L=L+1 - IF (L.GT.50) GO TO 234 - GO TO 232 -C -C ADJUST FOR LANDSAT ORIGIN. -C - 233 RLM=PI*(16.D0/31.D0+ONE/248.D0) - RLM2=RLM+TWO*PI - NN=NN+1 - IF (NN.GE.3) GO TO 236 - IF (LAMDP.GT.RLM.AND.LAMDP.LT.RLM2) GO TO 236 - IF (LAMDP.LE.RLM) LAMPP=2.5D0*PI - IF (LAMDP.GE.RLM2) LAMPP=PI/TWO - GO TO 231 - 234 IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ22Z0'/ - . ' 50 ITERATIONS WITHOUT CONVERGENCE.') - IERROR = 223 - 236 CONTINUE -C -C LAMDP COMPUTED. NOW COMPUTE PHIDP. -C - SP=DSIN(LAT) - PHIDP=ASINZ0(((ONE-ES)*CA*SP-SA*DCOS(LAT)*DSIN(LAMT))/DSQRT(ONE - . -ES*SP*SP)) -C -C COMPUTE X AND Y -C - TANPH=DLOG(DTAN(PI/4.0D0+PHIDP/TWO)) - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE - . +Q*SDSQ))) - D=DSQRT(XJ*XJ+S*S) - X=B*LAMDP+A2*DSIN(TWO*LAMDP)+A4*DSIN(4.0D0*LAMDP)-TANPH*S/D - X=A*X - Y=C1*SD+C3*DSIN(3.0D0*LAMDP)+TANPH*XJ/D - Y=A*Y - PROJ(1)=X+X0 - PROJ(2)=Y+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 224 - RETURN - 320 X = PROJ(1) -X0 - Y = PROJ(2) -Y0 -C -C COMPUTE TRANSFORMED LAT/LONG AND GEODETIC LAT/LONG, GIVEN X,Y. -C -C BEGIN INVERSE COMPUTATION WITH APPROXIMATION FOR LAMDP. SOLVE -C FOR TRANSFORMED LONG. -C - LAMDP=X/A/B - NN=0 - 325 SAV=LAMDP - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE+Q - . *SDSQ))) - LAMDP=X/A+Y/A*S/XJ-A2*DSIN(TWO*LAMDP)-A4*DSIN(4.0D0*LAMDP) - . -(S/XJ)*(C1*DSIN(LAMDP)+C3*DSIN(3.0D0*LAMDP)) - LAMDP=LAMDP/B - DIF=LAMDP-SAV - IF (DABS(DIF).LT.TOL) GO TO 330 - NN=NN+1 - IF (NN.EQ.50) GO TO 330 - GO TO 325 -C -C COMPUTE TRANSFORMED LAT. -C - 330 SL=DSIN(LAMDP) - FAC=DEXP(DSQRT(ONE+S*S/XJ/XJ)*(Y/A-C1*SL-C3*DSIN(3.0D0*LAMDP))) - ACTAN=DATAN(FAC) - PHIDP=TWO*(ACTAN-PI/4.0D0) -C -C COMPUTE GEODETIC LATITUDE. -C - DD=SL*SL - IF (DABS(DCOS(LAMDP)).LT.TOL) LAMDP=LAMDP-TOL - SPP=DSIN(PHIDP) - SPPSQ=SPP*SPP - LAMT=DATAN(((ONE-SPPSQ/(ONE-ES))*DTAN(LAMDP)*CA-SPP*SA*DSQRT(( - . ONE+Q*DD)*(ONE-SPPSQ)-SPPSQ*U)/DCOS(LAMDP))/(ONE-SPPSQ*(ONE+U)) - . ) -C -C CORRECT INVERSE QUADRANT. -C - IF (LAMT.GE.0) SL=ONE - IF (LAMT.LT.0) SL=-ONE - IF (DCOS(LAMDP).GE.0) SCL=ONE - IF (DCOS(LAMDP).LT.0) SCL=-ONE - LAMT=LAMT-PI/TWO*(ONE-SCL)*SL - LON=LAMT-P22*LAMDP -C -C COMPUTE GEODETIC LATITUDE. -C - IF (DABS(SA).LT.TOL) LAT=ASINZ0(SPP/DSQRT((ONE-ES)*(ONE-ES) - . +ES*SPPSQ)) - IF (DABS(SA).LT.TOL) GO TO 335 - LAT=DATAN((DTAN(LAMDP)*DCOS(LAMT)-CA*DSIN(LAMT))/((ONE-ES)*SA)) - 335 CONTINUE - IF (LAND.GE.4) GO TO 370 - GEOG(1)=LON+128.87D0*DG1-PI*TWO/251.D0*DBLE(PATH) - GO TO 380 - 370 GEOG(1)=LON+129.30D0*DG1-PI*TWO/233.D0*DBLE(PATH) - 380 GEOG(2)=LAT - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ23Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) * -C ********************************************************************** -C - SUBROUTINE PJ23Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,N,J,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . ACOEF(6),BCOEF(6) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ23/ A,LON0,X0,Y0,ACOEF,BCOEF,EC,LAT0,CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ23Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 232 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) -C -C CALCULATE X-PRIME AND Y-PRIME FOR OBLIQUE STEREOGRAPHIC PROJ. -C FROM LAT/LONG. -C - SINLON = DSIN (LON) - COSLON = DCOS (LON) - ESPHI = EC *DSIN(GEOG(2)) - CHI=TWO*DATAN(DTAN((HALFPI+GEOG(2))/TWO)*((ONE-ESPHI)/(ONE - . +ESPHI))**(EC/TWO)) - HALFPI - SCHI=DSIN(CHI) - CCHI=DCOS(CHI) - G=SCHIO*SCHI+CCHIO*CCHI*COSLON - S=TWO/(ONE+G) - XP=S*CCHI*SINLON - YP=S*(CCHIO*SCHI-SCHIO*CCHI*COSLON) -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C OBLIQUE STEREOGRAPHIC TO MODIFIED-STEREOGRAPHIC COORD. -C - R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - DO 140 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 140 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - 140 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - X=XP*AR-YP*AI+BR - Y=YP*AR+XP*AI+BI - PROJ(1)=X*A+X0 - PROJ(2)=Y*A+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 234 - RETURN - 220 X = (PROJ(1) - X0)/A - Y = (PROJ(2) - Y0)/A - XP=X - YP=Y - NN=0 -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C MODIFIED-STEREOGRAPHIC CONFORMAL TO OBLIQUE STEREOGRAPHIC -C COORDINATES (XP,YP). -C - 225 R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - CR=DBLE(N)*AR - CI=DBLE(N)*AI - DR=(DBLE(N-1))*BR - DI=(DBLE(N-1))*BI - DO 230 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 230 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - CRN=DR+R*CR - CIN=DI+R*CI - DR=DBLE(N-J)*ACOEF(N-J)-S*CR - DI=DBLE(N-J)*BCOEF(N-J)-S*CI - CR=CRN - CI=CIN - 230 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - FXYR=XP*AR-YP*AI+BR-X - FXYI=YP*AR+XP*AI+BI-Y - FPXYR=XP*CR-YP*CI+DR - FPXYI=YP*CR+XP*CI+DI - DEN=FPXYR*FPXYR+FPXYI*FPXYI - DXP=-(FXYR*FPXYR+FXYI*FPXYI)/DEN - DYP=-(FXYI*FPXYR-FXYR*FPXYI)/DEN - XP=XP+DXP - YP=YP+DYP - DS=DABS(DXP)+DABS(DYP) - NN=NN+1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN ITERATING INVERSE') - IERROR = 235 - GO TO 238 - 237 IF (DS.GT.EPSLN) GO TO 225 -C -C CONVERT OBLIQUE STEREOGRAPHIC COORDINATES TO LAT/LONG. -C - 238 RH = DSQRT (XP * XP + YP * YP) - Z = TWO * DATAN (RH / TWO) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 CHI = ASINZ0 (COSZ * SCHIO + YP *SINZ * CCHIO / RH) - NN=0 - PHI=CHI - 250 ESPHI=EC*DSIN(PHI) - DPHI=TWO*DATAN(DTAN((HALFPI+CHI)/TWO)*((ONE+ESPHI)/(ONE-ESPHI)) - . **(EC/TWO)) - HALFPI - PHI - PHI = PHI + DPHI - NN = NN + 1 - IF (NN.LE.20) GO TO 257 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,255) - 255 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN CALCULATING PHI FROM CHI') - IERROR = 236 - GO TO 260 - 257 IF (DABS(DPHI).GT.EPSLN) GO TO 250 - 260 GEOG(2)=PHI - GEOG(1) = ADJLZ0 (LON0 + DATAN2(XP*SINZ, RH*CCHIO*COSZ-YP*SCHIO - . *SINZ)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C QSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION QSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL Q). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-7/ -C - IF (ECCENT .LT. EPSLN) GO TO 020 - CON = ECCENT * SINPHI - QSFNZ0 = (ONE - ECCENT * ECCENT) * (SINPHI / (ONE - CON * CON) - - . (HALF / ECCENT) * DLOG ((ONE - CON) / (ONE + CON))) - RETURN -C - 020 QSFNZ0 = TWO * SINPHI - RETURN - END -C RADDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE RADDZ0 (RAD,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT ANGLE FROM RADIANS TO SIGNED DMS -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - REAL*8 RAD,CON,RADSEC,ZERO,TOL - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,BLANK,NEG - DATA RADSEC /206264.806247D0/ - DATA ZERO,TOL /0.0D0,1.0D-4/ - DATA BLANK,NEG /' ','-'/ -C -C CONVERT THE ANGLE TO SECONDS. -C - CON = DABS(RAD) * RADSEC - ISEC = IDINT(CON + TOL) -C -C DETERMINE THE SIGN OF THE ANGLE. -C - SGNA = BLANK - IF (RAD .LT. ZERO .AND. CON .GE. 0.00005D0) SGNA = NEG - IF (CON .LT. 0.00005D0) CON = ZERO -C -C COMPUTE DEGREES PART OF THE ANGLE. -C - INTG = ISEC / 3600 - DEGS = INTG - ISEC = INTG * 3600 - CON = CON - DBLE(ISEC) - ISEC = IDINT(CON + TOL) -C -C COMPUTE MINUTES PART OF THE ANGLE. -C - MINS = ISEC / 60 - ISEC = MINS * 60 - CON = CON - DBLE(ISEC) -C -C COMPUTE SECONDS PART OF THE ANGLE. -C - SECS = SNGL(CON) -C -C INCREASE MINS IF SECS CLOSE TO 60.000 -C - IF(SECS .LT. 59.9995D0) RETURN - MINS = MINS + 1 - SECS = 0.0 -C -C INCREASE DEGS IF MINS EQUAL 60 -C - IF(MINS .LE. 59) RETURN - MINS = 0 - DEGS = DEGS + 1 -C - RETURN - END -C SERAZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) -C -C COMPUTES INTEGRAL FUNCTION OF TRANSFORMED LONG. FOR FOURIER -C CONSTANTS A2, A4, B, C1, AND C3. -C LAM IS INTEGRAL VALUE OF TRANSFORMED LONG. -C - IMPLICIT REAL*8 (A-Z) - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - DATA DG1 /0.01745329252D0/ - DATA ONE,TWO /1.0D0,2.0D0/ - LAM=LAM*DG1 - SD=DSIN(LAM) - SDSQ=SD*SD - S=P22*SA*DCOS(LAM)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ) - . *(ONE+Q*SDSQ))) - H=DSQRT((ONE+Q*SDSQ)/(ONE+W*SDSQ))*(((ONE+W*SDSQ)/ - . ((ONE+Q*SDSQ)**TWO))-P22*CA) - SQ=DSQRT(XJ*XJ+S*S) - FB=(H*XJ-S*S)/SQ - FA2=FB*DCOS(TWO*LAM) - FA4=FB*DCOS(4.0D0*LAM) - FC=S*(H+XJ)/SQ - FC1=FC*DCOS(LAM) - FC3=FC*DCOS(3.0D0*LAM) - RETURN - END -C SPHDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SPHDZ0(ISPH,PARM) -C -C SUBROUTINE TO COMPUTE SPHEROID PARAMETERS -C -C ISPH IS THE SPHEROID CODE FROM THE FOLLOWING LIST: -C 0 = CLARKE 1866 1 = CLARKE 1880 -C 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C 4 = INTERNATIONAL 1909 5 = WGS 72 -C 6 = EVEREST 7 = WGS 66 -C 8 = GRS 1980 9 = AIRY -C 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C 12 = WGS 84 13 = SOUTHEAST ASIA -C 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C 16 = HOUGH 17 = MERCURY 1960 -C 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C 20 = INTERNATIONAL 1924 -C -C PARM IS ARRAY OF PROJECTION PARAMETERS: -C PARM(1) IS THE SEMI-MAJOR AXIS -C PARM(2) IS THE ECCENTRICITY SQUARED -C -C IF ISPH IS NEGATIVE, USER SPECIFIED PROJECTION PARAMETERS ARE TO -C DEFINE THE RADIUS OF SPHERE OR ELLIPSOID CONSTANTS AS APPROPRIATE -C -C IF ISPH = 0 , THE DEFAULT IS RESET TO CLARKE 1866 -C -C **** ***** -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION PARM(15),AXIS(21),BXIS(21) -C - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PROJZ0/ IPROJ -C - DATA ZERO,ONE /0.0D0,1.0D0/ -C - DATA AXIS/6378206.4D0,6378249.145D0,6377397.155D0,6378157.5D0, - . 6378388.0D0,6378135.0D0,6377276.3452D0,6378145.0D0,6378137.0D0, - . 6377563.396D0,6377304.063D0,6377340.189D0,6378137.0D0,6378155.D0, - . 6378160.0D0,6378245.0D0,6378270.0D0,6378166.0D0,6378150.0D0, - . 6370997.0D0,6378388.0D0/ -C - DATA BXIS/6356583.8D0,6356514.86955D0,6356078.96284D0, - . 6356772.2D0,6356911.94613D0,6356750.519915D0,6356075.4133D0, - . 6356759.769356D0,6356752.314140D0,6356256.91D0,6356103.039D0, - . 6356034.448D0,6356752.314245D0,6356773.3205D0,6356774.719D0, - . 6356863.0188D0,6356794.343479D0,6356784.283666D0,6356768.337303D0 - . ,6370997.0D0,6356911.95D0/ -C - IF (ISPH.GE.0) GO TO 5 -C -C INITIALIZE USER SPECIFIED SPHERE AND ELLIPSOID PARAMETERS -C - AZZ = ZERO - AZ = ZERO - EZ = ZERO - ESZ = ZERO - E0Z = ZERO - E1Z = ZERO - E2Z = ZERO - E3Z = ZERO - E4Z = ZERO -C -C FETCH FIRST TWO USER SPECIFIED PROJECTION PARAMETERS -C - A = DABS(PARM(1)) - B = DABS(PARM(2)) - IF (A .GT. ZERO .AND. B .GT. ZERO) GO TO 13 - IF (A .GT. ZERO .AND. B .LE. ZERO) GO TO 12 - IF (A .LE. ZERO .AND. B .GT. ZERO) GO TO 11 -C -C DEFAULT NORMAL SPHERE AND CLARKE 1866 ELLIPSOID -C - JSPH = 1 - GO TO 10 -C -C DEFAULT CLARKE 1866 ELLIPSOID -C - 11 A = AXIS(1) - B = BXIS(1) - GO TO 14 -C -C USER SPECIFIED RADIUS OF SPHERE -C - 12 AZZ = A - GO TO 15 -C -C USER SPECIFIED SEMI-MAJOR AND SEMI-MINOR AXES OF ELLIPSOID -C - 13 IF (B .LE. ONE) GO TO 15 - 14 ES = ONE - (B / A)**2 - GO TO 16 -C -C USER SPECIFIED SEMI-MAJOR AXIS AND ECCENTRICITY SQUARED -C - 15 ES = B - 16 AZ = A - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - PARM(1) = A - PARM(2) = ES - RETURN -C -C CHECK FOR VALID SPHEROID SELECTION -C - 5 IF (PARM(1).NE.ZERO.AND.IPROJ.NE.1) RETURN - JSPH = IABS(ISPH) + 1 - IF (JSPH.LE.21) GO TO 10 - IERROR = 999 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,1) ISPH - 1 FORMAT('0ERROR SPHDZ0: SPHEROID CODE OF ',I5,' RESET TO 0') - ISPH = 0 - JSPH = 1 -C -C RETRIEVE A AND B AXES FOR SELECTED SPHEROID -C - 10 A = AXIS(JSPH) - B = BXIS(JSPH) - ES = ONE - (B / A)**2 -C -C SET COMMON BLOCK PARAMETERS FOR SELECTED SPHEROID -C - AZZ = 6370997.0D0 - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - AZ = A - ESZ = ES - IF (ES.EQ.ZERO) AZZ=A -C - PARM(1) = A - PARM(2) = ES - RETURN - END -C TSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION TSFNZ0 (ECCENT,PHI,SINPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL T). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE /0.5D0,1.0D0/ - DATA HALFPI /1.5707963267948966D0/ -C - CON = ECCENT * SINPHI - COM = HALF * ECCENT - CON = ((ONE - CON) / (ONE + CON)) ** COM - TSFNZ0 = DTAN (HALF * (HALFPI - PHI)) / CON -C - RETURN - END -C UNTFZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE UNTFZ0 (INUNIT,IOUNIT,FACTOR,IFLG) -C -C SUBROUTINE TO DETERMINE CONVERGENCE FACTOR BETWEEN TWO LINEAL UNITS -C -C * INPUT ........ -C * INUNIT * UNIT CODE OF SOURCE. -C * IOUNIT * UNIT CODE OF TARGET. -C -C * OUTPUT ....... -C * FACTOR * CONVERGENCE FACTOR FROM SOURCE TO TARGET. -C * IFLG * RETURN FLAG .EQ. 0 , NORMAL RETURN. -C RETURN FLAG .NE. 0 , ABNORMAL RETURN. -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION FACTRS(6,6) - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - PARAMETER (ZERO = 0.0D0, MAXUNT = 6) - DATA FACTRS /0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.2062648062470963D06 , - . 0.5729577951308231D02 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.3048006096012192D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000002000004000D01 , - . 0.0000000000000000D00 , 0.3280833333333333D01 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3280839895013124D01 , - . 0.4848136811095360D-5 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.2777777777777778D-3 , 0.0000000000000000D00 , - . 0.1745329251994330D-1 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3600000000000000D04 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.9999980000000000D00 , - . 0.3048000000000000D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 / -C - IF (INUNIT .GE. 0 .AND. INUNIT .LT. MAXUNT .AND. - . IOUNIT .GE. 0 .AND. IOUNIT .LT. MAXUNT) THEN - FACTOR = FACTRS(IOUNIT+1 , INUNIT+1) - IF (FACTOR .NE. ZERO) THEN - IFLG = 0 - RETURN - ELSE - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INUNIT,IOUNIT - 2000 FORMAT (' INCONSISTENT UNIT CODES = ',I6,' / ',I6) - IFLG = 12 - RETURN - END IF - ELSE - IF (INUNIT.LT.0 .OR. INUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) INUNIT,IOUNIT - 2010 FORMAT (' ILLEGAL SOURCE OR TARGET UNIT CODE = ',I6,' / ', - . I6) - END IF - IF (IOUNIT.LT.0 .OR. IOUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOUNIT,IOUNIT - END IF - IFLG = 11 - RETURN - END IF -C - END diff --git a/CALPUFF_SRC/CALPUFF/cpl_calpuff.bat b/CALPUFF_SRC/CALPUFF/cpl_calpuff.bat deleted file mode 100644 index 9a62573..0000000 --- a/CALPUFF_SRC/CALPUFF/cpl_calpuff.bat +++ /dev/null @@ -1,20 +0,0 @@ -REM Compiling and linking with CALPUFF using Lahey LF95 for Windows - -lf95 modules.for calpuff.for -o0 -co -sav -out calpuff.exe >cpl_calpuff.txt - -pause - -Rem Do not use trap(doi) for programs that include ISORROPIA -rem lf95 modules.for calpuff.for -o0 -co -sav -trap doi -out calpuff.exe >cpl_calpuff.txt - -del *.obj -del *.map -del *.mod - -rem Switch settings ------------------------------ -rem -o0 No optimization -rem -co Display the compiler options that are used -rem -sav Save local variables -rem -trap doi Trap NDP divide-by-zero (d), overflow (o), and invalid operation (i) -rem -out Name the compiled executable to "calpuff.exe" -rem > Send compiler screen output to file "cpl_calpuff.txt" diff --git a/CALPUFF_SRC/CALPUFF/cpl_unix.bat b/CALPUFF_SRC/CALPUFF/cpl_unix.bat deleted file mode 100644 index 84c3afe..0000000 --- a/CALPUFF_SRC/CALPUFF/cpl_unix.bat +++ /dev/null @@ -1,19 +0,0 @@ -# Example settings for compiling on Linux with Portland Group 64-bit Compiler (make 32-bit executable!) - -pgf90 -O0 -Kieee -Msave -tp k8-32 -L/opt/pgi/linux86/11.5/liblf modules.for calpuff.for -o calpuff.x - - -# Do not use Ktrap(fp) for programs that include ISORROPIA -# pgf90 -O0 -Kieee -Ktrap=fp -Msave -tp k8-32 -L/opt/pgi/linux86/11.5/liblf modules.for calpuff.for -o calpuff.x - - -# Switch settings ------------------------------ -# pgf90 Portland Group Fortran 90 compiler (64-bit library here) -# -O0 Set the optimization level at Level 0 -# -Kieee Request special compilation semantics from the compiler. Perform float and double divides in -# conformance with the IEEE 754 standard -# -Ktrap=fp -# -Msave All local variables are subject to the SAVE statement -# -tp k8-32 Create 32-bit executable -# -L Library path that is installation-specific -# -o calpuff.exe Use file as the name of the executable program, rather than the default a.out diff --git a/CALPUFF_SRC/CALPUFF/csigma.puf b/CALPUFF_SRC/CALPUFF/csigma.puf deleted file mode 100644 index 8c82ac5..0000000 --- a/CALPUFF_SRC/CALPUFF/csigma.puf +++ /dev/null @@ -1,122 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /CSIGMA/ -- Dispersion coefficient constants CALPUFF -c----------------------------------------------------------------------- -c - common/csigma/ayt,azt(6),syh,szh,thfty,thftz,tyidr,tzidr,tzisdr, - 1 avefac,avefaci,yz0fac(mxnx,mxny,mxmetdom), - 2 az0fac(mxnx,mxny,mxmetdom), - 3 bz0trm(mxnx,mxny,mxmetdom), - 4 aypgt(6),bypgt(6),aypgti(6),bypgti(6), - 5 azpgt(6),bzpgt(6), - 6 ayurb(6),xiyurb(6),azurb(6),xizurb(6), - 7 nzbrur(6),xzbrur(10,6), - 8 azrur(10,6),bzrur(10,6), - 9 idoptys,idoptzs,irus,uavgs,kstabs,els,bvfs,mhftszs, - * tsigvs,tsigws,symins,szmins,ixcell,iycell,mdcell -c -c --- COMMON BLOCK /CSIGMA/ Variables: -c -c -c *** For MDISP = all -c Heffter(1965) time dependent growth coeffs. for long range. -c AYT - real const - Time dependent Y growth rate for -c all PGT classes. -c AZT(6) - real array - Time dependent Z growth rates for -c each PGT class. -c SYH - real const - Horizontal sigma (m) beyond which -c time dependent growth assumed. -c SZH - real const - Vertical sigma (m) beyond which -c time dependent growth assumed. -c THFTY - real - Virtual travel time (s) associated -c with SYH for "current" met.; -c transition to Heffter growth law. -c THFTZ - real - Virtual travel time (s) associated -c with SZH for "current" met.; -c transition to Heffter growth law. -c -c *** For MDISP = 1,2 -c Dispersion determined by local turbulence (sigv,sigw) and the -c Irwin(1983) recommended forms of (fy,fz) of Draxler(1976): -c fy = 1.0 / (1.0 + 0.9 * sqrt(tyidr * t) ) -c fz = 1.0 / (1.0 + 0.9 * sqrt(tzidr * t) ) for L < 0 -c fz = 1.0 / (1.0 + 0.945 * (tzisdr * t)**0.806 ) for L > 0 -c TYIDR - real const - Reciprocal time scale (1/s) for -c Draxler form of fy. -c TZIDR - real const - Reciprocal time scale (1/s) for -c Draxler form of fz for L < 0 -c TZISDR - real const - Reciprocal time scale (1/s) for -c Draxler stable form of fz (L > 0) -c -c *** For MDISP = 3 -c Pasquill-Gifford-Turner(PGT) coeffs. for RURAL conditions. -c Values of coeffs. and exponents from ISC approximations. -c NZBRUR(6)- int. array - Number segments per PGT class. -c XZBRUR(10,6)- real array - Junction x's (km) per PGT class. -c AZRUR(10,6)- real array - PGT Z coeffs. for each PGT class. -c BZRUR(10,6)- real array - PGT Z expons. for each PGT class. -c -c *** For MDISP = 3,4 -c AVEFAC - real array - Averaging time adjustment factor -c for sigma-y = (avet/3 min)**0.2 -c used for PG and MESOPUFF sigmas. -c AVEFACI - real - 1./AVEFAC -c YZ0FAC(mxnx,mxny,mxmetdom) -c - real array - Roughness adjustment factor -c for sigma-y = (z0/.03)**0.2 -c used for PG and MESOPUFF sigmas -c (RURAL only) -c AZ0FAC(mxnx,mxny,mxmetdom) -c - real array - Roughness factor for A in Ax**B -c used for PG and MESOPUFF sigma-z. -c A' = A * AZ0FAC -c (RURAL only) -c BZ0TRM(mxnx,mxny,mxmetdom) -c - real array - Roughness TERM for B in Ax**B -c used for PG and MESOPUFF sigma-z. -c B' = B - BZ0TRM -c (RURAL only) -c Briggs urban coeffs. for each PGT class for URBAN conditions. -c AYURB(6) - real array - Urban Y coeffs. by PGT class. -c XIYURB(6) - real array - Reciprocal length scale (1/m) -c for SIGY for each PGT class. -c AZURB(6) - real array - PGT Z coeffs. for each PGT class. -c XIZURB(6) - real array - Reciprocal length scale (1/m) -c for SIGZ for each PGT class. -c -c *** For MDISP = 4 -c Pasquill-Gifford-Turner(PGT) coeffs. for RURAL conditions. -c Values of coeffs. and exponents from MESOPUFF II approximations. -c AYPGT(6) - real array - PGT Y coeffs. for each PGT class. -c BYPGT(6) - real array - PGT Y expons. for each PGT class. -c AYPGTI(6) - real array - Reciprocals of AYPGT(6). -c BYPGTI(6) - real array - Reciprocals of BYPGT(6). -c AZPGT(6) - real array - PGT Z coeffs. for each PGT class. -c BZPGT(6) - real array - PGT Z expons. for each PGT class. -c -c --------------------------------------------------------------------- -c --- Current configuration and meteorological information -c --------------------------------------------------------------------- -c IDOPTYS - integer - Dispersion method option for SIGY ** -c IDOPTZS - integer - Dispersion method option for SIGZ ** -c ** computed from: -c 1,2 = SIGMA V,W -c 3 = PG curves (rural), MP (urban) -c 4 = MESOPUFF II curves (rural), -c MP (urban) -c 5 = CTDM (neutral/stable), -c IDOPT(1) (other) -c (All IDOPT - use Heffter eqns. for -c long travel times) -c IRUS - integer - Rural cell indicator (rural=0 ; urban=1) -c UAVGS - real - Mean transport speed (m/s) -c KSTABS - integer - PGT stability class at puff -c ELS - real - Current Monin-Obukhov length (m) -c BVFS - real - Current Brunt-Vaisala freq (1/s) -c MHFTSZS - integer - Flag indicating use of Heffter growth for z -c (0: NO Heffter 1: Heffter) -c TSIGVS - real - Current sigma-v velocity (m/s) -c TSIGWS - real - Current sigma-w velocity (m/s) -c SYMINS - real - Minimum value of sigma-y (m) -c SZMINS - real - Minimum value of sigma-z (m) -c IXCELL,IYCELL,MDCELL -c - integer - Current cell index (and domain) diff --git a/CALPUFF_SRC/CALPUFF/ctpass.puf b/CALPUFF_SRC/CALPUFF/ctpass.puf deleted file mode 100644 index 1d1eb4f..0000000 --- a/CALPUFF_SRC/CALPUFF/ctpass.puf +++ /dev/null @@ -1,132 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /CTPASS/ --- CTSG Variables CALPUFF -c----------------------------------------------------------------------- - - real majaxw,minaxw - logical ldb - - common/ctpass/nlev,ntpts,sz1,sz2,sy1,sy2,szr,syr,szmn,symn, - * frac,twokz,twoky,xrctm(mxrect),yrctm(mxrect), - * relief(mxhill),expo(2,mxhill),scale(2,mxhill), - * axmax(2,mxhill),xc(mxhill),yc(mxhill), - * thetah(mxhill),zgrid(mxhill),hda(mxhill), - * ubyna(mxhill),ih,ip,ir,iregl,iregu, - * z(mxlev),ws(mxlev),abvf(mxlev), - * q,u,hd,ubyn,zlid,thetaw, - * rotflo,rotang,alfw,beta,cbeta,d, - * h,baxi,r, - * xp,yp,xpf,ypf,zpuff,isc, - * xr,yr,xrf,yrf,xre,yre,zrec, - * x12f,x23f,xob,xbegin,xend,xspace, - * t12p,t12rl,t12ru,tstep,tstart,timpg, - * szimpg,syimpg,szesq,szosq,szpsq,szsq,at(2,mxtpts), - * mhillt,nzh(mxhill),zh(mxcntr,mxhill), - * majaxw(mxcntr,mxhill),minaxw(mxcntr,mxhill), - * ldb,idebug -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [a]=array -c----------------------------------------------------------------------- -c -c --- NOTE: horizontal coordinates are relative to MET grid origin (m) -c -c nlev number of levels of met data used to calc. Hd [i] -c ntpts number of points used to obtain flow factors [i] -c along trajectory of puff over hill (should be odd) -c sz1,sy1 (m) puff sigmas at the start of the timestep [r] -c sz2,sy2 (m) puff sigmas at the end of the timestep [r] -c szr,syr (m) puff sigmas at the receptor [r] -c szmn,symn(m) minimum sigma-z and sigma y allowed [r] -c frac fraction of step from start to receptor position [r] -c twokz,twoky diffusivities over the timestep [r] -c xrctm,yrctm(m) CTSG receptor coordinates in meters [ra] -c relief (m) height of crest of hill above base elevation [ra] -c expo hill shape exponents for major and minor axes [ra] -c scale (m) horizontal length scale along major and minor axes [ra] -c axmax (m) maximum axis lengths for major and minor axes [ra] -c xc,yc (m) coordinates of center of hill [ra] -c thetah (deg) orientation of major axis of hill (CW from north) [ra] -c zgrid (m) height of "base-plane" of hill above mean sea level[ra] -c hda (m) array of dividing-streamline heights [ra] -c (1 for each hill) -c ubyna (m) array of U/N values (1 for each hill) [ra] -c ih current hill-number (receptor loop - 0 denotes [i] -c no hill) -c ip current puff-number (receptor loop) [i] -c ir current receptor-number (receptor loop) [i] -c iregl,iregu region containing the receptor (l:lower; u:upper) [i] -c z (m) height of met data level (above ground) [ra] -c ws (m/s) wind speed at height z [ra] -c abvf (1/s) Brunt-Vaisala frequency in layer whose top is at z [ra] -c q (g) mass contained in current puff [r] -c u (m/s) wind speed for current puff [r] -c hd, ubyn (m) Hd and U/N for current hill [r] -c zlid (m) mixing lid for current puff [r] -c thetaw (deg) wind direction (CW from north) for current puff [r] -c rotflo (rad) angle of rotation CCW from the geographic coord. [r] -c system to the coord. system with x along the flow -c rotang (rad) angle of rotation CCW from hill-ellipse coord. [r] -c system to the coord. system with x along the flow -c alfw (rad) wind direction CW from the major axis of [r] -c hill-ellipse -c beta (rad) angle of rotation CCW from flow direction to the [r] -c normal to the hill-ellipse at the stagnation-point -c cbeta COS(beta) [r] -c d (m) distance between puff trajectory and stagnation [r] -c streamline -c h (m) height of the current hill above grid elevation [r] -c baxi (1/m) inverse of the minor semiaxis of the hill-ellipse [r] -c r ratio of major axis to the minor axis of [r] -c hill-ellipse -c xp,yp (m) grid coordinates of current puff [r] -c xpf,ypf (m) current puff position in flow coord. system [r] -c zpuff (m) height of current puff above grid elevation [r] -c isc stability class for current puff and timestep [i] -c xr,yr (m) grid coordinates of current receptor [r] -c xrf,yrf (m) current receptor position in flow coord. system [r] -c xre,yre (m) current receptor position in hill-ellipse coord. [r] -c system -c zrec (m) height of current receptor above grid elevation [r] -c (note that receptors must be on the surface) -c x12f,x23f (m) intersection of puff trajectory with boundaries [r] -c between regions 1&2, and 2&3 (flow coord. system) -c xob (m) x-coord. of the stagnation point in beta coord. [r] -c system -c xbegin,xend (m)location of beginning and ending points along [r] -c trajectory for factors contained in array "at" -c xspace (m) spacing between points contained in array "at" [r] -c t12p (s) travel time from puff position at start of period [r] -c to x12f -c t12rl,t12ru (s) travel time from x12f to the receptor position for [r] -c receptors in the lower (l) and upper (u) flows -c tstep (s) length of the time-step [r] -c tstart (s) age of the current puff at the start of the period [r] -c timpg (s) age of the current puff at x12f [r] -c szimpg (m) sigma-z at the impingement point [r] -c syimpg (m) sigma-y at the impingement point [r] -c szesq (m**2) square of the effective sigma-z of the puff at the [r] -c receptor -c szosq (m**2) square of the sigma-z of the puff at the x12f [r] -c (or 1 sec. after release if timpg<0) -c szsq (m**2) square of the sigma-z of the puff at the receptor [r] -c (no hill) -c szpsq (m**2) szsq-szosq [r] -c at array of deformation factors (th,tl) at points [ra] -c along the trajectory [at(1,-)=th, at(2,-)=tl] -c -c -------------- New data used to allow CTDM hill specification -------- -c mhillt option to use hill information from: [i] -c 1 = CTDM preprocessor -c 2 = original OPTHILL preprocessor -c nzh number of heights for which ellipse variables are [ia] -c provided, specified for each hill -c zh (m ) heights for which ellipse variables are provided [ra] -c (initially MSL, but referenced to grid cell elev -c in CTINIT) -c majaxw (m) length of major semi-axis of elliptical contour [ra] -c for a specific value of zh -c minaxw (m) length of minor semi-axis of elliptical contour [ra] -c for a specific value of zh -c ---------------------------------------------------------------------- -c ldb debug control logical [l] -c idebug io unit for debug writes [l] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/ctsgdat.puf b/CALPUFF_SRC/CALPUFF/ctsgdat.puf deleted file mode 100644 index 3a8b37e..0000000 --- a/CALPUFF_SRC/CALPUFF/ctsgdat.puf +++ /dev/null @@ -1,76 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /CTSGDAT/ -- Subgrid-scale complex terrain CALPUFF -c information -c---------------------------------------------------------------------- -c - common/CTSGDAT/NHILL,NCTREC,MHILL, - 1 XHILL2M,ZHILL2M,XCTDMKM,YCTDMKM,XMETCT0M,YMETCT0M, - 2 HILLDAT(11,mxhill),XRCT(mxrect),YRCT(mxrect),ELRECT(mxrect), - 3 IHILL(mxrect) -c -c --- COMMON BLOCK /CTSGDAT/ Variables: -c -c NHILL - integer - Number of subgrid-scale terrain -c features -c NCTREC - integer - Number of special complex terrain -c receptors -c MHILL - integer - Method for input of hill terrain -c data -c 1 = Created by CTDM processor -c programs (in CTDM format) -c 2 = Created by CALPUFF OPTHILL -c processor & read in Input -c Group (6b) -c XHILL2M - real - scale factor to convert horizontal -c hill dimensions to meters for -c MHILL=1 (CTDM Files) -c ZHILL2M - real - scale factor to convert vertical -c hill dimensions to meters for -c MHILL=1 (CTDM Files) -c XCTDMKM - real - x-origin of CTDM coordinate system -c referenced to "UTM" coordinate -c system used in CALPUFF (km) -c MHILL=1 (CTDM Files) -c YCTDMKM - real - y-origin of CTDM coordinate system -c referenced to "UTM" coordinate -c system used in CALPUFF (km) -c MHILL=1 (CTDM Files) -c XMETCT0M - real - x-origin of CTDM coordinate system -c referenced to SW corner of -c CALPUFF MET grid (m) -c MHILL=1 (CTDM Files) -c YMETCT0M - real - y-origin of CTDM coordinate system -c referenced to SW corner of -c CALPUFF MET grid (m) -c MHILL=1 (CTDM Files) -c HILLDAT(11,mxhill) - real - Hill data for MHILL=2 -c (1,-)= XC -- X coordinate of center of hill -c (met. grid units) -c (2,-)= YC -- Y coordinate of center of hill -c (met. grid units) -c (3,-)= THETAH -- Orientation of major axis of -c hill (clockwise from North) -c (4,-)= ZGRID -- Height of the "zero-plane" -c of the grid above mean sea level -c (5,-)= RELIEF -- Height of the crest of the -c hill above the grid elevation -c (6,-)= EXPO 1 -- Hill-shape exponent for the -c major axis -c (7,-)= EXPO 2 -- Hill-shape exponent for the -c major axis -c (8,-)= SCALE 1 -- Horizontal length scale -c along the major axis -c (9,-)= SCALE 2 -- Horizontal length scale -c along the minor axis -c (10,-)= AMAX -- Maximum allowed axis length -c for the major axis -c (11,-)= BMAX -- Maximum allowed axis length -c for the major axis -c XRCT(mxrect) - real - X coordinate of complex terrain -c receptor (met. grid units) -c YRCT(mxrect) - real - Y coordinate of complex terrain -c receptor (met. grid units) -c ELRECT(mxrect) - real - Ground elevation (m MSL) of each -c complex terrain receptor -c IHILL(mxrect) - integer - Hill number associated with each -c complex terrain receptor diff --git a/CALPUFF_SRC/CALPUFF/current.puf b/CALPUFF_SRC/CALPUFF/current.puf deleted file mode 100644 index ba75121..0000000 --- a/CALPUFF_SRC/CALPUFF/current.puf +++ /dev/null @@ -1,180 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /CURRENT/ -- Info. for current puff/slug CALPUFF -c---------------------------------------------------------------------- -c - logical lup1,lup2 -c - common/CURRENT/xb1,yb1,zb1,syb1,szb1, - 1 xe1,ye1,ze1,sye1,sze1, - 2 vtyb1,vtzb1,vtye1,vtze1, - 3 vdyb1,vdzb1,vdye1,vdze1, - 4 xb2,yb2,zb2,syb2,szb2, - 5 xttb1,xtte1,tb1,te1,sym1,szm1,zm1, - 6 xe2,ye2,ze2,sye2,sze2, - 7 vtyb2,vtzb2,vtye2,vtze2, - 8 vdyb2,vdzb2,vdye2,vdze2, - 9 xttb2,xtte2,tb2,te2,ixmc,iymc,mdmc, - & fracz1,fracz2,lup1,lup2, - 1 ipnum,isnum,istype,icode,imet, - 2 iage,speedi,srat,temis,iqstep, - 3 bidsq,xfrise,zfrise,sy0sq,vsetl,zplat, -c ----------- POLYGON area source data --------------- - 4 nside,xvert(mxvert),yvert(mxvert), - 5 xv(mxvert),yv(mxvert),aream2, -c ----------- POLYGON line source data --------------- - 6 xshift,xupedge, -c ----------- DISPERSION OPTION data --------------- - 7 idopty,idoptz -c -c -c --- COMMON BLOCK /CURRENT/ Variables: -c -c Puff or Older end of Slug ----- -c XB1,YB1,ZB1 - real -Coordinates (m) of the PUFF or OLDER -c end of the SLUG at the BEGINNING (B) -c of the time step (i.e., time = T). -c SYB1,SZB1 - real - are the corresponding Sigmas (m) with -c BID (note SX = SY assumed). -c XE1,YE1,ZE1 - real -Coordinates (m) of the PUFF or OLDER -c end of the SLUG at the END (E) of -c the time step (i.e., time = T+DT). -c SYE1,SZE1 - real - are the corresponding Sigmas (m) with -c BID (note SX = SY assumed). -c VTYB1,VTZB1 - real - Virtual travel TIME (s) for sigmas of -c PUFF or OLDER end of SLUG at BEGINNING -c of step -c VTYE1,VTZE1 - real - Virtual travel TIME (s) for sigmas of -c PUFF or OLDER end of SLUG at END -c of step -c VDYB1,VDZB1 - real - Virtual travel DIST (km) for sigmas of -c PUFF or OLDER end of SLUG at BEGINNING -c of step -c VDYE1,VDZE1 - real - Virtual travel DIST (km) for sigmas of -c PUFF or OLDER end of SLUG at END -c of step -c XTTB1 - real - Total travel distance of PUFF or OLDER -c end of SLUG at the BEGINNING of the -c time step. -c XTTE1 - real - Total travel distance of PUFF or OLDER -c end of SLUG at the END of the -c time step. -c TB1 - real - Total travel time of PUFF or OLDER -c end of SLUG at the BEGINNING of the -c time step. -c TE1 - real - Total travel time of PUFF or OLDER -c end of SLUG at the END of the -c time step. -c SYM1,SZM1,ZM1 - real - PUFF sigmas and ht (m) at midpoint -c with BID -c -c Younger end of Slug ---------- -c XB2,YB2,ZB2 - real - Coordinates (m) of the YOUNGER end -c of the SLUG at the BEGINNING (B) of -c the time step (i.e., time = T). -c SYB2,SZB2 - real - are the corresponding Sigmas (m) with -c BID (note SX = SY assumed). -c XE2,YE2,ZE2 - real -Coordinates (m) of the YOUNGER end -c of the SLUG at the END (E) of -c the time step (i.e., time = T+DT). -c SYE2,SZE2 - real - are the corresponding Sigmas (m) with -c BID (note SX = SY assumed). -c VTYB2,VTZB2 - real - Virtual travel TIME (s) for sigmas of -c YOUNGER end of SLUG at BEGINNING -c of step -c VTYE2,VTZE2 - real - Virtual travel TIME (s) for sigmas of -c YOUNGER end of SLUG at END of step -c VDYB2,VDZB2 - real - Virtual travel DIST (km) for sigmas of -c YOUNGER end of SLUG at BEGINNING -c of step -c VDYE2,VDZE2 - real - Virtual travel DIST (km) for sigmas of -c YOUNGER end of SLUG at END of step -c XTTB2 - real - Total travel distance of YOUNGER end -c at the BEGINNING of the time step. -c XTTE2 - real - Total travel distance of YOUNGER end -c at the END of the time step. -c TB2 - real - Total travel time of YOUNGER end -c at the BEGINNING of the time step. -c TE2 - real - Total travel distance of YOUNGER end -c at the END of the time step. -c -c Misc. Puff/Slug -------------- -c IXMC,IYMC,MDMC - integer - Grid cell (i,j) and Met domain (md) -c at midpoint of step (movement of puff -c or slug center) -c FRACZ1, FRACZ2 - real - Fraction of step beyond which puff ht -c is constant for upslope flow, or up -c to which puff height is constant for -c downslope flow, for puff (1); -c or for old (1) and new (2) end of slug -c LUP1,LUP2 - logical - Flag for upslope flow when .TRUE. for -c puff (1); or for old (1) and new (2) -c end of slug -c IPNUM - integer - Current "Puff(Slug)" index number -c ISNUM - integer - Associated source index -c ISTYPE - integer - Associated source type: -c 1 = Point Constant Emissions -c (2)= Point Variable Emissions -c 3 = Poly. Area Constant Emissions -c (4)= Poly. Area Variable Emissions -c 5 = Line Constant Emissions -c 6 = Volume Constant Emissions -c (7)= Grid Volume Constant Emissions -c (8)= Grid Volume Variable Emissions -c ICODE - integer - Current "Puff(Slug)" code -c (see IPUFCD in /PUFF/) -c IMET - integer - Met index for source tabulations such -c as numerical plume rise -c =1 current meteorology -c =2 previous meteorology -c =3 previous previous meteorology -c =4 (etc.) -c Limited by MXMETSAV parameter -c IAGE - integer - Age indicator. -c =0 implies material is being emitted. -c >0 implies material is older. -c SPEEDI - real - Wind speed at emission time (m/s) -c SRAT - real - Ratio of the vector mean wind speed -c to scalar speed at emission time -c TEMIS - real - Duration of the original emission (s) -c IQSTEP - integer - Emission step index for source -c BIDSQ - real - Square of buoyancy-induced sigma at -c final rise (m^2) -c XFRISE - real - Distance to final rise (m) -c ZFRISE - real - Final puff/slug rise (m) -- not height -c SY0SQ - real - Square of sigma-y associated with area -c source (m^2) -c VSETL - real - Gravitational settling velocity (m/s) -c for current puff -c ZPLAT - real - Platform (downwash) ht above surface (m) -c NSIDE - integer - # sides of the polygon area source. -c XVERT(mxvert) - real - X coordinates (m) of the vertices of -c the polygon area source. -c YVERT(mxvert) - real - Y coordinates (m) of the vertices of -c the polygon area source. -c XV(mxvert) - real - Upwind distances (m) from a receptor -c to vertices of polygon area source. -c YV(mxvert) - real - Crosswind distances (m) from receptor -c to vertices of polygon area source. -c AREAM2 - real - Area of source (m^2) -c XSHIFT - real - Distance from upwind edge of block -c of line sources to source of current -c slug (m) -c XUPEDGE - real - Distance from upwind edge of block -c of line sources to receptor, along -c current flow direction (m) -c IDOPTY,IDOPTZ - integer - Dispersion option for sigma-y and -c sigma-z (Derived from MDISP:1-5) -c -c *** Notes: -c -c --- Note that for IAGE = 0, (XB2,YB2,ZB2) = (XE2,YE2,ZE2) = (XS,YS,ZS) -c (i.e., where (XS,YS,ZS) are source coordinates) and -c (SYB2,SZB2) = (SYE2,SZE2) = (SY0,SZ0) (i.e., where (SY0,SZ0) are -c the initial sigmas at the source). -c -c --- SRAT is the ratio of the vector mean wind speed at emission time -c to SPEEDI. It is needed for model self-consistency and to avoid -c absurd results as the VMWS goes to zero. Note that for most -c reasonable winds, SRAT > 0.95 so there are few significant -c problems. -c -------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/dataset.puf b/CALPUFF_SRC/CALPUFF/dataset.puf deleted file mode 100644 index 968e1ca..0000000 --- a/CALPUFF_SRC/CALPUFF/dataset.puf +++ /dev/null @@ -1,77 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /DATASET/ -- CALPUFF dataset versions CALPUFF -c---------------------------------------------------------------------- - - character*16 vercmet,verisc,verplm,verprf,versfc - character*16 verparb,veraarb,verlarb,vervarb - character*16 veroz,verh2o2,vercoast,verflxb,verbcon,verrest - character*16 verflarb - - common/dataset/ vercmet(mxmetdom),verisc,verplm,verprf,versfc, - & verparb(mxemdat),veraarb(mxemdat), - & verlarb,vervarb(mxemdat),verflarb(mxemdat), - & veroz,verh2o2,vercoast,verflxb,verbcon,verrest - -c -c --- COMMON BLOCK /DATASET/ Variables: -c VERCMET - char*16 - Version of the CALMET -c binary meteorological file in -c CALPUFF/CALGRID format -c (CALMET.DAT) -c VERISC - char*16 - Version of the ISC-type of -c ASCII meteorological file -c (ISCMET.DAT) -c VERPLM - char*16 - Version of the AUSPLUME-type of -c ASCII meteorological file -c (PLMMET.DAT) -c VERPRF - char*16 - Version of the input CALPUFF -c file for "tower" met data, including -c turbulence data -c (PROFILE.DAT) -c VERSFC - char*16 - Version of the input CALPUFF -c file of surface parameters -c (SURFACE.DAT) -c VERPARB - char*16 - Version of the input CALPUFF -c file(s) containing point source emissions -c with arbitrarily-varying source and -c emission parameters -c (PTEMARB.DAT) -c VERVARB - char*16 - Version of the input CALPUFF -c file(s) containing volume sources -c with arbitrarily-varying source and -c emission parameters -c (VOLEMARB.DAT) -c VERAARB - char*16 - Version of the input CALPUFF -c file(s) containing buoyant area sources -c with arbitrarily-varying location and -c emissions -c (BAEMARB.DAT) -c VERLARB - char*16 - Version of the input CALPUFF -c file containing buoyant line sources -c with arbitrarily-varying location and -c emissions -c (LNEMARB.DAT) -c VERFLARB - char*16 - Version of the input CALPUFF -c file(s) containing flare sources -c with arbitrarily-varying location and -c emissions -c (FLEMARB.DAT) -c VEROZ - char*16 - Version of the input CALPUFF -c file with hourly ozone monitoring data -c (OZONE.DAT) -c VERH2O2 - char*16 - Version of the input CALPUFF -c file with hourly H2O2 monitoring data -c (H2O2.DAT) -c VERCOAST - char*16 - Version of the input CALPUFF -c file with coast line data used with -c sub-grid TIBL module -c (COASTLN.DAT) -c VERFLXB - char*16 - Version of the input CALPUFF -c file with boundary data used for mass -c flux module -c (FLUXBDY.DAT) -c VERBCON - char*16 - Version of the input CALPUFF -c file with boundary condition data -c (BCON.DAT) -c VERREST - char*16 - Version of the RESTART file -c (RESTART.DAT) diff --git a/CALPUFF_SRC/CALPUFF/datehr.puf b/CALPUFF_SRC/CALPUFF/datehr.puf deleted file mode 100644 index c9fe049..0000000 --- a/CALPUFF_SRC/CALPUFF/datehr.puf +++ /dev/null @@ -1,44 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /DATEHR/ -- Date/time variables CALPUFF -c---------------------------------------------------------------------- -c - integer nyrb,nmob,ndayb,njulb,nhrb,nsecb,ndathrb - integer nyre,nmoe,ndaye,njule,nhre,nsece,ndathre - integer nyrm,njulm,nhrm,nsecm,ndathrm - integer nyrab,nmoab,ndayab,njulab,nhrab,nsecab - integer nhrind - real xbtz - character*8 abtz -c - common/datehr/nyrb,nmob,ndayb,njulb,nhrb,nsecb,ndathrb, - 1 nyre,nmoe,ndaye,njule,nhre,nsece,ndathre, - 2 nyrm,njulm,nhrm,nsecm,ndathrm, - 3 nyrab,nmoab,ndayab,njulab,nhrab,nsecab, - 4 nhrind,xbtz,abtz -c -c --- COMMON BLOCK /DATEHR/ Variables: -c NYR[B,M,E] - integer - Four digit year -c NMO[B,E] - integer - Month -c NDAY[B,E] - integer - Day of month -c NJUL[B,M,E] - integer - Julian day -c NHR[B,M,E] - integer - Current hour (00-23) -c NSEC[B,M,E] - integer - Current second (0-3599) -c NDATHR[B,M,E] - integer - Code date and time (YYYYJJJHH, where -c YYYY=year, JJJ=Julian day, HH=hour) -c---------------------------------------------------------------------- -c --- Note: B,E denotes date-time at the beginning or end of the step -c M denotes date-time at the middle of the step -c---------------------------------------------------------------------- -c NYRAB - integer - Four digit year -c NMOAB - integer - Month -c NDAYAB - integer - Day of month -c NJULAB - integer - Julian day -c NHRAB - integer - Current hour (00-23) -c NSECAB - integer - Current second (0-3599) -c---------------------------------------------------------------------- -c --- Note: AB denotes date-time at the Beginning of an Averaging Pd -c---------------------------------------------------------------------- -c NHRIND - integer - Hour index (01-24) for midpoint of step -c XBTZ - real - Base time zone for current date/time -c ABTZ - char*8 - Base time zone for current date/time -c as string UTC+hhmm diff --git a/CALPUFF_SRC/CALPUFF/dispdat.puf b/CALPUFF_SRC/CALPUFF/dispdat.puf deleted file mode 100644 index c1d61f8..0000000 --- a/CALPUFF_SRC/CALPUFF/dispdat.puf +++ /dev/null @@ -1,28 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /DISPDAT/ -- Dispersion parameters CALPUFF -c -c---------------------------------------------------------------------- -c - common/DISPDAT/SYTDEP,JSUP,CONK1,CONK2,IURB1,IURB2,AVET,PGTIME - & ,AVGTIMFAC -c -c --- COMMON BLOCK /DISPDAT/ Variables: -c -c SYTDEP - real - Horizontal sigma (m) beyond which -c time dependent growth assumed. -c JSUP - integer - Stability class used to determine plume -c growth rates for puffs above the boundary -c layer -c CONK1 - real - Vertical dispersion constant for stable -c conditions -c CONK2 - real - Vertical dispersion constant for neutral/ -c unstable conditions -c IURB1, - integers - Range of land use categories for which -c IURB2 urban dispersion is assumed -c AVET - real - Averaging time of concentrations (minutes) -c (used to adjust PG sigma y with eqn. -c (AVET/PGTIME)**0.2 -c PGTIME - real - Averaging time (minutes) assumed for -c PG sigma y curves -c AVGTIMFAC - real - Computed (AVET/PGTIME)**0.2 used to adjust -c turbulence sigma-v for non-PG sigma y diff --git a/CALPUFF_SRC/CALPUFF/drydep.puf b/CALPUFF_SRC/CALPUFF/drydep.puf deleted file mode 100644 index 6e1ed5d..0000000 --- a/CALPUFF_SRC/CALPUFF/drydep.puf +++ /dev/null @@ -1,27 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /DRYDEP/ -- Dry deposition flags CALPUFF -c---------------------------------------------------------------------- -c - common/DRYDEP/idryflg(mxspec),vduser(24,mxspec),nvduser, - 1 zref,iveg -c -c --- COMMON BLOCK /DRYDEP/ Variable: -c -c IDRYFLG(mxspec) - integer - Array of dry deposition flags for -c each pollutant -c 0 = No deposition -c 1 = Resistance model - gas -c 2 = Resistance model - particle -c 3 = User-specified dep. velocities -c VDUSER(24,mxspec) - real - Deposition velocity (m/s) for each -c hour of the day and species -c (missing values indicated by -999.) -c NVDUSER - integer - Number of species for which the -c user-specified deposition velocities -c are used -c ZREF - real - Reference height (m) for computing -c the atmospheric resistance -c IVEG - integer - Vegetation index in unirrigated areas -c 1=vegetation is active & unstressed -c 2=vegetation is active & stressed -c 3=vegetation is inactive diff --git a/CALPUFF_SRC/CALPUFF/drygas.puf b/CALPUFF_SRC/CALPUFF/drygas.puf deleted file mode 100644 index 0508eeb..0000000 --- a/CALPUFF_SRC/CALPUFF/drygas.puf +++ /dev/null @@ -1,57 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /DRYGAS/ -- Dry deposition parameters CALPUFF -c---------------------------------------------------------------------- -c - common/DRYGAS/pdiff(mxspec),alphas(mxspec),react(mxspec), - 1 rm(mxspec),henry(mxspec),rgg(mxspec),rgw1(mxspec),rcut(mxspec), - 2 rd1(mxspec),rcutr,rgr,reactr,pconst,bmin,bmax,qswmax,dconst1, - 3 dconst2,dconst3 -c -c --- COMMON BLOCK /DRYGAS/ Variables: -c PDIFF(mxspec) - real - Molecular diffusivity (m**2/s) -c of each pollutant. -c SEE NOTE #1 -c ALPHAS(mxspec) - real - Solubility enhancement factor due -c to the aqueous phase reactivity of -c the pollutant. -c REACT(mxspec) - real - Reactivity factor for each -c pollutant. -c RM(mxspec) - real - Mesophyll resistance (s/m) -c SEE NOTE #2 -c HENRY(mxspec) - real - Henry's law constant (ratio of -c gas to aqueous phase concentration -c of the pollutant). -c RGG(mxspec) - real - Resistance (s/m) to direct -c transfer of the pollutant to the -c ground. -c RGW1(mxspec) - real - Ratio of HENRY(i)/(ALPHAS(i)*d3) -c where d3 is a constant. Used in -c computing resistance directly to -c water surface. -c RCUT(mxspec) - real - Cuticle resistance (s/m). -c RD1(mxspec) - real - Ratio d1*SC**d2/k, where d1,d2 are -c constants, SC is the Schmidt -c number, and k is the von Karman -c constant -c RCUTR - real - Reference cuticle resistance (s/m) -c SEE NOTE #2 -c RGR - real - Reference ground resistance (s/m) -c SEE NOTE #2 -c REACTR - real - Reference pollutant reactivity -c PCONST - real - Stomatal constant (m**2) -c BMIN - real - Minimum width of the stomatal -c opening (m) -c BMAX - real - Maximum width of the stomatal -c opening (m) -c QSWMAX - real - Short-wave solar radiation (W/m**2) -c level at which full opening of the -c stomata occurs -c DCONST1,DCONST2 - real - Empirical constants in deposition -c layer resistance equation -c DCONST3 - real - Constant in the "ground" resistance -c to water surfaces -c -c NOTE #1: Input units of this variable are cm**2/s. Conversion to m**2/s -c is made internally in the SETUP phase. -c -c NOTE #2: Input units of s/cm are converted to s/m in the SETUP phase. diff --git a/CALPUFF_SRC/CALPUFF/drypart.puf b/CALPUFF_SRC/CALPUFF/drypart.puf deleted file mode 100644 index 799b953..0000000 --- a/CALPUFF_SRC/CALPUFF/drypart.puf +++ /dev/null @@ -1,29 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /DRYPART/ -- Particle dry dep. parameters CALPUFF -c---------------------------------------------------------------------- -c - common/DRYPART/nspart,gdiam(mxpdep),gsig(mxpdep),rho(mxpdep), - 1 npsint,dconst4,pdiam(mxint,mxpdep),sc23(mxint,mxpdep), - 2 vgrav(mxint,mxpdep),tstop(mxint,mxpdep),fract(mxint,mxpdep), - 3 vairms -c -c --- COMMON BLOCK /DRYPART/ Variables: -c NSPART - real - Number of particle species -c GDIAM(mxpdep) - real - Geometric mass mean diameter -c (microns) -c GSIG(mxpdep) - real - Geometric standard deviation of -c particle distribution (microns) -c RHO(mxpdep) - real - Particle density (g/cm**3) -c NPSINT - integer - Number of size intervals used to -c evaluate the effective particle -c deposition velocity -c DCONST4 - real - Empirical constant in particle -c deposition layer resistance eqn. -c PDIAM(mxint,mxpdep) - real - Geometric mean diameter (microns) -c of each interval -c SC23(mxint,mxpdep) - real - Schmidt number ** DCONST4 -c VGRAV(mxint,mxpdep) - real - Gravitational settling velocity -c (m/s) -c TSTOP(mxint,mxpdep) - real - Stopping time (s) -c FRACT(mxint,mxpdep) - real - Mass fraction in each size interval -c VAIRMS - real - Viscosity of air (m**2/s) diff --git a/CALPUFF_SRC/CALPUFF/filnam.puf b/CALPUFF_SRC/CALPUFF/filnam.puf deleted file mode 100644 index 7af2c8a..0000000 --- a/CALPUFF_SRC/CALPUFF/filnam.puf +++ /dev/null @@ -1,181 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /FILNAM/ -- CALPUFF file names CALPUFF -c---------------------------------------------------------------------- -c - integer nmetdat(mxmetdom),imetdat(mxmetdom) - character*132 pufinp,metdat,iscdat,plmdat,puflst,condat, - 1 dfdat,wfdat,visdat,t2ddat,rhodat,lndat,ozdat,vddat, - 2 chemdat,hildat,rctdat,prfdat,sfcdat,rstartb,rstarte, - 3 cstdat,bdydat,flxdat,baldat,bcndat,fogdat,h2o2dat,debug, - 4 risdat,trkdat,nh3zdat - character*132 metdatl(mxmetdat,mxmetdom),metdoml(mxmetdom) - character*132 ptdat(mxemdat),ardat(mxemdat),voldat(mxemdat) - character*132 fldat(mxemdat) - character*16 auxext - logical lcfiles -c - common/filnam/nmetdatall,nmetdat,nmetdom,imetdat, - 1 nptdat,nardat,nvoldat,nfldat,nlndat, - 2 pufinp,metdat,metdatl,metdoml,iscdat,plmdat,puflst,condat, - 3 dfdat,wfdat,visdat,t2ddat,rhodat,ptdat,voldat,ardat,lndat, - 4 fldat,ozdat,vddat,chemdat, - 5 hildat,rctdat,prfdat,sfcdat,rstartb,rstarte, - 6 cstdat,bdydat,flxdat,baldat,bcndat,fogdat,h2o2dat,debug, - 7 risdat,trkdat,nh3zdat,auxext - common/fillog/lcfiles -c -c --- COMMON BLOCK /FILNAM/, /FILLOG/ Variables: -c NMETDATALL- integer- Number of names provided in METDATL for -c all met grids combined -c NMETDAT(mxmetdom)- integer- Number of names provided in METDATL for -c each met grid (master and nested grids) -c NMETDOM - integer- Number of met domains (master + nested) -c IMETDAT(mxmetdom)- integer- Current METDATL file being used for -c each met grid (master and nested grids) -c NPTDAT - integer - Number of names provided in PTDAT -c NARDAT - integer - Number of names provided in ARDAT -c NVOLDAT - integer - Number of names provided in VOLDAT -c NFLDAT - integer - Number of names provided in FLDAT -c NLNDAT - integer - Number of names provided in LNDAT -c (must be 0 or 1) -c PUFINP - char*132- Path & filename for the control file -c (default: CALPUFF.INP) -c METDAT - char*132- Path & filename for the CALMET -c binary meteorological file in -c CALPUFF/CALGRID format when single file -c is used -c (default: CALMET.DAT) -c METDATL(mxmetdat,mxmetdom) -c - char*132- Path & filename for the LIST of CALMET -c array binary meteorological files -c METDOML(mxmetdom) -c - char*132- List of names for CALMET domains -c array -c ISCDAT - char*132- Path & filename for the ISC-type of -c ASCII meteorological file -c (default: ISCMET.DAT) -c PLMDAT - char*132- Path & filename for the AUSPLUME-type of -c ASCII meteorological file -c (default: PLMMET.DAT) -c PUFLST - char*132- Path & filename for the output CALPUFF -c list file -c (default: CALPUFF.LST) -c CONDAT - char*132- Path & filename for the output CALPUFF -c unformatted concentration file -c (default: CONC.DAT) -c DFDAT - char*132- Path & filename for the output CALPUFF -c unformatted dry deposition flux file -c (default: DF.DAT) -c WFDAT - char*132- Path & filename for the output CALPUFF -c unformatted wet deposition flux file -c (default: WF.DAT) -c VISDAT - char*132- Path & filename for the output CALPUFF -c RH data file for visibility calculations -c (default: VISB.DAT) -c T2DDAT - char*132- Path & filename for the output CALPUFF -c 2D Temperature data file for visibility -c related processing -c (default: TK2D.DAT) -c RHODAT - char*132- Path & filename for the output CALPUFF -c 2D Density data file for visibility -c related processing -c (default: RHO2D.DAT) -c PTDAT(mxemdat) - char*132- Path & filename for the input CALPUFF -c file(s) containing point source emissions -c with arbitrarily-varying source and -c emission parameters -c (default: PTEMARB.DAT, for 1 file) -c FLDAT(mxemdat) - char*132- Path & filename for the input CALPUFF -c file(s) containing FLARE sources with -c arbitrarily-varying location and -c emissions -c (default: FLEMARB.DAT, for 1 file) -c VOLDAT(mxemdat) - char*132- Path & filename for the input CALPUFF -c file(s) containing volume sources -c with arbitrarily-varying source and -c emission parameters -c (default: VOLEMARB.DAT, for 1 file) -c ARDAT(mxemdat) - char*132- Path & filename for the input CALPUFF -c file(s) containing buoyant area sources -c with arbitrarily-varying location and -c emissions -c (default: BAEMARB.DAT, for 1 file) -c LNDAT - char*132- Path & filename for the input CALPUFF -c file containing buoyant line sources -c with arbitrarily-varying location and -c emissions -c (default: LNEMARB.DAT) -c OZDAT - char*132- Path & filename for the input CALPUFF -c file with hourly ozone monitoring data -c (default: OZONE.DAT) -c VDDAT - char*132- Path & filename for the input CALPUFF -c file with user-specified deposition -c velocities -c (default: VD.DAT) -c CHEMDAT - char*132- Path & filename for the input CALPUFF -c file with user-specified chemical -c transformation rates -c (default: CHEM.DAT) -c HILDAT - char*132- Path & filename for the input CALPUFF -c file with CTSG hill specifications from -c the CTDM terrain processor -c (default: HILL.DAT) -c RCTDAT - char*132- Path & filename for the input CALPUFF -c file with CTSG receptors from the -c CTDM receptor generator -c (default: HILLRCT.DAT) -c PRFDAT - char*132- Path & filename for the input CALPUFF -c file for "tower" met data, including -c turbulence data -c (default: PROFILE.DAT) -c SFCDAT - char*132- Path & filename for the input CALPUFF -c file of surface parameters -c (default: SURFACE.DAT) -c RSTARTB - char*132- Path & filename for the RESTART file used -c at beginning of continuation run -c RSTARTE - char*132- Path & filename for the RESTART file made -c during current run (last update at end) -c CSTDAT - char*132- Path & filename for the input CALPUFF -c file with coast line data used with -c sub-grid TIBL module -c (default: COASTLN.DAT) -c BDYDAT - char*132- Path & filename for the input CALPUFF -c file with boundary data used for mass -c flux module -c (default: FLUXBDY.DAT) -c FLXDAT - char*132- Path & filename for the output CALPUFF -c file with hourly mass flux data -c (default: MASSFLX.DAT) -c BALDAT - char*132- Path & filename for the output CALPUFF -c file with hourly mass balance data -c (default: MASSBAL.DAT) -c BCNDAT - char*132- Path & filename for the input CALPUFF -c file with boundary condition data -c (default: BCON.DAT) -c FOGDAT - char*132- Path & filename for the output CALPUFF -c file with data for FOG processor -c (default: FOG.DAT) -c H2O2DAT - char*132- Path & filename for the input CALPUFF -c file with hourly H2O2 monitoring data -c (default: H2O2.DAT) -c DEBUG - char*132- Path & filename for the output CALPUFF -c file containing debug puff/slug data -c (default: DEBUG.DAT) -c RISDAT - char*132- Path & filename for the output CALPUFF -c file with intermediate data from numerical -c rise module -c (default: RISE.DAT) -c TRKDAT - char*132- Path & filename for the output CALPUFF -c file with PUFF-TRACKING data -c (default: PFTRAK.DAT) -c NH3ZDAT - char*132- Path & filename for the input CALPUFF -c file with vertical NH3 concentration profile -c (default: NH3Z.DAT) -c AUXEXT - char*16 - filename extension (with dot) for -c auxiliary CALMET 2D/3D data files -c Expected input is without the dot -c (default: AUX) -c LCFILES - logical - Switch indicating if all characters in the -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c case letters (LCFILES=F). diff --git a/CALPUFF_SRC/CALPUFF/fl1.puf b/CALPUFF_SRC/CALPUFF/fl1.puf deleted file mode 100644 index 1412117..0000000 --- a/CALPUFF_SRC/CALPUFF/fl1.puf +++ /dev/null @@ -1,61 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /FL1/ -- Flare source data for sources CALPUFF -c configured in control-file -c (not active) -c---------------------------------------------------------------------- - character*16 CNAMFL1 - character*40 CSFFL1 - common/FL1/ NFL1,IFLU,NSFL1,QFL1(mxspec,mxfl1), - 2 IDSFFL1(mxspec,mxfl1),IXREFFL1(mxspfl), - 4 XFL1GRD(mxfl1),YFL1GRD(mxfl1), - 5 HTFL1(mxfl1),ELFL1(mxfl1), - 6 DFL1(mxfl1),TFL1(mxfl1), - 7 UFL1(mxfl1),VFL1(mxfl1),WFL1(mxfl1), - 8 SY0FL1(mxfl1),SZ0FL1(mxfl1), - 9 NEWFL1(mxfl1),CNAMFL1(mxfl1),CSFFL1(mxspfl) - -c -c --- COMMON BLOCK /FL1/ Variables: -c NFL1 - integer - Number control-file flare sources -c QFL1(mxspec,mxfl1) - real - Emission rate (g/s) for each -c pollutant -c NEWFL1(mxfl1) - integer - Number of puffs released by each -c source during the current step -c IFLU - integer - Units for emission rates in -c control file -c 1: g/s -c 2: kg/hr -c 3: lb/hr -c 4: ton/yr -c 5: Odour Unit * m**3/s -c 6: Odour Unit * m**3/min -c 7: metric tons/yr -c 8: Bq/s (Bq = becquerel = disintegrations/s) -c 9: GBq/yr -c NSFL1 - integer - Number of flare-species pairs -c with emissions scaling factors -c IDSFFL1(mxspec,mxfl1) - integer - Pointer to flare-species pair -c index, 0 to NSFL1 -c (0 if no scaling) -c CSFFL1(mxspfl) - c*40 arr - List of scale-factor table names -c for flare-species pairs -c IXREFFL1(mxspfl) - integer - Cross-reference pointer from -c flare-species pairs to -c scale-factor tables -c XFL1GRD(mxfl1) - real - X coordinate of a flare -c source in grid units -c (i.e., origin at (0.0,0.0)) -c YFL1GRD(mxfl1) - real - Y coordinate of a flare -c source in grid units -c (i.e., origin at (0.0,0.0)) -c HTFL1(mxfl1) - real - Effective stack height (m) -c ELFL1(mxfl1) - real - Ground elevation (m) above sea -c level -c DFL1(mxfl1) - real - Effective stack diameter (m) -c TFL1(mxfl1) - real - Effective stack temperature (K) -c UFL1(mxfl1) - real - Effective exit velocity in x (m/s) -c VFL1(mxfl1) - real - Effective exit velocity in y (m/s) -c WFL1(mxfl1) - real - Effective exit velocity in z (m/s) -c SY0FL1(mxfl1) - real - Initial sigma y (m) -c SZ0FL1(mxfl1) - real - Initial sigma z (m) -c CNAMFL1(mxfl1) - c*16 arr - Source names diff --git a/CALPUFF_SRC/CALPUFF/fl2.puf b/CALPUFF_SRC/CALPUFF/fl2.puf deleted file mode 100644 index 9eb2d82..0000000 --- a/CALPUFF_SRC/CALPUFF/fl2.puf +++ /dev/null @@ -1,160 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /FL2/ -- Flare source data for sources CALPUFF -c with variable characteristics -c in FLEMARB.DAT files -c---------------------------------------------------------------------- -c - character*12 cslst6 - character*16 cid6 - - logical*4 lutmfl2,llccfl2,lpsfl2,lemfl2,llazafl2,lttmfl2 - character*4 utmhemfl2,xyunitfl2 - character*8 datumfl2,pmapfl2 - character*12 datenfl2 - - common/FL2/ NFL2,NSE6,MFFL2(mxemdat), - 1 IBSRC6(mxemdat),IESRC6(mxemdat), - 2 IBDATHR6(mxemdat),IBSEC6(mxemdat),IEDATHR6(mxemdat), - 3 IESEC6(mxemdat),XTZ6(mxemdat),T2BTZ6(mxemdat), - 4 XMWEM6(mxspec),IXREM6(mxspec),TIEM6(8,mxfl2), - 5 lutmfl2(mxemdat),llccfl2(mxemdat),lpsfl2(mxemdat), - 6 lemfl2(mxemdat),llazafl2(mxemdat),lttmfl2(mxemdat), - 7 iutmznfl2(mxemdat),feastfl2(mxemdat),fnorthfl2(mxemdat), - 8 rnlat0fl2(mxemdat),relon0fl2(mxemdat), - 9 rnlat1fl2(mxemdat),rnlat2fl2(mxemdat),NSTEP6(mxemdat), - & NDHRQB6(mxqstep,mxemdat),NSECQB6(mxqstep,mxemdat), - 1 NDHRQE6(mxqstep,mxemdat),NSECQE6(mxqstep,mxemdat), - 2 XFL2GRD(mxqstep,mxfl2),YFL2GRD(mxqstep,mxfl2), - 3 HTFL2(mxqstep,mxfl2),ELFL2(mxqstep,mxfl2), - 4 DFL2(mxqstep,mxfl2),TFL2(mxqstep,mxfl2), - 5 UFL2(mxqstep,mxfl2),VFL2(mxqstep,mxfl2), - 6 WFL2(mxqstep,mxfl2), - 7 SY0FL2(mxqstep,mxfl2),SZ0FL2(mxqstep,mxfl2), - 8 QFL2(mxspec,mxqstep,mxfl2),NEWFL2(mxfl2), - 9 CSLST6(mxspec),CID6(mxfl2), - & pmapfl2(mxemdat),utmhemfl2(mxemdat),datumfl2(mxemdat), - 1 datenfl2(mxemdat),xyunitfl2(mxemdat) - - -c -c --- COMMON BLOCK /FL2/ Variables: -c NFL2 - integer - Number of flare sources -c NSE6 - integer - Number of emitted species in the file -c MFFL2(mxemdat) - integer - Flag for file type -c 0: UNFORMATTED (not supported!) -c 1: FORMATTED -c IBSRC6(mxemdat) - integer - Index for first source in a FLEMARB.DAT -c file -c IESRC6(mxemdat) - integer - Index for last source in a FLEMARB.DAT -c file -c IBDATHR6(mxemdat)- integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSEC6(mxemdat) - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHR6(mxemdat)- integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESEC6(mxemdat) - integer - Seconds of the last data record in the -c file (0000-3599) -c XTZ6(mxemdat) - real - Time zone (UTC=LST+XTZ6) -c T2BTZ6(mxemdat) - real - Hours to ADD to Local Time to obtain -c Base Time (xtz3-xbtz) -c XMWEM6(mxspec) - real - Molecular weight for each species -c IXREM6(mxspec) - integer - Cross referencing array of NSE6 -c values relating species ordering -c in the emissions file to the -c ordering in the main conc. array -c TIEM6(8,mxfl2) - real - Time-invariant data for arbitrarily- -c varying flare source emissions -c (1,-) = Flag for flux type -c 1: T, U, V, W -c 2: Fb, Fmx, Fmy, Fmz -c (2,-) = Not currently used -c (3,-) = Not currently used -c (4,-) = Not currently used -c (5,-) = Not currently used -c (6,-) = Not currently used -c (7,-) = Not currently used -c (8,-) = Not currently used -c -c --- MAP Projection Variables --- -c -c LUTMFL2(mxemdat) -logical*4- Flag for Universal Transverse Mercator -c LLCCFL2(mxemdat) -logical*4- Flag for Lambert Conformal Conic -c LPSFL2(mxemdat) -logical*4- Flag for Polar Stereographic -c LEMFL2(mxemdat) -logical*4- Flag for Equatorial Mercator -c LLAZAFL2(mxemdat) -logical*4- Flag for Lambert Azimuthal Equal Area -c LTTMFL2(mxemdat) -logical*4- Flag for Tangential Transverse Mercator -c -c IUTMZNFL2(mxemdat) -integer - UTM zone for UTM projection -c FEASTFL2(mxemdat) -real - False Easting (km) at projection origin -c FNORTHFL2(mxemdat) -real - False Northing (km) at projection origin -c RNLAT0FL2(mxemdat) -real - N. latitude & E. longitude of x=0 and y=0 -c RELON0FL2(mxemdat) (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1FL2(mxemdat) - real - Matching N. latitude(s) for projection -c RNLAT2FL2(mxemdat) (deg) (Used only if PMAP3= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c -c --- Variable data --- -c -c NSTEP6(mxemdat) - integer - Number of emission steps in -c current timestep -c NDHRQB6(mxqstep,mxemdat) & NSECQB6(mxqstep,mxemdat) -c - integer - Starting time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c NDHRQE6(mxqstep,mxemdat) & NSECQE6(mxqstep,mxemdat) -c - integer - Ending time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c XFL2GRD(mxqstep,mxfl2) - real- X coordinate of a flare -c source in grid units -c (i.e., origin at (0.0,0.0)) -c YFL2GRD(mxqstep,mxfl2) - real- Y coordinate of a flare -c source in grid units -c (i.e., origin at (0.0,0.0)) -c HTFL2(mxqstep,mxfl2) - real - Effective stack height (m) -c ELFL2(mxqstep,mxfl2) - real - Ground elevation (m) above sea -c level -c DFL2(mxqstep,mxfl2) - real - Effective stack diameter (m) -c TFL2(mxqstep,mxfl2) - real - Effective stack temperature (K) -c UFL2(mxqstep,mxfl2) - real - Effective exit velocity in x (m/s) -c VFL2(mxqstep,mxfl2) - real - Effective exit velocity in y (m/s) -c WFL2(mxqstep,mxfl2) - real - Effective exit velocity in z (m/s) -c SY0FL2(mxqstep,mxfl2) - real - Initial sigma y (m) -c SZ0FL2(mxqstep,mxfl2) - real - Initial sigma z (m) -c QFL2(mxspec,mxqstep,mxfl2) -c - real - Emission rate (g/s) for each -c pollutant -c NEWFL2(mxfl2) - integer - Number of puffs released by each -c source during the current step -c -c --- Character data --- -c CSLST6(mxspec) - char*12 - Species identifiers -c CID6(mxfl2) - char*16 - Source identifiers -c -c PMAPFL2(mxemdat) -character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMFL2(mxemdat) -character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMFL2(mxemdat) -character - Datum-Region for grid coordinates -c DATENFL2(mxemdat) -character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITFL2(mxemdat) -character - Units for coordinates (e.g., KM) diff --git a/CALPUFF_SRC/CALPUFF/flags.puf b/CALPUFF_SRC/CALPUFF/flags.puf deleted file mode 100644 index 25ecd92..0000000 --- a/CALPUFF_SRC/CALPUFF/flags.puf +++ /dev/null @@ -1,207 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /FLAGS/ -- Module control flags CALPUFF -c---------------------------------------------------------------------- -c - logical ldevel -c - common/flags/mgauss,mctadj,mctsg,mslug,mtrans,mchem,maqchem, - 1 mlwc,mdry,mwet,mdisp,mdisp2,mtauly,mcturb,mturbvw,mrough, - 2 mtip,mshear,msplit,mpartl,mtinv,mhftsz,mpdf,msgtibl,mbcon, - 3 mfog,mbdw,mreg,mdepbc,mtilt,mtauadv,ldevel,mpartlba,mrise, - 4 mtip_fl,mrise_fl -c -c --- COMMON BLOCK /FLAGS/ Variables: -c -c MGAUSS - integer - Gaussian vertical distribution in the -c near field ? -c 0 = no (i.e., uniform distribution assumed -c in the vertical -c 1 = yes (i.e., Gaussian distribution with -c reflections used) -c MCTADJ - integer - Terrain adjustment method -c 0 = no terrain adjustment -c 1 = ISC-type of terrain adjustment -c 2 = simple, CALPUFF-type of terrain -c adjustment -c 3 = partial plume height adjustment -c using a plume-path coefficient -c (e.g. half-height correction) -c MCTSG - integer - Subgrid-scale complex terrain modeled ? -c (0 = no, 1 = yes) -c MSLUG - integer - Near-field puffs modeled as elongated -c "slugs" ? -c 0 = no (i.e., circular puffs always used) -c 1 = yes (i.e., slug model used in the -c near field) -c MTRANS - integer - Transitional plume rise computed ? -c 0 = no (i.e., final rise only) -c 1 = yes (i.e., transitional rise computed) -c MCHEM - integer - Chemical transformation mechanism flag -c 0 = no chemistry -c 1 = MESOPUFF II transformation scheme -c 2 = user-specified transformation rates -c 3 = transformation rates computed -c internally (RIVAD/ARM3 scheme) -c 4 = secondary organic aerosol formation -c computed (MESOPUFF II scheme for OH) -c 5 = user-specified decay rates with or -c without transfer to child species -c 6 = Updated RIVAD with ISORROPIA -c equilibrium and RADM aqueous phase -c 7 = Updated RIVAD with ISORROPIA -c equilibrium, RADM aqueous phase -c and CalTech SOA -c MAQCHEM - integer - Aqueous phase transformation flag -c (Valid for MCHEM = 6 or 7) -c 0 = no aqueous phase transformation -c 1 = transformation rates adjusted -c for aqueous phase reactions -c MLWC - integer - Liquid Water Content flag -c (Used only if MAQCHEM = 1) -c 0 = water content estimated from cloud -c cover and precipitation rate -c 1 = 3D gridded water data read from CALMET -c water content output files (filenames -c are the CALMET.DAT names PLUS the -c extension LWCEXT -c MDRY - integer - Dry deposition modeled ? -c 0 = no -c 1 = yes -c MWET - integer - Wet deposition modeled ? -c 0 = no -c 1 = yes -c MDISP - integer - Method flag for computation of dispersion -c coefficients -c 1 = sigma y, sigma z computed from values -c of measured sigma v, sigma w read from -c file -c 2 = sigma y, sigma z computed from micro- -c meteorological variables (u*, w*, L) -c 3 = PG dispersion coefficients for RURAL -c areas (computed using the ISCST multi- -c segment approximation and MP coef- -c ficients in URBAN areas -c 4 = same as 3 except PG coefficients are -c computed using the MESOPUFF II eqns. -c 5 = CTDM sigmas used for stable and neutral -c conditions. For unstable conditions, -c sigmas are computed as in MDISP=1. -c MDISP=5 assumes that turbulence data -c are read. -c MDISP2 - integer - Method flag for BACKUP computation of -c dispersion coefficients (no meas. turb.) -c 2 = sigma y, sigma z computed from micro- -c meteorological variables (u*, w*, L) -c 3 = PG dispersion coefficients for RURAL -c areas (computed using the ISCST multi- -c segment approximation and MP coef- -c ficients in URBAN areas -c 4 = same as 3 except PG coefficients are -c computed using the MESOPUFF II eqns. -c MTAULY - integer - Method flag for assigning Lagrangian time -c scale for Fy formulation -c 0 = Draxler default 617.284 (s) -c 1 = Computed as Lag. Length / (.75 q) -c -- after SCIPUFF -c 10 = Direct user input (s) -c MTAUADV - integer - Method flag for assigning advective-decay -c timescale for turbulence advection -c 0 = No turbulence advection -c 1 = NOT IMPLEMENTED -c 10 = Direct user input of timescale (s) -c MCTURB - integer - Method flag for computating turbulence -c sigma-v & sigma-w -c 1 = Standard CALPUFF subroutines -c 2 = AERMOD subroutines -c MTURBVW - integer - Use sigma-v and/or sigma-w measurements? -c 1 = yes, use sigma-v or sigma-theta -c from PROFILE.DAT to compute sigma-y -c (valid for METFM=1,2,3,4,5) -c 2 = yes, use sigma-w measurements -c from PROFILE.DAT to compute sigma-z -c (valid for METFM=1,2,3,4,5) -c 3 = yes, use BOTH measurements from -c PROFILE.DAT to compute sig-y and sig-z -c (valid for METFM=1,2,3,4,5) -c 4 = yes, use sigma-theta measurements -c from PLMMET.DAT to compute sigma-y -c (valid only if METFM=3) -c MROUGH - integer - Roughness adjustment applied to PG sigma-z? -c 0 = no -c 1 = yes -c MTIP - integer - Stack tip downwash modeled ? -c 0 = no -c 1 = yes -c MSHEAR - integer - vertical wind shear above stack top -c modeled in plume rise? -c 0 = no -c 1 = yes -c MSPLIT - integer - Split puffs in vertical to track vertical -c wind shear ? -c 0 = no -c 1 = yes -c MPARTL - integer - partial penetration of elevated inversion -c modeled for point sources ? -c 0 = no -c 1 = yes -c MTINV - integer - Strength of inversion above CBL read from -c PROFILE.DAT for partial penetration? -c 0 = no -c 1 = yes -c MHFTSZ - integer - Heffter sigma-z growth at large distance -c modeled ? -c 0 = no -c 1 = yes -c MPDF - integer - Prob. Dist. Fcn. used for Convective B.L. ? -c 0 = no -c 1 = yes -c MBCON - integer - Boundary Conditions (concentration) applied ? -c 0 = no -c 1 = yes, BCON.DAT file -c 2 = yes, CONC.DAT file -c MSGTIBL - integer - Sub-Grid TIBL module used for shoreline ? -c 0 = no -c 1 = yes -c MFOG - integer - FOG model computations ? -c 0 = no -c 1 = Plume-length Mode -c 2 = Receptor Mode -c MAQCHEM - integer - Aqueous phase transformation flag -c (Valid for MCHEM = 1 or 3) -c 0 = no aqueous phase transformation -c 1 = transformation rates adjusted -c for aqueous phase reactions -c MBDW - integer - Method to simulate buiding downwash -c 1 = ISC method -c 2 = PRIME method -c MREG - integer - Impose regulatory options? -c 0 = no -c 1 = yes - USEPA short range (e.g.ISC) -c 2 = yes - USEPA long range/visibility -c 3 = yes - Australia EPA short range -c MDEPBC - integer - Flag for concentration profile adj. for -c surface depletion effects with BC puffs -c 0: Do not adjust -c 1: Adjust for depletion -c MTILT - integer - Gravitational settling (plume tilt)? -c (puff center falls at the gravitational -c settling velocity for 1 particle species) -c 0 = no -c 1 = yes -c LDEVEL - logical - Report output associated with new features -c or options currently under development -c MPARTLBA - integer - Partial penetration of elevated inversion -c modeled for buoyant area sources ? -c 0 = no -c 1 = yes -c MRISE - integer - Method used to compute plume rise for -c point sources not subject to building -c downwash? -c 1 = Briggs plume rise -c 2 = Numerical plume rise -c MTIP_FL - integer - Apply stack-tip downwash to FLARE sources? -c 0 = no (no stack-tip downwash) -c 1 = yes (apply stack-tip downwash) -c MRISE_FL - integer - Plume rise module for FLARE sources -c 1 = Briggs module -c 2 = Numerical rise module diff --git a/CALPUFF_SRC/CALPUFF/flvar.puf b/CALPUFF_SRC/CALPUFF/flvar.puf deleted file mode 100644 index d3c11e0..0000000 --- a/CALPUFF_SRC/CALPUFF/flvar.puf +++ /dev/null @@ -1,30 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /FLVAR/ --- FLOPUFF Variables CALPUFF -c----------------------------------------------------------------------- - - REAL*4 LX,LY,LXI,LYI,LXI2,LYI2,LYI3,LZ,LZI,LN,LNI - COMMON/FLVAR/ LX,LY,LXI, LXI2, LYI, LYI2, LYI3, LZI, - 1 LZ, LN, LNI, HASYM, BVUI, BVUI2, S, S2, B0N2, - 2 B0, B02, FR, - 3 GAM, HH -C----------------------------------------------------------------------- -C DEFINITIONS [i]=integer [r]=real [a]=array -C----------------------------------------------------------------------- -C LX (m) LENGTH SCALE OF HILL IN THE X-DIRECTION [r] -C LY (m) LENGTH SCALE OF HILL IN THE Y-DIRECTION [r] -C LXI,LXI2 1/LX AND 1/LX**2 [r] -C (m^-1[2]) -C LYI,LYI(2,3) 1/LY, 1/LY**2, 1/LY**3 [r] -C (m^-1[2,3]) -C LZ,LZI (m),(1/m) VERTICAL LENGTH SCALE AND ITS INVERSE [r] -C LN,LNI (m),(1/m) ABOVE, SCALED .5*SQRT(PI) [r] -C HASYM HILL ASYMMETRY FACTOR [r] -C BVUI,BVUI2 BRUNT-VAISALA FREQ/U, AND ITS SQUARE [r] -C (m^-1[2]) -C S,S2 STRATIFICATION FACTOR, AND ITS SQUARE [r] -C B0N2 SQUARE OF NEUTRAL VALUE OF PARAMETER B0 [r] -C B0,B02 STRATIFIED VALUE OF PARAMETER B0, AND ITS SQUARE [r] -C FR FROUDE NUMBER FOR CUT-OFF HILL [r] -C GAM (m^-2) ROTATION TERM [r] -C HH (m) HEIGHT OF HILL AT THE CREST (THE CUT-OFF HILL) [r] -C----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/fog.puf b/CALPUFF_SRC/CALPUFF/fog.puf deleted file mode 100644 index 0ae947a..0000000 --- a/CALPUFF_SRC/CALPUFF/fog.puf +++ /dev/null @@ -1,49 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /FOG/ -- FOG option data CALPUFF -c---------------------------------------------------------------------- -c - parameter (mxpt=mxpt1+mxpt2) - real xrfog(mxrfog) - real zrfog(mxrfog,mxpt) - integer ipcp(51), ifdays(366), ipfog(mxpt) - character*20 ftitle(4) - logical lpmode,ladtfog -c - common/FOG/ftitle,nfrec,nfpts,ipcp,ifyr,ifdays,nipfog,ipfog, - & xrfog,zrfog,issta,ixsrc,iysrc,mdsrc,txsmxfog, - & lpmode,ladtfog -c -c --- COMMON BLOCK /FOG/ Variables: -c -------------------------------------------------------------------- -c --- Output file header variables -c -------------------------------- -c FTITLE - character*4 - Title line for FOG output file -c NFREC - integer - Number of discrete receptors (ndrec) -c NFPTS - integer - Number of point sources -c IPCP - integer - Array of 51*0 (not used in Fog Model) -c IFYR - integer - Year of simulation (assumes only 1 year) -c IFDAYS - integer - Days to process in year -c 0: Do Not Process Day -c 1: Process Day -c (All days set to 0 to signal CALPUFF run) -c LPMODE - logical - Plume-mode indicator (T/F) -c -------------------------------------------------------------------- -c --- Computational variables (Plume Mode) -c ---------------------------------------- -c NIPFOG - integer - Number of active fog sources this hour -c IPFOG - integer - Puff index for first puff released -c from each active source this hour -c XRFOG - real - Receptor distances from source (m) -c for output -- MXRFOG values -c ZRFOG - real - Receptor height (m AGL) at the XRFOG -c distances for each each source -c -------------------------------------------------------------------- -c --- Computational variables -c ---------------------------- -c ISSTA - integer - Surface met station nearest source -c IXSRC,IYSRC - integer - Met grid cell nearest sources -c MDSRC - integer - MET grid domain index for [IX,IY]SRC -c TXSMXFOG - real - Maximum temperature excess (K) allowed -c when summing contributions at receptor -c LADTFOG - logical - Use summmed temperature excess at -c receptor, from all puffs (T/F) diff --git a/CALPUFF_SRC/CALPUFF/gen.puf b/CALPUFF_SRC/CALPUFF/gen.puf deleted file mode 100644 index 93db1e7..0000000 --- a/CALPUFF_SRC/CALPUFF/gen.puf +++ /dev/null @@ -1,70 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /GEN/ -- General run control information, CALPUFF -c file types -c---------------------------------------------------------------------- -c - character*12 cspec,cgrup -c - common/gen/ibyr,ibmo,ibdy,ibhr,ibsec,nsecdt,irlg,iavg, - 1 ibdathr,iedathr,iesec,nspec,nsdd,nse,ngrup, - 2 isplst(4,mxspec),cspec(mxspec),xmol(mxspec),cgrup(mxgrup), - 3 ispgrp(mxspec),metfm,mprffm,metrun,mrestart,nrespd -c -c -c --- COMMON BLOCK /GEN/ Variables: -c IBYR - integer - Beginning year of run (four digits) -c IBMO - integer - Beginning month of run -c IBDY - integer - Beginning day of run -c IBHR - integer - Beginning hour of run -c IBSEC - integer - Beginning second of run -c NSECDT - integer - Length of model timestep (seconds) -c IRLG - integer - Run length (in timesteps, NSECDT) -c IAVG - integer - Length of averaging period for all -c output (in timesteps, NSECDT) -c IBDATHR - integer - Beginning date-hour (YYYYJJJHH) -c IEDATHR - integer - Ending date-hour (YYYYJJJHH) -c IESEC - integer - Ending second of run -c NSPEC - integer - Total number of chemical species -c (advected + steady-state species) -c NSDD - integer - Number of species dry deposited -c NSE - integer - Number of species emitted -c NGRUP - integer - Number of Species-Groups -c ISPLST(4,mxspec) - integer - Flags indicating which species are -c (1,-)=modeled, (2,-) emitted (0=NO, 1=YES), -c (3,-)=dry deposition flag (0=no dep., -c 1=resistance model (gas), 2=resistance -c model (particle), 3=user-specified) -c (4,-)=species-group flag (0=not in group, -c 1=group1, 2=group2, etc.) -c CSPEC(mxspec) - char*12 - List of chemical species -c XMOL(mxspec) - real - Molecular weight for each species -c CGRUP(mxgrup) - char*12 - List of names for grouped species -c ISPGRP(mxspec) - integer - Index of group to which species belong -c METFM - integer - Meteorological data input format flag -c 1 = CALMET/AUSMET binary format -c (CALMET.DAT, AUSMET.DAT) -c 2 = ISC ASCII file (ISCMET.DAT) -c 3 = AUSPLUME ASCII file (PLMMET.DAT) -c 4 = CTDM PROFILE & SURFACE files -c 5 = AERMET PROFILE & SURFACE files -c MPRFFM - integer - Meteorological Profile Data Format -c 1 = CTDM plus tower file (PROFILE.DAT) -c 2 = AERMET tower file (PROFILE.DAT) -c METRUN - integer - Option to run ALL of the met periods -c found in the met files -c 0 = Run period defined by the user -c 1 = Run all periods found -c MRESTART - integer - Option to create/use a restart file -c 0 = No restart files read or written -c 1 = Old restart file used at start -c of a continuation run with "old" -c puffs from the preceding period; -c 2 = New restart file made during run -c 3 = Old restart file used at start -c of a continuation run with "old" -c puffs from the preceding period; -c << AND >> -c New restart file made during run -c NRESPD - integer - Number of periods in Restart output cycle -c 0 = File written only at last period -c >0 = File updated every NRESPD periods diff --git a/CALPUFF_SRC/CALPUFF/grid.puf b/CALPUFF_SRC/CALPUFF/grid.puf deleted file mode 100644 index 3514407..0000000 --- a/CALPUFF_SRC/CALPUFF/grid.puf +++ /dev/null @@ -1,109 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /GRID/ -- Grid parameters CALPUFF -c---------------------------------------------------------------------- -c -c --- UPDATE: -c --- V6.3 100212 (DGS): Nested CALMET grid requires additional array -c dimension for several variables; also remove -c nxm1,nxm2,nym1,nym2 and compute these as -c needed for specific grid (was ony used in -c SETCOM and GETELEV) -c - logical lsamp -c - common/GRID/nx,ny,nz,dgrid,dgridi,xorig,yorig, - 1 zface(mxnzp1),xtz,ibcomp,jbcomp,iecomp,jecomp, - 2 lsamp,ibsamp,jbsamp,iesamp,jesamp,meshdn,nxcmp,nycmp, - 3 nxsam,nysam,delsam,sam2grid,nxm1,nxm2,nym1,nym2,nzp1, - 4 zgpt(mxnz),elevg(mxnxg,mxnyg),relief(5,mxnx,mxny,mxmetdom), - 5 dzval,ivalw(mxvalz,mxnx,mxny,mxmetdom), - 6 xlatm(mxnx,mxny,mxmetdom),xlonm(mxnx,mxny,mxmetdom) -c -c --- COMMON BLOCK /GRID/ Variables: -c NX - integer - Number of METEOROLOGICAL grid points -c in X direction (outermost domain) -c NY - integer - Number of METEOROLOGICAL grid points -c in Y direction (outermost domain) -c NZ - integer - Number of vertical levels -c DGRID - real - METEOROLOGICAL grid spacing (m) -c (outermost domain) -c DGRIDI - real - 1./DGRID (outermost domain) -c XORIG - real - Reference X coordinate (m) of southwest -c corner of grid (outermost domain) -c YORIG - real - Reference Y coordinate (m) of southwest -c corner of grid (outermost domain) -c ZFACE(mxnzp1) - real - Cell face heights (m) (NZP1 values) -c XTZ - real - Base time zone -c (5.=EST, 6.=CST, 7.=MST, 8.=PST) -c IBCOMP - integer - Element number of the met. grid -c defining the beginning of the -c computational grid in the X direction -c (outermost domain) -c JBCOMP - integer - Element number of the met. grid -c defining the beginning of the -c computational grid in the Y direction -c (outermost domain) -c IECOMP - integer - Element number of the met. grid -c defining the end of the computational -c grid in the X direction -c (outermost domain) -c JECOMP - integer - Element number of the met. grid -c defining the end of the computational -c grid in the Y direction -c (outermost domain) -c LSAMP - logical - Flag indicating if gridded receptor -c (sampling) grid is used (T=yes, F=no) -c IBSAMP - integer - Element number of the met. grid -c defining the beginning of the -c sampling grid in the X direction -c (outermost domain) -c JBSAMP - integer - Element number of the met. grid -c defining the beginning of the -c sampling grid in the Y direction -c (outermost domain) -c IESAMP - integer - Element number of the met. grid -c defining the end of the sampling -c grid in the X direction -c JESAMP - integer - Element number of the met. grid -c defining the end of the sampling -c grid in the Y direction -c (outermost domain) -c MESHDN - integer - Nesting factor of the sampling grid. -c The sampling grid spacing (in meters) -c is DGRID/MESHDN (outermost domain) -c -c --- Computed variables -c NXCMP - integer - Number of COMPUTATIONAL grid points in -c the X direction -c NYCMP - integer - Number of COMPUTATIONAL grid points in -c the Y direction -c NXSAM - integer - Number of SAMPLING grid points in the -c X direction -c NYSAM - integer - Number of SAMPLING grid points in the -c Y direction -c DELSAM - real - SAMPLING grid spacing (m) -c SAM2GRID - real - SAMPLING grid spacing (met grid) -c NZP1 - integer - Number of vertical cell faces (NZ+1) -c ZGPT(mxnz) - real - Grid point heights (m) (NZ values) -c -c --- Terrain for Gridded Receptors -c ELEVG(mxngx,mxngy) - real - Terrain elevation (m MSL) at rec. -c -c --- Local Terrain Relief and Valley Width for MCTADJ = 2 -c RELIEF(5,mxnx,mxny,mxmetdom) -c - real - Local terrain elevation differences (m) -c along 4 directions for each Met cell -c 1: N/S -c 2: NE/SW -c 3: E/W -c 4: SE/NW -c And -c 5: the peak elevation (m MSL) -c DZVAL - real - Height increment (m) for the MXVALZ -c elements stored in IVALW array -c IVALW(mxvalz,mxnx,mxny,mxmetdom) -c - integer - Local valley width (met grid cells) -c XLATM(mxnx,mxny,mxmetdom) -c - real - N.Latitude of MET gridpoints -c XLONM(mxnx,mxny,mxmetdom) -c - real - W.Longitude of MET gridpoints diff --git a/CALPUFF_SRC/CALPUFF/gridnest.puf b/CALPUFF_SRC/CALPUFF/gridnest.puf deleted file mode 100644 index ce51940..0000000 --- a/CALPUFF_SRC/CALPUFF/gridnest.puf +++ /dev/null @@ -1,38 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /GRIDNEST/ -- Derived information from CALPUFF -c nested meteorological data -c files -c----------------------------------------------------------------------- - - integer*1 metcell(mxnx,mxny,mxmetdom) - integer ngrid - integer nestfac(mxmetdom),nestfacmx,ipargrd(mxmetdom) - real rnxnest0(mxmetdom),rnynest0(mxmetdom) - - real cgridll(2,mxmetdom),cgridur(2,mxmetdom) - - common/GRIDNEST/ ngrid,nestfac,nestfacmx,ipargrd, - & rnxnest0,rnynest0,cgridll,cgridur,metcell - -c --- COMMON BLOCK /GRIDNEST/ Variables: -c NGRID - integer - Number of CALMET met file grids -c NESTFAC(mxmetdom) - integer - Number of cells in each grid that -c equals one cell in outermost grid. -c This is applied in 1-D. -c NESTFACMX - integer - Maximum nest factor NESTFAC -c IPARGRD(mxmetdom) - integer - Parent grid ID for each nested grid -c RNXNEST0(mxmetdom) - real - Number of grid-k cells from origin of -c grid-1 to origin of grid-k in X -c RNYNEST0(mxmetdom) - real - Number of grid-k cells from origin of -c grid-1 to origin of grid-k in Y -c CGRIDLL(2,mxmetdom) - real - Lower-Left corner Coordinates of each -c MET grid domain in outermost grid units -c (1,_): x coordinate, (2,_): y coordinate -c CGRIDUR(2,mxmetdom) - real - Upper-Right corner Coordinates of each -c MET grid domain in outermost grid units -c (1,_): x coordinate, (2,_): y coordinate -c METCELL(mxnx,mxny,mxmetdom) -c -integer*1- Validity flag for each (i,j) grid -c point in each of the met grid domains -c METCELL=0 data in grid cell not used -c METCELL=1 data in grid cell used diff --git a/CALPUFF_SRC/CALPUFF/headbc2.puf b/CALPUFF_SRC/CALPUFF/headbc2.puf deleted file mode 100644 index d7c3c66..0000000 --- a/CALPUFF_SRC/CALPUFF/headbc2.puf +++ /dev/null @@ -1,132 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /HEADBC2/ --- MBCON=2 CONC.DAT Header CALPUFF -c----------------------------------------------------------------------- -c --- After HEAD.PST from CALPOST: Add BC to each variable name -c --- Add logicals for D and CT receptors -c ---------------------------------------------------------------------- - logical LSGRIDBC,LCOMPRSBC - logical ldiscBC,lctsgBC - character*6 avtimeBC - character*12 amodelBC,averBC,alevBC - character*15 asplstBC(mxspec) - character*80 atitleBC(3) - - character*4 utmhemBC - character*8 datumBC,pmapBC - character*12 datenBC - character*16 clat0BC,clon0BC,clat1BC,clat2BC - - common/headbc2/msyrBC,mjsdayBC,mshrBC,mssecBC,nsecdtBC, - * mnrunBC,mavgpdBC,mnperBC,mavgBC,ipverBC,irhverBC, - * ielmetBC,jelmetBC,delxBC,delyBC,nzBC, - * xorigkmBC,yorigkmBC,nsstaBC, - * iastarBC,iastopBC,jastarBC,jastopBC, - * isastrBC,isastpBC,jsastrBC,jsastpBC, - * ngxBC,ngyBC,ngrecBC, - * meshdnBC,nptsBC,nareasBC,nlinesBC,nvolsBC, - * ndrecBC,nctrecBC,LSGRIDBC,ldiscBC,lctsgBC,nszoutBC, - * xgrdBC(mxnxg,mxnyg),ygrdBC(mxnxg,mxnyg), - * xrecBC(mxrec),yrecBC(mxrec),zrecBC(mxrec), - * xctrBC(mxrect),yctrBC(mxrect),zctrBC(mxrect), - * ihillBC(mxrect), - * xkmstaBC(mxss),ykmstaBC(mxss),nearsBC(mxnxg,mxnyg), - * lcomprsBC,i2drhBC,iutmznBC,feastBC,fnorthBC, - * rnlat0BC,relon0BC,xlat1BC,xlat2BC, - * amodelBC,averBC,alevBC,atitleBC,avtimeBC,asplstBC, - * pmapBC,utmhemBC,datumBC,datenBC, - * clat0BC,clon0BC,clat1BC,clat2BC -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [a]=array -c [c]=character [L]=logical -c----------------------------------------------------------------------- -c ldiscBC Discrete receptors in file? (T/F) -c lctsgBC CTSG receptors in file? (T/F) -c----------------------------------------------------------------------- -c msyr,mjsday, Starting time of run: yr, Julian day, hour, second [i] -c mshr,mssec -c nsecdt Number of seconds in one model step [i] -c mnrun Number of model steps in model run [i] -c mavgpd Averaging time in model steps for results reported [i] -c by model -c mnper Number of averaging periods contained in model output[i] -c mavg Averaging time in AVTIME units [i] -c computed as mavg*nsecdt/[1, 60, or 3600]seconds -c ipver CALPUFF output file version flag [i] -c 0: Current version with begin-time/end-time format -c 1: Older version with end-time format -c irhver CALPUFF VISB file version flag [i] -c ielmet Number of met. grid points (x-direction) [i] -c jelmet Number of met. grid points (y-direction) [i] -c delx (km) Grid spacing in x-direction [r] -c dely (km) Grid spacing in y-direction [r] -c nz Number of layers (=1 for CALPUFF) [i] -c iastar Start of computational grid (x-direction) [i] -c iastop End of computational grid (x-direction) [i] -c jastar Start of computational grid (y-direction) [i] -c jastop End of computational grid (y-direction) [i] -c isastr Start of sampling grid (x-direction) [i] -c isastp End of sampling grid (x-direction) [i] -c jsastr Start of sampling grid (y-direction) [i] -c jsastp End of sampling grid (y-direction) [i] -c ngx,ngy Actual dimensions of gridded receptor array [i] -c ngrec Actual number of gridded receptors [i] -c meshdn Sampling grid spacing factor [i] -c npts Number of point sources [i] -c nareas Number of area sources [i] -c ndrec Number of discrete receptors [i] -c nctrec Number of complex terrain receptors [i] -c LSGRID Gridded receptors included? (T=yes) [L] -c nszout Number of chemical species/level combinations [i] -c xgrd (km) X-coordinate gridded receptors [ra] -c ygrd (km) Y-coordinate gridded receptors [ra] -c xrec (km) X-coordinate discrete receptors [ra] -c yrec (km) Y-coordinate discrete receptors [ra] -c zrec (m) Height of discrete receptors above sea level [ra] -c xctr (km) X-coordinate discrete receptors (complex terrain) [ra] -c yctr (km) Y-coordinate discrete receptors (complex terrain) [ra] -c zctr (m) Height of complex terrain receptors above sea level [ra] -c ihill Hill identification number for complex terrain [ia] -c receptors -c lcomprs Logical indicating whether data on disk are [L] -c compressed -c i2drh Flag for 2D array of relative humidity [i] -c amodel Name of the model used to produce concentrations [c] -c aver Version number of model [c] -c alev Level of revision of model [c] -c atitle Title for run [ca] -c avtime Averaging time units (second, minute, or hour) [c] -c asplst List of species/level names [ca] -c----------------------------------------------------------------------- -c IUTMZN - integer - UTM zone for UTM projection -c FEAST (km) - real - False Easting at projection origin -c FNORTH (km) - real - False Northing at projection origin -c RNLAT0, - real - N. latitude & E. longitude of x=0 and y=0 -c RELON0 (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c XLAT1, - real - Matching N. latitude(s) for projection -c XLAT2 (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c----------------------------------------------------------------------- -c PMAP - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEM - character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUM - character - Datum-Region for grid coordinates -c DATEN - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c CLAT0 - character - Character version of RNLAT0 -c CLON0 - character - Character version of RELON0 -c CLAT1 - character - Character version of XLAT1 -c CLAT2 - character - Character version of XLAT2 -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/isorropia_v2.2.for b/CALPUFF_SRC/CALPUFF/isorropia_v2.2.for deleted file mode 100644 index 43251a0..0000000 --- a/CALPUFF_SRC/CALPUFF/isorropia_v2.2.for +++ /dev/null @@ -1,47668 +0,0 @@ -c---------------------------------------------------------------------- -c --- ISORROPIA-II Version 2.2 --- -c---------------------------------------------------------------------- -c -c --- PURPOSE: This collection of subroutines comprises the ISORROPIA-II -c model, and is used in CALPUFF with permission from the -c authors under the following terms: -c -c --------------------------------------- -c Terms of Use for ISORROPIA/ISORROPIA-II -c --------------------------------------- -c -c - These codes are not to be included in any commercial package, or -c - used for any commercial applications (or for profit) without prior -c - authorization from the code authors (CF, AN, SP, CP). -c -c - The code is to be used for educational or non-profit purposes only. -c - Any other usage must first have authorization from the authors (CF, -c - AN, SP, CP). -c -c - ISORROPIA/ISORROPIA-II cannot be modified in any way without the -c - author's (CF, AN, SP, CP) consent. -c -c - No portion of the ISORROPIA/ISORROPIA-II source code can be used in -c - other codes without the author's (CF, AN, SP, CP) consent. -c -c - The codes are provided as-is, and the authors have no liability -c - from its usage. -c -c - Usage of the model, for any pourpose (educational, research, or -c - other) must acknowledge the usage of these codes, i.e. -c -c - Links to the ISORROPIA webpage must be provided -c - (http://nenes.eas.gatech.edu/ISORROPIA) -c - where users can download the latest version of the code, -c - as well as manuals and other materials. -c -c - The main ISORROPIA reference (Nenes et al., Aquatic Geochemistry, -c - 1998) must be cited in all publications and documentation. -c -c - The main ISORROPIA-II reference (Fountoukis and Nenes, -c - Atmos.Chem.Phys., 2007) must be cited in all publications and -c - documentation. -c -c - If ISORROPIA/ISORROPIA-II is to be included within another -c - model, some kind of agreement is required (such as an e-mail -c - confirmation) that subsequent users will abide to the terms -c - as outlined here. -c -c - Documentation and publications using ISORROPIA/ISORROPIA-II -c - should cite the ISORROPIA webpage. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c --- ISOCOM.FOR -c --- ISOFWD.FOR -c --- ISOREV.FOR -c ----------------------------- - -c---------------------------------------------------------------------- -c --- ISOCOM.FOR --- -c---------------------------------------------------------------------- - -C ====================================================================== -C -C *** ISORROPIA CODE II -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 [8]. -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 WI(6) - calcium -C WI(7) - potassium -C WI(8) - magnesium -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 [8]. -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 WT(6) - total calcium -C WT(7) - total potassium -C WT(8) - total magnesium -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 [15]. -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 AERLIQ(13) - Ca2+(aq) -C AERLIQ(14) - K+(aq) -C AERLIQ(15) - Mg2+(aq) -C -C 4. [AERSLD] -C DOUBLE PRECISION array of length [19]. -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 AERSLD(10) - CaSO4(s) -C AERSLD(11) - Ca(NO3)2(s) -C AERSLD(12) - CaCl2(s) -C AERSLD(13) - K2SO4(s) -C AERSLD(14) - KHSO4(s) -C AERSLD(15) - KNO3(s) -C AERSLD(16) - KCl(s) -C AERSLD(17) - MgSO4(s) -C AERSLD(18) - Mg(NO3)2(s) -C AERSLD(19) - MgCl2(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 [9]. -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 OTHER(7): Sulfate ratio with crustal species, defined as (in moles/m3) : -C (total ammonia + total crustal species + total Na) / (total sulfate) -C -C OTHER(8): Crustal species + sodium ratio, defined as (in moles/m3) : -C (total crustal species + total Na) / (total sulfate) -C -C OTHER(9): Crustal species ratio, defined as (in moles/m3) : -C (total crustal species) / (total sulfate) -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE ISOROPIA (WI, RHI, TEMPI, CNTRL, - & WT, GAS, AERLIQ, AERSLD, SCASI, OTHER) - INCLUDE 'isrpia.inc' - PARAMETER (NCTRL=2,NOTHER=9) - 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)+WI(6)+WI(7)+WI(8) .LE. TINY) - & THEN !Everything=0 - CALL INIT1 (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(4)+WI(5)+WI(6)+WI(7)+WI(8) .LE. TINY) THEN !Ca,K,Mg,Na,Cl,NO3=0 - CALL ISRP1F (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(5)+WI(6)+WI(7)+WI(8) .LE. TINY) THEN !Ca,K,Mg,Na,Cl=0 - CALL ISRP2F (WI, RHI, TEMPI) - ELSE IF (WI(6)+WI(7)+WI(8) .LE. TINY) THEN !Ca,K,Mg=0 - CALL ISRP3F (WI, RHI, TEMPI) - ELSE - CALL ISRP4F (WI, RHI, TEMPI) - ENDIF -C -C *** SOLVE REVERSE PROBLEM ********************************************* -C - ELSE - IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5)+WI(6)+WI(7)+WI(8) .LE. TINY) - & THEN !Everything=0 - CALL INIT1 (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(4)+WI(5)+WI(6)+WI(7)+WI(8) .LE. TINY) THEN !Ca,K,Mg,Na,Cl,NO3=0 - CALL ISRP1R (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(5)+WI(6)+WI(7)+WI(8) .LE. TINY) THEN !Ca,K,Mg,Na,Cl=0 - CALL ISRP2R (WI, RHI, TEMPI) - ELSE IF (WI(6)+WI(7)+WI(8) .LE. TINY) THEN !Ca,K,Mg=0 - CALL ISRP3R (WI, RHI, TEMPI) - ELSE - CALL ISRP4R (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,7 ! Liquid aerosol species - AERLIQ(I) = MOLAL(I) - 10 CONTINUE - DO 20 I=1,NGASAQ - AERLIQ(7+1+I) = GASAQ(I) - 20 CONTINUE - AERLIQ(7+1) = WATER*1.0D3/18.0D0 - AERLIQ(7+NGASAQ+2) = COH -C - DO 250 I=8,10 ! Liquid aerosol species - AERLIQ(I+5) = MOLAL(I) - 250 CONTINUE -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 - AERSLD(10) = CCASO4 - AERSLD(11) = CCANO32 - AERSLD(12) = CCACL2 - AERSLD(13) = CK2SO4 - AERSLD(14) = CKHSO4 - AERSLD(15) = CKNO3 - AERSLD(16) = CKCL - AERSLD(17) = CMGSO4 - AERSLD(18) = CMGNO32 - AERSLD(19) = CMGCL2 -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 - OTHER(7) = SO4RAT - OTHER(8) = CRNARAT - OTHER(9) = CRRAT -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) - WT(6) = WI(6) - WT(7) = WI(7) - WT(8) = WI(8) - - - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 /'2.2 (04/16/12)'/ -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.,136.1,164.,111.,174.2,136.1,101.1,74.5, - & 120.3,148.3,95.2/ - & IMW/ 1.0,23.0,18.0,35.5,96.0,97.0,62.0,40.1,39.1,24.3/ - & WMW/23.0,98.0,17.0,63.0,36.5,40.1,39.1,24.3/ -C - DATA ZZ /1,2,1,2,1,1,2,1,1,1,1,1,2,4,2,2,2,1,1,1,4,2,2/ - & Z /1,1,1,1,2,1,1,2,1,2/ -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 awpc= potassium chloride -C - DATA AWPC/172.62, 165.75, 159.10, 152.67, 146.46, 140.45, 134.64, - & 129.03, 123.61, 118.38, 113.34, 108.48, 103.79, 99.27, - & 94.93, 90.74, 86.71, 82.84, 79.11, 75.53, 72.09, 68.79, - & 65.63, 62.59, 59.68, 56.90, 54.23, 51.68, 49.24, 46.91, - & 44.68, 42.56, 40.53, 38.60, 36.76, 35.00, 33.33, 31.75, - & 30.24, 28.81, 27.45, 26.16, 24.94, 23.78, 22.68, 21.64, - & 20.66, 19.74, 18.86, 18.03, 17.25, 16.51, 15.82, 15.16, - & 14.54, 13.96, 13.41, 12.89, 12.40, 11.94, 11.50, 11.08, - & 10.69, 10.32, 9.96, 9.62, 9.30, 8.99, 8.69, 8.40, 8.12, - & 7.85, 7.59, 7.33, 7.08, 6.83, 6.58, 6.33, 6.08, 5.84, - & 5.59, 5.34, 5.09, 4.83, 4.57, 4.31, 4.04, 3.76, 3.48, - & 3.19, 2.90, 2.60, 2.29, 1.98, 1.66, 1.33, 0.99, 0.65, - & 0.30, 0.1/ -C -C awps= potassium sulfate -C - DATA AWPS/1014.82, 969.72, 926.16, 884.11, 843.54, 804.41, 766.68, - & 730.32, 695.30, 661.58, 629.14, 597.93, 567.92, 539.09, - & 511.41, 484.83, 459.34, 434.89, 411.47, 389.04, 367.58, - & 347.05, 327.43, 308.69, 290.80, 273.73, 257.47, 241.98, - & 227.24, 213.22, 199.90, 187.26, 175.27, 163.91, 153.15, - & 142.97, 133.36, 124.28, 115.73, 107.66, 100.08, 92.95, - & 86.26, 79.99, 74.12, 68.63, 63.50, 58.73, 54.27, 50.14, - & 46.30, 42.74, 39.44, 36.40, 33.59, 31.00, 28.63, 26.45, - & 24.45, 22.62, 20.95, 19.43, 18.05, 16.79, 15.64, 14.61, - & 13.66, 12.81, 12.03, 11.33, 10.68, 10.09, 9.55, 9.06, - & 8.60, 8.17, 7.76, 7.38, 7.02, 6.66, 6.32, 5.98, 5.65, - & 5.31, 4.98, 4.64, 4.31, 3.96, 3.62, 3.27, 2.92, 2.57, - & 2.22, 1.87, 1.53, 1.20, 0.87, 0.57, 0.28, 0.1/ -C -C awpn= potassium nitrate -C - DATA AWPN/44*1000.00, 953.05, 881.09, 813.39, - & 749.78, 690.09, 634.14, 581.77, 532.83, 487.16, 444.61, - & 405.02, 368.26, 334.18, 302.64, 273.51, 246.67, 221.97, - & 199.31, 178.56, 159.60, 142.33, 126.63, 112.40, 99.54, - & 87.96, 77.55, 68.24, 59.92, 52.53, 45.98, 40.2, 35.11, - & 30.65, 26.75, 23.35, 20.40, 17.85, 15.63, 13.72, 12.06, - & 10.61, 9.35, 8.24, 7.25, 6.37, 5.56, 4.82, 4.12, 3.47, - & 2.86, 2.28, 1.74, 1.24, 0.79, 0.40, 0.1/ -C -C awpb= potassium bisulfate -C - DATA AWPB/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 awcc= calcium chloride -C - DATA AWCC/19.9, 19.0, 18.15, 17.35, 16.6, 15.89, 15.22, 14.58, - & 13.99, 13.43, 12.90, 12.41, 11.94, 11.50, 11.09, 10.7, - & 10.34, 9.99, 9.67, 9.37, 9.09, 8.83, 8.57, 8.34, 8.12, - & 7.91, 7.71, 7.53, 7.35, 7.19, 7.03, 6.88, 6.74, 6.6, - & 6.47, 6.35, 6.23, 6.12, 6.01, 5.90, 5.80, 5.70, 5.61, - & 5.51, 5.42, 5.33, 5.24, 5.16, 5.07, 4.99, 4.91, 4.82, - & 4.74, 4.66, 4.58, 4.50, 4.42, 4.34, 4.26, 4.19, 4.11, - & 4.03, 3.95, 3.87, 3.79, 3.72, 3.64, 3.56, 3.48, 3.41, - & 3.33, 3.25, 3.17, 3.09, 3.01, 2.93, 2.85, 2.76, 2.68, - & 2.59, 2.50, 2.41, 2.32, 2.23, 2.13, 2.03, 1.93, 1.82, - & 1.71, 1.59, 1.47, 1.35, 1.22, 1.07, 0.93, 0.77, 0.61, - & 0.44, 0.25, 0.1/ -C -C awcn= calcium nitrate -C - DATA AWCN/32.89, 31.46, 30.12, 28.84, 27.64, 26.51, 25.44, 24.44, - & 23.49, 22.59, 21.75, 20.96, 20.22, 19.51, 18.85, 18.23, - & 17.64, 17.09, 16.56, 16.07, 15.61, 15.17, 14.75, 14.36, - & 13.99, 13.63, 13.3, 12.98, 12.68, 12.39, 12.11, 11.84, - & 11.59, 11.35, 11.11, 10.88, 10.66, 10.45, 10.24, 10.04, - & 9.84, 9.65, 9.46, 9.28, 9.1, 8.92, 8.74, 8.57, 8.4, - & 8.23, 8.06, 7.9, 7.73, 7.57, 7.41, 7.25, 7.1,6.94, 6.79, - & 6.63, 6.48, 6.33, 6.18, 6.03, 5.89, 5.74, 5.60, 5.46, - & 5.32, 5.17, 5.04, 4.9, 4.76, 4.62, 4.49, 4.35, 4.22, - & 4.08, 3.94, 3.80, 3.66, 3.52, 3.38, 3.23, 3.08, 2.93, - & 2.77, 2.60, 2.43, 2.25, 2.07, 1.87, 1.67, 1.45, 1.22, - & 0.97, 0.72, 0.44, 0.14, 0.1/ -C -C awmc= magnesium chloride -C - DATA AWMC/11.24, 10.99, 10.74, 10.5, 10.26, 10.03, 9.81, 9.59, - & 9.38, 9.18, 8.98, 8.79, 8.60, 8.42, 8.25, 8.07, 7.91, - & 7.75, 7.59, 7.44, 7.29, 7.15, 7.01, 6.88, 6.75, 6.62, - & 6.5, 6.38, 6.27, 6.16, 6.05, 5.94, 5.85, 5.75, 5.65, - & 5.56, 5.47, 5.38, 5.30, 5.22, 5.14, 5.06, 4.98, 4.91, - & 4.84, 4.77, 4.7, 4.63, 4.57, 4.5, 4.44, 4.37, 4.31, - & 4.25, 4.19, 4.13, 4.07, 4.01, 3.95, 3.89, 3.83, 3.77, - & 3.71, 3.65, 3.58, 3.52, 3.46, 3.39, 3.33, 3.26, 3.19, - & 3.12, 3.05, 2.98, 2.9, 2.82, 2.75, 2.67, 2.58, 2.49, - & 2.41, 2.32, 2.22, 2.13, 2.03, 1.92, 1.82, 1.71, 1.60, - & 1.48, 1.36, 1.24, 1.11, 0.98, 0.84, 0.70, 0.56, 0.41, - & 0.25, 0.1/ -C -C awmn= magnesium nitrate -C - DATA AWMN/12.00, 11.84, 11.68, 11.52, 11.36, 11.2, 11.04, 10.88, - & 10.72, 10.56, 10.40, 10.25, 10.09, 9.93, 9.78, 9.63, - & 9.47, 9.32, 9.17, 9.02, 8.87, 8.72, 8.58, 8.43, 8.29, - & 8.15, 8.01, 7.87, 7.73, 7.59, 7.46, 7.33, 7.2, 7.07, - & 6.94, 6.82, 6.69, 6.57, 6.45, 6.33, 6.21, 6.01, 5.98, - & 5.87, 5.76, 5.65, 5.55, 5.44, 5.34, 5.24, 5.14, 5.04, - & 4.94, 4.84, 4.75, 4.66, 4.56, 4.47, 4.38, 4.29, 4.21, - & 4.12, 4.03, 3.95, 3.86, 3.78, 3.69, 3.61, 3.53, 3.45, - & 3.36, 3.28, 3.19, 3.11, 3.03, 2.94, 2.85, 2.76, 2.67, - & 2.58, 2.49, 2.39, 2.3, 2.2, 2.1, 1.99, 1.88, 1.77, 1.66, - & 1.54, 1.42, 1.29, 1.16, 1.02, 0.88, 0.73, 0.58, 0.42, - & 0.25, 0.1/ -C -C awmn= magnesium sulfate -C - DATA AWMS/0.93, 2.5, 3.94, 5.25, 6.45, 7.54, 8.52, 9.40, 10.19, - & 10.89, 11.50, 12.04, 12.51, 12.90, 13.23, 13.50, 13.72, - & 13.88, 13.99, 14.07, 14.1, 14.09, 14.05, 13.98, 13.88, - & 13.75, 13.6, 13.43, 13.25, 13.05, 12.83, 12.61, 12.37, - & 12.13, 11.88, 11.63, 11.37, 11.12, 10.86, 10.60, 10.35, - & 10.09, 9.85, 9.6, 9.36, 9.13, 8.9, 8.68, 8.47, 8.26, - & 8.07, 7.87, 7.69, 7.52, 7.35, 7.19, 7.03, 6.89, 6.75, - & 6.62, 6.49, 6.37, 6.26, 6.15, 6.04, 5.94, 5.84, 5.75, - & 5.65, 5.56, 5.47, 5.38, 5.29, 5.20, 5.11, 5.01, 4.92, - & 4.82, 4.71, 4.60, 4.49, 4.36, 4.24, 4.10, 3.96, 3.81, - & 3.65, 3.48, 3.30, 3.11, 2.92, 2.71, 2.49, 2.26, 2.02, - & 1.76, 1.50, 1.22, 0.94, 0.64/ -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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = 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 -C M0(01) = AWSC(IRH) ! NACl -C IF (M0(01) .LT. 100.0) THEN -C IC = M0(01) -C CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -C ENDIF -CC -C M0(02) = AWSS(IRH) ! (NA)2SO4 -C IF (M0(02) .LT. 100.0) THEN -C IC = 3.0*M0(02) -C CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -C ENDIF -CC -C M0(03) = AWSN(IRH) ! NANO3 -C IF (M0(03) .LT. 100.0) THEN -C IC = M0(03) -C CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -C ENDIF -CC - M0(04) = AWAS(IRH) ! (NH4)2SO4 -CC IF (M0(04) .LT. 100.0) THEN -CC IC = 3.0*M0(04) -C C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -CC ENDIF -C -C M0(05) = AWAN(IRH) ! NH4NO3 -C IF (M0(05) .LT. 100.0) THEN -C IC = M0(05) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -C ENDIF -CC -C M0(06) = AWAC(IRH) ! NH4CL -C IF (M0(06) .LT. 100.0) THEN -C IC = M0(06) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(07) = AWSA(IRH) ! 2H-SO4 -CC IF (M0(07) .LT. 100.0) THEN -CC IC = 3.0*M0(07) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -CC 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 -CC IF (M0(09) .LT. 100.0) THEN -CC IC = M0(09) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -CC ENDIF -C -C M0(12) = AWSB(IRH) ! NAHSO4 -C IF (M0(12) .LT. 100.0) THEN -C IC = M0(12) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -CC IF (M0(13) .LT. 100.0) THEN -CC IC = 4.0*M0(13) -CC CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC G130 = 0.2*(3.0*GI0+2.0*GII) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC G13I = 0.2*(3.0*GI0+2.0*GII) -CC M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -CC ENDIF -C -C *** OTHER INITIALIZATIONS ********************************************* -C - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - SODRAT = ZERO - CRNARAT = ZERO - CRRAT = 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = 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 -C M0(01) = AWSC(IRH) ! NACl -C IF (M0(01) .LT. 100.0) THEN -C IC = M0(01) -C CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -C ENDIF -CC -C M0(02) = AWSS(IRH) ! (NA)2SO4 -C IF (M0(02) .LT. 100.0) THEN -C IC = 3.0*M0(02) -C CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -C ENDIF -CCC -C M0(03) = AWSN(IRH) ! NANO3 -C IF (M0(03) .LT. 100.0) THEN -C IC = M0(03) -C CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(04) = AWAS(IRH) ! (NH4)2SO4 -CC IF (M0(04) .LT. 100.0) THEN -CC IC = 3.0*M0(04) -CC CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(05) = AWAN(IRH) ! NH4NO3 -CC IF (M0(05) .LT. 100.0) THEN -CC IC = M0(05) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -CC ENDIF -C -C M0(06) = AWAC(IRH) ! NH4CL -C IF (M0(06) .LT. 100.0) THEN -C IC = M0(06) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -C ENDIF -CC - M0(07) = AWSA(IRH) ! 2H-SO4 -CC IF (M0(07) .LT. 100.0) THEN -CC IC = 3.0*M0(07) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -CC 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 -CC IF (M0(09) .LT. 100.0) THEN -CC IC = M0(09) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -CC ENDIF -C -C M0(12) = AWSB(IRH) ! NAHSO4 -C IF (M0(12) .LT. 100.0) THEN -C IC = M0(12) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -C IF (M0(13) .LT. 100.0) THEN -C IC = 4.0*M0(13) -C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C G130 = 0.2*(3.0*GI0+2.0*GII) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C G13I = 0.2*(3.0*GI0+2.0*GII) -C M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -C ENDIF -C -C *** OTHER INITIALIZATIONS ********************************************* -C - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - SODRAT = ZERO - CRNARAT = ZERO - CRRAT = 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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = 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 -CC IF (M0(01) .LT. 100.0) THEN -CC IC = M0(01) -CC CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(02) = AWSS(IRH) ! (NA)2SO4 -CC IF (M0(02) .LT. 100.0) THEN -CC IC = 3.0*M0(02) -CC CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(03) = AWSN(IRH) ! NANO3 -CC IF (M0(03) .LT. 100.0) THEN -CC IC = M0(03) -CC CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C C M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(04) = AWAS(IRH) ! (NH4)2SO4 -CC IF (M0(04) .LT. 100.0) THEN -CC IC = 3.0*M0(04) -CC CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(05) = AWAN(IRH) ! NH4NO3 -CC IF (M0(05) .LT. 100.0) THEN -CC IC = M0(05) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(06) = AWAC(IRH) ! NH4CL -CC IF (M0(06) .LT. 100.0) THEN -CC IC = M0(06) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(07) = AWSA(IRH) ! 2H-SO4 -CC IF (M0(07) .LT. 100.0) THEN -CC IC = 3.0*M0(07) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -CC 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 -CC IF (M0(09) .LT. 100.0) THEN -CC IC = M0(09) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(12) = AWSB(IRH) ! NAHSO4 -CC IF (M0(12) .LT. 100.0) THEN -CC IC = M0(12) -CC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -CC ENDIF -C - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -CC IF (M0(13) .LT. 100.0) THEN -CC IC = 4.0*M0(13) -CC CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC G130 = 0.2*(3.0*GI0+2.0*GII) -CC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -CC & XX,XX,XX,XX,XX,XX,XX,XX,XX) -CC G13I = 0.2*(3.0*GI0+2.0*GII) -CC M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -CC ENDIF -C -C *** OTHER INITIALIZATIONS ********************************************* -C - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - CRNARAT = ZERO - CRRAT = 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 ISOINIT3 ******************************************* -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE INIT4 -C *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM, -C SODIUM, CHLORIDE, NITRATE, SULFATE, CALCIUM, POTASSIUM, MAGNESIUM -C AEROSOL SYSTEMS (SUBROUTINE ISRP4) -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE INIT4 (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 -C 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) -C XK10 = 5.746D-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! ISORR - XK10 = 4.199D-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! (Mozurkewich, 1993) -C 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) -CCC - XK15 = 6.067D5 ! CA(NO3)2(s) <==> CA(aq) + 2NO3(aq) - XK16 = 7.974D11 ! CACL2(s) <==> CA(aq) + 2CL(aq) - XK17 = 1.569D-2 ! K2SO4(s) <==> 2K(aq) + SO4(aq) - XK18 = 24.016 ! KHSO4(s) <==> K(aq) + HSO4(aq) - XK19 = 0.872 ! KNO3(s) <==> K(aq) + NO3(aq) - XK20 = 8.680 ! KCL(s) <==> K(aq) + CL(aq) - XK23 = 1.079D5 ! MGS04(s) <==> MG(aq) + SO4(aq) - XK24 = 2.507D15 ! MG(NO3)2(s) <==> MG(aq) + 2NO3(aq) - XK25 = 9.557D21 ! MGCL2(s) <==> MG(aq) + 2CL(aq) -C XK26 = 4.299D-7 ! CO2(aq) + H2O <==> HCO3(aq) + H(aq) -C XK27 = 4.678D-11 ! HCO3(aq) <==> CO3(aq) + H(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 -C 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) -C XK10= XK10*EXP(-74.38*(T0T-1.0) + 6.120*COEF) ! ISORR - XK10= XK10*EXP(-74.7351*(T0T-1.0) + 6.025*COEF) ! (Mozurkewich, 1993) -C 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) -CCC -C XK15= XK15 *EXP( .0*(T0T-1.0) + .0*COEF) -C XK16= XK16 *EXP( .0*(T0T-1.0) + .0*COEF) - XK17= XK17 *EXP(-9.585*(T0T-1.0) + 45.81*COEF) - XK18= XK18 *EXP(-8.423*(T0T-1.0) + 17.96*COEF) - XK19= XK19 *EXP(-14.08*(T0T-1.0) + 19.39*COEF) - XK20= XK20 *EXP(-6.902*(T0T-1.0) + 19.95*COEF) -C XK23= XK23 *EXP( .0*(T0T-1.0) + .0*COEF) -C XK24= XK24 *EXP( .0*(T0T-1.0) + .0*COEF) -C XK25= XK25 *EXP( .0*(T0T-1.0) + .0*COEF) -C XK26= XK26 *EXP(-3.0821*(T0T-1.0) + 31.8139*COEF) -C XK27= XK27 *EXP(-5.9908*(T0T-1.0) + 38.844*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 - DRCANO32 = 0.4906D0 - DRCACL2 = 0.2830D0 - DRK2SO4 = 0.9750D0 - DRKHSO4 = 0.8600D0 - DRKNO3 = 0.9248D0 - DRKCL = 0.8426D0 - DRMGSO4 = 0.8613D0 - DRMGNO32 = 0.5400D0 - DRMGCL2 = 0.3284D0 - 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 DRCANO32 = DRCANO32*EXP(-430.5*TCF) - DRCANO32 = DRCANO32*EXP(509.4*TCF) ! KELLY & WEXLER (2005) FOR CANO32.4H20 -C DRCACL2 = DRCACL2 *EXP(-1121.*TCF) - DRCACL2 = DRCACL2 *EXP(551.1*TCF) ! KELLY & WEXLER (2005) FOR CACL2.6H20 - DRK2SO4 = DRK2SO4 *EXP(35.6*TCF) -C DRKHSO4 = DRKHSO4 *EXP( 0.*TCF) -C DRKNO3 = DRKNO3 *EXP( 0.*TCF) - DRKCL = DRKCL *EXP(159.*TCF) - DRMGSO4 = DRMGSO4 *EXP(-714.45*TCF) - DRMGNO32 = DRMGNO32*EXP(230.2*TCF) ! KELLY & WEXLER (2005) FOR MGNO32.6H20 -C DRMGCL2 = DRMGCL2 *EXP(-1860.*TCF) - DRMGCL2 = DRMGCL2 *EXP(42.23*TCF) ! KELLY & WEXLER (2005) FOR MGCL2.6H20 -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 -C - DRMO1 = 0.460D0 ! (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4 - DRMO2 = 0.691D0 ! (NH4)2SO4, NH4Cl, NA2SO4, K2SO4, MGSO4 - DRMO3 = 0.697D0 ! (NH4)2SO4, NA2SO4, K2SO4, MGSO4 - DRML1 = 0.240D0 ! K2SO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - DRML2 = 0.363D0 ! K2SO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - DRML3 = 0.610D0 ! K2SO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC - DRMM1 = 0.240D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 - DRMM2 = 0.596D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 - DRMP1 = 0.200D0 ! CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - DRMP2 = 0.240D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - DRMP3 = 0.240D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - DRMP4 = 0.240D0 ! K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - DRMP5 = 0.240D0 ! K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4NO3, NH4CL -CC - DRMV1 = 0.494D0 ! (NH4)2SO4, NH4NO3, NA2SO4, K2SO4, MGSO4 -CC -CC -C DRMO1 = 0.1D0 ! (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4 -C DRMO2 = 0.1D0 ! (NH4)2SO4, NH4Cl, NA2SO4, K2SO4, MGSO4 -C DRMO3 = 0.1D0 ! (NH4)2SO4, NA2SO4, K2SO4, MGSO4 -C DRML1 = 0.1D0 ! K2SO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -C DRML2 = 0.1D0 ! K2SO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -C DRML3 = 0.1D0 ! K2SO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -C DRMM1 = 0.1D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 -C DRMM2 = 0.1D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -C DRMP1 = 0.1D0 ! CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C DRMP2 = 0.1D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C DRMP3 = 0.1D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C DRMP4 = 0.1D0 ! K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C DRMP5 = 0.1D0 ! K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4NO3, NH4CL -CC -C DRMV1 = 0.1D0 ! (NH4)2SO4, NH4NO3, NA2SO4, K2SO4, MGSO4 -C -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 - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = 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 -C IF (M0(01) .LT. 100.0) THEN -C IC = M0(01) -C CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(02) = AWSS(IRH) ! (NA)2SO4 -C IF (M0(02) .LT. 100.0) THEN -C IC = 3.0*M0(02) -C CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(03) = AWSN(IRH) ! NANO3 -C IF (M0(03) .LT. 100.0) THEN -C IC = M0(03) -C CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(04) = AWAS(IRH) ! (NH4)2SO4 -C IF (M0(04) .LT. 100.0) THEN -C IC = 3.0*M0(04) -C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(05) = AWAN(IRH) ! NH4NO3 -C IF (M0(05) .LT. 100.0) THEN -C IC = M0(05) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(06) = AWAC(IRH) ! NH4CL -C IF (M0(06) .LT. 100.0) THEN -C IC = M0(06) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(07) = AWSA(IRH) ! 2H-SO4 -C IF (M0(07) .LT. 100.0) THEN -C IC = 3.0*M0(07) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -C 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 -C IF (M0(09) .LT. 100.0) THEN -C IC = M0(09) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(12) = AWSB(IRH) ! NAHSO4 -C IF (M0(12) .LT. 100.0) THEN -C IC = M0(12) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -C IF (M0(13) .LT. 100.0) THEN -C IC = 4.0*M0(13) -C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C G130 = 0.2*(3.0*GI0+2.0*GII) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -C G13I = 0.2*(3.0*GI0+2.0*GII) -C M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -C ENDIF -C - M0(15) = AWCN(IRH) ! CA(NO3)2 -C IF (M0(15) .LT. 100.0) THEN -C IC = M0(15) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & GI0,XX,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & GII,XX,XX,XX,XX,XX,XX,XX,XX) -C M0(15) = M0(15)*EXP(LN10*(GI0-GII)) -C ENDIF -CC - M0(16) = AWCC(IRH) ! CACl2 -C IF (M0(16) .LT. 100.0) THEN -C IC = M0(16) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,GI0,XX,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,GII,XX,XX,XX,XX,XX,XX,XX) -C M0(16) = M0(16)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(17) = AWPS(IRH) ! K2SO4 -C IF (M0(17) .LT. 100.0) THEN -C IC = M0(17) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,GI0,XX,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,GII,XX,XX,XX,XX,XX,XX) -C M0(17) = M0(17)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(18) = AWPB(IRH) ! KHSO4 -C IF (M0(18) .LT. 100.0) THEN -C IC = M0(18) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,GI0,XX,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,GII,XX,XX,XX,XX,XX) -C M0(18) = M0(18)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(19) = AWPN(IRH) ! KNO3 -C IF (M0(19) .LT. 100.0) THEN -C IC = M0(19) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,GI0,XX,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,GII,XX,XX,XX,XX) -C M0(19) = M0(19)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(20) = AWPC(IRH) ! KCl -C IF (M0(20) .LT. 100.0) THEN -C IC = M0(20) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,GI0,XX,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,GII,XX,XX,XX) -C M0(20) = M0(20)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(21) = AWMS(IRH) ! MGSO4 -C IF (M0(21) .LT. 100.0) THEN -C IC = M0(21) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,GI0,XX,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,GII,XX,XX) -C M0(21) = M0(21)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(22) = AWMN(IRH) ! MG(NO3)2 -C IF (M0(22) .LT. 100.0) THEN -C IC = M0(22) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,GI0,XX) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,GII,XX) -C M0(22) = M0(22)*EXP(LN10*(GI0-GII)) -C ENDIF -C - M0(23) = AWMC(IRH) ! MGCL2 -C IF (M0(23) .LT. 100.0) THEN -C IC = M0(23) -C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,GI0) -C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -C & XX,XX,XX,XX,XX,XX,XX,XX,GII) -C M0(23) = M0(23)*EXP(LN10*(GI0-GII)) -C ENDIF -C -C *** OTHER INITIALIZATIONS ********************************************* -C - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - SO4RAT = 2.D0 - CRNARAT = 2.D0 - CRRAT = 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 INIT4 ******************************************* -C - END -C -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 -C *** ISORROPIA CODE -C *** BLOCK DATA AERSR -C *** CONTAINS DATA FOR AEROSOL SULFATE RATIO ARRAY NEEDED IN FUNCTION -C GETASR -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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,280)/ - & 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, - & 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, - & 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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 = 0.0d0 - 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 - ENDIF -C -C *** CALCULATE HCL SPECIATION IN THE GAS PHASE ************************* -C - GHCL = MAX(X-DELT, 0.0d0) ! 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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 = 0.0d0 - 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 - ENDIF -C -C *** CALCULATE HNO3 SPECIATION IN THE GAS PHASE ************************ -C - GHNO3 = MAX(X-DELT, 0.0d0) ! 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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))! Constrict in acceptible 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 -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 -C -C *** CALCULATE ROOTS *************************************************** -C - CALL POLY3 (M1, M2, M3, DELCL, ISLV) ! HCL DISSOLUTION - IF (ISLV.NE.0) THEN - DELCL = TINY ! TINY AMOUNTS OF HCL ASSUMED WHEN NO ROOT - WRITE (ERRINF,'(1PE7.1)') TINY - CALL PUSHERR (0022, ERRINF) ! WARNING ERROR: NO SOLUTION - 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 - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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 II -C *** SUBROUTINE CALCHCO3 -C *** CORRECTS FOR H+ WHEN CRUSTALS ARE IN EXCESS -C -C CARBONATES ARE IN EXCESS, HCO3- IS ASSUMED A MINOR SPECIES, -C THE H+ CONCENTRATION IS CALCULATED FROM THE -C CO2(aq) + H2O <-> (HCO3-) + (H+) -C HCO3- <-> (H+) + (CO3--) EQUILIBRIUM. -C THE CO3-- CONCENTRATION IS ASSUMED NEGLIGIBLE WITH RESPECT TO HCO3- -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C -C SUBROUTINE CALCHCO3 -C INCLUDE 'isrpia.inc' -C DOUBLE PRECISION KAPA -CCC CHARACTER ERRINF*40 -CC -CC *** SPECIAL CASE; WATER=ZERO ****************************************** -CC -C IF (WATER.LE.TINY) THEN -C GOTO 521 -C ENDIF -CC -CC *** CALCULATE CO2 DISSOLUTION ***************************************** -CC -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT = 0.0d0 -CC DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -C KAPA = MOLAL(1) -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** -CC -C ALFA = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -CC ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -CC *** CALCULATE CUBIC EQUATION COEFFICIENTS ***************************** -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS HCO3- -CC -C BB =-(KAPA + X + ALFA) -C CC = KAPA*X -C DD = BB*BB - 4.D0*CC -CC -C IF (DD.GE.ZERO) THEN -C SQDD = SQRT(DD) -C DELT = 0.5*(-BB - SQDD) -C ELSE -C DELT = ZERO -C ENDIF -C -C ENDIF -CC -CC *** CALCULATE H+ ***************************************************** -CC -C MOLAL(1) = KAPA - DELT ! H+ -CC -C521 RETURN -CC -CC *** END OF SUBROUTINE CALCHCO3 *************************************** -CC -C END -CC -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCAMAQ -C *** THIS SUBROUTINE CALCULATES THE NH3(aq) GENERATED FROM (H,NH4+). -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - 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 CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCMR - INCLUDE 'isrpia.inc' - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C - 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.5D0*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 *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE POOR ; CR+NA POOR CASE -C - ELSE IF (SC.EQ.'O') THEN - MOLALR(2) = 0.5D0*MOLAL(2) ! NA2SO4 - TOTS4 = MOLAL(5)+MOLAL(6) ! Total SO4 - MOLALR(17)= 0.5*MOLAL(9) ! K2SO4 - MOLALR(21)= MOLAL(10) ! MGSO4 - MOLALR(4) = MAX(TOTS4 - MOLALR(2) - MOLALR(17) - & - MOLALR(21), 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-CA-K-MG SYSTEM ; SULFATE POOR ; CR+NA RICH; CR POOR CASE -C *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ -C - ELSE IF (SC.EQ.'M') 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 - MOLALR(17)= PSI9 ! K2SO4 - MOLALR(21)= PSI10 ! MGSO4 -C -C *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE POOR ; CR+NA RICH; CR RICH CASE -C *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ -C - ELSE IF (SC.EQ.'P') THEN - MOLALR(1) = PSI7 ! NACL - MOLALR(3) = PSI8 ! NANO3 - MOLALR(15)= PSI12 ! CANO32 - MOLALR(16)= PSI17 ! CACL2 - MOLALR(19)= PSI13 ! KNO3 - MOLALR(20)= PSI14 ! KCL - MOLALR(22)= PSI15 ! MGNO32 - MOLALR(23)= PSI16 ! MGCL2 - FRNO3 = MAX(MOLAL(7)-MOLALR(3)-2.D0*MOLALR(15) - & -MOLALR(19)-2.D0*MOLALR(22), ZERO) ! "FREE" NO3 - FRCL = MAX(MOLAL(4)-MOLALR(1)-2.D0*MOLALR(16) - & -MOLALR(20)-2.D0*MOLALR(23), 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 - MOLALR(17)= PSI9 ! K2SO4 - MOLALR(21)= PSI10 ! MGSO4 -C -C *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE RICH CASE ; NO FREE ACID -C - ELSE IF (SC.EQ.'L') THEN - MOLALR(04) = PSI5 ! (NH4)2SO4 - MOLALR(02) = PSI4 ! NA2SO4 - MOLALR(09) = PSI1 ! NH4HSO4 - MOLALR(12) = PSI3 ! NAHSO4 - MOLALR(13) = PSI2 ! LC - MOLALR(17) = PSI6 ! K2SO4 - MOLALR(21) = PSI7 ! MGSO4 - MOLALR(18) = PSI8 ! KHSO4 -C -C *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE SUPER RICH CASE ; FREE ACID -C - ELSE IF (SC.EQ.'K') THEN - MOLALR(09) = MOLAL(3) ! NH4HSO4 - MOLALR(12) = MOLAL(2) ! NAHSO4 - MOLALR(14) = MOLAL(8) ! CASO4 - MOLALR(18) = MOLAL(9) ! KHSO4 - MOLALR(21) = MOLAL(10) ! MGSO4 - MOLALR(07) = MOLAL(5)+MOLAL(6)-MOLAL(3) - & -MOLAL(2)-MOLAL(8)-MOLAL(9)-MOLAL(10) ! 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 *** NH4-SO4-NO3-NA-CL-CA-K-MG SYSTEM ; SULFATE POOR, CRUSTAL&SODIUM POOR CASE -C - ELSE IF (SC.EQ.'V') THEN - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(4) = PSI6 ! (NH4)2SO4 - MOLALR(5) = PSI5 ! NH4NO3 - MOLALR(6) = PSI4 ! NH4CL - MOLALR(17)= PSI7 ! K2SO4 - MOLALR(21)= PSI8 ! MGSO4 -C -C *** NH4-SO4-NO3-NA-CL-CA-K-MG SYSTEM ; SULFATE POOR, CRUSTAL&SODIUM RICH, CRUSTAL POOR CASE -C - ELSE IF (SC.EQ.'U') THEN - MOLALR(1) = PSI3 ! NACL - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(3) = PSI2 ! NANO3 - MOLALR(5) = PSI5 ! NH4NO3 - MOLALR(6) = PSI4 ! NH4CL - MOLALR(17)= PSI7 ! K2SO4 - MOLALR(21)= PSI8 ! MGSO4 -C -C *** NH4-SO4-NO3-NA-CL-CA-K-MG SYSTEM ; SULFATE POOR, CRUSTAL&SODIUM RICH, CRUSTAL RICH CASE -C - ELSE IF (SC.EQ.'W') THEN - MOLALR(1) = PSI7 ! NACL - MOLALR(3) = PSI8 ! NANO3 - MOLALR(5) = PSI6 ! NH4NO3 - MOLALR(6) = PSI5 ! NH4CL - MOLALR(15)= PSI12 ! CANO32 - MOLALR(16)= PSI17 ! CACL2 - MOLALR(17)= PSI9 ! K2SO4 - MOLALR(19)= PSI13 ! KNO3 - MOLALR(20)= PSI14 ! KCL - MOLALR(21)= PSI10 ! MGSO4 - MOLALR(22)= PSI15 ! MGNO32 - MOLALR(23)= PSI16 ! MGCL2 -C -C *** UNKNOWN CASE -C -C ELSE -C 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 -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 II -C *** SUBROUTINE CALCMDRH2 -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 CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCMDRH2 (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 - CCASO = CCASO4 - CK2SO = CK2SO4 - CMGSO = CMGSO4 - CKHSO = CKHSO4 - CCAN32O = CCANO32 - CCAC2L = CCACL2 - CKN3O = CKNO3 - CKCLO = CKCL - CMGN32O = CMGNO32 - CMGC2L = CMGCL2 -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 -C - CCASO4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CKHSO4 = ZERO - CCANO32 = ZERO - CCACL2 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO -C - 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 - CCASO4 = CCASO - CK2SO4 = CK2SO - CMGSO4 = CMGSO - CKHSO4 = CKHSO - CCANO32 = CCAN32O - CCACL2 = CCAC2L - CKNO3 = CKN3O - CKCL = CKCLO - CMGNO32 = CMGN32O - CMGCL2 = CMGC2L -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 - DCASUL = CCASO - CCASO4 - DPOSUL = CK2SO - CK2SO4 - DMGSUL = CMGSO - CMGSO4 - DPOBIS = CKHSO - CKHSO4 - DCANIT = CCAN32O - CCANO32 - DCACHL = CCAC2L - CCACL2 - DPONIT = CKN3O - CKNO3 - DPOCHL = CKCLO - CKCL - DMGNIT = CMGN32O - CMGNO32 - DMGCHL = CMGC2L - CMGCL2 -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 + 2.D0*DCACHL + - & 2.D0*DMGCHL + DPOCHL) ! CL- - MOLAL(5) = ONEMWF*(DAMSUL + DSOSUL + DLC - MOLAL(6) - & +DCASUL + DPOSUL + DMGSUL) ! SO4-- !VB 17 Sept 2001 - MOLAL(6) = ONEMWF*(MOLAL(6) + DSOBIS + DAMBIS + DLC + DPOBIS) ! HSO4- - MOLAL(7) = ONEMWF*(DAMNIT + DSONIT + DNAG + 2.D0*DCANIT - & + 2.D0*DMGNIT + DPONIT) ! NO3- - MOLAL(8) = ONEMWF*(DCASUL + DCANIT + DCACHL) ! CA2+ - MOLAL(9) = ONEMWF*(2.D0*DPOSUL + DPONIT + DPOCHL + DPOBIS) ! K+ - MOLAL(10)= ONEMWF*(DMGSUL + DMGNIT + DMGCHL) ! MG2+ - 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 - CCASO4 = WF*CCASO + ONEMWF*CCASO4 - CK2SO4 = WF*CK2SO + ONEMWF*CK2SO4 - CMGSO4 = WF*CMGSO + ONEMWF*CMGSO4 - CKHSO4 = WF*CKHSO + ONEMWF*CKHSO4 - CCANO32 = WF*CCAN32O + ONEMWF*CCANO32 - CCACL2 = WF*CCAC2L + ONEMWF*CCACL2 - CMGNO32 = WF*CMGN32O + ONEMWF*CMGNO32 - CMGCL2 = WF*CMGC2L + ONEMWF*CMGCL2 - CKCL = WF*CKCLO + ONEMWF*CKCL -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 CALCMDRH2 **************************************** -C - END -C - -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). (REVERSE PROBLEM) -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 -C *** ISORROPIA CODE -C *** SUBROUTINE CALCMDRPII -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). (REVERSE PROBLEM) -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE CALCMDRPII (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 - CCASO = CCASO4 - CK2SO = CK2SO4 - CMGSO = CMGSO4 - CKHSO = CKHSO4 - CCAN32O = CCANO32 - CCAC2L = CCACL2 - CKN3O = CKNO3 - CKCLO = CKCL - CMGN32O = CMGNO32 - CMGC2L = CMGCL2 -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 -C - CCASO4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CKHSO4 = ZERO - CCANO32 = ZERO - CCACL2 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO -C - 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 - DPOBIS = CKHSO - CKHSO4 -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 - CCASO4 = WF*CCASO + ONEMWF*CCASO4 - CK2SO4 = WF*CK2SO + ONEMWF*CK2SO4 - CMGSO4 = WF*CMGSO + ONEMWF*CMGSO4 - CKHSO4 = WF*CKHSO + ONEMWF*CKHSO4 - CCANO32 = WF*CCAN32O + ONEMWF*CCANO32 - CCACL2 = WF*CCAC2L + ONEMWF*CCACL2 - CMGNO32 = WF*CMGN32O + ONEMWF*CMGNO32 - CMGCL2 = WF*CMGC2L + ONEMWF*CMGCL2 - CKCL = WF*CKCLO + ONEMWF*CKCL -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 - 2.D0*CCACL2 - - & 2.D0*CMGCL2 - CKCL ! CL- - MOLAL(7)= WAER(4) - CNANO3 - CNH4NO3 - CKNO3 - & - 2.D0*CCANO32 - 2.D0*CMGNO32 ! NO3- - MOLAL(6)= ONEMWF*(MOLAL(6) + DSOBIS + DAMBIS + DLC + DPOBIS) ! HSO4- - MOLAL(5)= WAER(2) - MOLAL(6) - CLC - CNH42S4 - CNA2SO4 - & - CCASO4 - CK2SO4 - CMGSO4 ! SO4-- - MOLAL(8)= WAER(6) - CCASO4 - CCANO32 - CCACL2 ! CA++ - MOLAL(9)= WAER(7) - 2.D0*CK2SO4 - CKNO3 - CKCL - CKHSO4 ! K+ - MOLAL(10)=WAER(8) - CMGSO4 - CMGNO32 - CMGCL2 ! MG++ -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 CALCMDRPII ************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCHS4 -C *** THIS SUBROUTINE CALCULATES THE HSO4 GENERATED FROM (H,SO4). -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 II -C *** SUBROUTINE CALCACT -C *** CALCULATES MULTI-COMPONENT 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 -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCACT - INCLUDE 'isrpia.inc' -C - COMMON /DRVINP/ WI(8), RHI, TEMPI, IPROBI, METSTBLI, IACALCI, - & NADJI -C - IF (W(1)+W(4)+W(5)+W(6)+W(7)+W(8) .LE. 6.d0*TINY) THEN !Ca,K,Mg,Na,Cl,NO3=0 - CALL CALCACT1 - ELSE IF (W(1)+W(5)+W(6)+W(7)+W(8) .LE. 5.d0*TINY) THEN !Ca,K,Mg,Na,Cl=0 - CALL CALCACT2 - ELSE IF (W(6)+W(7)+W(8) .LE. 3.d0*TINY) THEN !Ca,K,Mg=0 - CALL CALCACT3 - ELSE - CALL CALCACT4 - ENDIF -C -C *** Return point ; End of subroutine -C - RETURN - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCACT4 -C *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -C METHOD FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTASSIUM-MAGNESIUM -C AEROSOL SYSTEM. THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -C KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL4). -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCACT4 - INCLUDE 'isrpia.inc' -C - REAL EX10 - REAL G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(6),F2A(4),F2B(4) - DOUBLE PRECISION MPL, XIJ, YJI - DATA G0/24*0D0/ - -C - GA(I,J)= (F1(I)/Z(I) + F2A(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H - GB(I,J)= (F1(I)/Z(I+4) + F2B(J)/Z(J+3)) / (Z(I+4)+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) -C WRITE(*,*) 'FRST - GAMA:',GAMA(:) -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 KMFUL4 (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),G0(4,4),G0(4,1),G0(5,2), - & G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - 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),G0(4,4),G0(4,1),G0(5,2), - & G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - 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,4 - F1(I)=0.0 - F2A(I)=0.0 - F2B(I)=0.0 -100 CONTINUE - F1(5)=0.0 - F1(6)=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)) - F2A(J) = F2A(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) -110 CONTINUE -C - DO 330 I=4,6 - ZPL = Z(I+4) - MPL = MOLAL(I+4)/WATER - DO 330 J=1,4 - ZMI = Z(J+3) - IF (J.EQ.3) THEN - IF (I.EQ.4 .OR. I.EQ.6) THEN - GO TO 330 - ENDIF - ENDIF - 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)) - F2B(J) = F2B(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) -330 CONTINUE - -C -C *** LOG10 OF ACTIVITY COEFFICIENTS *********************************** -C - GAMA(01) = GA(2,1)*ZZ(01) ! NACL - GAMA(02) = GA(2,2)*ZZ(02) ! NA2SO4 - GAMA(03) = GA(2,4)*ZZ(03) ! NANO3 - GAMA(04) = GA(3,2)*ZZ(04) ! (NH4)2SO4 - GAMA(05) = GA(3,4)*ZZ(05) ! NH4NO3 - GAMA(06) = GA(3,1)*ZZ(06) ! NH4CL - GAMA(07) = GA(1,2)*ZZ(07) ! 2H-SO4 - GAMA(08) = GA(1,3)*ZZ(08) ! H-HSO4 - GAMA(09) = GA(3,3)*ZZ(09) ! NH4HSO4 - GAMA(10) = GA(1,4)*ZZ(10) ! HNO3 - GAMA(11) = GA(1,1)*ZZ(11) ! HCL - GAMA(12) = GA(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 - GAMA(14) = 0.0d0 ! CASO4 - GAMA(15) = GB(4,4)*ZZ(15) ! CA(NO3)2 - GAMA(16) = GB(4,1)*ZZ(16) ! CACL2 - GAMA(17) = GB(5,2)*ZZ(17) ! K2SO4 - GAMA(18) = GB(5,3)*ZZ(18) ! KHSO4 - GAMA(19) = GB(5,4)*ZZ(19) ! KNO3 - GAMA(20) = GB(5,1)*ZZ(20) ! KCL - GAMA(21) = GB(6,2)*ZZ(21) ! MGSO4 - GAMA(22) = GB(6,4)*ZZ(22) ! MG(NO3)2 - GAMA(23) = GB(6,1)*ZZ(23) ! MGCL2 -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 - GAMA(I)=10.0**GAMA(I) -CC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] - 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 WRITE(*,*) 'ICLACT:',ICLACT -C WRITE(*,*) 'GAMA:',GAMA(:) -C -C *** END OF SUBROUTINE ACTIVITY **************************************** -C - RETURN - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCACT3 -C *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -C METHOD FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. -C THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -C KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL3). -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCACT3 - INCLUDE 'isrpia.inc' -C - REAL EX10, URF - REAL G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4) - DOUBLE PRECISION MPL, XIJ, YJI - PARAMETER (URF=0.5) - DATA G0/24*0D0/ -C 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,13 - GAMOU(I) = GAMA(I) -C WRITE(*,*) 'FRST - GAMA:',GAMA(:) -10 CONTINUE - ENDIF -C - DO 20 I=1,13 ! Inner loop - GAMIN(I) = GAMA(I) -20 CONTINUE -C -C *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** -C - IONIC=0.0 - DO 30 I=1,7 - 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 KMFUL3 (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),G0(4,4),G0(4,1),G0(5,2), - & G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - 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,13 - GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(I)=10.0**GAMA(I) -C 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,13 - 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,13 - 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 WRITE(*,*) 'ICLACT:',ICLACT -C WRITE(*,*) 'GAMA:',GAMA(:) -C -C *** END OF SUBROUTINE ACTIVITY **************************************** -C - RETURN - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCACT2 -C *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -C METHOD FOR AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. -C THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -C KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL2). -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCACT2 - INCLUDE 'isrpia.inc' -C - REAL EX10, URF - REAL G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4) - DOUBLE PRECISION MPL, XIJ, YJI - PARAMETER (URF=0.5) - DATA G0/24*0D0/ -C 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=7,10 - GAMOU(I) = GAMA(I) -10 CONTINUE - GAMOU(4) = GAMA(4) - GAMOU(5) = GAMA(5) - GAMOU(13) = GAMA(13) -C WRITE(*,*) 'FRST - GAMA:',GAMA(:) - ENDIF -C - DO 20 I=7,10 ! Inner loop - GAMIN(I) = GAMA(I) -20 CONTINUE - GAMIN(4) = GAMA(4) - GAMIN(5) = GAMA(5) - GAMIN(13) = GAMA(13) -C -C *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** -C - IONIC=0.0 - MOLAL(2) = ZERO - MOLAL(4) = ZERO - DO 30 I=1,7 - IONIC=IONIC + MOLAL(I)*Z(I)*Z(I) -30 CONTINUE - IONIC = MAX(MIN(0.5*IONIC/WATER,100.d0), TINY) - -C ! slc.debug -C write(*,*) 'ionic: ', ionic -C write(*,*) 'water: ', water - -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 KMFUL2 (IONIC, SNGL(TEMP),G0(3,2),G0(3,4),G0(1,2), - & G0(1,3),G0(3,3),G0(1,4)) - 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),G0(4,4),G0(4,1),G0(5,2), - & G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - ENDIF - - ! slc.debug -C write(*,*) 'G0: ',G0(3,2),G0(3,4),G0(1,2) -C write(*,*) 'G0: ',G0(1,3),G0(3,3),G0(1,4) - -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 - -C ! slc.debug -C write(*,*) 'Z: ',Z -C write(*,*) 'H: ',H -C WRITE(*,*) 'MOLAL: ',MOLAL - - DO 110 I=1,3,2 - ZPL = Z(I) - MPL = MOLAL(I)/WATER - DO 110 J=2,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 ! slc.debug -C write(*,*) 'F1', F1 -C write(*,*) 'F2', F2 - -C -C *** LOG10 OF ACTIVITY COEFFICIENTS *********************************** -C -C GAMA(01) = G(2,1)*ZZ(01) ! NACL -C GAMA(02) = G(2,2)*ZZ(02) ! NA2SO4 -C 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 -C 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 -C GAMA(11) = G(1,1)*ZZ(11) ! HCL -C 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=7,10 - GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(I)=10.0**GAMA(I) -C 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 - GAMA(4)=MAX(-5.0d0, MIN(GAMA(4),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(4)=10.0**GAMA(4) -C GAMA(I)=EXP(LN10*GAMA(I)) -CC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -C GAMA(4) = GAMIN(4)*(1.0-URF) + URF*GAMA(4) ! Under-relax GAMA's -C - GAMA(5)=MAX(-5.0d0, MIN(GAMA(5),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(5)=10.0**GAMA(5) -C GAMA(I)=EXP(LN10*GAMA(I)) -CC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -C GAMA(5) = GAMIN(5)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's -C - GAMA(13)=MAX(-5.0d0, MIN(GAMA(13),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(13)=10.0**GAMA(13) -C GAMA(I)=EXP(LN10*GAMA(I)) -CC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -C GAMA(13) = GAMIN(13)*(1.0-URF) + URF*GAMA(13) ! Under-relax GAMA's -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=7,10 - ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I))) -210 CONTINUE - ERROU=MAX(ERROU, ABS((GAMOU(4)-GAMA(4))/GAMOU(4))) - ERROU=MAX(ERROU, ABS((GAMOU(5)-GAMA(5))/GAMOU(5))) - ERROU=MAX(ERROU, ABS((GAMOU(13)-GAMA(13))/GAMOU(13))) -C - CALAOU = ERROU .GE. EPSACT ! SETUP FLAGS - FRST =.FALSE. - ENDIF -C -C INNER CALCULATION LOOP ; ALWAYS -C - ERRIN = ZERO ! CONVERGENCE CRITERION - DO 220 I=7,10 - ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I))) -220 CONTINUE - ERRIN = MAX (ERRIN, ABS((GAMIN(4)-GAMA(4))/GAMIN(4))) - ERRIN = MAX (ERRIN, ABS((GAMIN(5)-GAMA(5))/GAMIN(5))) - ERRIN = MAX (ERRIN, ABS((GAMIN(13)-GAMA(13))/GAMIN(13))) - CALAIN = ERRIN .GE. EPSACT -C - ICLACT = ICLACT + 1 ! Increment ACTIVITY call counter -C WRITE(*,*) 'ICLACT:',ICLACT -C WRITE(*,*) 'GAMA:',GAMA(:) -C -C *** END OF SUBROUTINE ACTIVITY **************************************** -C - RETURN - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCACT1 -C *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -C METHOD FOR AN AMMONIUM-SULFATE AEROSOL SYSTEM. -C THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -C KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL1). -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCACT1 - INCLUDE 'isrpia.inc' -C - REAL EX10, URF - REAL G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4) - DOUBLE PRECISION MPL, XIJ, YJI - PARAMETER (URF=0.5) - DATA G0/24*0D0/ -C 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=7,9 - GAMOU(I) = GAMA(I) -10 CONTINUE - GAMOU(4) = GAMA(4) -C GAMOU(5) = GAMA(5) - GAMOU(13) = GAMA(13) - ENDIF -C - DO 20 I=7,9 ! Inner loop - GAMIN(I) = GAMA(I) -20 CONTINUE - GAMIN(4) = GAMA(4) -C GAMIN(5) = GAMA(5) - GAMIN(13) = GAMA(13) -C -C *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** -C - IONIC=0.0 - MOLAL(2) = ZERO - MOLAL(4) = ZERO - MOLAL(7) = ZERO - DO 30 I=1,7 - 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 KMFUL1 (IONIC, SNGL(TEMP),G0(3,2),G0(1,2), - & G0(1,3),G0(3,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),G0(4,4),G0(4,1),G0(5,2), - & G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - 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,2 - ZPL = Z(I) - MPL = MOLAL(I)/WATER - DO 110 J=2,3 - 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 -C GAMA(01) = G(2,1)*ZZ(01) ! NACL -C GAMA(02) = G(2,2)*ZZ(02) ! NA2SO4 -C GAMA(03) = G(2,4)*ZZ(03) ! NANO3 - GAMA(04) = G(3,2)*ZZ(04) ! (NH4)2SO4 -C GAMA(05) = G(3,4)*ZZ(05) ! NH4NO3 -C 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 -C GAMA(09) = 0.5*(GAMA(04)+GAMA(07)) ! NH4HSO4 ; AIM (Wexler & Seinfeld, 1991) -C GAMA(10) = G(1,4)*ZZ(10) ! HNO3 -C GAMA(11) = G(1,1)*ZZ(11) ! HCL -C 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=7,9 - GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(I)=10.0**GAMA(I) -C 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 - GAMA(4)=MAX(-5.0d0, MIN(GAMA(4),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(4)=10.0**GAMA(4) -C GAMA(I)=EXP(LN10*GAMA(I)) -CC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -C GAMA(4) = GAMIN(4)*(1.0-URF) + URF*GAMA(4) ! Under-relax GAMA's -C -C GAMA(5)=MAX(-5.0d0, MIN(GAMA(5),5.0d0) ) ! F77 LIBRARY ROUTINE -C GAMA(5)=10.0**GAMA(5) -CC GAMA(I)=EXP(LN10*GAMA(I)) -CCC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -C GAMA(5) = GAMIN(5)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's -C - GAMA(13)=MAX(-5.0d0, MIN(GAMA(13),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(13)=10.0**GAMA(13) -C GAMA(I)=EXP(LN10*GAMA(I)) -CC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -C GAMA(13) = GAMIN(13)*(1.0-URF) + URF*GAMA(13) ! Under-relax GAMA's -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=7,9 - ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I))) -210 CONTINUE - ERROU=MAX(ERROU, ABS((GAMOU(4)-GAMA(4))/GAMOU(4))) -C ERROU=MAX(ERROU, ABS((GAMOU(5)-GAMA(5))/GAMOU(5))) - ERROU=MAX(ERROU, ABS((GAMOU(13)-GAMA(13))/GAMOU(13))) -C - CALAOU = ERROU .GE. EPSACT ! SETUP FLAGS - FRST =.FALSE. - ENDIF -C -C INNER CALCULATION LOOP ; ALWAYS -C - ERRIN = ZERO ! CONVERGENCE CRITERION - DO 220 I=7,9 - ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I))) -220 CONTINUE - ERRIN = MAX (ERRIN, ABS((GAMIN(4)-GAMA(4))/GAMIN(4))) -C ERRIN = MAX (ERRIN, ABS((GAMIN(5)-GAMA(5))/GAMIN(5))) - ERRIN = MAX (ERRIN, ABS((GAMIN(13)-GAMA(13))/GAMIN(13))) - CALAIN = ERRIN .GE. EPSACT -C - ICLACT = ICLACT + 1 ! Increment ACTIVITY call counter -C -C *** END OF SUBROUTINE ACTIVITY **************************************** -C - RETURN - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE RSTGAM -C *** RESETS ACTIVITY COEFFICIENT ARRAYS TO DEFAULT VALUE OF 0.1 -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 -C *** ISORROPIA CODE -C *** SUBROUTINE RSTGAMP -C *** RESETS ACTIVITY COEFFICIENT ARRAYS TO DEFAULT VALUE OF 0.1 IF -C *** GREATER THAN THE THRESHOLD VALUE. -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE RSTGAMP - INCLUDE 'isrpia.inc' - DOUBLE PRECISION GMAX, GTHRESH - INTEGER I -C - GTHRESH = 100.D0 - GMAX = 0.1D0 - DO I=1, NPAIR - GMAX = MAX(GMAX,GAMA(I)) - ENDDO - IF ((GMAX) .GT. (GTHRESH)) THEN - DO I = 1,NPAIR - GAMA(I) = 1.D-1 - GAMIN(I) = GREAT - GAMOU(I) = GREAT - ENDDO - CALAOU = .TRUE. - FRST = .TRUE. - ENDIF -C - END SUBROUTINE RSTGAMP -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE KMFUL4 -C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -C FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTASSIUM-MAGNESIUM -C AEROSOL SYSTEM. -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE KMFUL4 (IONIC,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09, - & G10,G11,G12,G15,G16,G17,G18,G19,G20, - & G21,G22,G23) - REAL Ionic, TEMP - DATA Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11,Z15,Z16,Z17,Z19,Z20, - & Z21,Z22,Z23/1, 2, 1, 2, 1, 1, 2, 1, 1, 1, 2, 2, 2, 1, 1, 4, - & 2, 2/ -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) - CALL MKBI(0.930, IONIC, SION, Z15, G15) - CALL MKBI(2.400, IONIC, SION, Z16, G16) - CALL MKBI(-0.25, IONIC, SION, Z17, G17) - CALL MKBI(-2.33, IONIC, SION, Z19, G19) - CALL MKBI(0.920, IONIC, SION, Z20, G20) - CALL MKBI(0.150, IONIC, SION, Z21, G21) - CALL MKBI(2.320, IONIC, SION, Z22, G22) - CALL MKBI(2.900, IONIC, SION, Z23, G23) -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 - G15 = CF1*G15 - CF2*Z15 - G16 = CF1*G16 - CF2*Z16 - G17 = CF1*G17 - CF2*Z17 - G19 = CF1*G19 - CF2*Z19 - G20 = CF1*G20 - CF2*Z20 - G21 = CF1*G21 - CF2*Z21 - G22 = CF1*G22 - CF2*Z22 - G23 = CF1*G23 - CF2*Z23 - - ENDIF -C - G09 = G06 + G08 - G11 - G12 = G01 + G08 - G11 - G18 = G08 + G20 - G11 -C -C *** Return point ; End of subroutine -C - RETURN - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE KMFUL3 -C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -C FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE KMFUL3 (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 KMFUL2 -C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -C FOR AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE KMFUL2 (IONIC,TEMP,G04,G05,G07,G08,G09,G10) - REAL Ionic, TEMP - REAL G06, G11 - 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 -C CALL MKBI(2.230, IONIC, SION, Z01, G01) -C CALL MKBI(-0.19, IONIC, SION, Z02, G02) -C 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)) -C G01 = CF1*G01 - CF2*Z01 -C G02 = CF1*G02 - CF2*Z02 -C 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 -C ! original method of calculating G09 - G09 = G06 + G08 - G11 - -C ! slc.debug -C ! G09 = G05 + G08 - G10 -C G12 = G01 + G08 - G11 -C -C *** Return point ; End of subroutine -C - RETURN - END -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE KMFUL1 -C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -C FOR AN AMMONIUM-SULFATE AEROSOL SYSTEM. -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE KMFUL1 (IONIC,TEMP,G04,G07,G08,G09) - REAL Ionic, TEMP - REAL G06, G08, G11 - 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 -C CALL MKBI(2.230, IONIC, SION, Z01, G01) -C CALL MKBI(-0.19, IONIC, SION, Z02, G02) -C CALL MKBI(-0.39, IONIC, SION, Z03, G03) - CALL MKBI(-0.25, IONIC, SION, Z04, G04) -C 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) -C 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)) -C G01 = CF1*G01 - CF2*Z01 -C G02 = CF1*G02 - CF2*Z02 -C G03 = CF1*G03 - CF2*Z03 - G04 = CF1*G04 - CF2*Z04 -C G05 = CF1*G05 - CF2*Z05 - G06 = CF1*G06 - CF2*Z06 - G07 = CF1*G07 - CF2*Z07 - G08 = CF1*G08 - CF2*Z08 -C G10 = CF1*G10 - CF2*Z10 - G11 = CF1*G11 - CF2*Z11 - ENDIF -C -C ! Correction - G09 is G0(3,3), which is not calculated in CALCACT1 -C ! Use G09 from CALCACT3 to represent G09 (slc.2.2012) - G09 = G06 + G08 - G11 - -C G09 = G05 + G08 - G10 ! CALCULATED IN CALCACT1 -C G12 = G01 + G08 - G11 -C -C *** Return point ; End of subroutine -C - RETURN - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE MKBI -C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE KMTAB (IN,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, - & G11,G12,G15,G16,G17,G18,G19,G20,G21,G22,G23) - REAL IN, Temp, binarray (23) -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,binarray) - ELSEIF (IND.EQ.2) THEN - CALL KM223 (IN,binarray) - ELSEIF (IND.EQ.3) THEN - CALL KM248 (IN,binarray) - ELSEIF (IND.EQ.4) THEN - CALL KM273 (IN,binarray) - ELSEIF (IND.EQ.5) THEN - CALL KM298 (IN,binarray) - ELSE - CALL KM323 (IN,binarray) - ENDIF -C - G01 = binarray(01) - G02 = binarray(02) - G03 = binarray(03) - G04 = binarray(04) - G05 = binarray(05) - G06 = binarray(06) - G07 = binarray(07) - G08 = binarray(08) - G09 = binarray(09) - G10 = binarray(10) - G11 = binarray(11) - G12 = binarray(12) - G13 = binarray(13) - G14 = binarray(14) - G15 = binarray(15) - G16 = binarray(16) - G17 = binarray(17) - G18 = binarray(18) - G19 = binarray(19) - G20 = binarray(20) - G21 = binarray(21) - G22 = binarray(22) - G23 = binarray(23) -C -C *** Return point; End of subroutine -C - RETURN - END - - -C INTEGER FUNCTION IBACPOS(IN) -CC -CC Compute the index in the binary activity coefficient array -CC based on the input ionic strength. -CC -CC Chris Nolte, 6/16/05 -CC -C implicit none -C real IN -C IF (IN .LE. 0.300000E+02) THEN -C ibacpos = MIN(NINT( 0.200000E+02*IN) + 1, 600) -C ELSE -C ibacpos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) -C ENDIF -C ibacpos = min(ibacpos, 741) -C return -C 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE KM198 (IONIC, BINARR) -C -C *** Common block definition -C - COMMON /KMC198/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL Binarr (23), Ionic -C -C *** Find position in arrays for bincoef -C - IF (Ionic.LE. 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) -C -C *** Assign values to return array -C - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) -C -C *** Return point ; End of subroutine -C - RETURN - END - - - BLOCK DATA KMCF198 -C -C *** Common block definition -C - COMMON /KMC198/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - -C -C *** NaCl -C - DATA BNC01M/ - &-0.050,-0.103,-0.127,-0.142,-0.154,-0.162,-0.169,-0.174,-0.178, - &-0.181,-0.184,-0.186,-0.188,-0.189,-0.190,-0.191,-0.191,-0.192, - &-0.192,-0.191,-0.191,-0.191,-0.190,-0.189,-0.188,-0.188,-0.187, - &-0.185,-0.184,-0.183,-0.182,-0.181,-0.179,-0.178,-0.176,-0.175, - &-0.173,-0.172,-0.170,-0.169,-0.167,-0.166,-0.164,-0.162,-0.161, - &-0.159,-0.157,-0.156,-0.154,-0.152,-0.151,-0.149,-0.147,-0.146, - &-0.144,-0.142,-0.140,-0.139,-0.137,-0.135,-0.134,-0.132,-0.130, - &-0.128,-0.127,-0.125,-0.123,-0.121,-0.120,-0.118,-0.116,-0.114, - &-0.112,-0.111,-0.109,-0.107,-0.105,-0.103,-0.101,-0.099,-0.098, - &-0.096,-0.094,-0.092,-0.090,-0.088,-0.086,-0.084,-0.082,-0.080, - &-0.078,-0.075,-0.073,-0.071,-0.069,-0.067,-0.065,-0.063,-0.060, - &-0.058,-0.056,-0.054,-0.051,-0.049,-0.047,-0.045,-0.042,-0.040, - &-0.038,-0.035,-0.033,-0.031,-0.028,-0.026,-0.024,-0.021,-0.019, - &-0.016,-0.014,-0.012,-0.009,-0.007,-0.004,-0.002, 0.000, 0.003, - & 0.005, 0.008, 0.010, 0.012, 0.015, 0.017, 0.020, 0.022, 0.024, - & 0.027, 0.029, 0.032, 0.034, 0.036, 0.039, 0.041, 0.044, 0.046, - & 0.048, 0.051, 0.053, 0.055, 0.058, 0.060, 0.063, 0.065, 0.067, - & 0.070, 0.072, 0.074, 0.077, 0.079, 0.081, 0.084, 0.086, 0.088, - & 0.091, 0.093, 0.095, 0.098, 0.100, 0.102, 0.105, 0.107, 0.109, - & 0.112, 0.114, 0.116, 0.118, 0.121, 0.123, 0.125, 0.127, 0.130, - & 0.132, 0.134, 0.137, 0.139, 0.141, 0.143, 0.146, 0.148, 0.150, - & 0.152, 0.154, 0.157, 0.159, 0.161, 0.163, 0.166, 0.168, 0.170, - & 0.172, 0.174, 0.176, 0.179, 0.181, 0.183, 0.185, 0.187, 0.190, - & 0.192, 0.194, 0.196, 0.198, 0.200, 0.202, 0.205, 0.207, 0.209, - & 0.211, 0.213, 0.215, 0.217, 0.219, 0.222, 0.224, 0.226, 0.228, - & 0.230, 0.232, 0.234, 0.236, 0.238, 0.240, 0.242, 0.244, 0.246, - & 0.249, 0.251, 0.253, 0.255, 0.257, 0.259, 0.261, 0.263, 0.265, - & 0.267, 0.269, 0.271, 0.273, 0.275, 0.277, 0.279, 0.281, 0.283, - & 0.285, 0.287, 0.289, 0.291, 0.293, 0.295, 0.297, 0.299, 0.301, - & 0.303, 0.304, 0.306, 0.308, 0.310, 0.312, 0.314, 0.316, 0.318, - & 0.320, 0.322, 0.324, 0.326, 0.328, 0.329, 0.331, 0.333, 0.335, - & 0.337, 0.339, 0.341, 0.343, 0.344, 0.346, 0.348, 0.350, 0.352, - & 0.354, 0.356, 0.357, 0.359, 0.361, 0.363, 0.365, 0.367, 0.368, - & 0.370, 0.372, 0.374, 0.376, 0.377, 0.379, 0.381, 0.383, 0.385, - & 0.386, 0.388, 0.390, 0.392, 0.393, 0.395, 0.397, 0.399, 0.401, - & 0.402, 0.404, 0.406, 0.408, 0.409, 0.411, 0.413, 0.414, 0.416, - & 0.418, 0.420, 0.421, 0.423, 0.425, 0.426, 0.428, 0.430, 0.432, - & 0.433, 0.435, 0.437, 0.438, 0.440, 0.442, 0.443, 0.445, 0.447, - & 0.448, 0.450, 0.452, 0.453, 0.455, 0.457, 0.458, 0.460, 0.461, - & 0.463, 0.465, 0.466, 0.468, 0.470, 0.471, 0.473, 0.474, 0.476, - & 0.478, 0.479, 0.481, 0.482, 0.484, 0.486, 0.487, 0.489, 0.490, - & 0.492, 0.493, 0.495, 0.497, 0.498, 0.500, 0.501, 0.503, 0.504, - & 0.506, 0.508, 0.509, 0.511, 0.512, 0.514, 0.515, 0.517, 0.518, - & 0.520, 0.521, 0.523, 0.524, 0.526, 0.527, 0.529, 0.530, 0.532, - & 0.533, 0.535, 0.536, 0.538, 0.554, 0.568, 0.582, 0.596, 0.610, - & 0.623, 0.636, 0.649, 0.661, 0.674, 0.686, 0.698, 0.709, 0.721, - & 0.732, 0.743, 0.754, 0.765, 0.775, 0.786, 0.796, 0.806, 0.815, - & 0.825, 0.834, 0.844, 0.853, 0.862, 0.870, 0.879, 0.887, 0.896, - & 0.904, 0.912, 0.920, 0.928, 0.935, 0.943, 0.950, 0.957, 0.964, - & 0.971, 0.978, 0.985, 0.992, 0.998, 1.005, 1.011, 1.017, 1.023, - & 1.029, 1.035, 1.041, 1.047, 1.052, 1.058, 1.063, 1.068, 1.074, - & 1.079, 1.084, 1.089, 1.094, 1.099, 1.103, 1.108, 1.112, 1.117, - & 1.121, 1.126, 1.130, 1.134, 1.138, 1.142, 1.146, 1.150, 1.154, - & 1.158, 1.161, 1.165, 1.169, 1.172, 1.175, 1.179, 1.182, 1.185, - & 1.189, 1.192, 1.195, 1.198, 1.201, 1.204, 1.206, 1.209, 1.212, - & 1.215, 1.217, 1.220, 1.222, 1.225, 1.227, 1.230, 1.232, 1.234, - & 1.236, 1.239, 1.241, 1.243, 1.245, 1.247, 1.249, 1.251, 1.253, - & 1.254, 1.256, 1.258, 1.260, 1.261, 1.263, 1.264, 1.266, 1.267, - & 1.269, 1.270, 1.272, 1.273, 1.274, 1.276, 1.277, 1.278, 1.279, - & 1.280, 1.281, 1.283, 1.284, 1.285, 1.286, 1.286, 1.287, 1.288, - & 1.289, 1.290, 1.291, 1.291, 1.292, 1.293, 1.293, 1.294, 1.295, - & 1.295, 1.296, 1.296, 1.297, 1.297, 1.297, 1.298, 1.298, 1.298, - & 1.299, 1.299, 1.299 - & / -C -C *** Na2SO4 -C - DATA BNC02M/ - &-0.103,-0.225,-0.288,-0.332,-0.367,-0.397,-0.422,-0.445,-0.465, - &-0.484,-0.501,-0.516,-0.531,-0.545,-0.558,-0.570,-0.582,-0.593, - &-0.604,-0.614,-0.624,-0.633,-0.643,-0.651,-0.660,-0.668,-0.676, - &-0.684,-0.692,-0.699,-0.707,-0.714,-0.721,-0.727,-0.734,-0.741, - &-0.747,-0.753,-0.759,-0.765,-0.771,-0.777,-0.783,-0.788,-0.794, - &-0.799,-0.804,-0.810,-0.815,-0.820,-0.825,-0.830,-0.835,-0.840, - &-0.845,-0.849,-0.854,-0.859,-0.863,-0.868,-0.872,-0.877,-0.881, - &-0.885,-0.889,-0.894,-0.898,-0.902,-0.906,-0.910,-0.914,-0.918, - &-0.922,-0.926,-0.930,-0.934,-0.938,-0.942,-0.946,-0.949,-0.953, - &-0.957,-0.961,-0.964,-0.968,-0.971,-0.975,-0.979,-0.982,-0.986, - &-0.989,-0.993,-0.996,-1.000,-1.003,-1.007,-1.010,-1.014,-1.017, - &-1.020,-1.024,-1.027,-1.030,-1.034,-1.037,-1.040,-1.044,-1.047, - &-1.050,-1.053,-1.057,-1.060,-1.063,-1.066,-1.069,-1.072,-1.076, - &-1.079,-1.082,-1.085,-1.088,-1.091,-1.094,-1.097,-1.100,-1.103, - &-1.106,-1.109,-1.112,-1.115,-1.118,-1.121,-1.124,-1.127,-1.130, - &-1.133,-1.136,-1.139,-1.142,-1.145,-1.147,-1.150,-1.153,-1.156, - &-1.159,-1.162,-1.165,-1.167,-1.170,-1.173,-1.176,-1.179,-1.181, - &-1.184,-1.187,-1.190,-1.192,-1.195,-1.198,-1.200,-1.203,-1.206, - &-1.209,-1.211,-1.214,-1.217,-1.219,-1.222,-1.225,-1.227,-1.230, - &-1.232,-1.235,-1.238,-1.240,-1.243,-1.246,-1.248,-1.251,-1.253, - &-1.256,-1.258,-1.261,-1.264,-1.266,-1.269,-1.271,-1.274,-1.276, - &-1.279,-1.281,-1.284,-1.286,-1.289,-1.291,-1.294,-1.296,-1.299, - &-1.301,-1.304,-1.306,-1.309,-1.311,-1.313,-1.316,-1.318,-1.321, - &-1.323,-1.326,-1.328,-1.330,-1.333,-1.335,-1.338,-1.340,-1.342, - &-1.345,-1.347,-1.350,-1.352,-1.354,-1.357,-1.359,-1.361,-1.364, - &-1.366,-1.368,-1.371,-1.373,-1.375,-1.378,-1.380,-1.382,-1.385, - &-1.387,-1.389,-1.392,-1.394,-1.396,-1.399,-1.401,-1.403,-1.405, - &-1.408,-1.410,-1.412,-1.415,-1.417,-1.419,-1.421,-1.424,-1.426, - &-1.428,-1.430,-1.433,-1.435,-1.437,-1.439,-1.442,-1.444,-1.446, - &-1.448,-1.450,-1.453,-1.455,-1.457,-1.459,-1.461,-1.464,-1.466, - &-1.468,-1.470,-1.472,-1.475,-1.477,-1.479,-1.481,-1.483,-1.485, - &-1.488,-1.490,-1.492,-1.494,-1.496,-1.498,-1.501,-1.503,-1.505, - &-1.507,-1.509,-1.511,-1.513,-1.516,-1.518,-1.520,-1.522,-1.524, - &-1.526,-1.528,-1.530,-1.533,-1.535,-1.537,-1.539,-1.541,-1.543, - &-1.545,-1.547,-1.549,-1.551,-1.554,-1.556,-1.558,-1.560,-1.562, - &-1.564,-1.566,-1.568,-1.570,-1.572,-1.574,-1.576,-1.578,-1.580, - &-1.583,-1.585,-1.587,-1.589,-1.591,-1.593,-1.595,-1.597,-1.599, - &-1.601,-1.603,-1.605,-1.607,-1.609,-1.611,-1.613,-1.615,-1.617, - &-1.619,-1.621,-1.623,-1.625,-1.627,-1.629,-1.631,-1.633,-1.635, - &-1.637,-1.639,-1.641,-1.643,-1.645,-1.647,-1.649,-1.651,-1.653, - &-1.655,-1.657,-1.659,-1.661,-1.663,-1.665,-1.667,-1.669,-1.671, - &-1.673,-1.675,-1.677,-1.679,-1.681,-1.683,-1.685,-1.687,-1.689, - &-1.691,-1.693,-1.695,-1.696,-1.698,-1.700,-1.702,-1.704,-1.706, - &-1.708,-1.710,-1.712,-1.714,-1.716,-1.718,-1.720,-1.722,-1.724, - &-1.726,-1.727,-1.729,-1.731,-1.752,-1.771,-1.790,-1.808,-1.827, - &-1.845,-1.864,-1.882,-1.900,-1.918,-1.936,-1.954,-1.972,-1.989, - &-2.007,-2.024,-2.042,-2.059,-2.076,-2.093,-2.110,-2.127,-2.144, - &-2.161,-2.178,-2.194,-2.211,-2.228,-2.244,-2.261,-2.277,-2.293, - &-2.310,-2.326,-2.342,-2.358,-2.374,-2.390,-2.406,-2.422,-2.438, - &-2.454,-2.470,-2.486,-2.501,-2.517,-2.533,-2.548,-2.564,-2.579, - &-2.595,-2.610,-2.626,-2.641,-2.657,-2.672,-2.687,-2.702,-2.718, - &-2.733,-2.748,-2.763,-2.778,-2.793,-2.808,-2.823,-2.838,-2.853, - &-2.868,-2.883,-2.898,-2.913,-2.927,-2.942,-2.957,-2.972,-2.986, - &-3.001,-3.016,-3.030,-3.045,-3.059,-3.074,-3.089,-3.103,-3.118, - &-3.132,-3.147,-3.161,-3.175,-3.190,-3.204,-3.219,-3.233,-3.247, - &-3.261,-3.276,-3.290,-3.304,-3.318,-3.333,-3.347,-3.361,-3.375, - &-3.389,-3.403,-3.417,-3.432,-3.446,-3.460,-3.474,-3.488,-3.502, - &-3.516,-3.530,-3.544,-3.558,-3.571,-3.585,-3.599,-3.613,-3.627, - &-3.641,-3.655,-3.669,-3.682,-3.696,-3.710,-3.724,-3.737,-3.751, - &-3.765,-3.779,-3.792,-3.806,-3.820,-3.833,-3.847,-3.861,-3.874, - &-3.888,-3.901,-3.915,-3.929,-3.942,-3.956,-3.969,-3.983,-3.996, - &-4.010,-4.023,-4.037,-4.050,-4.064,-4.077,-4.091,-4.104,-4.118, - &-4.131,-4.144,-4.158 - & / -C -C *** NaNO3 -C - DATA BNC03M/ - &-0.052,-0.114,-0.145,-0.168,-0.187,-0.202,-0.215,-0.227,-0.238, - &-0.248,-0.257,-0.265,-0.273,-0.281,-0.288,-0.294,-0.301,-0.307, - &-0.313,-0.318,-0.324,-0.329,-0.334,-0.339,-0.344,-0.349,-0.353, - &-0.357,-0.362,-0.366,-0.370,-0.374,-0.378,-0.382,-0.386,-0.389, - &-0.393,-0.396,-0.400,-0.403,-0.407,-0.410,-0.413,-0.416,-0.419, - &-0.423,-0.426,-0.429,-0.432,-0.435,-0.437,-0.440,-0.443,-0.446, - &-0.449,-0.451,-0.454,-0.457,-0.459,-0.462,-0.464,-0.467,-0.469, - &-0.472,-0.474,-0.477,-0.479,-0.482,-0.484,-0.486,-0.489,-0.491, - &-0.493,-0.496,-0.498,-0.500,-0.502,-0.505,-0.507,-0.509,-0.511, - &-0.513,-0.516,-0.518,-0.520,-0.522,-0.524,-0.526,-0.528,-0.530, - &-0.532,-0.534,-0.537,-0.539,-0.541,-0.543,-0.545,-0.547,-0.549, - &-0.551,-0.553,-0.555,-0.557,-0.559,-0.561,-0.562,-0.564,-0.566, - &-0.568,-0.570,-0.572,-0.574,-0.576,-0.578,-0.580,-0.582,-0.583, - &-0.585,-0.587,-0.589,-0.591,-0.593,-0.594,-0.596,-0.598,-0.600, - &-0.602,-0.604,-0.605,-0.607,-0.609,-0.611,-0.612,-0.614,-0.616, - &-0.618,-0.619,-0.621,-0.623,-0.625,-0.626,-0.628,-0.630,-0.631, - &-0.633,-0.635,-0.637,-0.638,-0.640,-0.642,-0.643,-0.645,-0.647, - &-0.648,-0.650,-0.651,-0.653,-0.655,-0.656,-0.658,-0.660,-0.661, - &-0.663,-0.664,-0.666,-0.668,-0.669,-0.671,-0.672,-0.674,-0.676, - &-0.677,-0.679,-0.680,-0.682,-0.683,-0.685,-0.686,-0.688,-0.689, - &-0.691,-0.693,-0.694,-0.696,-0.697,-0.699,-0.700,-0.702,-0.703, - &-0.705,-0.706,-0.708,-0.709,-0.711,-0.712,-0.714,-0.715,-0.717, - &-0.718,-0.719,-0.721,-0.722,-0.724,-0.725,-0.727,-0.728,-0.730, - &-0.731,-0.733,-0.734,-0.735,-0.737,-0.738,-0.740,-0.741,-0.743, - &-0.744,-0.745,-0.747,-0.748,-0.750,-0.751,-0.752,-0.754,-0.755, - &-0.757,-0.758,-0.759,-0.761,-0.762,-0.763,-0.765,-0.766,-0.768, - &-0.769,-0.770,-0.772,-0.773,-0.774,-0.776,-0.777,-0.778,-0.780, - &-0.781,-0.782,-0.784,-0.785,-0.787,-0.788,-0.789,-0.791,-0.792, - &-0.793,-0.794,-0.796,-0.797,-0.798,-0.800,-0.801,-0.802,-0.804, - &-0.805,-0.806,-0.808,-0.809,-0.810,-0.812,-0.813,-0.814,-0.815, - &-0.817,-0.818,-0.819,-0.821,-0.822,-0.823,-0.824,-0.826,-0.827, - &-0.828,-0.829,-0.831,-0.832,-0.833,-0.835,-0.836,-0.837,-0.838, - &-0.840,-0.841,-0.842,-0.843,-0.845,-0.846,-0.847,-0.848,-0.850, - &-0.851,-0.852,-0.853,-0.854,-0.856,-0.857,-0.858,-0.859,-0.861, - &-0.862,-0.863,-0.864,-0.866,-0.867,-0.868,-0.869,-0.870,-0.872, - &-0.873,-0.874,-0.875,-0.876,-0.878,-0.879,-0.880,-0.881,-0.882, - &-0.884,-0.885,-0.886,-0.887,-0.888,-0.890,-0.891,-0.892,-0.893, - &-0.894,-0.896,-0.897,-0.898,-0.899,-0.900,-0.901,-0.903,-0.904, - &-0.905,-0.906,-0.907,-0.908,-0.910,-0.911,-0.912,-0.913,-0.914, - &-0.915,-0.917,-0.918,-0.919,-0.920,-0.921,-0.922,-0.924,-0.925, - &-0.926,-0.927,-0.928,-0.929,-0.930,-0.932,-0.933,-0.934,-0.935, - &-0.936,-0.937,-0.938,-0.940,-0.941,-0.942,-0.943,-0.944,-0.945, - &-0.946,-0.947,-0.949,-0.950,-0.951,-0.952,-0.953,-0.954,-0.955, - &-0.956,-0.958,-0.959,-0.960,-0.961,-0.962,-0.963,-0.964,-0.965, - &-0.966,-0.968,-0.969,-0.970,-0.982,-0.992,-1.003,-1.014,-1.025, - &-1.035,-1.046,-1.056,-1.066,-1.076,-1.087,-1.097,-1.107,-1.117, - &-1.126,-1.136,-1.146,-1.156,-1.165,-1.175,-1.185,-1.194,-1.203, - &-1.213,-1.222,-1.231,-1.241,-1.250,-1.259,-1.268,-1.277,-1.286, - &-1.295,-1.304,-1.313,-1.322,-1.331,-1.340,-1.349,-1.357,-1.366, - &-1.375,-1.383,-1.392,-1.401,-1.409,-1.418,-1.426,-1.435,-1.443, - &-1.452,-1.460,-1.468,-1.477,-1.485,-1.493,-1.502,-1.510,-1.518, - &-1.526,-1.535,-1.543,-1.551,-1.559,-1.567,-1.575,-1.583,-1.591, - &-1.599,-1.607,-1.615,-1.623,-1.631,-1.639,-1.647,-1.655,-1.663, - &-1.671,-1.679,-1.686,-1.694,-1.702,-1.710,-1.718,-1.725,-1.733, - &-1.741,-1.749,-1.756,-1.764,-1.772,-1.779,-1.787,-1.794,-1.802, - &-1.810,-1.817,-1.825,-1.832,-1.840,-1.847,-1.855,-1.862,-1.870, - &-1.877,-1.885,-1.892,-1.900,-1.907,-1.915,-1.922,-1.929,-1.937, - &-1.944,-1.952,-1.959,-1.966,-1.974,-1.981,-1.988,-1.996,-2.003, - &-2.010,-2.018,-2.025,-2.032,-2.039,-2.047,-2.054,-2.061,-2.068, - &-2.075,-2.083,-2.090,-2.097,-2.104,-2.111,-2.118,-2.126,-2.133, - &-2.140,-2.147,-2.154,-2.161,-2.168,-2.175,-2.183,-2.190,-2.197, - &-2.204,-2.211,-2.218,-2.225,-2.232,-2.239,-2.246,-2.253,-2.260, - &-2.267,-2.274,-2.281 - & / -C -C *** (NH4)2SO4 -C - DATA BNC04M/ - &-0.103,-0.226,-0.289,-0.334,-0.369,-0.399,-0.425,-0.448,-0.468, - &-0.487,-0.505,-0.521,-0.536,-0.550,-0.563,-0.576,-0.588,-0.599, - &-0.610,-0.621,-0.631,-0.641,-0.650,-0.659,-0.668,-0.677,-0.685, - &-0.693,-0.701,-0.709,-0.717,-0.724,-0.731,-0.738,-0.745,-0.752, - &-0.758,-0.765,-0.771,-0.777,-0.784,-0.790,-0.796,-0.801,-0.807, - &-0.813,-0.818,-0.824,-0.829,-0.835,-0.840,-0.845,-0.850,-0.855, - &-0.860,-0.865,-0.870,-0.875,-0.880,-0.884,-0.889,-0.894,-0.898, - &-0.903,-0.907,-0.912,-0.916,-0.920,-0.925,-0.929,-0.933,-0.937, - &-0.942,-0.946,-0.950,-0.954,-0.958,-0.962,-0.966,-0.970,-0.974, - &-0.978,-0.982,-0.985,-0.989,-0.993,-0.997,-1.001,-1.004,-1.008, - &-1.012,-1.016,-1.019,-1.023,-1.027,-1.030,-1.034,-1.037,-1.041, - &-1.045,-1.048,-1.052,-1.055,-1.059,-1.062,-1.066,-1.069,-1.072, - &-1.076,-1.079,-1.083,-1.086,-1.089,-1.093,-1.096,-1.099,-1.103, - &-1.106,-1.109,-1.113,-1.116,-1.119,-1.122,-1.126,-1.129,-1.132, - &-1.135,-1.138,-1.142,-1.145,-1.148,-1.151,-1.154,-1.157,-1.160, - &-1.164,-1.167,-1.170,-1.173,-1.176,-1.179,-1.182,-1.185,-1.188, - &-1.191,-1.194,-1.197,-1.200,-1.203,-1.206,-1.209,-1.212,-1.215, - &-1.218,-1.221,-1.223,-1.226,-1.229,-1.232,-1.235,-1.238,-1.241, - &-1.244,-1.246,-1.249,-1.252,-1.255,-1.258,-1.261,-1.263,-1.266, - &-1.269,-1.272,-1.274,-1.277,-1.280,-1.283,-1.285,-1.288,-1.291, - &-1.294,-1.296,-1.299,-1.302,-1.304,-1.307,-1.310,-1.313,-1.315, - &-1.318,-1.321,-1.323,-1.326,-1.328,-1.331,-1.334,-1.336,-1.339, - &-1.342,-1.344,-1.347,-1.349,-1.352,-1.355,-1.357,-1.360,-1.362, - &-1.365,-1.367,-1.370,-1.373,-1.375,-1.378,-1.380,-1.383,-1.385, - &-1.388,-1.390,-1.393,-1.395,-1.398,-1.400,-1.403,-1.405,-1.408, - &-1.410,-1.413,-1.415,-1.418,-1.420,-1.423,-1.425,-1.427,-1.430, - &-1.432,-1.435,-1.437,-1.440,-1.442,-1.445,-1.447,-1.449,-1.452, - &-1.454,-1.457,-1.459,-1.461,-1.464,-1.466,-1.469,-1.471,-1.473, - &-1.476,-1.478,-1.480,-1.483,-1.485,-1.487,-1.490,-1.492,-1.495, - &-1.497,-1.499,-1.502,-1.504,-1.506,-1.509,-1.511,-1.513,-1.515, - &-1.518,-1.520,-1.522,-1.525,-1.527,-1.529,-1.532,-1.534,-1.536, - &-1.538,-1.541,-1.543,-1.545,-1.548,-1.550,-1.552,-1.554,-1.557, - &-1.559,-1.561,-1.563,-1.566,-1.568,-1.570,-1.572,-1.575,-1.577, - &-1.579,-1.581,-1.583,-1.586,-1.588,-1.590,-1.592,-1.595,-1.597, - &-1.599,-1.601,-1.603,-1.606,-1.608,-1.610,-1.612,-1.614,-1.616, - &-1.619,-1.621,-1.623,-1.625,-1.627,-1.630,-1.632,-1.634,-1.636, - &-1.638,-1.640,-1.642,-1.645,-1.647,-1.649,-1.651,-1.653,-1.655, - &-1.658,-1.660,-1.662,-1.664,-1.666,-1.668,-1.670,-1.672,-1.675, - &-1.677,-1.679,-1.681,-1.683,-1.685,-1.687,-1.689,-1.691,-1.694, - &-1.696,-1.698,-1.700,-1.702,-1.704,-1.706,-1.708,-1.710,-1.712, - &-1.714,-1.717,-1.719,-1.721,-1.723,-1.725,-1.727,-1.729,-1.731, - &-1.733,-1.735,-1.737,-1.739,-1.741,-1.743,-1.745,-1.748,-1.750, - &-1.752,-1.754,-1.756,-1.758,-1.760,-1.762,-1.764,-1.766,-1.768, - &-1.770,-1.772,-1.774,-1.776,-1.778,-1.780,-1.782,-1.784,-1.786, - &-1.788,-1.790,-1.792,-1.794,-1.816,-1.836,-1.855,-1.875,-1.894, - &-1.914,-1.933,-1.952,-1.971,-1.989,-2.008,-2.027,-2.045,-2.063, - &-2.082,-2.100,-2.118,-2.136,-2.154,-2.171,-2.189,-2.207,-2.224, - &-2.242,-2.259,-2.276,-2.293,-2.311,-2.328,-2.345,-2.362,-2.379, - &-2.395,-2.412,-2.429,-2.446,-2.462,-2.479,-2.495,-2.512,-2.528, - &-2.544,-2.561,-2.577,-2.593,-2.609,-2.625,-2.642,-2.658,-2.674, - &-2.689,-2.705,-2.721,-2.737,-2.753,-2.768,-2.784,-2.800,-2.815, - &-2.831,-2.847,-2.862,-2.878,-2.893,-2.908,-2.924,-2.939,-2.954, - &-2.970,-2.985,-3.000,-3.015,-3.031,-3.046,-3.061,-3.076,-3.091, - &-3.106,-3.121,-3.136,-3.151,-3.166,-3.181,-3.196,-3.210,-3.225, - &-3.240,-3.255,-3.270,-3.284,-3.299,-3.314,-3.328,-3.343,-3.358, - &-3.372,-3.387,-3.401,-3.416,-3.430,-3.445,-3.459,-3.474,-3.488, - &-3.503,-3.517,-3.531,-3.546,-3.560,-3.574,-3.589,-3.603,-3.617, - &-3.631,-3.646,-3.660,-3.674,-3.688,-3.702,-3.717,-3.731,-3.745, - &-3.759,-3.773,-3.787,-3.801,-3.815,-3.829,-3.843,-3.857,-3.871, - &-3.885,-3.899,-3.913,-3.927,-3.941,-3.955,-3.969,-3.982,-3.996, - &-4.010,-4.024,-4.038,-4.051,-4.065,-4.079,-4.093,-4.107,-4.120, - &-4.134,-4.148,-4.161,-4.175,-4.189,-4.202,-4.216,-4.230,-4.243, - &-4.257,-4.271,-4.284 - & / -C -C *** NH4NO3 -C - DATA BNC05M/ - &-0.052,-0.117,-0.152,-0.178,-0.199,-0.217,-0.232,-0.247,-0.260, - &-0.272,-0.283,-0.294,-0.304,-0.314,-0.323,-0.332,-0.341,-0.349, - &-0.357,-0.365,-0.372,-0.379,-0.386,-0.393,-0.400,-0.407,-0.413, - &-0.419,-0.426,-0.432,-0.437,-0.443,-0.449,-0.455,-0.460,-0.466, - &-0.471,-0.476,-0.481,-0.486,-0.491,-0.496,-0.501,-0.506,-0.511, - &-0.515,-0.520,-0.524,-0.529,-0.533,-0.537,-0.542,-0.546,-0.550, - &-0.554,-0.558,-0.563,-0.567,-0.570,-0.574,-0.578,-0.582,-0.586, - &-0.590,-0.593,-0.597,-0.601,-0.604,-0.608,-0.612,-0.615,-0.619, - &-0.622,-0.626,-0.629,-0.633,-0.636,-0.640,-0.643,-0.646,-0.650, - &-0.653,-0.656,-0.660,-0.663,-0.666,-0.670,-0.673,-0.676,-0.679, - &-0.683,-0.686,-0.689,-0.692,-0.696,-0.699,-0.702,-0.705,-0.708, - &-0.711,-0.715,-0.718,-0.721,-0.724,-0.727,-0.730,-0.733,-0.736, - &-0.739,-0.742,-0.746,-0.749,-0.752,-0.755,-0.758,-0.761,-0.764, - &-0.767,-0.770,-0.773,-0.776,-0.778,-0.781,-0.784,-0.787,-0.790, - &-0.793,-0.796,-0.799,-0.802,-0.805,-0.807,-0.810,-0.813,-0.816, - &-0.819,-0.821,-0.824,-0.827,-0.830,-0.833,-0.835,-0.838,-0.841, - &-0.843,-0.846,-0.849,-0.852,-0.854,-0.857,-0.860,-0.862,-0.865, - &-0.867,-0.870,-0.873,-0.875,-0.878,-0.880,-0.883,-0.886,-0.888, - &-0.891,-0.893,-0.896,-0.898,-0.901,-0.903,-0.906,-0.908,-0.911, - &-0.913,-0.916,-0.918,-0.921,-0.923,-0.926,-0.928,-0.930,-0.933, - &-0.935,-0.938,-0.940,-0.942,-0.945,-0.947,-0.950,-0.952,-0.954, - &-0.957,-0.959,-0.961,-0.964,-0.966,-0.968,-0.971,-0.973,-0.975, - &-0.977,-0.980,-0.982,-0.984,-0.987,-0.989,-0.991,-0.993,-0.996, - &-0.998,-1.000,-1.002,-1.004,-1.007,-1.009,-1.011,-1.013,-1.015, - &-1.018,-1.020,-1.022,-1.024,-1.026,-1.028,-1.031,-1.033,-1.035, - &-1.037,-1.039,-1.041,-1.043,-1.046,-1.048,-1.050,-1.052,-1.054, - &-1.056,-1.058,-1.060,-1.062,-1.064,-1.066,-1.068,-1.070,-1.072, - &-1.075,-1.077,-1.079,-1.081,-1.083,-1.085,-1.087,-1.089,-1.091, - &-1.093,-1.095,-1.097,-1.099,-1.101,-1.103,-1.105,-1.107,-1.109, - &-1.110,-1.112,-1.114,-1.116,-1.118,-1.120,-1.122,-1.124,-1.126, - &-1.128,-1.130,-1.132,-1.134,-1.136,-1.137,-1.139,-1.141,-1.143, - &-1.145,-1.147,-1.149,-1.151,-1.153,-1.154,-1.156,-1.158,-1.160, - &-1.162,-1.164,-1.166,-1.167,-1.169,-1.171,-1.173,-1.175,-1.176, - &-1.178,-1.180,-1.182,-1.184,-1.186,-1.187,-1.189,-1.191,-1.193, - &-1.195,-1.196,-1.198,-1.200,-1.202,-1.203,-1.205,-1.207,-1.209, - &-1.210,-1.212,-1.214,-1.216,-1.217,-1.219,-1.221,-1.223,-1.224, - &-1.226,-1.228,-1.230,-1.231,-1.233,-1.235,-1.236,-1.238,-1.240, - &-1.241,-1.243,-1.245,-1.247,-1.248,-1.250,-1.252,-1.253,-1.255, - &-1.257,-1.258,-1.260,-1.262,-1.263,-1.265,-1.267,-1.268,-1.270, - &-1.272,-1.273,-1.275,-1.276,-1.278,-1.280,-1.281,-1.283,-1.285, - &-1.286,-1.288,-1.289,-1.291,-1.293,-1.294,-1.296,-1.298,-1.299, - &-1.301,-1.302,-1.304,-1.306,-1.307,-1.309,-1.310,-1.312,-1.313, - &-1.315,-1.317,-1.318,-1.320,-1.321,-1.323,-1.324,-1.326,-1.328, - &-1.329,-1.331,-1.332,-1.334,-1.335,-1.337,-1.338,-1.340,-1.341, - &-1.343,-1.345,-1.346,-1.348,-1.364,-1.379,-1.394,-1.408,-1.422, - &-1.436,-1.450,-1.464,-1.478,-1.491,-1.504,-1.518,-1.531,-1.543, - &-1.556,-1.569,-1.581,-1.593,-1.606,-1.618,-1.630,-1.641,-1.653, - &-1.665,-1.676,-1.688,-1.699,-1.710,-1.722,-1.733,-1.744,-1.755, - &-1.765,-1.776,-1.787,-1.797,-1.808,-1.818,-1.829,-1.839,-1.849, - &-1.859,-1.870,-1.880,-1.890,-1.900,-1.909,-1.919,-1.929,-1.939, - &-1.948,-1.958,-1.968,-1.977,-1.986,-1.996,-2.005,-2.015,-2.024, - &-2.033,-2.042,-2.051,-2.060,-2.070,-2.079,-2.088,-2.096,-2.105, - &-2.114,-2.123,-2.132,-2.141,-2.149,-2.158,-2.167,-2.175,-2.184, - &-2.193,-2.201,-2.210,-2.218,-2.226,-2.235,-2.243,-2.252,-2.260, - &-2.268,-2.277,-2.285,-2.293,-2.301,-2.309,-2.318,-2.326,-2.334, - &-2.342,-2.350,-2.358,-2.366,-2.374,-2.382,-2.390,-2.398,-2.406, - &-2.414,-2.422,-2.429,-2.437,-2.445,-2.453,-2.461,-2.468,-2.476, - &-2.484,-2.492,-2.499,-2.507,-2.515,-2.522,-2.530,-2.537,-2.545, - &-2.553,-2.560,-2.568,-2.575,-2.583,-2.590,-2.598,-2.605,-2.613, - &-2.620,-2.628,-2.635,-2.642,-2.650,-2.657,-2.664,-2.672,-2.679, - &-2.686,-2.694,-2.701,-2.708,-2.716,-2.723,-2.730,-2.737,-2.745, - &-2.752,-2.759,-2.766,-2.773,-2.781,-2.788,-2.795,-2.802,-2.809, - &-2.816,-2.823,-2.831 - & / -C -C *** NH4Cl -C - DATA BNC06M/ - &-0.051,-0.108,-0.136,-0.155,-0.170,-0.182,-0.192,-0.200,-0.207, - &-0.214,-0.220,-0.225,-0.230,-0.234,-0.238,-0.242,-0.245,-0.248, - &-0.251,-0.254,-0.256,-0.259,-0.261,-0.263,-0.265,-0.267,-0.269, - &-0.270,-0.272,-0.274,-0.275,-0.276,-0.278,-0.279,-0.280,-0.281, - &-0.283,-0.284,-0.285,-0.286,-0.287,-0.288,-0.289,-0.289,-0.290, - &-0.291,-0.292,-0.293,-0.293,-0.294,-0.295,-0.296,-0.296,-0.297, - &-0.298,-0.298,-0.299,-0.300,-0.300,-0.301,-0.301,-0.302,-0.302, - &-0.303,-0.303,-0.304,-0.304,-0.305,-0.305,-0.306,-0.306,-0.307, - &-0.307,-0.308,-0.308,-0.308,-0.309,-0.309,-0.309,-0.310,-0.310, - &-0.310,-0.311,-0.311,-0.311,-0.312,-0.312,-0.312,-0.312,-0.313, - &-0.313,-0.313,-0.313,-0.313,-0.314,-0.314,-0.314,-0.314,-0.314, - &-0.314,-0.314,-0.314,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, - &-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, - &-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, - &-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, - &-0.315,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314, - &-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.313, - &-0.313,-0.313,-0.313,-0.313,-0.313,-0.313,-0.313,-0.313,-0.313, - &-0.313,-0.313,-0.313,-0.313,-0.312,-0.312,-0.312,-0.312,-0.312, - &-0.312,-0.312,-0.312,-0.312,-0.312,-0.312,-0.312,-0.312,-0.312, - &-0.311,-0.311,-0.311,-0.311,-0.311,-0.311,-0.311,-0.311,-0.311, - &-0.311,-0.311,-0.311,-0.311,-0.311,-0.310,-0.310,-0.310,-0.310, - &-0.310,-0.310,-0.310,-0.310,-0.310,-0.310,-0.310,-0.310,-0.310, - &-0.310,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309, - &-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.308, - &-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308, - &-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.307, - &-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, - &-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, - &-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, - &-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.307, - &-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, - &-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, - &-0.307,-0.307,-0.307,-0.307,-0.307,-0.308,-0.308,-0.308,-0.308, - &-0.308,-0.308,-0.308,-0.308,-0.308,-0.309,-0.310,-0.311,-0.311, - &-0.312,-0.313,-0.314,-0.315,-0.316,-0.317,-0.319,-0.320,-0.321, - &-0.322,-0.324,-0.325,-0.327,-0.328,-0.330,-0.331,-0.333,-0.335, - &-0.336,-0.338,-0.340,-0.342,-0.344,-0.346,-0.348,-0.350,-0.352, - &-0.354,-0.356,-0.358,-0.360,-0.362,-0.365,-0.367,-0.369,-0.371, - &-0.374,-0.376,-0.379,-0.381,-0.383,-0.386,-0.389,-0.391,-0.394, - &-0.396,-0.399,-0.401,-0.404,-0.407,-0.410,-0.412,-0.415,-0.418, - &-0.421,-0.423,-0.426,-0.429,-0.432,-0.435,-0.438,-0.441,-0.444, - &-0.447,-0.450,-0.453,-0.456,-0.459,-0.462,-0.465,-0.468,-0.471, - &-0.475,-0.478,-0.481,-0.484,-0.487,-0.491,-0.494,-0.497,-0.500, - &-0.504,-0.507,-0.510,-0.514,-0.517,-0.520,-0.524,-0.527,-0.531, - &-0.534,-0.537,-0.541,-0.544,-0.548,-0.551,-0.555,-0.558,-0.562, - &-0.565,-0.569,-0.573,-0.576,-0.580,-0.583,-0.587,-0.591,-0.594, - &-0.598,-0.601,-0.605,-0.609,-0.612,-0.616,-0.620,-0.624,-0.627, - &-0.631,-0.635,-0.639,-0.642,-0.646,-0.650,-0.654,-0.657,-0.661, - &-0.665,-0.669,-0.673,-0.677,-0.680,-0.684,-0.688,-0.692,-0.696, - &-0.700,-0.704,-0.708,-0.711,-0.715,-0.719,-0.723,-0.727,-0.731, - &-0.735,-0.739,-0.743,-0.747,-0.751,-0.755,-0.759,-0.763,-0.767, - &-0.771,-0.775,-0.779 - & / -C -C *** (2H,SO4) -C - DATA BNC07M/ - &-0.103,-0.225,-0.286,-0.330,-0.365,-0.394,-0.419,-0.441,-0.460, - &-0.478,-0.495,-0.510,-0.524,-0.538,-0.550,-0.562,-0.573,-0.584, - &-0.594,-0.604,-0.613,-0.622,-0.631,-0.640,-0.648,-0.656,-0.663, - &-0.671,-0.678,-0.685,-0.692,-0.699,-0.705,-0.711,-0.718,-0.724, - &-0.730,-0.736,-0.741,-0.747,-0.753,-0.758,-0.763,-0.769,-0.774, - &-0.779,-0.784,-0.789,-0.794,-0.798,-0.803,-0.808,-0.812,-0.817, - &-0.821,-0.826,-0.830,-0.834,-0.839,-0.843,-0.847,-0.851,-0.855, - &-0.859,-0.863,-0.867,-0.871,-0.875,-0.879,-0.883,-0.886,-0.890, - &-0.894,-0.897,-0.901,-0.905,-0.908,-0.912,-0.915,-0.919,-0.922, - &-0.926,-0.929,-0.933,-0.936,-0.939,-0.943,-0.946,-0.949,-0.953, - &-0.956,-0.959,-0.962,-0.965,-0.969,-0.972,-0.975,-0.978,-0.981, - &-0.984,-0.987,-0.990,-0.994,-0.997,-1.000,-1.003,-1.006,-1.009, - &-1.012,-1.015,-1.017,-1.020,-1.023,-1.026,-1.029,-1.032,-1.035, - &-1.038,-1.041,-1.043,-1.046,-1.049,-1.052,-1.055,-1.057,-1.060, - &-1.063,-1.066,-1.068,-1.071,-1.074,-1.077,-1.079,-1.082,-1.085, - &-1.087,-1.090,-1.093,-1.095,-1.098,-1.100,-1.103,-1.106,-1.108, - &-1.111,-1.113,-1.116,-1.119,-1.121,-1.124,-1.126,-1.129,-1.131, - &-1.134,-1.136,-1.139,-1.141,-1.144,-1.146,-1.149,-1.151,-1.154, - &-1.156,-1.159,-1.161,-1.163,-1.166,-1.168,-1.171,-1.173,-1.176, - &-1.178,-1.180,-1.183,-1.185,-1.187,-1.190,-1.192,-1.195,-1.197, - &-1.199,-1.202,-1.204,-1.206,-1.209,-1.211,-1.213,-1.216,-1.218, - &-1.220,-1.222,-1.225,-1.227,-1.229,-1.232,-1.234,-1.236,-1.238, - &-1.241,-1.243,-1.245,-1.247,-1.250,-1.252,-1.254,-1.256,-1.258, - &-1.261,-1.263,-1.265,-1.267,-1.270,-1.272,-1.274,-1.276,-1.278, - &-1.280,-1.283,-1.285,-1.287,-1.289,-1.291,-1.293,-1.296,-1.298, - &-1.300,-1.302,-1.304,-1.306,-1.308,-1.311,-1.313,-1.315,-1.317, - &-1.319,-1.321,-1.323,-1.325,-1.328,-1.330,-1.332,-1.334,-1.336, - &-1.338,-1.340,-1.342,-1.344,-1.346,-1.348,-1.350,-1.353,-1.355, - &-1.357,-1.359,-1.361,-1.363,-1.365,-1.367,-1.369,-1.371,-1.373, - &-1.375,-1.377,-1.379,-1.381,-1.383,-1.385,-1.387,-1.389,-1.391, - &-1.393,-1.395,-1.397,-1.399,-1.401,-1.403,-1.405,-1.407,-1.409, - &-1.411,-1.413,-1.415,-1.417,-1.419,-1.421,-1.423,-1.425,-1.427, - &-1.429,-1.431,-1.433,-1.435,-1.437,-1.439,-1.441,-1.443,-1.445, - &-1.447,-1.449,-1.451,-1.453,-1.455,-1.456,-1.458,-1.460,-1.462, - &-1.464,-1.466,-1.468,-1.470,-1.472,-1.474,-1.476,-1.478,-1.480, - &-1.481,-1.483,-1.485,-1.487,-1.489,-1.491,-1.493,-1.495,-1.497, - &-1.499,-1.500,-1.502,-1.504,-1.506,-1.508,-1.510,-1.512,-1.514, - &-1.516,-1.517,-1.519,-1.521,-1.523,-1.525,-1.527,-1.529,-1.531, - &-1.532,-1.534,-1.536,-1.538,-1.540,-1.542,-1.544,-1.545,-1.547, - &-1.549,-1.551,-1.553,-1.555,-1.557,-1.558,-1.560,-1.562,-1.564, - &-1.566,-1.568,-1.569,-1.571,-1.573,-1.575,-1.577,-1.579,-1.580, - &-1.582,-1.584,-1.586,-1.588,-1.589,-1.591,-1.593,-1.595,-1.597, - &-1.598,-1.600,-1.602,-1.604,-1.606,-1.608,-1.609,-1.611,-1.613, - &-1.615,-1.617,-1.618,-1.620,-1.622,-1.624,-1.625,-1.627,-1.629, - &-1.631,-1.633,-1.634,-1.636,-1.655,-1.673,-1.691,-1.708,-1.725, - &-1.742,-1.760,-1.777,-1.793,-1.810,-1.827,-1.844,-1.860,-1.877, - &-1.893,-1.910,-1.926,-1.942,-1.958,-1.974,-1.990,-2.006,-2.022, - &-2.038,-2.054,-2.070,-2.086,-2.101,-2.117,-2.132,-2.148,-2.163, - &-2.179,-2.194,-2.210,-2.225,-2.240,-2.255,-2.271,-2.286,-2.301, - &-2.316,-2.331,-2.346,-2.361,-2.376,-2.391,-2.406,-2.420,-2.435, - &-2.450,-2.465,-2.479,-2.494,-2.509,-2.523,-2.538,-2.553,-2.567, - &-2.582,-2.596,-2.611,-2.625,-2.640,-2.654,-2.668,-2.683,-2.697, - &-2.711,-2.726,-2.740,-2.754,-2.768,-2.783,-2.797,-2.811,-2.825, - &-2.839,-2.853,-2.867,-2.881,-2.895,-2.909,-2.923,-2.937,-2.951, - &-2.965,-2.979,-2.993,-3.007,-3.021,-3.035,-3.049,-3.063,-3.076, - &-3.090,-3.104,-3.118,-3.132,-3.145,-3.159,-3.173,-3.186,-3.200, - &-3.214,-3.227,-3.241,-3.255,-3.268,-3.282,-3.295,-3.309,-3.323, - &-3.336,-3.350,-3.363,-3.377,-3.390,-3.404,-3.417,-3.431,-3.444, - &-3.458,-3.471,-3.484,-3.498,-3.511,-3.525,-3.538,-3.551,-3.565, - &-3.578,-3.591,-3.605,-3.618,-3.631,-3.645,-3.658,-3.671,-3.684, - &-3.698,-3.711,-3.724,-3.737,-3.750,-3.764,-3.777,-3.790,-3.803, - &-3.816,-3.829,-3.843,-3.856,-3.869,-3.882,-3.895,-3.908,-3.921, - &-3.934,-3.947,-3.960 - & / -C -C *** (H,HSO4) -C - DATA BNC08M/ - &-0.047,-0.093,-0.110,-0.119,-0.125,-0.128,-0.130,-0.130,-0.129, - &-0.128,-0.126,-0.123,-0.119,-0.116,-0.111,-0.107,-0.102,-0.096, - &-0.091,-0.085,-0.079,-0.073,-0.066,-0.059,-0.052,-0.045,-0.037, - &-0.030,-0.022,-0.014,-0.006, 0.003, 0.011, 0.020, 0.028, 0.037, - & 0.046, 0.055, 0.065, 0.074, 0.083, 0.093, 0.103, 0.113, 0.122, - & 0.132, 0.142, 0.152, 0.163, 0.173, 0.183, 0.194, 0.204, 0.215, - & 0.225, 0.236, 0.247, 0.258, 0.268, 0.279, 0.290, 0.301, 0.312, - & 0.323, 0.334, 0.346, 0.357, 0.368, 0.380, 0.391, 0.402, 0.414, - & 0.425, 0.437, 0.449, 0.461, 0.472, 0.484, 0.496, 0.508, 0.520, - & 0.532, 0.544, 0.557, 0.569, 0.581, 0.594, 0.606, 0.619, 0.631, - & 0.644, 0.657, 0.669, 0.682, 0.695, 0.708, 0.721, 0.734, 0.747, - & 0.761, 0.774, 0.787, 0.800, 0.814, 0.827, 0.841, 0.854, 0.868, - & 0.881, 0.895, 0.908, 0.922, 0.936, 0.949, 0.963, 0.977, 0.990, - & 1.004, 1.018, 1.031, 1.045, 1.059, 1.072, 1.086, 1.100, 1.114, - & 1.127, 1.141, 1.155, 1.168, 1.182, 1.195, 1.209, 1.223, 1.236, - & 1.250, 1.263, 1.277, 1.290, 1.304, 1.317, 1.331, 1.344, 1.358, - & 1.371, 1.384, 1.398, 1.411, 1.424, 1.437, 1.451, 1.464, 1.477, - & 1.490, 1.503, 1.516, 1.529, 1.542, 1.555, 1.568, 1.581, 1.594, - & 1.607, 1.620, 1.633, 1.646, 1.659, 1.671, 1.684, 1.697, 1.709, - & 1.722, 1.735, 1.747, 1.760, 1.772, 1.785, 1.798, 1.810, 1.822, - & 1.835, 1.847, 1.860, 1.872, 1.884, 1.896, 1.909, 1.921, 1.933, - & 1.945, 1.957, 1.970, 1.982, 1.994, 2.006, 2.018, 2.030, 2.042, - & 2.054, 2.065, 2.077, 2.089, 2.101, 2.113, 2.125, 2.136, 2.148, - & 2.160, 2.171, 2.183, 2.195, 2.206, 2.218, 2.229, 2.241, 2.252, - & 2.264, 2.275, 2.286, 2.298, 2.309, 2.320, 2.332, 2.343, 2.354, - & 2.365, 2.377, 2.388, 2.399, 2.410, 2.421, 2.432, 2.443, 2.454, - & 2.465, 2.476, 2.487, 2.498, 2.509, 2.520, 2.531, 2.541, 2.552, - & 2.563, 2.574, 2.584, 2.595, 2.606, 2.616, 2.627, 2.638, 2.648, - & 2.659, 2.669, 2.680, 2.690, 2.701, 2.711, 2.722, 2.732, 2.742, - & 2.753, 2.763, 2.773, 2.784, 2.794, 2.804, 2.814, 2.825, 2.835, - & 2.845, 2.855, 2.865, 2.875, 2.885, 2.895, 2.905, 2.915, 2.925, - & 2.935, 2.945, 2.955, 2.965, 2.975, 2.985, 2.995, 3.005, 3.014, - & 3.024, 3.034, 3.044, 3.053, 3.063, 3.073, 3.082, 3.092, 3.102, - & 3.111, 3.121, 3.130, 3.140, 3.149, 3.159, 3.168, 3.178, 3.187, - & 3.197, 3.206, 3.215, 3.225, 3.234, 3.243, 3.253, 3.262, 3.271, - & 3.280, 3.290, 3.299, 3.308, 3.317, 3.326, 3.336, 3.345, 3.354, - & 3.363, 3.372, 3.381, 3.390, 3.399, 3.408, 3.417, 3.426, 3.435, - & 3.444, 3.453, 3.462, 3.470, 3.479, 3.488, 3.497, 3.506, 3.514, - & 3.523, 3.532, 3.541, 3.549, 3.558, 3.567, 3.575, 3.584, 3.593, - & 3.601, 3.610, 3.619, 3.627, 3.636, 3.644, 3.653, 3.661, 3.670, - & 3.678, 3.687, 3.695, 3.704, 3.712, 3.720, 3.729, 3.737, 3.745, - & 3.754, 3.762, 3.770, 3.779, 3.787, 3.795, 3.803, 3.812, 3.820, - & 3.828, 3.836, 3.844, 3.852, 3.861, 3.869, 3.877, 3.885, 3.893, - & 3.901, 3.909, 3.917, 3.925, 3.933, 3.941, 3.949, 3.957, 3.965, - & 3.973, 3.981, 3.989, 3.997, 4.081, 4.158, 4.233, 4.307, 4.380, - & 4.452, 4.522, 4.592, 4.660, 4.727, 4.793, 4.859, 4.923, 4.986, - & 5.048, 5.110, 5.171, 5.230, 5.289, 5.347, 5.405, 5.461, 5.517, - & 5.572, 5.626, 5.680, 5.733, 5.785, 5.837, 5.888, 5.938, 5.988, - & 6.037, 6.085, 6.133, 6.181, 6.228, 6.274, 6.320, 6.365, 6.410, - & 6.454, 6.498, 6.541, 6.584, 6.626, 6.668, 6.710, 6.751, 6.792, - & 6.832, 6.872, 6.911, 6.950, 6.989, 7.027, 7.065, 7.102, 7.139, - & 7.176, 7.212, 7.248, 7.284, 7.319, 7.354, 7.389, 7.424, 7.458, - & 7.491, 7.525, 7.558, 7.591, 7.623, 7.656, 7.688, 7.719, 7.751, - & 7.782, 7.813, 7.844, 7.874, 7.904, 7.934, 7.964, 7.993, 8.022, - & 8.051, 8.080, 8.108, 8.137, 8.165, 8.192, 8.220, 8.247, 8.274, - & 8.301, 8.328, 8.354, 8.381, 8.407, 8.433, 8.458, 8.484, 8.509, - & 8.534, 8.559, 8.584, 8.609, 8.633, 8.657, 8.681, 8.705, 8.729, - & 8.752, 8.776, 8.799, 8.822, 8.845, 8.868, 8.890, 8.913, 8.935, - & 8.957, 8.979, 9.001, 9.022, 9.044, 9.065, 9.086, 9.107, 9.128, - & 9.149, 9.170, 9.190, 9.211, 9.231, 9.251, 9.271, 9.291, 9.311, - & 9.330, 9.350, 9.369, 9.388, 9.407, 9.426, 9.445, 9.464, 9.483, - & 9.501, 9.520, 9.538, 9.556, 9.574, 9.592, 9.610, 9.628, 9.645, - & 9.663, 9.680, 9.698 - & / -C -C *** NH4HSO4 -C - DATA BNC09M/ - &-0.050,-0.107,-0.134,-0.153,-0.167,-0.179,-0.189,-0.197,-0.204, - &-0.211,-0.216,-0.221,-0.226,-0.230,-0.234,-0.237,-0.240,-0.243, - &-0.245,-0.247,-0.249,-0.251,-0.252,-0.254,-0.255,-0.256,-0.256, - &-0.257,-0.257,-0.258,-0.258,-0.258,-0.258,-0.258,-0.257,-0.257, - &-0.256,-0.255,-0.255,-0.254,-0.253,-0.252,-0.250,-0.249,-0.248, - &-0.246,-0.245,-0.243,-0.242,-0.240,-0.238,-0.236,-0.234,-0.232, - &-0.230,-0.228,-0.226,-0.224,-0.221,-0.219,-0.217,-0.214,-0.212, - &-0.209,-0.207,-0.204,-0.201,-0.199,-0.196,-0.193,-0.190,-0.188, - &-0.185,-0.182,-0.179,-0.176,-0.173,-0.170,-0.167,-0.163,-0.160, - &-0.157,-0.154,-0.150,-0.147,-0.144,-0.140,-0.137,-0.133,-0.130, - &-0.126,-0.123,-0.119,-0.116,-0.112,-0.108,-0.104,-0.101,-0.097, - &-0.093,-0.089,-0.086,-0.082,-0.078,-0.074,-0.070,-0.066,-0.062, - &-0.058,-0.054,-0.050,-0.046,-0.042,-0.038,-0.034,-0.030,-0.026, - &-0.022,-0.018,-0.014,-0.010,-0.006,-0.002, 0.002, 0.006, 0.010, - & 0.014, 0.018, 0.022, 0.026, 0.030, 0.034, 0.038, 0.042, 0.046, - & 0.050, 0.054, 0.058, 0.062, 0.066, 0.070, 0.074, 0.078, 0.082, - & 0.086, 0.090, 0.094, 0.098, 0.102, 0.106, 0.110, 0.114, 0.117, - & 0.121, 0.125, 0.129, 0.133, 0.137, 0.140, 0.144, 0.148, 0.152, - & 0.156, 0.159, 0.163, 0.167, 0.171, 0.174, 0.178, 0.182, 0.186, - & 0.189, 0.193, 0.197, 0.200, 0.204, 0.208, 0.211, 0.215, 0.219, - & 0.222, 0.226, 0.229, 0.233, 0.237, 0.240, 0.244, 0.247, 0.251, - & 0.254, 0.258, 0.261, 0.265, 0.268, 0.272, 0.275, 0.279, 0.282, - & 0.286, 0.289, 0.293, 0.296, 0.299, 0.303, 0.306, 0.309, 0.313, - & 0.316, 0.320, 0.323, 0.326, 0.330, 0.333, 0.336, 0.339, 0.343, - & 0.346, 0.349, 0.353, 0.356, 0.359, 0.362, 0.366, 0.369, 0.372, - & 0.375, 0.378, 0.382, 0.385, 0.388, 0.391, 0.394, 0.397, 0.401, - & 0.404, 0.407, 0.410, 0.413, 0.416, 0.419, 0.422, 0.425, 0.428, - & 0.431, 0.434, 0.438, 0.441, 0.444, 0.447, 0.450, 0.453, 0.456, - & 0.459, 0.462, 0.465, 0.467, 0.470, 0.473, 0.476, 0.479, 0.482, - & 0.485, 0.488, 0.491, 0.494, 0.497, 0.500, 0.502, 0.505, 0.508, - & 0.511, 0.514, 0.517, 0.520, 0.522, 0.525, 0.528, 0.531, 0.534, - & 0.536, 0.539, 0.542, 0.545, 0.547, 0.550, 0.553, 0.556, 0.558, - & 0.561, 0.564, 0.567, 0.569, 0.572, 0.575, 0.577, 0.580, 0.583, - & 0.585, 0.588, 0.591, 0.593, 0.596, 0.599, 0.601, 0.604, 0.607, - & 0.609, 0.612, 0.614, 0.617, 0.620, 0.622, 0.625, 0.627, 0.630, - & 0.633, 0.635, 0.638, 0.640, 0.643, 0.645, 0.648, 0.650, 0.653, - & 0.655, 0.658, 0.660, 0.663, 0.665, 0.668, 0.670, 0.673, 0.675, - & 0.678, 0.680, 0.683, 0.685, 0.687, 0.690, 0.692, 0.695, 0.697, - & 0.700, 0.702, 0.704, 0.707, 0.709, 0.711, 0.714, 0.716, 0.719, - & 0.721, 0.723, 0.726, 0.728, 0.730, 0.733, 0.735, 0.737, 0.740, - & 0.742, 0.744, 0.747, 0.749, 0.751, 0.754, 0.756, 0.758, 0.760, - & 0.763, 0.765, 0.767, 0.769, 0.772, 0.774, 0.776, 0.778, 0.781, - & 0.783, 0.785, 0.787, 0.790, 0.792, 0.794, 0.796, 0.798, 0.801, - & 0.803, 0.805, 0.807, 0.809, 0.811, 0.814, 0.816, 0.818, 0.820, - & 0.822, 0.824, 0.827, 0.829, 0.851, 0.872, 0.892, 0.912, 0.932, - & 0.951, 0.969, 0.988, 1.006, 1.024, 1.041, 1.058, 1.075, 1.091, - & 1.107, 1.123, 1.139, 1.154, 1.169, 1.184, 1.199, 1.213, 1.227, - & 1.241, 1.255, 1.268, 1.282, 1.295, 1.307, 1.320, 1.332, 1.345, - & 1.357, 1.368, 1.380, 1.392, 1.403, 1.414, 1.425, 1.436, 1.446, - & 1.457, 1.467, 1.478, 1.488, 1.497, 1.507, 1.517, 1.526, 1.536, - & 1.545, 1.554, 1.563, 1.572, 1.580, 1.589, 1.597, 1.606, 1.614, - & 1.622, 1.630, 1.638, 1.646, 1.653, 1.661, 1.668, 1.676, 1.683, - & 1.690, 1.697, 1.704, 1.711, 1.718, 1.724, 1.731, 1.737, 1.744, - & 1.750, 1.756, 1.762, 1.769, 1.775, 1.780, 1.786, 1.792, 1.798, - & 1.803, 1.809, 1.814, 1.820, 1.825, 1.830, 1.835, 1.840, 1.845, - & 1.850, 1.855, 1.860, 1.865, 1.870, 1.874, 1.879, 1.883, 1.888, - & 1.892, 1.896, 1.901, 1.905, 1.909, 1.913, 1.917, 1.921, 1.925, - & 1.929, 1.933, 1.936, 1.940, 1.944, 1.947, 1.951, 1.955, 1.958, - & 1.961, 1.965, 1.968, 1.971, 1.975, 1.978, 1.981, 1.984, 1.987, - & 1.990, 1.993, 1.996, 1.999, 2.001, 2.004, 2.007, 2.010, 2.012, - & 2.015, 2.017, 2.020, 2.022, 2.025, 2.027, 2.030, 2.032, 2.034, - & 2.037, 2.039, 2.041, 2.043, 2.045, 2.047, 2.049, 2.051, 2.053, - & 2.055, 2.057, 2.059 - & / -C -C *** (H,NO3) -C - DATA BNC10M/ - &-0.049,-0.102,-0.125,-0.140,-0.150,-0.158,-0.163,-0.168,-0.171, - &-0.174,-0.176,-0.178,-0.179,-0.179,-0.179,-0.179,-0.179,-0.179, - &-0.178,-0.177,-0.176,-0.175,-0.174,-0.172,-0.171,-0.169,-0.168, - &-0.166,-0.164,-0.162,-0.160,-0.158,-0.156,-0.154,-0.152,-0.150, - &-0.148,-0.146,-0.144,-0.141,-0.139,-0.137,-0.135,-0.132,-0.130, - &-0.128,-0.126,-0.123,-0.121,-0.119,-0.116,-0.114,-0.112,-0.109, - &-0.107,-0.105,-0.102,-0.100,-0.098,-0.095,-0.093,-0.091,-0.088, - &-0.086,-0.084,-0.081,-0.079,-0.077,-0.074,-0.072,-0.070,-0.067, - &-0.065,-0.062,-0.060,-0.057,-0.055,-0.052,-0.050,-0.048,-0.045, - &-0.042,-0.040,-0.037,-0.035,-0.032,-0.030,-0.027,-0.024,-0.022, - &-0.019,-0.016,-0.013,-0.011,-0.008,-0.005,-0.002, 0.001, 0.003, - & 0.006, 0.009, 0.012, 0.015, 0.018, 0.021, 0.024, 0.027, 0.030, - & 0.033, 0.036, 0.039, 0.042, 0.045, 0.048, 0.051, 0.054, 0.057, - & 0.060, 0.063, 0.066, 0.069, 0.072, 0.075, 0.078, 0.081, 0.084, - & 0.087, 0.091, 0.094, 0.097, 0.100, 0.103, 0.106, 0.109, 0.112, - & 0.115, 0.118, 0.121, 0.124, 0.127, 0.130, 0.133, 0.136, 0.139, - & 0.142, 0.146, 0.149, 0.152, 0.155, 0.158, 0.161, 0.164, 0.167, - & 0.170, 0.173, 0.176, 0.179, 0.182, 0.185, 0.188, 0.191, 0.193, - & 0.196, 0.199, 0.202, 0.205, 0.208, 0.211, 0.214, 0.217, 0.220, - & 0.223, 0.226, 0.229, 0.232, 0.235, 0.237, 0.240, 0.243, 0.246, - & 0.249, 0.252, 0.255, 0.258, 0.260, 0.263, 0.266, 0.269, 0.272, - & 0.275, 0.278, 0.280, 0.283, 0.286, 0.289, 0.292, 0.294, 0.297, - & 0.300, 0.303, 0.306, 0.308, 0.311, 0.314, 0.317, 0.319, 0.322, - & 0.325, 0.328, 0.330, 0.333, 0.336, 0.339, 0.341, 0.344, 0.347, - & 0.349, 0.352, 0.355, 0.358, 0.360, 0.363, 0.366, 0.368, 0.371, - & 0.374, 0.376, 0.379, 0.382, 0.384, 0.387, 0.389, 0.392, 0.395, - & 0.397, 0.400, 0.403, 0.405, 0.408, 0.410, 0.413, 0.415, 0.418, - & 0.421, 0.423, 0.426, 0.428, 0.431, 0.433, 0.436, 0.438, 0.441, - & 0.444, 0.446, 0.449, 0.451, 0.454, 0.456, 0.459, 0.461, 0.464, - & 0.466, 0.469, 0.471, 0.473, 0.476, 0.478, 0.481, 0.483, 0.486, - & 0.488, 0.491, 0.493, 0.495, 0.498, 0.500, 0.503, 0.505, 0.508, - & 0.510, 0.512, 0.515, 0.517, 0.519, 0.522, 0.524, 0.527, 0.529, - & 0.531, 0.534, 0.536, 0.538, 0.541, 0.543, 0.545, 0.548, 0.550, - & 0.552, 0.555, 0.557, 0.559, 0.562, 0.564, 0.566, 0.568, 0.571, - & 0.573, 0.575, 0.578, 0.580, 0.582, 0.584, 0.587, 0.589, 0.591, - & 0.593, 0.595, 0.598, 0.600, 0.602, 0.604, 0.607, 0.609, 0.611, - & 0.613, 0.615, 0.618, 0.620, 0.622, 0.624, 0.626, 0.628, 0.631, - & 0.633, 0.635, 0.637, 0.639, 0.641, 0.644, 0.646, 0.648, 0.650, - & 0.652, 0.654, 0.656, 0.658, 0.660, 0.663, 0.665, 0.667, 0.669, - & 0.671, 0.673, 0.675, 0.677, 0.679, 0.681, 0.683, 0.685, 0.688, - & 0.690, 0.692, 0.694, 0.696, 0.698, 0.700, 0.702, 0.704, 0.706, - & 0.708, 0.710, 0.712, 0.714, 0.716, 0.718, 0.720, 0.722, 0.724, - & 0.726, 0.728, 0.730, 0.732, 0.734, 0.736, 0.738, 0.740, 0.742, - & 0.743, 0.745, 0.747, 0.749, 0.751, 0.753, 0.755, 0.757, 0.759, - & 0.761, 0.763, 0.765, 0.767, 0.787, 0.805, 0.824, 0.841, 0.859, - & 0.876, 0.893, 0.909, 0.926, 0.942, 0.957, 0.973, 0.988, 1.003, - & 1.017, 1.032, 1.046, 1.060, 1.073, 1.087, 1.100, 1.113, 1.126, - & 1.138, 1.151, 1.163, 1.175, 1.187, 1.198, 1.210, 1.221, 1.232, - & 1.243, 1.253, 1.264, 1.274, 1.285, 1.295, 1.305, 1.314, 1.324, - & 1.333, 1.343, 1.352, 1.361, 1.370, 1.378, 1.387, 1.395, 1.404, - & 1.412, 1.420, 1.428, 1.436, 1.444, 1.451, 1.459, 1.466, 1.474, - & 1.481, 1.488, 1.495, 1.502, 1.509, 1.515, 1.522, 1.529, 1.535, - & 1.541, 1.548, 1.554, 1.560, 1.566, 1.572, 1.577, 1.583, 1.589, - & 1.594, 1.600, 1.605, 1.610, 1.616, 1.621, 1.626, 1.631, 1.636, - & 1.641, 1.645, 1.650, 1.655, 1.659, 1.664, 1.668, 1.673, 1.677, - & 1.681, 1.685, 1.690, 1.694, 1.698, 1.702, 1.705, 1.709, 1.713, - & 1.717, 1.720, 1.724, 1.728, 1.731, 1.734, 1.738, 1.741, 1.744, - & 1.748, 1.751, 1.754, 1.757, 1.760, 1.763, 1.766, 1.769, 1.772, - & 1.775, 1.777, 1.780, 1.783, 1.785, 1.788, 1.790, 1.793, 1.795, - & 1.798, 1.800, 1.802, 1.805, 1.807, 1.809, 1.811, 1.813, 1.815, - & 1.817, 1.819, 1.821, 1.823, 1.825, 1.827, 1.829, 1.831, 1.832, - & 1.834, 1.836, 1.838, 1.839, 1.841, 1.842, 1.844, 1.845, 1.847, - & 1.848, 1.849, 1.851 - & / -C -C *** (H,Cl) -C - DATA BNC11M/ - &-0.048,-0.094,-0.112,-0.122,-0.128,-0.131,-0.133,-0.133,-0.133, - &-0.131,-0.129,-0.126,-0.123,-0.119,-0.116,-0.111,-0.107,-0.102, - &-0.097,-0.092,-0.086,-0.080,-0.075,-0.069,-0.062,-0.056,-0.050, - &-0.043,-0.037,-0.030,-0.023,-0.016,-0.009,-0.002, 0.005, 0.012, - & 0.020, 0.027, 0.035, 0.042, 0.050, 0.057, 0.065, 0.072, 0.080, - & 0.088, 0.095, 0.103, 0.111, 0.119, 0.126, 0.134, 0.142, 0.150, - & 0.158, 0.166, 0.174, 0.182, 0.190, 0.198, 0.206, 0.214, 0.222, - & 0.230, 0.238, 0.246, 0.254, 0.262, 0.270, 0.278, 0.287, 0.295, - & 0.303, 0.311, 0.320, 0.328, 0.336, 0.345, 0.353, 0.362, 0.370, - & 0.379, 0.387, 0.396, 0.405, 0.413, 0.422, 0.431, 0.440, 0.449, - & 0.457, 0.466, 0.475, 0.484, 0.494, 0.503, 0.512, 0.521, 0.530, - & 0.540, 0.549, 0.558, 0.568, 0.577, 0.587, 0.596, 0.606, 0.615, - & 0.625, 0.634, 0.644, 0.653, 0.663, 0.673, 0.682, 0.692, 0.702, - & 0.711, 0.721, 0.731, 0.740, 0.750, 0.760, 0.769, 0.779, 0.789, - & 0.798, 0.808, 0.818, 0.827, 0.837, 0.847, 0.856, 0.866, 0.875, - & 0.885, 0.895, 0.904, 0.914, 0.923, 0.933, 0.942, 0.952, 0.961, - & 0.971, 0.980, 0.990, 0.999, 1.009, 1.018, 1.027, 1.037, 1.046, - & 1.055, 1.065, 1.074, 1.083, 1.093, 1.102, 1.111, 1.120, 1.130, - & 1.139, 1.148, 1.157, 1.166, 1.175, 1.184, 1.194, 1.203, 1.212, - & 1.221, 1.230, 1.239, 1.248, 1.257, 1.266, 1.275, 1.283, 1.292, - & 1.301, 1.310, 1.319, 1.328, 1.336, 1.345, 1.354, 1.363, 1.372, - & 1.380, 1.389, 1.398, 1.406, 1.415, 1.423, 1.432, 1.441, 1.449, - & 1.458, 1.466, 1.475, 1.483, 1.492, 1.500, 1.509, 1.517, 1.526, - & 1.534, 1.542, 1.551, 1.559, 1.567, 1.576, 1.584, 1.592, 1.600, - & 1.609, 1.617, 1.625, 1.633, 1.641, 1.649, 1.658, 1.666, 1.674, - & 1.682, 1.690, 1.698, 1.706, 1.714, 1.722, 1.730, 1.738, 1.746, - & 1.754, 1.762, 1.769, 1.777, 1.785, 1.793, 1.801, 1.809, 1.816, - & 1.824, 1.832, 1.840, 1.847, 1.855, 1.863, 1.870, 1.878, 1.886, - & 1.893, 1.901, 1.908, 1.916, 1.924, 1.931, 1.939, 1.946, 1.954, - & 1.961, 1.969, 1.976, 1.983, 1.991, 1.998, 2.006, 2.013, 2.020, - & 2.028, 2.035, 2.042, 2.049, 2.057, 2.064, 2.071, 2.078, 2.086, - & 2.093, 2.100, 2.107, 2.114, 2.122, 2.129, 2.136, 2.143, 2.150, - & 2.157, 2.164, 2.171, 2.178, 2.185, 2.192, 2.199, 2.206, 2.213, - & 2.220, 2.227, 2.234, 2.241, 2.247, 2.254, 2.261, 2.268, 2.275, - & 2.282, 2.288, 2.295, 2.302, 2.309, 2.315, 2.322, 2.329, 2.336, - & 2.342, 2.349, 2.356, 2.362, 2.369, 2.376, 2.382, 2.389, 2.395, - & 2.402, 2.408, 2.415, 2.421, 2.428, 2.434, 2.441, 2.447, 2.454, - & 2.460, 2.467, 2.473, 2.480, 2.486, 2.492, 2.499, 2.505, 2.512, - & 2.518, 2.524, 2.531, 2.537, 2.543, 2.549, 2.556, 2.562, 2.568, - & 2.574, 2.581, 2.587, 2.593, 2.599, 2.605, 2.612, 2.618, 2.624, - & 2.630, 2.636, 2.642, 2.648, 2.654, 2.660, 2.666, 2.672, 2.679, - & 2.685, 2.691, 2.697, 2.703, 2.709, 2.714, 2.720, 2.726, 2.732, - & 2.738, 2.744, 2.750, 2.756, 2.762, 2.768, 2.774, 2.779, 2.785, - & 2.791, 2.797, 2.803, 2.808, 2.814, 2.820, 2.826, 2.832, 2.837, - & 2.843, 2.849, 2.854, 2.860, 2.921, 2.976, 3.031, 3.084, 3.137, - & 3.189, 3.240, 3.290, 3.339, 3.387, 3.435, 3.482, 3.528, 3.574, - & 3.619, 3.663, 3.706, 3.749, 3.792, 3.833, 3.874, 3.915, 3.955, - & 3.994, 4.033, 4.072, 4.109, 4.147, 4.184, 4.220, 4.256, 4.291, - & 4.327, 4.361, 4.395, 4.429, 4.462, 4.495, 4.528, 4.560, 4.592, - & 4.623, 4.654, 4.685, 4.716, 4.746, 4.775, 4.805, 4.834, 4.862, - & 4.891, 4.919, 4.947, 4.974, 5.001, 5.028, 5.055, 5.081, 5.107, - & 5.133, 5.159, 5.184, 5.209, 5.234, 5.259, 5.283, 5.307, 5.331, - & 5.355, 5.378, 5.401, 5.424, 5.447, 5.469, 5.492, 5.514, 5.536, - & 5.557, 5.579, 5.600, 5.621, 5.642, 5.663, 5.684, 5.704, 5.724, - & 5.744, 5.764, 5.784, 5.803, 5.823, 5.842, 5.861, 5.880, 5.898, - & 5.917, 5.935, 5.953, 5.972, 5.989, 6.007, 6.025, 6.042, 6.060, - & 6.077, 6.094, 6.111, 6.128, 6.144, 6.161, 6.177, 6.194, 6.210, - & 6.226, 6.242, 6.257, 6.273, 6.289, 6.304, 6.319, 6.334, 6.350, - & 6.365, 6.379, 6.394, 6.409, 6.423, 6.438, 6.452, 6.466, 6.480, - & 6.494, 6.508, 6.522, 6.536, 6.549, 6.563, 6.576, 6.589, 6.602, - & 6.616, 6.629, 6.641, 6.654, 6.667, 6.680, 6.692, 6.705, 6.717, - & 6.729, 6.742, 6.754, 6.766, 6.778, 6.790, 6.801, 6.813, 6.825, - & 6.836, 6.848, 6.859 - & / -C -C *** NaHSO4 -C - DATA BNC12M/ - &-0.049,-0.101,-0.125,-0.140,-0.151,-0.159,-0.166,-0.171,-0.175, - &-0.178,-0.181,-0.183,-0.184,-0.185,-0.186,-0.186,-0.186,-0.186, - &-0.186,-0.185,-0.184,-0.183,-0.181,-0.180,-0.178,-0.176,-0.174, - &-0.172,-0.170,-0.167,-0.165,-0.162,-0.159,-0.156,-0.153,-0.150, - &-0.147,-0.144,-0.140,-0.137,-0.133,-0.130,-0.126,-0.122,-0.118, - &-0.114,-0.110,-0.106,-0.102,-0.098,-0.094,-0.090,-0.085,-0.081, - &-0.076,-0.072,-0.068,-0.063,-0.058,-0.054,-0.049,-0.044,-0.040, - &-0.035,-0.030,-0.025,-0.020,-0.015,-0.010,-0.005, 0.000, 0.005, - & 0.010, 0.015, 0.020, 0.026, 0.031, 0.036, 0.042, 0.047, 0.052, - & 0.058, 0.063, 0.069, 0.075, 0.080, 0.086, 0.092, 0.097, 0.103, - & 0.109, 0.115, 0.121, 0.127, 0.133, 0.139, 0.145, 0.151, 0.157, - & 0.163, 0.169, 0.175, 0.181, 0.188, 0.194, 0.200, 0.206, 0.213, - & 0.219, 0.225, 0.232, 0.238, 0.244, 0.251, 0.257, 0.264, 0.270, - & 0.276, 0.283, 0.289, 0.296, 0.302, 0.308, 0.315, 0.321, 0.328, - & 0.334, 0.341, 0.347, 0.353, 0.360, 0.366, 0.373, 0.379, 0.385, - & 0.392, 0.398, 0.404, 0.411, 0.417, 0.423, 0.430, 0.436, 0.442, - & 0.448, 0.455, 0.461, 0.467, 0.473, 0.480, 0.486, 0.492, 0.498, - & 0.504, 0.510, 0.517, 0.523, 0.529, 0.535, 0.541, 0.547, 0.553, - & 0.559, 0.565, 0.571, 0.577, 0.583, 0.589, 0.595, 0.601, 0.607, - & 0.613, 0.619, 0.625, 0.631, 0.637, 0.642, 0.648, 0.654, 0.660, - & 0.666, 0.671, 0.677, 0.683, 0.689, 0.694, 0.700, 0.706, 0.712, - & 0.717, 0.723, 0.729, 0.734, 0.740, 0.746, 0.751, 0.757, 0.762, - & 0.768, 0.773, 0.779, 0.785, 0.790, 0.796, 0.801, 0.807, 0.812, - & 0.817, 0.823, 0.828, 0.834, 0.839, 0.845, 0.850, 0.855, 0.861, - & 0.866, 0.871, 0.877, 0.882, 0.887, 0.893, 0.898, 0.903, 0.908, - & 0.914, 0.919, 0.924, 0.929, 0.934, 0.939, 0.945, 0.950, 0.955, - & 0.960, 0.965, 0.970, 0.975, 0.980, 0.986, 0.991, 0.996, 1.001, - & 1.006, 1.011, 1.016, 1.021, 1.026, 1.031, 1.036, 1.041, 1.046, - & 1.050, 1.055, 1.060, 1.065, 1.070, 1.075, 1.080, 1.085, 1.089, - & 1.094, 1.099, 1.104, 1.109, 1.114, 1.118, 1.123, 1.128, 1.133, - & 1.137, 1.142, 1.147, 1.151, 1.156, 1.161, 1.165, 1.170, 1.175, - & 1.179, 1.184, 1.189, 1.193, 1.198, 1.203, 1.207, 1.212, 1.216, - & 1.221, 1.225, 1.230, 1.234, 1.239, 1.243, 1.248, 1.252, 1.257, - & 1.261, 1.266, 1.270, 1.275, 1.279, 1.284, 1.288, 1.293, 1.297, - & 1.301, 1.306, 1.310, 1.314, 1.319, 1.323, 1.327, 1.332, 1.336, - & 1.340, 1.345, 1.349, 1.353, 1.358, 1.362, 1.366, 1.370, 1.375, - & 1.379, 1.383, 1.387, 1.391, 1.396, 1.400, 1.404, 1.408, 1.412, - & 1.417, 1.421, 1.425, 1.429, 1.433, 1.437, 1.441, 1.445, 1.450, - & 1.454, 1.458, 1.462, 1.466, 1.470, 1.474, 1.478, 1.482, 1.486, - & 1.490, 1.494, 1.498, 1.502, 1.506, 1.510, 1.514, 1.518, 1.522, - & 1.526, 1.530, 1.534, 1.538, 1.542, 1.546, 1.549, 1.553, 1.557, - & 1.561, 1.565, 1.569, 1.573, 1.577, 1.580, 1.584, 1.588, 1.592, - & 1.596, 1.600, 1.603, 1.607, 1.611, 1.615, 1.618, 1.622, 1.626, - & 1.630, 1.633, 1.637, 1.641, 1.645, 1.648, 1.652, 1.656, 1.660, - & 1.663, 1.667, 1.671, 1.674, 1.714, 1.749, 1.784, 1.819, 1.853, - & 1.886, 1.919, 1.951, 1.982, 2.014, 2.044, 2.074, 2.104, 2.133, - & 2.162, 2.190, 2.218, 2.246, 2.273, 2.300, 2.326, 2.352, 2.377, - & 2.403, 2.427, 2.452, 2.476, 2.500, 2.523, 2.547, 2.569, 2.592, - & 2.614, 2.636, 2.658, 2.679, 2.700, 2.721, 2.742, 2.762, 2.782, - & 2.802, 2.822, 2.841, 2.860, 2.879, 2.898, 2.916, 2.934, 2.952, - & 2.970, 2.988, 3.005, 3.022, 3.039, 3.056, 3.073, 3.089, 3.105, - & 3.121, 3.137, 3.153, 3.168, 3.184, 3.199, 3.214, 3.229, 3.244, - & 3.258, 3.273, 3.287, 3.301, 3.315, 3.329, 3.342, 3.356, 3.369, - & 3.382, 3.395, 3.408, 3.421, 3.434, 3.446, 3.459, 3.471, 3.483, - & 3.496, 3.507, 3.519, 3.531, 3.543, 3.554, 3.566, 3.577, 3.588, - & 3.599, 3.610, 3.621, 3.632, 3.642, 3.653, 3.663, 3.674, 3.684, - & 3.694, 3.704, 3.714, 3.724, 3.734, 3.743, 3.753, 3.762, 3.772, - & 3.781, 3.790, 3.800, 3.809, 3.818, 3.826, 3.835, 3.844, 3.853, - & 3.861, 3.870, 3.878, 3.887, 3.895, 3.903, 3.911, 3.919, 3.927, - & 3.935, 3.943, 3.951, 3.959, 3.966, 3.974, 3.981, 3.989, 3.996, - & 4.004, 4.011, 4.018, 4.025, 4.032, 4.039, 4.046, 4.053, 4.060, - & 4.067, 4.073, 4.080, 4.087, 4.093, 4.100, 4.106, 4.113, 4.119, - & 4.125, 4.131, 4.138 - & / -C -C *** (NH4)3H(SO4)2 -C - DATA BNC13M/ - &-0.082,-0.178,-0.227,-0.261,-0.288,-0.311,-0.330,-0.347,-0.363, - &-0.377,-0.389,-0.401,-0.412,-0.422,-0.431,-0.440,-0.449,-0.457, - &-0.464,-0.471,-0.478,-0.485,-0.491,-0.497,-0.503,-0.508,-0.514, - &-0.519,-0.524,-0.529,-0.533,-0.538,-0.542,-0.546,-0.550,-0.554, - &-0.557,-0.561,-0.565,-0.568,-0.571,-0.574,-0.578,-0.581,-0.583, - &-0.586,-0.589,-0.592,-0.594,-0.597,-0.599,-0.602,-0.604,-0.606, - &-0.608,-0.610,-0.612,-0.614,-0.616,-0.618,-0.620,-0.622,-0.624, - &-0.625,-0.627,-0.629,-0.630,-0.632,-0.633,-0.635,-0.636,-0.637, - &-0.639,-0.640,-0.641,-0.643,-0.644,-0.645,-0.646,-0.647,-0.648, - &-0.649,-0.650,-0.651,-0.652,-0.653,-0.654,-0.655,-0.656,-0.657, - &-0.658,-0.658,-0.659,-0.660,-0.661,-0.661,-0.662,-0.663,-0.663, - &-0.664,-0.665,-0.665,-0.666,-0.666,-0.667,-0.667,-0.668,-0.668, - &-0.669,-0.669,-0.670,-0.670,-0.671,-0.671,-0.671,-0.672,-0.672, - &-0.673,-0.673,-0.673,-0.674,-0.674,-0.674,-0.675,-0.675,-0.675, - &-0.676,-0.676,-0.676,-0.676,-0.677,-0.677,-0.677,-0.677,-0.678, - &-0.678,-0.678,-0.679,-0.679,-0.679,-0.679,-0.679,-0.680,-0.680, - &-0.680,-0.680,-0.681,-0.681,-0.681,-0.681,-0.681,-0.682,-0.682, - &-0.682,-0.682,-0.682,-0.683,-0.683,-0.683,-0.683,-0.683,-0.684, - &-0.684,-0.684,-0.684,-0.684,-0.685,-0.685,-0.685,-0.685,-0.685, - &-0.686,-0.686,-0.686,-0.686,-0.686,-0.687,-0.687,-0.687,-0.687, - &-0.687,-0.687,-0.688,-0.688,-0.688,-0.688,-0.688,-0.689,-0.689, - &-0.689,-0.689,-0.689,-0.690,-0.690,-0.690,-0.690,-0.690,-0.691, - &-0.691,-0.691,-0.691,-0.691,-0.691,-0.692,-0.692,-0.692,-0.692, - &-0.692,-0.693,-0.693,-0.693,-0.693,-0.693,-0.694,-0.694,-0.694, - &-0.694,-0.694,-0.695,-0.695,-0.695,-0.695,-0.695,-0.696,-0.696, - &-0.696,-0.696,-0.696,-0.697,-0.697,-0.697,-0.697,-0.698,-0.698, - &-0.698,-0.698,-0.698,-0.699,-0.699,-0.699,-0.699,-0.699,-0.700, - &-0.700,-0.700,-0.700,-0.701,-0.701,-0.701,-0.701,-0.702,-0.702, - &-0.702,-0.702,-0.702,-0.703,-0.703,-0.703,-0.703,-0.704,-0.704, - &-0.704,-0.704,-0.705,-0.705,-0.705,-0.705,-0.706,-0.706,-0.706, - &-0.706,-0.706,-0.707,-0.707,-0.707,-0.707,-0.708,-0.708,-0.708, - &-0.708,-0.709,-0.709,-0.709,-0.710,-0.710,-0.710,-0.710,-0.711, - &-0.711,-0.711,-0.711,-0.712,-0.712,-0.712,-0.712,-0.713,-0.713, - &-0.713,-0.713,-0.714,-0.714,-0.714,-0.715,-0.715,-0.715,-0.715, - &-0.716,-0.716,-0.716,-0.716,-0.717,-0.717,-0.717,-0.718,-0.718, - &-0.718,-0.718,-0.719,-0.719,-0.719,-0.720,-0.720,-0.720,-0.720, - &-0.721,-0.721,-0.721,-0.722,-0.722,-0.722,-0.723,-0.723,-0.723, - &-0.723,-0.724,-0.724,-0.724,-0.725,-0.725,-0.725,-0.726,-0.726, - &-0.726,-0.727,-0.727,-0.727,-0.727,-0.728,-0.728,-0.728,-0.729, - &-0.729,-0.729,-0.730,-0.730,-0.730,-0.731,-0.731,-0.731,-0.732, - &-0.732,-0.732,-0.733,-0.733,-0.733,-0.733,-0.734,-0.734,-0.734, - &-0.735,-0.735,-0.735,-0.736,-0.736,-0.736,-0.737,-0.737,-0.737, - &-0.738,-0.738,-0.738,-0.739,-0.739,-0.740,-0.740,-0.740,-0.741, - &-0.741,-0.741,-0.742,-0.742,-0.742,-0.743,-0.743,-0.743,-0.744, - &-0.744,-0.744,-0.745,-0.745,-0.749,-0.753,-0.756,-0.760,-0.764, - &-0.768,-0.772,-0.776,-0.780,-0.784,-0.788,-0.793,-0.797,-0.801, - &-0.806,-0.810,-0.815,-0.820,-0.824,-0.829,-0.834,-0.839,-0.844, - &-0.848,-0.853,-0.858,-0.863,-0.869,-0.874,-0.879,-0.884,-0.889, - &-0.895,-0.900,-0.905,-0.911,-0.916,-0.922,-0.927,-0.933,-0.938, - &-0.944,-0.950,-0.955,-0.961,-0.967,-0.972,-0.978,-0.984,-0.990, - &-0.996,-1.002,-1.008,-1.014,-1.020,-1.026,-1.032,-1.038,-1.044, - &-1.050,-1.056,-1.062,-1.068,-1.075,-1.081,-1.087,-1.093,-1.100, - &-1.106,-1.112,-1.119,-1.125,-1.131,-1.138,-1.144,-1.151,-1.157, - &-1.164,-1.170,-1.177,-1.183,-1.190,-1.196,-1.203,-1.209,-1.216, - &-1.223,-1.229,-1.236,-1.243,-1.249,-1.256,-1.263,-1.270,-1.276, - &-1.283,-1.290,-1.297,-1.304,-1.310,-1.317,-1.324,-1.331,-1.338, - &-1.345,-1.352,-1.359,-1.365,-1.372,-1.379,-1.386,-1.393,-1.400, - &-1.407,-1.414,-1.421,-1.428,-1.435,-1.442,-1.450,-1.457,-1.464, - &-1.471,-1.478,-1.485,-1.492,-1.499,-1.506,-1.514,-1.521,-1.528, - &-1.535,-1.542,-1.549,-1.557,-1.564,-1.571,-1.578,-1.586,-1.593, - &-1.600,-1.607,-1.615,-1.622,-1.629,-1.636,-1.644,-1.651,-1.658, - &-1.666,-1.673,-1.680,-1.688,-1.695,-1.702,-1.710,-1.717,-1.725, - &-1.732,-1.739,-1.747 - & / -C -C *** CASO4 -C - DATA BNC14M/ - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000 - & / -C -C *** CANO32 -C - DATA BNC15M/ - &-0.101,-0.216,-0.271,-0.308,-0.337,-0.360,-0.379,-0.396,-0.410, - &-0.422,-0.433,-0.443,-0.452,-0.460,-0.468,-0.475,-0.481,-0.487, - &-0.492,-0.497,-0.502,-0.506,-0.510,-0.514,-0.517,-0.520,-0.524, - &-0.526,-0.529,-0.532,-0.534,-0.537,-0.539,-0.541,-0.543,-0.545, - &-0.547,-0.549,-0.550,-0.552,-0.553,-0.555,-0.556,-0.558,-0.559, - &-0.560,-0.561,-0.563,-0.564,-0.565,-0.566,-0.567,-0.568,-0.569, - &-0.570,-0.571,-0.572,-0.572,-0.573,-0.574,-0.575,-0.576,-0.576, - &-0.577,-0.578,-0.578,-0.579,-0.580,-0.580,-0.581,-0.581,-0.582, - &-0.582,-0.583,-0.583,-0.584,-0.584,-0.585,-0.585,-0.585,-0.586, - &-0.586,-0.586,-0.586,-0.587,-0.587,-0.587,-0.587,-0.587,-0.587, - &-0.587,-0.588,-0.588,-0.588,-0.588,-0.588,-0.587,-0.587,-0.587, - &-0.587,-0.587,-0.587,-0.587,-0.587,-0.586,-0.586,-0.586,-0.586, - &-0.585,-0.585,-0.585,-0.585,-0.584,-0.584,-0.584,-0.583,-0.583, - &-0.583,-0.582,-0.582,-0.581,-0.581,-0.581,-0.580,-0.580,-0.579, - &-0.579,-0.579,-0.578,-0.578,-0.577,-0.577,-0.576,-0.576,-0.576, - &-0.575,-0.575,-0.574,-0.574,-0.573,-0.573,-0.572,-0.572,-0.571, - &-0.571,-0.570,-0.570,-0.570,-0.569,-0.569,-0.568,-0.568,-0.567, - &-0.567,-0.566,-0.566,-0.565,-0.565,-0.564,-0.564,-0.563,-0.563, - &-0.562,-0.562,-0.562,-0.561,-0.561,-0.560,-0.560,-0.559,-0.559, - &-0.558,-0.558,-0.557,-0.557,-0.556,-0.556,-0.555,-0.555,-0.554, - &-0.554,-0.554,-0.553,-0.553,-0.552,-0.552,-0.551,-0.551,-0.550, - &-0.550,-0.549,-0.549,-0.548,-0.548,-0.548,-0.547,-0.547,-0.546, - &-0.546,-0.545,-0.545,-0.544,-0.544,-0.544,-0.543,-0.543,-0.542, - &-0.542,-0.541,-0.541,-0.540,-0.540,-0.540,-0.539,-0.539,-0.538, - &-0.538,-0.537,-0.537,-0.537,-0.536,-0.536,-0.535,-0.535,-0.535, - &-0.534,-0.534,-0.533,-0.533,-0.533,-0.532,-0.532,-0.531,-0.531, - &-0.531,-0.530,-0.530,-0.529,-0.529,-0.529,-0.528,-0.528,-0.527, - &-0.527,-0.527,-0.526,-0.526,-0.525,-0.525,-0.525,-0.524,-0.524, - &-0.524,-0.523,-0.523,-0.523,-0.522,-0.522,-0.521,-0.521,-0.521, - &-0.520,-0.520,-0.520,-0.519,-0.519,-0.519,-0.518,-0.518,-0.518, - &-0.517,-0.517,-0.517,-0.516,-0.516,-0.516,-0.515,-0.515,-0.515, - &-0.514,-0.514,-0.514,-0.513,-0.513,-0.513,-0.512,-0.512,-0.512, - &-0.512,-0.511,-0.511,-0.511,-0.510,-0.510,-0.510,-0.509,-0.509, - &-0.509,-0.509,-0.508,-0.508,-0.508,-0.507,-0.507,-0.507,-0.507, - &-0.506,-0.506,-0.506,-0.506,-0.505,-0.505,-0.505,-0.504,-0.504, - &-0.504,-0.504,-0.503,-0.503,-0.503,-0.503,-0.502,-0.502,-0.502, - &-0.502,-0.501,-0.501,-0.501,-0.501,-0.501,-0.500,-0.500,-0.500, - &-0.500,-0.499,-0.499,-0.499,-0.499,-0.499,-0.498,-0.498,-0.498, - &-0.498,-0.497,-0.497,-0.497,-0.497,-0.497,-0.496,-0.496,-0.496, - &-0.496,-0.496,-0.495,-0.495,-0.495,-0.495,-0.495,-0.495,-0.494, - &-0.494,-0.494,-0.494,-0.494,-0.493,-0.493,-0.493,-0.493,-0.493, - &-0.493,-0.492,-0.492,-0.492,-0.492,-0.492,-0.492,-0.491,-0.491, - &-0.491,-0.491,-0.491,-0.491,-0.491,-0.490,-0.490,-0.490,-0.490, - &-0.490,-0.490,-0.490,-0.489,-0.489,-0.489,-0.489,-0.489,-0.489, - &-0.489,-0.489,-0.488,-0.488,-0.487,-0.486,-0.485,-0.485,-0.484, - &-0.484,-0.484,-0.484,-0.484,-0.484,-0.484,-0.485,-0.485,-0.486, - &-0.487,-0.488,-0.489,-0.490,-0.491,-0.492,-0.494,-0.495,-0.497, - &-0.499,-0.501,-0.503,-0.505,-0.507,-0.509,-0.511,-0.514,-0.516, - &-0.519,-0.522,-0.524,-0.527,-0.530,-0.533,-0.536,-0.539,-0.543, - &-0.546,-0.549,-0.553,-0.556,-0.560,-0.563,-0.567,-0.571,-0.575, - &-0.578,-0.582,-0.586,-0.590,-0.595,-0.599,-0.603,-0.607,-0.612, - &-0.616,-0.620,-0.625,-0.629,-0.634,-0.639,-0.643,-0.648,-0.653, - &-0.658,-0.663,-0.668,-0.673,-0.678,-0.683,-0.688,-0.693,-0.698, - &-0.703,-0.709,-0.714,-0.719,-0.725,-0.730,-0.736,-0.741,-0.747, - &-0.752,-0.758,-0.764,-0.769,-0.775,-0.781,-0.787,-0.792,-0.798, - &-0.804,-0.810,-0.816,-0.822,-0.828,-0.834,-0.840,-0.846,-0.853, - &-0.859,-0.865,-0.871,-0.877,-0.884,-0.890,-0.896,-0.903,-0.909, - &-0.916,-0.922,-0.929,-0.935,-0.942,-0.948,-0.955,-0.961,-0.968, - &-0.975,-0.981,-0.988,-0.995,-1.001,-1.008,-1.015,-1.022,-1.029, - &-1.036,-1.042,-1.049,-1.056,-1.063,-1.070,-1.077,-1.084,-1.091, - &-1.098,-1.105,-1.112,-1.119,-1.127,-1.134,-1.141,-1.148,-1.155, - &-1.162,-1.170,-1.177,-1.184,-1.191,-1.199,-1.206,-1.213,-1.221, - &-1.228,-1.235,-1.243 - & / -C -C *** CACL2 -C - DATA BNC16M/ - &-0.099,-0.205,-0.252,-0.282,-0.304,-0.320,-0.332,-0.342,-0.350, - &-0.356,-0.361,-0.364,-0.367,-0.369,-0.370,-0.371,-0.371,-0.371, - &-0.370,-0.370,-0.368,-0.367,-0.365,-0.363,-0.361,-0.358,-0.356, - &-0.353,-0.350,-0.347,-0.344,-0.341,-0.337,-0.334,-0.330,-0.327, - &-0.323,-0.320,-0.316,-0.312,-0.308,-0.305,-0.301,-0.297,-0.293, - &-0.289,-0.285,-0.281,-0.277,-0.273,-0.269,-0.265,-0.262,-0.258, - &-0.254,-0.250,-0.246,-0.242,-0.238,-0.234,-0.230,-0.226,-0.222, - &-0.218,-0.213,-0.209,-0.205,-0.201,-0.197,-0.193,-0.189,-0.185, - &-0.181,-0.176,-0.172,-0.168,-0.164,-0.160,-0.155,-0.151,-0.146, - &-0.142,-0.138,-0.133,-0.129,-0.124,-0.120,-0.115,-0.110,-0.106, - &-0.101,-0.096,-0.091,-0.086,-0.082,-0.077,-0.072,-0.067,-0.062, - &-0.057,-0.052,-0.047,-0.042,-0.036,-0.031,-0.026,-0.021,-0.016, - &-0.010,-0.005, 0.000, 0.005, 0.011, 0.016, 0.021, 0.027, 0.032, - & 0.037, 0.043, 0.048, 0.054, 0.059, 0.064, 0.070, 0.075, 0.081, - & 0.086, 0.092, 0.097, 0.102, 0.108, 0.113, 0.119, 0.124, 0.129, - & 0.135, 0.140, 0.146, 0.151, 0.156, 0.162, 0.167, 0.173, 0.178, - & 0.183, 0.189, 0.194, 0.199, 0.205, 0.210, 0.215, 0.221, 0.226, - & 0.231, 0.237, 0.242, 0.247, 0.252, 0.258, 0.263, 0.268, 0.273, - & 0.279, 0.284, 0.289, 0.294, 0.299, 0.305, 0.310, 0.315, 0.320, - & 0.325, 0.331, 0.336, 0.341, 0.346, 0.351, 0.356, 0.361, 0.366, - & 0.371, 0.377, 0.382, 0.387, 0.392, 0.397, 0.402, 0.407, 0.412, - & 0.417, 0.422, 0.427, 0.432, 0.437, 0.442, 0.447, 0.452, 0.457, - & 0.462, 0.467, 0.472, 0.476, 0.481, 0.486, 0.491, 0.496, 0.501, - & 0.506, 0.511, 0.515, 0.520, 0.525, 0.530, 0.535, 0.539, 0.544, - & 0.549, 0.554, 0.559, 0.563, 0.568, 0.573, 0.578, 0.582, 0.587, - & 0.592, 0.596, 0.601, 0.606, 0.610, 0.615, 0.620, 0.624, 0.629, - & 0.634, 0.638, 0.643, 0.647, 0.652, 0.657, 0.661, 0.666, 0.670, - & 0.675, 0.679, 0.684, 0.688, 0.693, 0.697, 0.702, 0.706, 0.711, - & 0.715, 0.720, 0.724, 0.729, 0.733, 0.737, 0.742, 0.746, 0.751, - & 0.755, 0.759, 0.764, 0.768, 0.773, 0.777, 0.781, 0.786, 0.790, - & 0.794, 0.798, 0.803, 0.807, 0.811, 0.816, 0.820, 0.824, 0.828, - & 0.833, 0.837, 0.841, 0.845, 0.849, 0.854, 0.858, 0.862, 0.866, - & 0.870, 0.874, 0.879, 0.883, 0.887, 0.891, 0.895, 0.899, 0.903, - & 0.907, 0.912, 0.916, 0.920, 0.924, 0.928, 0.932, 0.936, 0.940, - & 0.944, 0.948, 0.952, 0.956, 0.960, 0.964, 0.968, 0.972, 0.976, - & 0.980, 0.984, 0.988, 0.992, 0.995, 0.999, 1.003, 1.007, 1.011, - & 1.015, 1.019, 1.023, 1.026, 1.030, 1.034, 1.038, 1.042, 1.046, - & 1.049, 1.053, 1.057, 1.061, 1.065, 1.068, 1.072, 1.076, 1.080, - & 1.083, 1.087, 1.091, 1.095, 1.098, 1.102, 1.106, 1.109, 1.113, - & 1.117, 1.120, 1.124, 1.128, 1.131, 1.135, 1.139, 1.142, 1.146, - & 1.150, 1.153, 1.157, 1.160, 1.164, 1.168, 1.171, 1.175, 1.178, - & 1.182, 1.185, 1.189, 1.192, 1.196, 1.200, 1.203, 1.207, 1.210, - & 1.214, 1.217, 1.221, 1.224, 1.227, 1.231, 1.234, 1.238, 1.241, - & 1.245, 1.248, 1.252, 1.255, 1.258, 1.262, 1.265, 1.269, 1.272, - & 1.275, 1.279, 1.282, 1.285, 1.321, 1.354, 1.386, 1.417, 1.448, - & 1.478, 1.508, 1.537, 1.565, 1.593, 1.621, 1.648, 1.674, 1.700, - & 1.726, 1.751, 1.776, 1.800, 1.824, 1.848, 1.871, 1.893, 1.916, - & 1.938, 1.959, 1.980, 2.001, 2.022, 2.042, 2.061, 2.081, 2.100, - & 2.119, 2.137, 2.156, 2.173, 2.191, 2.208, 2.225, 2.242, 2.259, - & 2.275, 2.291, 2.307, 2.322, 2.337, 2.352, 2.367, 2.382, 2.396, - & 2.410, 2.424, 2.438, 2.451, 2.464, 2.477, 2.490, 2.502, 2.515, - & 2.527, 2.539, 2.551, 2.562, 2.574, 2.585, 2.596, 2.607, 2.618, - & 2.628, 2.639, 2.649, 2.659, 2.669, 2.679, 2.688, 2.698, 2.707, - & 2.716, 2.725, 2.734, 2.743, 2.751, 2.760, 2.768, 2.776, 2.784, - & 2.792, 2.800, 2.808, 2.815, 2.823, 2.830, 2.837, 2.844, 2.851, - & 2.858, 2.865, 2.871, 2.878, 2.884, 2.890, 2.896, 2.902, 2.908, - & 2.914, 2.920, 2.925, 2.931, 2.936, 2.942, 2.947, 2.952, 2.957, - & 2.962, 2.967, 2.972, 2.976, 2.981, 2.985, 2.990, 2.994, 2.998, - & 3.003, 3.007, 3.011, 3.014, 3.018, 3.022, 3.026, 3.029, 3.033, - & 3.036, 3.040, 3.043, 3.046, 3.049, 3.052, 3.055, 3.058, 3.061, - & 3.064, 3.066, 3.069, 3.072, 3.074, 3.077, 3.079, 3.081, 3.083, - & 3.086, 3.088, 3.090, 3.092, 3.094, 3.096, 3.097, 3.099, 3.101, - & 3.102, 3.104, 3.105 - & / -C -C *** K2SO4 -C - DATA BNC17M/ - &-0.103,-0.226,-0.289,-0.334,-0.369,-0.399,-0.425,-0.448,-0.468, - &-0.487,-0.505,-0.521,-0.536,-0.550,-0.563,-0.576,-0.588,-0.599, - &-0.610,-0.621,-0.631,-0.641,-0.650,-0.659,-0.668,-0.677,-0.685, - &-0.693,-0.701,-0.709,-0.717,-0.724,-0.731,-0.738,-0.745,-0.752, - &-0.758,-0.765,-0.771,-0.777,-0.784,-0.790,-0.796,-0.801,-0.807, - &-0.813,-0.818,-0.824,-0.829,-0.835,-0.840,-0.845,-0.850,-0.855, - &-0.860,-0.865,-0.870,-0.875,-0.880,-0.884,-0.889,-0.894,-0.898, - &-0.903,-0.907,-0.912,-0.916,-0.920,-0.925,-0.929,-0.933,-0.937, - &-0.942,-0.946,-0.950,-0.954,-0.958,-0.962,-0.966,-0.970,-0.974, - &-0.978,-0.982,-0.985,-0.989,-0.993,-0.997,-1.001,-1.004,-1.008, - &-1.012,-1.016,-1.019,-1.023,-1.027,-1.030,-1.034,-1.037,-1.041, - &-1.045,-1.048,-1.052,-1.055,-1.059,-1.062,-1.066,-1.069,-1.072, - &-1.076,-1.079,-1.083,-1.086,-1.089,-1.093,-1.096,-1.099,-1.103, - &-1.106,-1.109,-1.113,-1.116,-1.119,-1.122,-1.126,-1.129,-1.132, - &-1.135,-1.138,-1.142,-1.145,-1.148,-1.151,-1.154,-1.157,-1.160, - &-1.164,-1.167,-1.170,-1.173,-1.176,-1.179,-1.182,-1.185,-1.188, - &-1.191,-1.194,-1.197,-1.200,-1.203,-1.206,-1.209,-1.212,-1.215, - &-1.218,-1.221,-1.223,-1.226,-1.229,-1.232,-1.235,-1.238,-1.241, - &-1.244,-1.246,-1.249,-1.252,-1.255,-1.258,-1.261,-1.263,-1.266, - &-1.269,-1.272,-1.274,-1.277,-1.280,-1.283,-1.285,-1.288,-1.291, - &-1.294,-1.296,-1.299,-1.302,-1.304,-1.307,-1.310,-1.313,-1.315, - &-1.318,-1.321,-1.323,-1.326,-1.328,-1.331,-1.334,-1.336,-1.339, - &-1.342,-1.344,-1.347,-1.349,-1.352,-1.355,-1.357,-1.360,-1.362, - &-1.365,-1.367,-1.370,-1.373,-1.375,-1.378,-1.380,-1.383,-1.385, - &-1.388,-1.390,-1.393,-1.395,-1.398,-1.400,-1.403,-1.405,-1.408, - &-1.410,-1.413,-1.415,-1.418,-1.420,-1.423,-1.425,-1.427,-1.430, - &-1.432,-1.435,-1.437,-1.440,-1.442,-1.445,-1.447,-1.449,-1.452, - &-1.454,-1.457,-1.459,-1.461,-1.464,-1.466,-1.469,-1.471,-1.473, - &-1.476,-1.478,-1.480,-1.483,-1.485,-1.487,-1.490,-1.492,-1.495, - &-1.497,-1.499,-1.502,-1.504,-1.506,-1.509,-1.511,-1.513,-1.515, - &-1.518,-1.520,-1.522,-1.525,-1.527,-1.529,-1.532,-1.534,-1.536, - &-1.538,-1.541,-1.543,-1.545,-1.548,-1.550,-1.552,-1.554,-1.557, - &-1.559,-1.561,-1.563,-1.566,-1.568,-1.570,-1.572,-1.575,-1.577, - &-1.579,-1.581,-1.583,-1.586,-1.588,-1.590,-1.592,-1.595,-1.597, - &-1.599,-1.601,-1.603,-1.606,-1.608,-1.610,-1.612,-1.614,-1.616, - &-1.619,-1.621,-1.623,-1.625,-1.627,-1.630,-1.632,-1.634,-1.636, - &-1.638,-1.640,-1.642,-1.645,-1.647,-1.649,-1.651,-1.653,-1.655, - &-1.658,-1.660,-1.662,-1.664,-1.666,-1.668,-1.670,-1.672,-1.675, - &-1.677,-1.679,-1.681,-1.683,-1.685,-1.687,-1.689,-1.691,-1.694, - &-1.696,-1.698,-1.700,-1.702,-1.704,-1.706,-1.708,-1.710,-1.712, - &-1.714,-1.717,-1.719,-1.721,-1.723,-1.725,-1.727,-1.729,-1.731, - &-1.733,-1.735,-1.737,-1.739,-1.741,-1.743,-1.745,-1.748,-1.750, - &-1.752,-1.754,-1.756,-1.758,-1.760,-1.762,-1.764,-1.766,-1.768, - &-1.770,-1.772,-1.774,-1.776,-1.778,-1.780,-1.782,-1.784,-1.786, - &-1.788,-1.790,-1.792,-1.794,-1.816,-1.836,-1.855,-1.875,-1.894, - &-1.914,-1.933,-1.952,-1.971,-1.989,-2.008,-2.027,-2.045,-2.063, - &-2.082,-2.100,-2.118,-2.136,-2.154,-2.171,-2.189,-2.207,-2.224, - &-2.242,-2.259,-2.276,-2.293,-2.311,-2.328,-2.345,-2.362,-2.379, - &-2.395,-2.412,-2.429,-2.446,-2.462,-2.479,-2.495,-2.512,-2.528, - &-2.544,-2.561,-2.577,-2.593,-2.609,-2.625,-2.642,-2.658,-2.674, - &-2.689,-2.705,-2.721,-2.737,-2.753,-2.768,-2.784,-2.800,-2.815, - &-2.831,-2.847,-2.862,-2.878,-2.893,-2.908,-2.924,-2.939,-2.954, - &-2.970,-2.985,-3.000,-3.015,-3.031,-3.046,-3.061,-3.076,-3.091, - &-3.106,-3.121,-3.136,-3.151,-3.166,-3.181,-3.196,-3.210,-3.225, - &-3.240,-3.255,-3.270,-3.284,-3.299,-3.314,-3.328,-3.343,-3.358, - &-3.372,-3.387,-3.401,-3.416,-3.430,-3.445,-3.459,-3.474,-3.488, - &-3.503,-3.517,-3.531,-3.546,-3.560,-3.574,-3.589,-3.603,-3.617, - &-3.631,-3.646,-3.660,-3.674,-3.688,-3.702,-3.717,-3.731,-3.745, - &-3.759,-3.773,-3.787,-3.801,-3.815,-3.829,-3.843,-3.857,-3.871, - &-3.885,-3.899,-3.913,-3.927,-3.941,-3.955,-3.969,-3.982,-3.996, - &-4.010,-4.024,-4.038,-4.051,-4.065,-4.079,-4.093,-4.107,-4.120, - &-4.134,-4.148,-4.161,-4.175,-4.189,-4.202,-4.216,-4.230,-4.243, - &-4.257,-4.271,-4.284 - & / -C -C *** KHSO4 -C - DATA BNC18M/ - &-0.050,-0.106,-0.133,-0.152,-0.166,-0.177,-0.187,-0.195,-0.202, - &-0.208,-0.214,-0.218,-0.223,-0.227,-0.230,-0.233,-0.236,-0.238, - &-0.240,-0.242,-0.244,-0.246,-0.247,-0.248,-0.249,-0.250,-0.250, - &-0.250,-0.251,-0.251,-0.251,-0.251,-0.250,-0.250,-0.249,-0.249, - &-0.248,-0.247,-0.246,-0.245,-0.244,-0.242,-0.241,-0.240,-0.238, - &-0.236,-0.235,-0.233,-0.231,-0.229,-0.227,-0.225,-0.223,-0.221, - &-0.219,-0.216,-0.214,-0.212,-0.209,-0.207,-0.204,-0.202,-0.199, - &-0.196,-0.193,-0.191,-0.188,-0.185,-0.182,-0.179,-0.176,-0.173, - &-0.170,-0.167,-0.164,-0.161,-0.158,-0.154,-0.151,-0.148,-0.144, - &-0.141,-0.138,-0.134,-0.131,-0.127,-0.124,-0.120,-0.116,-0.113, - &-0.109,-0.105,-0.102,-0.098,-0.094,-0.090,-0.086,-0.082,-0.078, - &-0.074,-0.071,-0.067,-0.063,-0.059,-0.054,-0.050,-0.046,-0.042, - &-0.038,-0.034,-0.030,-0.026,-0.022,-0.017,-0.013,-0.009,-0.005, - &-0.001, 0.004, 0.008, 0.012, 0.016, 0.020, 0.025, 0.029, 0.033, - & 0.037, 0.041, 0.046, 0.050, 0.054, 0.058, 0.062, 0.067, 0.071, - & 0.075, 0.079, 0.083, 0.087, 0.091, 0.096, 0.100, 0.104, 0.108, - & 0.112, 0.116, 0.120, 0.124, 0.128, 0.132, 0.136, 0.141, 0.145, - & 0.149, 0.153, 0.157, 0.161, 0.165, 0.169, 0.173, 0.176, 0.180, - & 0.184, 0.188, 0.192, 0.196, 0.200, 0.204, 0.208, 0.212, 0.215, - & 0.219, 0.223, 0.227, 0.231, 0.235, 0.238, 0.242, 0.246, 0.250, - & 0.254, 0.257, 0.261, 0.265, 0.268, 0.272, 0.276, 0.280, 0.283, - & 0.287, 0.291, 0.294, 0.298, 0.302, 0.305, 0.309, 0.312, 0.316, - & 0.320, 0.323, 0.327, 0.330, 0.334, 0.337, 0.341, 0.344, 0.348, - & 0.351, 0.355, 0.358, 0.362, 0.365, 0.369, 0.372, 0.376, 0.379, - & 0.382, 0.386, 0.389, 0.393, 0.396, 0.399, 0.403, 0.406, 0.409, - & 0.413, 0.416, 0.419, 0.423, 0.426, 0.429, 0.433, 0.436, 0.439, - & 0.442, 0.446, 0.449, 0.452, 0.455, 0.459, 0.462, 0.465, 0.468, - & 0.471, 0.475, 0.478, 0.481, 0.484, 0.487, 0.490, 0.493, 0.497, - & 0.500, 0.503, 0.506, 0.509, 0.512, 0.515, 0.518, 0.521, 0.524, - & 0.527, 0.530, 0.533, 0.536, 0.539, 0.542, 0.545, 0.548, 0.551, - & 0.554, 0.557, 0.560, 0.563, 0.566, 0.569, 0.572, 0.575, 0.578, - & 0.581, 0.584, 0.587, 0.590, 0.592, 0.595, 0.598, 0.601, 0.604, - & 0.607, 0.610, 0.612, 0.615, 0.618, 0.621, 0.624, 0.627, 0.629, - & 0.632, 0.635, 0.638, 0.640, 0.643, 0.646, 0.649, 0.651, 0.654, - & 0.657, 0.660, 0.662, 0.665, 0.668, 0.671, 0.673, 0.676, 0.679, - & 0.681, 0.684, 0.687, 0.689, 0.692, 0.695, 0.697, 0.700, 0.702, - & 0.705, 0.708, 0.710, 0.713, 0.716, 0.718, 0.721, 0.723, 0.726, - & 0.728, 0.731, 0.734, 0.736, 0.739, 0.741, 0.744, 0.746, 0.749, - & 0.751, 0.754, 0.756, 0.759, 0.761, 0.764, 0.766, 0.769, 0.771, - & 0.774, 0.776, 0.779, 0.781, 0.784, 0.786, 0.788, 0.791, 0.793, - & 0.796, 0.798, 0.801, 0.803, 0.805, 0.808, 0.810, 0.813, 0.815, - & 0.817, 0.820, 0.822, 0.824, 0.827, 0.829, 0.832, 0.834, 0.836, - & 0.839, 0.841, 0.843, 0.846, 0.848, 0.850, 0.852, 0.855, 0.857, - & 0.859, 0.862, 0.864, 0.866, 0.868, 0.871, 0.873, 0.875, 0.878, - & 0.880, 0.882, 0.884, 0.887, 0.910, 0.932, 0.953, 0.974, 0.995, - & 1.015, 1.034, 1.054, 1.072, 1.091, 1.109, 1.127, 1.145, 1.162, - & 1.179, 1.196, 1.213, 1.229, 1.245, 1.260, 1.276, 1.291, 1.306, - & 1.320, 1.335, 1.349, 1.363, 1.377, 1.390, 1.404, 1.417, 1.430, - & 1.442, 1.455, 1.467, 1.479, 1.491, 1.503, 1.515, 1.526, 1.538, - & 1.549, 1.560, 1.570, 1.581, 1.592, 1.602, 1.612, 1.622, 1.632, - & 1.642, 1.652, 1.661, 1.671, 1.680, 1.689, 1.698, 1.707, 1.716, - & 1.724, 1.733, 1.741, 1.750, 1.758, 1.766, 1.774, 1.782, 1.789, - & 1.797, 1.805, 1.812, 1.820, 1.827, 1.834, 1.841, 1.848, 1.855, - & 1.862, 1.868, 1.875, 1.882, 1.888, 1.894, 1.901, 1.907, 1.913, - & 1.919, 1.925, 1.931, 1.937, 1.943, 1.948, 1.954, 1.959, 1.965, - & 1.970, 1.976, 1.981, 1.986, 1.991, 1.996, 2.001, 2.006, 2.011, - & 2.016, 2.020, 2.025, 2.030, 2.034, 2.039, 2.043, 2.048, 2.052, - & 2.056, 2.060, 2.064, 2.069, 2.073, 2.077, 2.080, 2.084, 2.088, - & 2.092, 2.096, 2.099, 2.103, 2.107, 2.110, 2.114, 2.117, 2.120, - & 2.124, 2.127, 2.130, 2.133, 2.137, 2.140, 2.143, 2.146, 2.149, - & 2.152, 2.155, 2.158, 2.160, 2.163, 2.166, 2.169, 2.171, 2.174, - & 2.176, 2.179, 2.181, 2.184, 2.186, 2.189, 2.191, 2.193, 2.196, - & 2.198, 2.200, 2.202 - & / -C -C *** KNO3 -C - DATA BNC19M/ - &-0.053,-0.124,-0.164,-0.194,-0.219,-0.242,-0.262,-0.281,-0.298, - &-0.314,-0.330,-0.345,-0.359,-0.372,-0.385,-0.398,-0.411,-0.423, - &-0.434,-0.446,-0.457,-0.468,-0.478,-0.489,-0.499,-0.509,-0.519, - &-0.528,-0.538,-0.547,-0.556,-0.565,-0.574,-0.583,-0.592,-0.600, - &-0.608,-0.617,-0.625,-0.633,-0.641,-0.648,-0.656,-0.664,-0.671, - &-0.678,-0.686,-0.693,-0.700,-0.707,-0.714,-0.721,-0.727,-0.734, - &-0.741,-0.747,-0.754,-0.760,-0.766,-0.773,-0.779,-0.785,-0.791, - &-0.797,-0.803,-0.809,-0.815,-0.821,-0.827,-0.832,-0.838,-0.844, - &-0.849,-0.855,-0.861,-0.866,-0.872,-0.877,-0.883,-0.888,-0.894, - &-0.899,-0.904,-0.910,-0.915,-0.920,-0.926,-0.931,-0.936,-0.942, - &-0.947,-0.952,-0.957,-0.963,-0.968,-0.973,-0.978,-0.983,-0.988, - &-0.994,-0.999,-1.004,-1.009,-1.014,-1.019,-1.024,-1.029,-1.034, - &-1.039,-1.044,-1.049,-1.054,-1.059,-1.064,-1.069,-1.074,-1.079, - &-1.083,-1.088,-1.093,-1.098,-1.103,-1.107,-1.112,-1.117,-1.122, - &-1.126,-1.131,-1.136,-1.140,-1.145,-1.149,-1.154,-1.158,-1.163, - &-1.168,-1.172,-1.176,-1.181,-1.185,-1.190,-1.194,-1.199,-1.203, - &-1.207,-1.212,-1.216,-1.220,-1.224,-1.229,-1.233,-1.237,-1.241, - &-1.245,-1.250,-1.254,-1.258,-1.262,-1.266,-1.270,-1.274,-1.278, - &-1.282,-1.286,-1.290,-1.294,-1.298,-1.302,-1.306,-1.310,-1.314, - &-1.318,-1.321,-1.325,-1.329,-1.333,-1.337,-1.341,-1.344,-1.348, - &-1.352,-1.355,-1.359,-1.363,-1.367,-1.370,-1.374,-1.378,-1.381, - &-1.385,-1.388,-1.392,-1.395,-1.399,-1.403,-1.406,-1.410,-1.413, - &-1.417,-1.420,-1.423,-1.427,-1.430,-1.434,-1.437,-1.441,-1.444, - &-1.447,-1.451,-1.454,-1.457,-1.461,-1.464,-1.467,-1.470,-1.474, - &-1.477,-1.480,-1.483,-1.487,-1.490,-1.493,-1.496,-1.499,-1.503, - &-1.506,-1.509,-1.512,-1.515,-1.518,-1.521,-1.524,-1.528,-1.531, - &-1.534,-1.537,-1.540,-1.543,-1.546,-1.549,-1.552,-1.555,-1.558, - &-1.561,-1.564,-1.566,-1.569,-1.572,-1.575,-1.578,-1.581,-1.584, - &-1.587,-1.590,-1.592,-1.595,-1.598,-1.601,-1.604,-1.607,-1.609, - &-1.612,-1.615,-1.618,-1.620,-1.623,-1.626,-1.629,-1.631,-1.634, - &-1.637,-1.639,-1.642,-1.645,-1.647,-1.650,-1.653,-1.655,-1.658, - &-1.661,-1.663,-1.666,-1.668,-1.671,-1.674,-1.676,-1.679,-1.681, - &-1.684,-1.686,-1.689,-1.691,-1.694,-1.696,-1.699,-1.701,-1.704, - &-1.706,-1.709,-1.711,-1.714,-1.716,-1.719,-1.721,-1.724,-1.726, - &-1.728,-1.731,-1.733,-1.736,-1.738,-1.740,-1.743,-1.745,-1.747, - &-1.750,-1.752,-1.754,-1.757,-1.759,-1.761,-1.764,-1.766,-1.768, - &-1.771,-1.773,-1.775,-1.777,-1.780,-1.782,-1.784,-1.786,-1.789, - &-1.791,-1.793,-1.795,-1.797,-1.800,-1.802,-1.804,-1.806,-1.808, - &-1.811,-1.813,-1.815,-1.817,-1.819,-1.821,-1.823,-1.826,-1.828, - &-1.830,-1.832,-1.834,-1.836,-1.838,-1.840,-1.842,-1.844,-1.847, - &-1.849,-1.851,-1.853,-1.855,-1.857,-1.859,-1.861,-1.863,-1.865, - &-1.867,-1.869,-1.871,-1.873,-1.875,-1.877,-1.879,-1.881,-1.883, - &-1.885,-1.887,-1.889,-1.891,-1.893,-1.895,-1.897,-1.898,-1.900, - &-1.902,-1.904,-1.906,-1.908,-1.910,-1.912,-1.914,-1.916,-1.917, - &-1.919,-1.921,-1.923,-1.925,-1.945,-1.963,-1.980,-1.997,-2.014, - &-2.030,-2.046,-2.062,-2.077,-2.092,-2.107,-2.122,-2.136,-2.150, - &-2.163,-2.177,-2.190,-2.203,-2.216,-2.228,-2.241,-2.253,-2.265, - &-2.277,-2.289,-2.300,-2.311,-2.323,-2.334,-2.345,-2.356,-2.366, - &-2.377,-2.387,-2.398,-2.408,-2.418,-2.428,-2.438,-2.448,-2.457, - &-2.467,-2.477,-2.486,-2.496,-2.505,-2.514,-2.523,-2.532,-2.541, - &-2.550,-2.559,-2.568,-2.577,-2.586,-2.594,-2.603,-2.611,-2.620, - &-2.628,-2.637,-2.645,-2.653,-2.662,-2.670,-2.678,-2.686,-2.694, - &-2.702,-2.710,-2.718,-2.726,-2.734,-2.742,-2.750,-2.758,-2.765, - &-2.773,-2.781,-2.789,-2.796,-2.804,-2.811,-2.819,-2.827,-2.834, - &-2.842,-2.849,-2.857,-2.864,-2.871,-2.879,-2.886,-2.893,-2.901, - &-2.908,-2.915,-2.923,-2.930,-2.937,-2.944,-2.951,-2.959,-2.966, - &-2.973,-2.980,-2.987,-2.994,-3.001,-3.008,-3.015,-3.022,-3.029, - &-3.036,-3.043,-3.050,-3.057,-3.064,-3.071,-3.078,-3.085,-3.092, - &-3.099,-3.106,-3.113,-3.119,-3.126,-3.133,-3.140,-3.147,-3.154, - &-3.160,-3.167,-3.174,-3.181,-3.187,-3.194,-3.201,-3.208,-3.214, - &-3.221,-3.228,-3.234,-3.241,-3.248,-3.254,-3.261,-3.268,-3.274, - &-3.281,-3.287,-3.294,-3.301,-3.307,-3.314,-3.320,-3.327,-3.334, - &-3.340,-3.347,-3.353 - & / -C -C *** KCL -C - DATA BNC20M/ - &-0.051,-0.108,-0.135,-0.154,-0.169,-0.180,-0.190,-0.198,-0.205, - &-0.211,-0.217,-0.222,-0.226,-0.231,-0.234,-0.238,-0.241,-0.244, - &-0.246,-0.249,-0.251,-0.253,-0.255,-0.257,-0.259,-0.261,-0.262, - &-0.264,-0.265,-0.267,-0.268,-0.269,-0.270,-0.271,-0.272,-0.273, - &-0.274,-0.275,-0.276,-0.277,-0.278,-0.278,-0.279,-0.280,-0.280, - &-0.281,-0.282,-0.282,-0.283,-0.283,-0.284,-0.285,-0.285,-0.286, - &-0.286,-0.287,-0.287,-0.287,-0.288,-0.288,-0.289,-0.289,-0.289, - &-0.290,-0.290,-0.291,-0.291,-0.291,-0.292,-0.292,-0.292,-0.292, - &-0.293,-0.293,-0.293,-0.293,-0.294,-0.294,-0.294,-0.294,-0.294, - &-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295, - &-0.295,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296, - &-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295, - &-0.295,-0.295,-0.294,-0.294,-0.294,-0.294,-0.294,-0.294,-0.294, - &-0.293,-0.293,-0.293,-0.293,-0.293,-0.293,-0.292,-0.292,-0.292, - &-0.292,-0.292,-0.291,-0.291,-0.291,-0.291,-0.291,-0.290,-0.290, - &-0.290,-0.290,-0.290,-0.289,-0.289,-0.289,-0.289,-0.289,-0.288, - &-0.288,-0.288,-0.288,-0.287,-0.287,-0.287,-0.287,-0.287,-0.286, - &-0.286,-0.286,-0.286,-0.285,-0.285,-0.285,-0.285,-0.285,-0.284, - &-0.284,-0.284,-0.284,-0.283,-0.283,-0.283,-0.283,-0.283,-0.282, - &-0.282,-0.282,-0.282,-0.281,-0.281,-0.281,-0.281,-0.281,-0.280, - &-0.280,-0.280,-0.280,-0.279,-0.279,-0.279,-0.279,-0.279,-0.278, - &-0.278,-0.278,-0.278,-0.278,-0.277,-0.277,-0.277,-0.277,-0.276, - &-0.276,-0.276,-0.276,-0.276,-0.275,-0.275,-0.275,-0.275,-0.275, - &-0.274,-0.274,-0.274,-0.274,-0.274,-0.273,-0.273,-0.273,-0.273, - &-0.273,-0.272,-0.272,-0.272,-0.272,-0.272,-0.271,-0.271,-0.271, - &-0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.270,-0.270,-0.269, - &-0.269,-0.269,-0.269,-0.269,-0.268,-0.268,-0.268,-0.268,-0.268, - &-0.268,-0.267,-0.267,-0.267,-0.267,-0.267,-0.266,-0.266,-0.266, - &-0.266,-0.266,-0.266,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265, - &-0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.263,-0.263,-0.263, - &-0.263,-0.263,-0.263,-0.263,-0.262,-0.262,-0.262,-0.262,-0.262, - &-0.262,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.260, - &-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.259,-0.259, - &-0.259,-0.259,-0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.258, - &-0.258,-0.258,-0.258,-0.258,-0.257,-0.257,-0.257,-0.257,-0.257, - &-0.257,-0.257,-0.257,-0.257,-0.256,-0.256,-0.256,-0.256,-0.256, - &-0.256,-0.256,-0.256,-0.256,-0.255,-0.255,-0.255,-0.255,-0.255, - &-0.255,-0.255,-0.255,-0.255,-0.255,-0.254,-0.254,-0.254,-0.254, - &-0.254,-0.254,-0.254,-0.254,-0.254,-0.254,-0.253,-0.253,-0.253, - &-0.253,-0.253,-0.253,-0.253,-0.253,-0.253,-0.253,-0.253,-0.253, - &-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252, - &-0.252,-0.252,-0.252,-0.252,-0.252,-0.251,-0.251,-0.251,-0.251, - &-0.251,-0.251,-0.251,-0.251,-0.251,-0.251,-0.251,-0.251,-0.251, - &-0.251,-0.251,-0.251,-0.250,-0.250,-0.250,-0.250,-0.250,-0.250, - &-0.250,-0.250,-0.250,-0.250,-0.250,-0.249,-0.249,-0.249,-0.248, - &-0.248,-0.248,-0.248,-0.249,-0.249,-0.249,-0.249,-0.250,-0.250, - &-0.251,-0.251,-0.252,-0.252,-0.253,-0.254,-0.255,-0.255,-0.256, - &-0.257,-0.258,-0.259,-0.261,-0.262,-0.263,-0.264,-0.265,-0.267, - &-0.268,-0.269,-0.271,-0.272,-0.274,-0.276,-0.277,-0.279,-0.280, - &-0.282,-0.284,-0.286,-0.287,-0.289,-0.291,-0.293,-0.295,-0.297, - &-0.299,-0.301,-0.303,-0.305,-0.307,-0.309,-0.312,-0.314,-0.316, - &-0.318,-0.321,-0.323,-0.325,-0.328,-0.330,-0.332,-0.335,-0.337, - &-0.340,-0.342,-0.345,-0.347,-0.350,-0.352,-0.355,-0.358,-0.360, - &-0.363,-0.366,-0.368,-0.371,-0.374,-0.377,-0.379,-0.382,-0.385, - &-0.388,-0.391,-0.394,-0.396,-0.399,-0.402,-0.405,-0.408,-0.411, - &-0.414,-0.417,-0.420,-0.423,-0.426,-0.429,-0.432,-0.436,-0.439, - &-0.442,-0.445,-0.448,-0.451,-0.454,-0.458,-0.461,-0.464,-0.467, - &-0.471,-0.474,-0.477,-0.480,-0.484,-0.487,-0.490,-0.494,-0.497, - &-0.500,-0.504,-0.507,-0.511,-0.514,-0.517,-0.521,-0.524,-0.528, - &-0.531,-0.535,-0.538,-0.542,-0.545,-0.549,-0.552,-0.556,-0.559, - &-0.563,-0.566,-0.570,-0.574,-0.577,-0.581,-0.584,-0.588,-0.592, - &-0.595,-0.599,-0.603,-0.606,-0.610,-0.614,-0.617,-0.621,-0.625, - &-0.628,-0.632,-0.636 - & / -C -C *** MGSO4 -C - DATA BNC21M/ - &-0.205,-0.445,-0.564,-0.649,-0.715,-0.770,-0.817,-0.858,-0.895, - &-0.928,-0.958,-0.986,-1.012,-1.036,-1.058,-1.079,-1.099,-1.118, - &-1.136,-1.153,-1.170,-1.185,-1.200,-1.215,-1.229,-1.242,-1.255, - &-1.268,-1.280,-1.292,-1.303,-1.315,-1.325,-1.336,-1.346,-1.357, - &-1.366,-1.376,-1.386,-1.395,-1.404,-1.413,-1.421,-1.430,-1.438, - &-1.447,-1.455,-1.463,-1.471,-1.478,-1.486,-1.494,-1.501,-1.508, - &-1.515,-1.523,-1.530,-1.536,-1.543,-1.550,-1.557,-1.563,-1.570, - &-1.576,-1.583,-1.589,-1.595,-1.601,-1.607,-1.613,-1.619,-1.625, - &-1.631,-1.637,-1.643,-1.648,-1.654,-1.659,-1.665,-1.670,-1.676, - &-1.681,-1.687,-1.692,-1.697,-1.702,-1.707,-1.713,-1.718,-1.723, - &-1.728,-1.733,-1.738,-1.742,-1.747,-1.752,-1.757,-1.762,-1.766, - &-1.771,-1.776,-1.780,-1.785,-1.789,-1.794,-1.798,-1.803,-1.807, - &-1.812,-1.816,-1.820,-1.825,-1.829,-1.833,-1.838,-1.842,-1.846, - &-1.850,-1.854,-1.858,-1.863,-1.867,-1.871,-1.875,-1.879,-1.883, - &-1.887,-1.891,-1.895,-1.899,-1.903,-1.907,-1.911,-1.915,-1.919, - &-1.922,-1.926,-1.930,-1.934,-1.938,-1.942,-1.945,-1.949,-1.953, - &-1.957,-1.960,-1.964,-1.968,-1.972,-1.975,-1.979,-1.983,-1.986, - &-1.990,-1.994,-1.997,-2.001,-2.004,-2.008,-2.012,-2.015,-2.019, - &-2.022,-2.026,-2.029,-2.033,-2.036,-2.040,-2.043,-2.047,-2.050, - &-2.054,-2.057,-2.061,-2.064,-2.068,-2.071,-2.074,-2.078,-2.081, - &-2.085,-2.088,-2.091,-2.095,-2.098,-2.102,-2.105,-2.108,-2.112, - &-2.115,-2.118,-2.122,-2.125,-2.128,-2.132,-2.135,-2.138,-2.141, - &-2.145,-2.148,-2.151,-2.154,-2.158,-2.161,-2.164,-2.167,-2.171, - &-2.174,-2.177,-2.180,-2.184,-2.187,-2.190,-2.193,-2.196,-2.200, - &-2.203,-2.206,-2.209,-2.212,-2.215,-2.219,-2.222,-2.225,-2.228, - &-2.231,-2.234,-2.237,-2.241,-2.244,-2.247,-2.250,-2.253,-2.256, - &-2.259,-2.262,-2.265,-2.269,-2.272,-2.275,-2.278,-2.281,-2.284, - &-2.287,-2.290,-2.293,-2.296,-2.299,-2.302,-2.305,-2.308,-2.311, - &-2.314,-2.317,-2.320,-2.324,-2.327,-2.330,-2.333,-2.336,-2.339, - &-2.342,-2.345,-2.348,-2.351,-2.354,-2.357,-2.360,-2.363,-2.366, - &-2.369,-2.371,-2.374,-2.377,-2.380,-2.383,-2.386,-2.389,-2.392, - &-2.395,-2.398,-2.401,-2.404,-2.407,-2.410,-2.413,-2.416,-2.419, - &-2.422,-2.425,-2.427,-2.430,-2.433,-2.436,-2.439,-2.442,-2.445, - &-2.448,-2.451,-2.454,-2.457,-2.460,-2.462,-2.465,-2.468,-2.471, - &-2.474,-2.477,-2.480,-2.483,-2.485,-2.488,-2.491,-2.494,-2.497, - &-2.500,-2.503,-2.506,-2.508,-2.511,-2.514,-2.517,-2.520,-2.523, - &-2.526,-2.528,-2.531,-2.534,-2.537,-2.540,-2.543,-2.546,-2.548, - &-2.551,-2.554,-2.557,-2.560,-2.563,-2.565,-2.568,-2.571,-2.574, - &-2.577,-2.579,-2.582,-2.585,-2.588,-2.591,-2.594,-2.596,-2.599, - &-2.602,-2.605,-2.608,-2.610,-2.613,-2.616,-2.619,-2.622,-2.624, - &-2.627,-2.630,-2.633,-2.635,-2.638,-2.641,-2.644,-2.647,-2.649, - &-2.652,-2.655,-2.658,-2.661,-2.663,-2.666,-2.669,-2.672,-2.674, - &-2.677,-2.680,-2.683,-2.685,-2.688,-2.691,-2.694,-2.696,-2.699, - &-2.702,-2.705,-2.707,-2.710,-2.713,-2.716,-2.718,-2.721,-2.724, - &-2.727,-2.729,-2.732,-2.735,-2.765,-2.792,-2.819,-2.846,-2.873, - &-2.900,-2.927,-2.953,-2.980,-3.006,-3.033,-3.059,-3.086,-3.112, - &-3.138,-3.164,-3.191,-3.217,-3.243,-3.269,-3.295,-3.321,-3.346, - &-3.372,-3.398,-3.424,-3.449,-3.475,-3.501,-3.526,-3.552,-3.578, - &-3.603,-3.629,-3.654,-3.679,-3.705,-3.730,-3.755,-3.781,-3.806, - &-3.831,-3.857,-3.882,-3.907,-3.932,-3.957,-3.982,-4.008,-4.033, - &-4.058,-4.083,-4.108,-4.133,-4.158,-4.183,-4.208,-4.233,-4.258, - &-4.282,-4.307,-4.332,-4.357,-4.382,-4.407,-4.431,-4.456,-4.481, - &-4.506,-4.530,-4.555,-4.580,-4.605,-4.629,-4.654,-4.679,-4.703, - &-4.728,-4.752,-4.777,-4.802,-4.826,-4.851,-4.875,-4.900,-4.924, - &-4.949,-4.973,-4.998,-5.022,-5.047,-5.071,-5.096,-5.120,-5.145, - &-5.169,-5.193,-5.218,-5.242,-5.267,-5.291,-5.315,-5.340,-5.364, - &-5.388,-5.413,-5.437,-5.461,-5.485,-5.510,-5.534,-5.558,-5.582, - &-5.607,-5.631,-5.655,-5.679,-5.703,-5.728,-5.752,-5.776,-5.800, - &-5.824,-5.848,-5.873,-5.897,-5.921,-5.945,-5.969,-5.993,-6.017, - &-6.041,-6.065,-6.089,-6.113,-6.137,-6.161,-6.186,-6.210,-6.234, - &-6.258,-6.282,-6.306,-6.329,-6.353,-6.377,-6.401,-6.425,-6.449, - &-6.473,-6.497,-6.521,-6.545,-6.569,-6.593,-6.617,-6.641,-6.664, - &-6.688,-6.712,-6.736 - & / -C -C *** MGNO32 -C - DATA BNC22M/ - &-0.099,-0.205,-0.253,-0.283,-0.305,-0.322,-0.335,-0.345,-0.353, - &-0.359,-0.364,-0.368,-0.371,-0.374,-0.375,-0.376,-0.377,-0.377, - &-0.376,-0.376,-0.375,-0.373,-0.372,-0.370,-0.368,-0.366,-0.364, - &-0.361,-0.359,-0.356,-0.353,-0.350,-0.347,-0.344,-0.341,-0.338, - &-0.334,-0.331,-0.328,-0.324,-0.321,-0.317,-0.314,-0.310,-0.306, - &-0.303,-0.299,-0.295,-0.292,-0.288,-0.284,-0.281,-0.277,-0.273, - &-0.270,-0.266,-0.262,-0.258,-0.255,-0.251,-0.247,-0.243,-0.240, - &-0.236,-0.232,-0.228,-0.225,-0.221,-0.217,-0.213,-0.209,-0.205, - &-0.201,-0.197,-0.194,-0.190,-0.186,-0.182,-0.177,-0.173,-0.169, - &-0.165,-0.161,-0.157,-0.153,-0.148,-0.144,-0.140,-0.135,-0.131, - &-0.126,-0.122,-0.117,-0.113,-0.108,-0.104,-0.099,-0.094,-0.090, - &-0.085,-0.080,-0.075,-0.070,-0.066,-0.061,-0.056,-0.051,-0.046, - &-0.041,-0.036,-0.031,-0.026,-0.021,-0.016,-0.011,-0.006,-0.001, - & 0.004, 0.010, 0.015, 0.020, 0.025, 0.030, 0.035, 0.040, 0.045, - & 0.050, 0.056, 0.061, 0.066, 0.071, 0.076, 0.081, 0.086, 0.092, - & 0.097, 0.102, 0.107, 0.112, 0.117, 0.122, 0.127, 0.132, 0.137, - & 0.143, 0.148, 0.153, 0.158, 0.163, 0.168, 0.173, 0.178, 0.183, - & 0.188, 0.193, 0.198, 0.203, 0.208, 0.213, 0.218, 0.223, 0.228, - & 0.233, 0.238, 0.243, 0.248, 0.253, 0.258, 0.262, 0.267, 0.272, - & 0.277, 0.282, 0.287, 0.292, 0.297, 0.302, 0.306, 0.311, 0.316, - & 0.321, 0.326, 0.331, 0.335, 0.340, 0.345, 0.350, 0.354, 0.359, - & 0.364, 0.369, 0.373, 0.378, 0.383, 0.388, 0.392, 0.397, 0.402, - & 0.406, 0.411, 0.416, 0.420, 0.425, 0.430, 0.434, 0.439, 0.444, - & 0.448, 0.453, 0.457, 0.462, 0.466, 0.471, 0.476, 0.480, 0.485, - & 0.489, 0.494, 0.498, 0.503, 0.507, 0.512, 0.516, 0.521, 0.525, - & 0.530, 0.534, 0.538, 0.543, 0.547, 0.552, 0.556, 0.561, 0.565, - & 0.569, 0.574, 0.578, 0.582, 0.587, 0.591, 0.595, 0.600, 0.604, - & 0.608, 0.613, 0.617, 0.621, 0.625, 0.630, 0.634, 0.638, 0.642, - & 0.647, 0.651, 0.655, 0.659, 0.664, 0.668, 0.672, 0.676, 0.680, - & 0.684, 0.689, 0.693, 0.697, 0.701, 0.705, 0.709, 0.713, 0.717, - & 0.721, 0.726, 0.730, 0.734, 0.738, 0.742, 0.746, 0.750, 0.754, - & 0.758, 0.762, 0.766, 0.770, 0.774, 0.778, 0.782, 0.786, 0.790, - & 0.794, 0.798, 0.801, 0.805, 0.809, 0.813, 0.817, 0.821, 0.825, - & 0.829, 0.833, 0.836, 0.840, 0.844, 0.848, 0.852, 0.856, 0.859, - & 0.863, 0.867, 0.871, 0.875, 0.878, 0.882, 0.886, 0.890, 0.893, - & 0.897, 0.901, 0.905, 0.908, 0.912, 0.916, 0.919, 0.923, 0.927, - & 0.931, 0.934, 0.938, 0.941, 0.945, 0.949, 0.952, 0.956, 0.960, - & 0.963, 0.967, 0.970, 0.974, 0.978, 0.981, 0.985, 0.988, 0.992, - & 0.995, 0.999, 1.002, 1.006, 1.010, 1.013, 1.017, 1.020, 1.024, - & 1.027, 1.031, 1.034, 1.037, 1.041, 1.044, 1.048, 1.051, 1.055, - & 1.058, 1.061, 1.065, 1.068, 1.072, 1.075, 1.078, 1.082, 1.085, - & 1.089, 1.092, 1.095, 1.099, 1.102, 1.105, 1.109, 1.112, 1.115, - & 1.119, 1.122, 1.125, 1.128, 1.132, 1.135, 1.138, 1.142, 1.145, - & 1.148, 1.151, 1.155, 1.158, 1.161, 1.164, 1.167, 1.171, 1.174, - & 1.177, 1.180, 1.183, 1.187, 1.220, 1.251, 1.281, 1.311, 1.340, - & 1.369, 1.397, 1.424, 1.451, 1.477, 1.503, 1.529, 1.554, 1.579, - & 1.603, 1.627, 1.650, 1.673, 1.695, 1.717, 1.739, 1.760, 1.781, - & 1.802, 1.822, 1.842, 1.862, 1.881, 1.900, 1.918, 1.937, 1.955, - & 1.972, 1.990, 2.007, 2.024, 2.040, 2.056, 2.072, 2.088, 2.103, - & 2.119, 2.134, 2.148, 2.163, 2.177, 2.191, 2.205, 2.218, 2.231, - & 2.245, 2.257, 2.270, 2.283, 2.295, 2.307, 2.319, 2.330, 2.342, - & 2.353, 2.364, 2.375, 2.386, 2.397, 2.407, 2.417, 2.427, 2.437, - & 2.447, 2.456, 2.466, 2.475, 2.484, 2.493, 2.502, 2.511, 2.519, - & 2.528, 2.536, 2.544, 2.552, 2.560, 2.567, 2.575, 2.582, 2.590, - & 2.597, 2.604, 2.611, 2.618, 2.624, 2.631, 2.637, 2.644, 2.650, - & 2.656, 2.662, 2.668, 2.674, 2.680, 2.685, 2.691, 2.696, 2.701, - & 2.706, 2.712, 2.717, 2.721, 2.726, 2.731, 2.735, 2.740, 2.744, - & 2.749, 2.753, 2.757, 2.761, 2.765, 2.769, 2.773, 2.777, 2.780, - & 2.784, 2.787, 2.791, 2.794, 2.797, 2.801, 2.804, 2.807, 2.810, - & 2.812, 2.815, 2.818, 2.821, 2.823, 2.826, 2.828, 2.831, 2.833, - & 2.835, 2.837, 2.839, 2.841, 2.843, 2.845, 2.847, 2.849, 2.851, - & 2.852, 2.854, 2.856, 2.857, 2.859, 2.860, 2.861, 2.862, 2.864, - & 2.865, 2.866, 2.867 - & / -C -C *** MGCL2 -C - DATA BNC23M/ - &-0.098,-0.202,-0.247,-0.275,-0.294,-0.308,-0.319,-0.327,-0.333, - &-0.337,-0.340,-0.342,-0.343,-0.343,-0.343,-0.341,-0.340,-0.338, - &-0.336,-0.333,-0.330,-0.326,-0.323,-0.319,-0.315,-0.311,-0.306, - &-0.302,-0.297,-0.293,-0.288,-0.283,-0.278,-0.273,-0.267,-0.262, - &-0.257,-0.251,-0.246,-0.241,-0.235,-0.230,-0.224,-0.218,-0.213, - &-0.207,-0.202,-0.196,-0.190,-0.185,-0.179,-0.174,-0.168,-0.162, - &-0.157,-0.151,-0.145,-0.140,-0.134,-0.128,-0.123,-0.117,-0.111, - &-0.106,-0.100,-0.094,-0.089,-0.083,-0.077,-0.071,-0.066,-0.060, - &-0.054,-0.048,-0.042,-0.037,-0.031,-0.025,-0.019,-0.013,-0.007, - &-0.001, 0.006, 0.012, 0.018, 0.024, 0.030, 0.037, 0.043, 0.049, - & 0.056, 0.062, 0.069, 0.075, 0.082, 0.089, 0.095, 0.102, 0.109, - & 0.116, 0.122, 0.129, 0.136, 0.143, 0.150, 0.157, 0.164, 0.171, - & 0.178, 0.185, 0.192, 0.199, 0.207, 0.214, 0.221, 0.228, 0.235, - & 0.242, 0.250, 0.257, 0.264, 0.271, 0.278, 0.286, 0.293, 0.300, - & 0.307, 0.315, 0.322, 0.329, 0.336, 0.344, 0.351, 0.358, 0.365, - & 0.372, 0.380, 0.387, 0.394, 0.401, 0.408, 0.416, 0.423, 0.430, - & 0.437, 0.444, 0.451, 0.458, 0.466, 0.473, 0.480, 0.487, 0.494, - & 0.501, 0.508, 0.515, 0.522, 0.529, 0.536, 0.543, 0.550, 0.557, - & 0.564, 0.571, 0.578, 0.585, 0.592, 0.599, 0.606, 0.613, 0.620, - & 0.626, 0.633, 0.640, 0.647, 0.654, 0.661, 0.667, 0.674, 0.681, - & 0.688, 0.695, 0.701, 0.708, 0.715, 0.722, 0.728, 0.735, 0.742, - & 0.748, 0.755, 0.762, 0.768, 0.775, 0.782, 0.788, 0.795, 0.801, - & 0.808, 0.815, 0.821, 0.828, 0.834, 0.841, 0.847, 0.854, 0.860, - & 0.867, 0.873, 0.879, 0.886, 0.892, 0.899, 0.905, 0.912, 0.918, - & 0.924, 0.931, 0.937, 0.943, 0.950, 0.956, 0.962, 0.968, 0.975, - & 0.981, 0.987, 0.993, 1.000, 1.006, 1.012, 1.018, 1.024, 1.031, - & 1.037, 1.043, 1.049, 1.055, 1.061, 1.067, 1.073, 1.080, 1.086, - & 1.092, 1.098, 1.104, 1.110, 1.116, 1.122, 1.128, 1.134, 1.140, - & 1.146, 1.151, 1.157, 1.163, 1.169, 1.175, 1.181, 1.187, 1.193, - & 1.199, 1.204, 1.210, 1.216, 1.222, 1.228, 1.233, 1.239, 1.245, - & 1.251, 1.256, 1.262, 1.268, 1.273, 1.279, 1.285, 1.291, 1.296, - & 1.302, 1.307, 1.313, 1.319, 1.324, 1.330, 1.335, 1.341, 1.347, - & 1.352, 1.358, 1.363, 1.369, 1.374, 1.380, 1.385, 1.391, 1.396, - & 1.402, 1.407, 1.412, 1.418, 1.423, 1.429, 1.434, 1.439, 1.445, - & 1.450, 1.455, 1.461, 1.466, 1.471, 1.477, 1.482, 1.487, 1.493, - & 1.498, 1.503, 1.508, 1.514, 1.519, 1.524, 1.529, 1.534, 1.540, - & 1.545, 1.550, 1.555, 1.560, 1.565, 1.570, 1.576, 1.581, 1.586, - & 1.591, 1.596, 1.601, 1.606, 1.611, 1.616, 1.621, 1.626, 1.631, - & 1.636, 1.641, 1.646, 1.651, 1.656, 1.661, 1.666, 1.671, 1.676, - & 1.681, 1.686, 1.691, 1.695, 1.700, 1.705, 1.710, 1.715, 1.720, - & 1.725, 1.729, 1.734, 1.739, 1.744, 1.749, 1.753, 1.758, 1.763, - & 1.768, 1.772, 1.777, 1.782, 1.786, 1.791, 1.796, 1.801, 1.805, - & 1.810, 1.815, 1.819, 1.824, 1.829, 1.833, 1.838, 1.842, 1.847, - & 1.852, 1.856, 1.861, 1.865, 1.870, 1.874, 1.879, 1.883, 1.888, - & 1.892, 1.897, 1.902, 1.906, 1.954, 1.998, 2.040, 2.082, 2.124, - & 2.164, 2.204, 2.243, 2.282, 2.319, 2.356, 2.393, 2.429, 2.464, - & 2.499, 2.533, 2.567, 2.600, 2.632, 2.664, 2.695, 2.726, 2.757, - & 2.787, 2.816, 2.845, 2.874, 2.902, 2.930, 2.957, 2.984, 3.010, - & 3.036, 3.062, 3.087, 3.112, 3.137, 3.161, 3.185, 3.208, 3.232, - & 3.254, 3.277, 3.299, 3.321, 3.342, 3.364, 3.385, 3.405, 3.426, - & 3.446, 3.466, 3.485, 3.504, 3.523, 3.542, 3.561, 3.579, 3.597, - & 3.615, 3.632, 3.649, 3.666, 3.683, 3.700, 3.716, 3.732, 3.748, - & 3.764, 3.779, 3.795, 3.810, 3.825, 3.839, 3.854, 3.868, 3.882, - & 3.896, 3.910, 3.924, 3.937, 3.950, 3.964, 3.976, 3.989, 4.002, - & 4.014, 4.026, 4.039, 4.050, 4.062, 4.074, 4.085, 4.097, 4.108, - & 4.119, 4.130, 4.141, 4.151, 4.162, 4.172, 4.182, 4.192, 4.202, - & 4.212, 4.222, 4.231, 4.241, 4.250, 4.259, 4.268, 4.277, 4.286, - & 4.295, 4.304, 4.312, 4.321, 4.329, 4.337, 4.345, 4.353, 4.361, - & 4.369, 4.376, 4.384, 4.391, 4.399, 4.406, 4.413, 4.420, 4.427, - & 4.434, 4.441, 4.447, 4.454, 4.460, 4.467, 4.473, 4.479, 4.485, - & 4.491, 4.497, 4.503, 4.509, 4.515, 4.520, 4.526, 4.531, 4.537, - & 4.542, 4.547, 4.552, 4.557, 4.562, 4.567, 4.572, 4.577, 4.582, - & 4.586, 4.591, 4.595 - & / - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE KM223 (IONIC, BINARR) -C -C *** Common block definition -C - COMMON /KMC223/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL Binarr (23), Ionic -C -C *** Find position in arrays for bincoef -C - IF (Ionic.LE. 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) -C -C *** Assign values to return array -C - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) -C -C *** Return point ; End of subroutine -C - RETURN - END - - - BLOCK DATA KMCF223 -C -C *** Common block definition -C - COMMON /KMC223/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - -C -C *** NaCl -C - DATA BNC01M/ - &-0.049,-0.101,-0.124,-0.140,-0.151,-0.159,-0.166,-0.171,-0.175, - &-0.178,-0.181,-0.183,-0.185,-0.187,-0.188,-0.188,-0.189,-0.189, - &-0.189,-0.189,-0.189,-0.189,-0.188,-0.187,-0.187,-0.186,-0.185, - &-0.184,-0.183,-0.182,-0.181,-0.180,-0.178,-0.177,-0.176,-0.174, - &-0.173,-0.172,-0.170,-0.169,-0.167,-0.166,-0.164,-0.163,-0.161, - &-0.159,-0.158,-0.156,-0.155,-0.153,-0.151,-0.150,-0.148,-0.147, - &-0.145,-0.143,-0.142,-0.140,-0.138,-0.137,-0.135,-0.134,-0.132, - &-0.130,-0.128,-0.127,-0.125,-0.123,-0.122,-0.120,-0.118,-0.117, - &-0.115,-0.113,-0.111,-0.110,-0.108,-0.106,-0.104,-0.102,-0.101, - &-0.099,-0.097,-0.095,-0.093,-0.091,-0.089,-0.087,-0.085,-0.083, - &-0.081,-0.079,-0.077,-0.075,-0.073,-0.071,-0.069,-0.067,-0.065, - &-0.063,-0.061,-0.058,-0.056,-0.054,-0.052,-0.050,-0.048,-0.045, - &-0.043,-0.041,-0.039,-0.036,-0.034,-0.032,-0.030,-0.027,-0.025, - &-0.023,-0.020,-0.018,-0.016,-0.014,-0.011,-0.009,-0.007,-0.004, - &-0.002, 0.000, 0.003, 0.005, 0.007, 0.010, 0.012, 0.014, 0.016, - & 0.019, 0.021, 0.023, 0.026, 0.028, 0.030, 0.033, 0.035, 0.037, - & 0.039, 0.042, 0.044, 0.046, 0.049, 0.051, 0.053, 0.055, 0.058, - & 0.060, 0.062, 0.064, 0.067, 0.069, 0.071, 0.073, 0.076, 0.078, - & 0.080, 0.082, 0.085, 0.087, 0.089, 0.091, 0.094, 0.096, 0.098, - & 0.100, 0.102, 0.105, 0.107, 0.109, 0.111, 0.113, 0.116, 0.118, - & 0.120, 0.122, 0.124, 0.126, 0.129, 0.131, 0.133, 0.135, 0.137, - & 0.139, 0.142, 0.144, 0.146, 0.148, 0.150, 0.152, 0.154, 0.157, - & 0.159, 0.161, 0.163, 0.165, 0.167, 0.169, 0.171, 0.173, 0.175, - & 0.178, 0.180, 0.182, 0.184, 0.186, 0.188, 0.190, 0.192, 0.194, - & 0.196, 0.198, 0.200, 0.202, 0.204, 0.206, 0.208, 0.211, 0.213, - & 0.215, 0.217, 0.219, 0.221, 0.223, 0.225, 0.227, 0.229, 0.231, - & 0.233, 0.235, 0.237, 0.239, 0.241, 0.243, 0.245, 0.246, 0.248, - & 0.250, 0.252, 0.254, 0.256, 0.258, 0.260, 0.262, 0.264, 0.266, - & 0.268, 0.270, 0.272, 0.274, 0.276, 0.277, 0.279, 0.281, 0.283, - & 0.285, 0.287, 0.289, 0.291, 0.293, 0.295, 0.296, 0.298, 0.300, - & 0.302, 0.304, 0.306, 0.308, 0.309, 0.311, 0.313, 0.315, 0.317, - & 0.319, 0.320, 0.322, 0.324, 0.326, 0.328, 0.330, 0.331, 0.333, - & 0.335, 0.337, 0.339, 0.340, 0.342, 0.344, 0.346, 0.348, 0.349, - & 0.351, 0.353, 0.355, 0.356, 0.358, 0.360, 0.362, 0.363, 0.365, - & 0.367, 0.369, 0.370, 0.372, 0.374, 0.376, 0.377, 0.379, 0.381, - & 0.383, 0.384, 0.386, 0.388, 0.389, 0.391, 0.393, 0.394, 0.396, - & 0.398, 0.400, 0.401, 0.403, 0.405, 0.406, 0.408, 0.410, 0.411, - & 0.413, 0.415, 0.416, 0.418, 0.420, 0.421, 0.423, 0.424, 0.426, - & 0.428, 0.429, 0.431, 0.433, 0.434, 0.436, 0.437, 0.439, 0.441, - & 0.442, 0.444, 0.446, 0.447, 0.449, 0.450, 0.452, 0.453, 0.455, - & 0.457, 0.458, 0.460, 0.461, 0.463, 0.464, 0.466, 0.468, 0.469, - & 0.471, 0.472, 0.474, 0.475, 0.477, 0.478, 0.480, 0.482, 0.483, - & 0.485, 0.486, 0.488, 0.489, 0.491, 0.492, 0.494, 0.495, 0.497, - & 0.498, 0.500, 0.501, 0.503, 0.504, 0.506, 0.507, 0.509, 0.510, - & 0.512, 0.513, 0.515, 0.516, 0.532, 0.546, 0.560, 0.574, 0.588, - & 0.601, 0.614, 0.627, 0.639, 0.652, 0.664, 0.676, 0.688, 0.700, - & 0.711, 0.722, 0.733, 0.744, 0.755, 0.765, 0.776, 0.786, 0.796, - & 0.806, 0.816, 0.825, 0.835, 0.844, 0.853, 0.862, 0.871, 0.880, - & 0.888, 0.897, 0.905, 0.913, 0.921, 0.929, 0.937, 0.945, 0.952, - & 0.960, 0.967, 0.975, 0.982, 0.989, 0.996, 1.003, 1.009, 1.016, - & 1.023, 1.029, 1.036, 1.042, 1.048, 1.054, 1.060, 1.066, 1.072, - & 1.078, 1.084, 1.089, 1.095, 1.100, 1.106, 1.111, 1.116, 1.121, - & 1.126, 1.131, 1.136, 1.141, 1.146, 1.151, 1.156, 1.160, 1.165, - & 1.169, 1.174, 1.178, 1.182, 1.187, 1.191, 1.195, 1.199, 1.203, - & 1.207, 1.211, 1.215, 1.219, 1.223, 1.226, 1.230, 1.234, 1.237, - & 1.241, 1.244, 1.247, 1.251, 1.254, 1.257, 1.261, 1.264, 1.267, - & 1.270, 1.273, 1.276, 1.279, 1.282, 1.285, 1.288, 1.291, 1.293, - & 1.296, 1.299, 1.301, 1.304, 1.306, 1.309, 1.311, 1.314, 1.316, - & 1.319, 1.321, 1.323, 1.326, 1.328, 1.330, 1.332, 1.334, 1.336, - & 1.339, 1.341, 1.343, 1.345, 1.347, 1.348, 1.350, 1.352, 1.354, - & 1.356, 1.358, 1.359, 1.361, 1.363, 1.364, 1.366, 1.368, 1.369, - & 1.371, 1.372, 1.374, 1.375, 1.377, 1.378, 1.379, 1.381, 1.382, - & 1.383, 1.385, 1.386 - & / -C -C *** Na2SO4 -C - DATA BNC02M/ - &-0.100,-0.220,-0.280,-0.323,-0.357,-0.385,-0.409,-0.431,-0.450, - &-0.468,-0.484,-0.499,-0.513,-0.526,-0.538,-0.549,-0.560,-0.571, - &-0.581,-0.590,-0.600,-0.608,-0.617,-0.625,-0.633,-0.641,-0.648, - &-0.655,-0.662,-0.669,-0.676,-0.682,-0.689,-0.695,-0.701,-0.707, - &-0.713,-0.718,-0.724,-0.729,-0.735,-0.740,-0.745,-0.750,-0.755, - &-0.760,-0.765,-0.769,-0.774,-0.779,-0.783,-0.788,-0.792,-0.796, - &-0.800,-0.805,-0.809,-0.813,-0.817,-0.821,-0.825,-0.829,-0.833, - &-0.836,-0.840,-0.844,-0.848,-0.851,-0.855,-0.858,-0.862,-0.866, - &-0.869,-0.873,-0.876,-0.879,-0.883,-0.886,-0.889,-0.893,-0.896, - &-0.899,-0.902,-0.906,-0.909,-0.912,-0.915,-0.918,-0.921,-0.924, - &-0.927,-0.930,-0.933,-0.936,-0.939,-0.942,-0.945,-0.948,-0.951, - &-0.954,-0.957,-0.960,-0.963,-0.966,-0.968,-0.971,-0.974,-0.977, - &-0.980,-0.982,-0.985,-0.988,-0.991,-0.993,-0.996,-0.999,-1.001, - &-1.004,-1.007,-1.009,-1.012,-1.015,-1.017,-1.020,-1.022,-1.025, - &-1.028,-1.030,-1.033,-1.035,-1.038,-1.040,-1.043,-1.045,-1.048, - &-1.050,-1.053,-1.055,-1.058,-1.060,-1.062,-1.065,-1.067,-1.070, - &-1.072,-1.074,-1.077,-1.079,-1.082,-1.084,-1.086,-1.089,-1.091, - &-1.093,-1.096,-1.098,-1.100,-1.102,-1.105,-1.107,-1.109,-1.112, - &-1.114,-1.116,-1.118,-1.121,-1.123,-1.125,-1.127,-1.129,-1.132, - &-1.134,-1.136,-1.138,-1.140,-1.143,-1.145,-1.147,-1.149,-1.151, - &-1.153,-1.155,-1.158,-1.160,-1.162,-1.164,-1.166,-1.168,-1.170, - &-1.172,-1.174,-1.177,-1.179,-1.181,-1.183,-1.185,-1.187,-1.189, - &-1.191,-1.193,-1.195,-1.197,-1.199,-1.201,-1.203,-1.205,-1.207, - &-1.209,-1.211,-1.213,-1.215,-1.217,-1.219,-1.221,-1.223,-1.225, - &-1.227,-1.229,-1.231,-1.233,-1.235,-1.237,-1.239,-1.241,-1.243, - &-1.245,-1.247,-1.248,-1.250,-1.252,-1.254,-1.256,-1.258,-1.260, - &-1.262,-1.264,-1.266,-1.268,-1.269,-1.271,-1.273,-1.275,-1.277, - &-1.279,-1.281,-1.283,-1.284,-1.286,-1.288,-1.290,-1.292,-1.294, - &-1.296,-1.297,-1.299,-1.301,-1.303,-1.305,-1.306,-1.308,-1.310, - &-1.312,-1.314,-1.316,-1.317,-1.319,-1.321,-1.323,-1.325,-1.326, - &-1.328,-1.330,-1.332,-1.333,-1.335,-1.337,-1.339,-1.341,-1.342, - &-1.344,-1.346,-1.348,-1.349,-1.351,-1.353,-1.355,-1.356,-1.358, - &-1.360,-1.362,-1.363,-1.365,-1.367,-1.369,-1.370,-1.372,-1.374, - &-1.375,-1.377,-1.379,-1.381,-1.382,-1.384,-1.386,-1.387,-1.389, - &-1.391,-1.393,-1.394,-1.396,-1.398,-1.399,-1.401,-1.403,-1.404, - &-1.406,-1.408,-1.409,-1.411,-1.413,-1.414,-1.416,-1.418,-1.419, - &-1.421,-1.423,-1.424,-1.426,-1.428,-1.429,-1.431,-1.433,-1.434, - &-1.436,-1.438,-1.439,-1.441,-1.442,-1.444,-1.446,-1.447,-1.449, - &-1.451,-1.452,-1.454,-1.456,-1.457,-1.459,-1.460,-1.462,-1.464, - &-1.465,-1.467,-1.468,-1.470,-1.472,-1.473,-1.475,-1.476,-1.478, - &-1.480,-1.481,-1.483,-1.484,-1.486,-1.488,-1.489,-1.491,-1.492, - &-1.494,-1.496,-1.497,-1.499,-1.500,-1.502,-1.503,-1.505,-1.507, - &-1.508,-1.510,-1.511,-1.513,-1.514,-1.516,-1.518,-1.519,-1.521, - &-1.522,-1.524,-1.525,-1.527,-1.528,-1.530,-1.531,-1.533,-1.535, - &-1.536,-1.538,-1.539,-1.541,-1.557,-1.572,-1.587,-1.602,-1.617, - &-1.632,-1.647,-1.661,-1.675,-1.690,-1.704,-1.718,-1.732,-1.746, - &-1.760,-1.774,-1.787,-1.801,-1.815,-1.828,-1.841,-1.855,-1.868, - &-1.881,-1.895,-1.908,-1.921,-1.934,-1.947,-1.960,-1.972,-1.985, - &-1.998,-2.011,-2.023,-2.036,-2.048,-2.061,-2.074,-2.086,-2.098, - &-2.111,-2.123,-2.135,-2.148,-2.160,-2.172,-2.184,-2.196,-2.208, - &-2.220,-2.232,-2.244,-2.256,-2.268,-2.280,-2.292,-2.304,-2.315, - &-2.327,-2.339,-2.351,-2.362,-2.374,-2.386,-2.397,-2.409,-2.420, - &-2.432,-2.443,-2.455,-2.466,-2.478,-2.489,-2.501,-2.512,-2.523, - &-2.535,-2.546,-2.557,-2.568,-2.580,-2.591,-2.602,-2.613,-2.625, - &-2.636,-2.647,-2.658,-2.669,-2.680,-2.691,-2.702,-2.713,-2.724, - &-2.735,-2.746,-2.757,-2.768,-2.779,-2.790,-2.801,-2.812,-2.823, - &-2.833,-2.844,-2.855,-2.866,-2.877,-2.888,-2.898,-2.909,-2.920, - &-2.930,-2.941,-2.952,-2.963,-2.973,-2.984,-2.995,-3.005,-3.016, - &-3.026,-3.037,-3.048,-3.058,-3.069,-3.079,-3.090,-3.100,-3.111, - &-3.121,-3.132,-3.142,-3.153,-3.163,-3.174,-3.184,-3.195,-3.205, - &-3.215,-3.226,-3.236,-3.247,-3.257,-3.267,-3.278,-3.288,-3.298, - &-3.309,-3.319,-3.329,-3.340,-3.350,-3.360,-3.370,-3.381,-3.391, - &-3.401,-3.411,-3.422 - & / -C -C *** NaNO3 -C - DATA BNC03M/ - &-0.050,-0.111,-0.141,-0.164,-0.181,-0.196,-0.209,-0.220,-0.230, - &-0.239,-0.248,-0.256,-0.263,-0.270,-0.277,-0.283,-0.289,-0.295, - &-0.300,-0.306,-0.311,-0.316,-0.320,-0.325,-0.329,-0.334,-0.338, - &-0.342,-0.346,-0.350,-0.353,-0.357,-0.360,-0.364,-0.367,-0.371, - &-0.374,-0.377,-0.380,-0.384,-0.387,-0.390,-0.392,-0.395,-0.398, - &-0.401,-0.404,-0.406,-0.409,-0.412,-0.414,-0.417,-0.419,-0.422, - &-0.424,-0.427,-0.429,-0.432,-0.434,-0.436,-0.438,-0.441,-0.443, - &-0.445,-0.447,-0.449,-0.452,-0.454,-0.456,-0.458,-0.460,-0.462, - &-0.464,-0.466,-0.468,-0.470,-0.472,-0.474,-0.476,-0.478,-0.480, - &-0.482,-0.484,-0.485,-0.487,-0.489,-0.491,-0.493,-0.495,-0.496, - &-0.498,-0.500,-0.502,-0.504,-0.505,-0.507,-0.509,-0.511,-0.512, - &-0.514,-0.516,-0.518,-0.519,-0.521,-0.523,-0.524,-0.526,-0.528, - &-0.529,-0.531,-0.533,-0.534,-0.536,-0.538,-0.539,-0.541,-0.543, - &-0.544,-0.546,-0.547,-0.549,-0.551,-0.552,-0.554,-0.555,-0.557, - &-0.558,-0.560,-0.561,-0.563,-0.564,-0.566,-0.568,-0.569,-0.571, - &-0.572,-0.574,-0.575,-0.576,-0.578,-0.579,-0.581,-0.582,-0.584, - &-0.585,-0.587,-0.588,-0.590,-0.591,-0.592,-0.594,-0.595,-0.597, - &-0.598,-0.600,-0.601,-0.602,-0.604,-0.605,-0.606,-0.608,-0.609, - &-0.611,-0.612,-0.613,-0.615,-0.616,-0.617,-0.619,-0.620,-0.621, - &-0.623,-0.624,-0.625,-0.627,-0.628,-0.629,-0.631,-0.632,-0.633, - &-0.635,-0.636,-0.637,-0.638,-0.640,-0.641,-0.642,-0.643,-0.645, - &-0.646,-0.647,-0.649,-0.650,-0.651,-0.652,-0.654,-0.655,-0.656, - &-0.657,-0.659,-0.660,-0.661,-0.662,-0.663,-0.665,-0.666,-0.667, - &-0.668,-0.670,-0.671,-0.672,-0.673,-0.674,-0.676,-0.677,-0.678, - &-0.679,-0.680,-0.681,-0.683,-0.684,-0.685,-0.686,-0.687,-0.689, - &-0.690,-0.691,-0.692,-0.693,-0.694,-0.695,-0.697,-0.698,-0.699, - &-0.700,-0.701,-0.702,-0.703,-0.705,-0.706,-0.707,-0.708,-0.709, - &-0.710,-0.711,-0.712,-0.714,-0.715,-0.716,-0.717,-0.718,-0.719, - &-0.720,-0.721,-0.722,-0.724,-0.725,-0.726,-0.727,-0.728,-0.729, - &-0.730,-0.731,-0.732,-0.733,-0.734,-0.736,-0.737,-0.738,-0.739, - &-0.740,-0.741,-0.742,-0.743,-0.744,-0.745,-0.746,-0.747,-0.748, - &-0.749,-0.750,-0.751,-0.753,-0.754,-0.755,-0.756,-0.757,-0.758, - &-0.759,-0.760,-0.761,-0.762,-0.763,-0.764,-0.765,-0.766,-0.767, - &-0.768,-0.769,-0.770,-0.771,-0.772,-0.773,-0.774,-0.775,-0.776, - &-0.777,-0.778,-0.779,-0.780,-0.781,-0.782,-0.783,-0.784,-0.785, - &-0.786,-0.787,-0.788,-0.789,-0.790,-0.791,-0.792,-0.793,-0.794, - &-0.795,-0.796,-0.797,-0.798,-0.799,-0.800,-0.801,-0.802,-0.803, - &-0.804,-0.805,-0.806,-0.807,-0.808,-0.809,-0.810,-0.811,-0.812, - &-0.813,-0.814,-0.815,-0.816,-0.817,-0.818,-0.818,-0.819,-0.820, - &-0.821,-0.822,-0.823,-0.824,-0.825,-0.826,-0.827,-0.828,-0.829, - &-0.830,-0.831,-0.832,-0.833,-0.834,-0.835,-0.835,-0.836,-0.837, - &-0.838,-0.839,-0.840,-0.841,-0.842,-0.843,-0.844,-0.845,-0.846, - &-0.847,-0.848,-0.848,-0.849,-0.850,-0.851,-0.852,-0.853,-0.854, - &-0.855,-0.856,-0.857,-0.858,-0.859,-0.859,-0.860,-0.861,-0.862, - &-0.863,-0.864,-0.865,-0.866,-0.875,-0.884,-0.893,-0.902,-0.910, - &-0.919,-0.927,-0.936,-0.944,-0.952,-0.961,-0.969,-0.977,-0.985, - &-0.993,-1.001,-1.008,-1.016,-1.024,-1.032,-1.039,-1.047,-1.054, - &-1.062,-1.069,-1.077,-1.084,-1.092,-1.099,-1.106,-1.113,-1.121, - &-1.128,-1.135,-1.142,-1.149,-1.156,-1.163,-1.170,-1.177,-1.184, - &-1.191,-1.198,-1.204,-1.211,-1.218,-1.225,-1.231,-1.238,-1.245, - &-1.251,-1.258,-1.265,-1.271,-1.278,-1.284,-1.291,-1.297,-1.304, - &-1.310,-1.317,-1.323,-1.330,-1.336,-1.342,-1.349,-1.355,-1.361, - &-1.368,-1.374,-1.380,-1.386,-1.393,-1.399,-1.405,-1.411,-1.417, - &-1.423,-1.430,-1.436,-1.442,-1.448,-1.454,-1.460,-1.466,-1.472, - &-1.478,-1.484,-1.490,-1.496,-1.502,-1.508,-1.514,-1.520,-1.526, - &-1.532,-1.538,-1.543,-1.549,-1.555,-1.561,-1.567,-1.573,-1.578, - &-1.584,-1.590,-1.596,-1.602,-1.607,-1.613,-1.619,-1.625,-1.630, - &-1.636,-1.642,-1.648,-1.653,-1.659,-1.665,-1.670,-1.676,-1.682, - &-1.687,-1.693,-1.698,-1.704,-1.710,-1.715,-1.721,-1.726,-1.732, - &-1.738,-1.743,-1.749,-1.754,-1.760,-1.765,-1.771,-1.776,-1.782, - &-1.787,-1.793,-1.798,-1.804,-1.809,-1.815,-1.820,-1.826,-1.831, - &-1.837,-1.842,-1.847,-1.853,-1.858,-1.864,-1.869,-1.875,-1.880, - &-1.885,-1.891,-1.896 - & / -C -C *** (NH4)2SO4 -C - DATA BNC04M/ - &-0.101,-0.220,-0.281,-0.324,-0.358,-0.387,-0.412,-0.434,-0.453, - &-0.471,-0.487,-0.503,-0.517,-0.530,-0.543,-0.555,-0.566,-0.577, - &-0.587,-0.597,-0.606,-0.615,-0.624,-0.632,-0.641,-0.649,-0.656, - &-0.664,-0.671,-0.678,-0.685,-0.692,-0.698,-0.705,-0.711,-0.717, - &-0.723,-0.729,-0.735,-0.740,-0.746,-0.752,-0.757,-0.762,-0.767, - &-0.772,-0.777,-0.782,-0.787,-0.792,-0.797,-0.801,-0.806,-0.810, - &-0.815,-0.819,-0.824,-0.828,-0.832,-0.836,-0.840,-0.844,-0.848, - &-0.852,-0.856,-0.860,-0.864,-0.868,-0.872,-0.876,-0.879,-0.883, - &-0.887,-0.890,-0.894,-0.897,-0.901,-0.904,-0.908,-0.911,-0.915, - &-0.918,-0.922,-0.925,-0.928,-0.932,-0.935,-0.938,-0.942,-0.945, - &-0.948,-0.951,-0.954,-0.958,-0.961,-0.964,-0.967,-0.970,-0.973, - &-0.976,-0.979,-0.982,-0.985,-0.988,-0.991,-0.994,-0.997,-1.000, - &-1.003,-1.006,-1.009,-1.012,-1.015,-1.018,-1.021,-1.024,-1.026, - &-1.029,-1.032,-1.035,-1.038,-1.040,-1.043,-1.046,-1.049,-1.051, - &-1.054,-1.057,-1.060,-1.062,-1.065,-1.068,-1.070,-1.073,-1.076, - &-1.078,-1.081,-1.083,-1.086,-1.089,-1.091,-1.094,-1.096,-1.099, - &-1.102,-1.104,-1.107,-1.109,-1.112,-1.114,-1.117,-1.119,-1.122, - &-1.124,-1.127,-1.129,-1.131,-1.134,-1.136,-1.139,-1.141,-1.144, - &-1.146,-1.148,-1.151,-1.153,-1.155,-1.158,-1.160,-1.163,-1.165, - &-1.167,-1.170,-1.172,-1.174,-1.177,-1.179,-1.181,-1.183,-1.186, - &-1.188,-1.190,-1.193,-1.195,-1.197,-1.199,-1.202,-1.204,-1.206, - &-1.208,-1.210,-1.213,-1.215,-1.217,-1.219,-1.221,-1.224,-1.226, - &-1.228,-1.230,-1.232,-1.235,-1.237,-1.239,-1.241,-1.243,-1.245, - &-1.247,-1.250,-1.252,-1.254,-1.256,-1.258,-1.260,-1.262,-1.264, - &-1.266,-1.269,-1.271,-1.273,-1.275,-1.277,-1.279,-1.281,-1.283, - &-1.285,-1.287,-1.289,-1.291,-1.293,-1.295,-1.297,-1.299,-1.301, - &-1.303,-1.305,-1.307,-1.309,-1.311,-1.313,-1.315,-1.317,-1.319, - &-1.321,-1.323,-1.325,-1.327,-1.329,-1.331,-1.333,-1.335,-1.337, - &-1.339,-1.341,-1.343,-1.345,-1.347,-1.349,-1.351,-1.353,-1.355, - &-1.357,-1.358,-1.360,-1.362,-1.364,-1.366,-1.368,-1.370,-1.372, - &-1.374,-1.376,-1.377,-1.379,-1.381,-1.383,-1.385,-1.387,-1.389, - &-1.391,-1.392,-1.394,-1.396,-1.398,-1.400,-1.402,-1.404,-1.405, - &-1.407,-1.409,-1.411,-1.413,-1.415,-1.417,-1.418,-1.420,-1.422, - &-1.424,-1.426,-1.427,-1.429,-1.431,-1.433,-1.435,-1.437,-1.438, - &-1.440,-1.442,-1.444,-1.445,-1.447,-1.449,-1.451,-1.453,-1.454, - &-1.456,-1.458,-1.460,-1.462,-1.463,-1.465,-1.467,-1.469,-1.470, - &-1.472,-1.474,-1.476,-1.477,-1.479,-1.481,-1.483,-1.484,-1.486, - &-1.488,-1.490,-1.491,-1.493,-1.495,-1.496,-1.498,-1.500,-1.502, - &-1.503,-1.505,-1.507,-1.509,-1.510,-1.512,-1.514,-1.515,-1.517, - &-1.519,-1.520,-1.522,-1.524,-1.526,-1.527,-1.529,-1.531,-1.532, - &-1.534,-1.536,-1.537,-1.539,-1.541,-1.542,-1.544,-1.546,-1.547, - &-1.549,-1.551,-1.552,-1.554,-1.556,-1.557,-1.559,-1.561,-1.562, - &-1.564,-1.566,-1.567,-1.569,-1.571,-1.572,-1.574,-1.576,-1.577, - &-1.579,-1.580,-1.582,-1.584,-1.585,-1.587,-1.589,-1.590,-1.592, - &-1.594,-1.595,-1.597,-1.598,-1.616,-1.632,-1.648,-1.663,-1.679, - &-1.694,-1.710,-1.725,-1.740,-1.755,-1.770,-1.785,-1.799,-1.814, - &-1.828,-1.843,-1.857,-1.871,-1.885,-1.900,-1.914,-1.928,-1.941, - &-1.955,-1.969,-1.983,-1.996,-2.010,-2.023,-2.037,-2.050,-2.063, - &-2.077,-2.090,-2.103,-2.116,-2.129,-2.142,-2.155,-2.168,-2.181, - &-2.194,-2.206,-2.219,-2.232,-2.244,-2.257,-2.269,-2.282,-2.294, - &-2.307,-2.319,-2.332,-2.344,-2.356,-2.369,-2.381,-2.393,-2.405, - &-2.417,-2.429,-2.441,-2.454,-2.466,-2.478,-2.489,-2.501,-2.513, - &-2.525,-2.537,-2.549,-2.561,-2.572,-2.584,-2.596,-2.608,-2.619, - &-2.631,-2.642,-2.654,-2.666,-2.677,-2.689,-2.700,-2.712,-2.723, - &-2.735,-2.746,-2.757,-2.769,-2.780,-2.792,-2.803,-2.814,-2.825, - &-2.837,-2.848,-2.859,-2.870,-2.882,-2.893,-2.904,-2.915,-2.926, - &-2.937,-2.948,-2.959,-2.971,-2.982,-2.993,-3.004,-3.015,-3.026, - &-3.037,-3.048,-3.058,-3.069,-3.080,-3.091,-3.102,-3.113,-3.124, - &-3.135,-3.145,-3.156,-3.167,-3.178,-3.189,-3.199,-3.210,-3.221, - &-3.232,-3.242,-3.253,-3.264,-3.274,-3.285,-3.296,-3.306,-3.317, - &-3.327,-3.338,-3.349,-3.359,-3.370,-3.380,-3.391,-3.401,-3.412, - &-3.422,-3.433,-3.443,-3.454,-3.464,-3.475,-3.485,-3.496,-3.506, - &-3.517,-3.527,-3.537 - & / -C -C *** NH4NO3 -C - DATA BNC05M/ - &-0.051,-0.114,-0.148,-0.172,-0.192,-0.209,-0.224,-0.238,-0.250, - &-0.262,-0.272,-0.282,-0.292,-0.301,-0.310,-0.318,-0.326,-0.333, - &-0.341,-0.348,-0.355,-0.362,-0.368,-0.375,-0.381,-0.387,-0.393, - &-0.398,-0.404,-0.410,-0.415,-0.420,-0.426,-0.431,-0.436,-0.441, - &-0.446,-0.450,-0.455,-0.460,-0.464,-0.469,-0.473,-0.477,-0.482, - &-0.486,-0.490,-0.494,-0.498,-0.502,-0.506,-0.510,-0.514,-0.518, - &-0.521,-0.525,-0.529,-0.532,-0.536,-0.539,-0.543,-0.546,-0.550, - &-0.553,-0.556,-0.560,-0.563,-0.566,-0.570,-0.573,-0.576,-0.579, - &-0.582,-0.585,-0.588,-0.592,-0.595,-0.598,-0.601,-0.604,-0.607, - &-0.610,-0.613,-0.616,-0.619,-0.622,-0.624,-0.627,-0.630,-0.633, - &-0.636,-0.639,-0.642,-0.645,-0.647,-0.650,-0.653,-0.656,-0.659, - &-0.662,-0.664,-0.667,-0.670,-0.673,-0.675,-0.678,-0.681,-0.684, - &-0.686,-0.689,-0.692,-0.694,-0.697,-0.700,-0.702,-0.705,-0.708, - &-0.710,-0.713,-0.716,-0.718,-0.721,-0.723,-0.726,-0.729,-0.731, - &-0.734,-0.736,-0.739,-0.741,-0.744,-0.746,-0.749,-0.751,-0.754, - &-0.756,-0.759,-0.761,-0.764,-0.766,-0.768,-0.771,-0.773,-0.776, - &-0.778,-0.780,-0.783,-0.785,-0.787,-0.790,-0.792,-0.794,-0.797, - &-0.799,-0.801,-0.804,-0.806,-0.808,-0.810,-0.813,-0.815,-0.817, - &-0.819,-0.822,-0.824,-0.826,-0.828,-0.831,-0.833,-0.835,-0.837, - &-0.839,-0.841,-0.844,-0.846,-0.848,-0.850,-0.852,-0.854,-0.856, - &-0.858,-0.860,-0.863,-0.865,-0.867,-0.869,-0.871,-0.873,-0.875, - &-0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.889,-0.891,-0.893, - &-0.895,-0.897,-0.899,-0.901,-0.903,-0.905,-0.907,-0.909,-0.911, - &-0.913,-0.915,-0.917,-0.919,-0.920,-0.922,-0.924,-0.926,-0.928, - &-0.930,-0.932,-0.934,-0.936,-0.938,-0.939,-0.941,-0.943,-0.945, - &-0.947,-0.949,-0.950,-0.952,-0.954,-0.956,-0.958,-0.960,-0.961, - &-0.963,-0.965,-0.967,-0.969,-0.970,-0.972,-0.974,-0.976,-0.977, - &-0.979,-0.981,-0.983,-0.984,-0.986,-0.988,-0.990,-0.991,-0.993, - &-0.995,-0.997,-0.998,-1.000,-1.002,-1.003,-1.005,-1.007,-1.008, - &-1.010,-1.012,-1.013,-1.015,-1.017,-1.019,-1.020,-1.022,-1.023, - &-1.025,-1.027,-1.028,-1.030,-1.032,-1.033,-1.035,-1.037,-1.038, - &-1.040,-1.041,-1.043,-1.045,-1.046,-1.048,-1.049,-1.051,-1.053, - &-1.054,-1.056,-1.057,-1.059,-1.061,-1.062,-1.064,-1.065,-1.067, - &-1.068,-1.070,-1.071,-1.073,-1.075,-1.076,-1.078,-1.079,-1.081, - &-1.082,-1.084,-1.085,-1.087,-1.088,-1.090,-1.091,-1.093,-1.094, - &-1.096,-1.097,-1.099,-1.100,-1.102,-1.103,-1.105,-1.106,-1.108, - &-1.109,-1.111,-1.112,-1.114,-1.115,-1.116,-1.118,-1.119,-1.121, - &-1.122,-1.124,-1.125,-1.127,-1.128,-1.129,-1.131,-1.132,-1.134, - &-1.135,-1.137,-1.138,-1.139,-1.141,-1.142,-1.144,-1.145,-1.146, - &-1.148,-1.149,-1.151,-1.152,-1.153,-1.155,-1.156,-1.158,-1.159, - &-1.160,-1.162,-1.163,-1.164,-1.166,-1.167,-1.168,-1.170,-1.171, - &-1.173,-1.174,-1.175,-1.177,-1.178,-1.179,-1.181,-1.182,-1.183, - &-1.185,-1.186,-1.187,-1.189,-1.190,-1.191,-1.193,-1.194,-1.195, - &-1.197,-1.198,-1.199,-1.200,-1.202,-1.203,-1.204,-1.206,-1.207, - &-1.208,-1.210,-1.211,-1.212,-1.226,-1.238,-1.251,-1.263,-1.275, - &-1.287,-1.298,-1.310,-1.321,-1.333,-1.344,-1.355,-1.365,-1.376, - &-1.387,-1.397,-1.407,-1.417,-1.427,-1.437,-1.447,-1.457,-1.467, - &-1.476,-1.486,-1.495,-1.505,-1.514,-1.523,-1.532,-1.541,-1.550, - &-1.559,-1.567,-1.576,-1.585,-1.593,-1.602,-1.610,-1.619,-1.627, - &-1.635,-1.643,-1.651,-1.659,-1.667,-1.675,-1.683,-1.691,-1.699, - &-1.707,-1.715,-1.722,-1.730,-1.737,-1.745,-1.752,-1.760,-1.767, - &-1.775,-1.782,-1.789,-1.797,-1.804,-1.811,-1.818,-1.825,-1.832, - &-1.840,-1.847,-1.854,-1.861,-1.867,-1.874,-1.881,-1.888,-1.895, - &-1.902,-1.908,-1.915,-1.922,-1.929,-1.935,-1.942,-1.948,-1.955, - &-1.962,-1.968,-1.975,-1.981,-1.988,-1.994,-2.000,-2.007,-2.013, - &-2.020,-2.026,-2.032,-2.039,-2.045,-2.051,-2.057,-2.064,-2.070, - &-2.076,-2.082,-2.088,-2.094,-2.100,-2.107,-2.113,-2.119,-2.125, - &-2.131,-2.137,-2.143,-2.149,-2.155,-2.161,-2.167,-2.173,-2.179, - &-2.184,-2.190,-2.196,-2.202,-2.208,-2.214,-2.220,-2.225,-2.231, - &-2.237,-2.243,-2.248,-2.254,-2.260,-2.266,-2.271,-2.277,-2.283, - &-2.288,-2.294,-2.300,-2.305,-2.311,-2.317,-2.322,-2.328,-2.333, - &-2.339,-2.345,-2.350,-2.356,-2.361,-2.367,-2.372,-2.378,-2.383, - &-2.389,-2.394,-2.400 - & / -C -C *** NH4Cl -C - DATA BNC06M/ - &-0.049,-0.106,-0.133,-0.151,-0.166,-0.177,-0.187,-0.195,-0.202, - &-0.208,-0.214,-0.219,-0.224,-0.228,-0.231,-0.235,-0.238,-0.241, - &-0.244,-0.246,-0.249,-0.251,-0.253,-0.255,-0.257,-0.259,-0.260, - &-0.262,-0.264,-0.265,-0.266,-0.268,-0.269,-0.270,-0.271,-0.272, - &-0.273,-0.274,-0.275,-0.276,-0.277,-0.278,-0.278,-0.279,-0.280, - &-0.281,-0.281,-0.282,-0.283,-0.283,-0.284,-0.284,-0.285,-0.285, - &-0.286,-0.287,-0.287,-0.288,-0.288,-0.288,-0.289,-0.289,-0.290, - &-0.290,-0.291,-0.291,-0.291,-0.292,-0.292,-0.292,-0.293,-0.293, - &-0.293,-0.294,-0.294,-0.294,-0.294,-0.295,-0.295,-0.295,-0.295, - &-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.297,-0.297,-0.297, - &-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297, - &-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297, - &-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297, - &-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296, - &-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.294,-0.294, - &-0.294,-0.294,-0.294,-0.294,-0.294,-0.293,-0.293,-0.293,-0.293, - &-0.293,-0.293,-0.292,-0.292,-0.292,-0.292,-0.292,-0.292,-0.291, - &-0.291,-0.291,-0.291,-0.291,-0.291,-0.290,-0.290,-0.290,-0.290, - &-0.290,-0.290,-0.289,-0.289,-0.289,-0.289,-0.289,-0.288,-0.288, - &-0.288,-0.288,-0.288,-0.288,-0.287,-0.287,-0.287,-0.287,-0.287, - &-0.287,-0.286,-0.286,-0.286,-0.286,-0.286,-0.286,-0.285,-0.285, - &-0.285,-0.285,-0.285,-0.284,-0.284,-0.284,-0.284,-0.284,-0.284, - &-0.283,-0.283,-0.283,-0.283,-0.283,-0.283,-0.282,-0.282,-0.282, - &-0.282,-0.282,-0.282,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, - &-0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.279,-0.279,-0.279, - &-0.279,-0.279,-0.279,-0.278,-0.278,-0.278,-0.278,-0.278,-0.278, - &-0.277,-0.277,-0.277,-0.277,-0.277,-0.277,-0.276,-0.276,-0.276, - &-0.276,-0.276,-0.276,-0.276,-0.275,-0.275,-0.275,-0.275,-0.275, - &-0.275,-0.275,-0.274,-0.274,-0.274,-0.274,-0.274,-0.274,-0.273, - &-0.273,-0.273,-0.273,-0.273,-0.273,-0.273,-0.272,-0.272,-0.272, - &-0.272,-0.272,-0.272,-0.272,-0.271,-0.271,-0.271,-0.271,-0.271, - &-0.271,-0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.270,-0.270, - &-0.270,-0.270,-0.269,-0.269,-0.269,-0.269,-0.269,-0.269,-0.269, - &-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268, - &-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.266, - &-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.265, - &-0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265, - &-0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.264, - &-0.264,-0.263,-0.263,-0.263,-0.263,-0.263,-0.263,-0.263,-0.263, - &-0.263,-0.263,-0.263,-0.262,-0.262,-0.262,-0.262,-0.262,-0.262, - &-0.262,-0.262,-0.262,-0.262,-0.262,-0.262,-0.261,-0.261,-0.261, - &-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261, - &-0.261,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260, - &-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.259,-0.259,-0.259, - &-0.259,-0.259,-0.259,-0.259,-0.258,-0.258,-0.257,-0.257,-0.257, - &-0.256,-0.256,-0.256,-0.256,-0.256,-0.255,-0.255,-0.256,-0.256, - &-0.256,-0.256,-0.256,-0.256,-0.257,-0.257,-0.257,-0.258,-0.258, - &-0.259,-0.259,-0.260,-0.260,-0.261,-0.262,-0.262,-0.263,-0.264, - &-0.265,-0.265,-0.266,-0.267,-0.268,-0.269,-0.270,-0.271,-0.272, - &-0.273,-0.274,-0.275,-0.277,-0.278,-0.279,-0.280,-0.281,-0.283, - &-0.284,-0.285,-0.287,-0.288,-0.289,-0.291,-0.292,-0.294,-0.295, - &-0.297,-0.298,-0.300,-0.301,-0.303,-0.304,-0.306,-0.308,-0.309, - &-0.311,-0.313,-0.314,-0.316,-0.318,-0.320,-0.321,-0.323,-0.325, - &-0.327,-0.329,-0.331,-0.332,-0.334,-0.336,-0.338,-0.340,-0.342, - &-0.344,-0.346,-0.348,-0.350,-0.352,-0.354,-0.356,-0.358,-0.360, - &-0.362,-0.364,-0.367,-0.369,-0.371,-0.373,-0.375,-0.377,-0.379, - &-0.382,-0.384,-0.386,-0.388,-0.391,-0.393,-0.395,-0.397,-0.400, - &-0.402,-0.404,-0.406,-0.409,-0.411,-0.413,-0.416,-0.418,-0.421, - &-0.423,-0.425,-0.428,-0.430,-0.433,-0.435,-0.437,-0.440,-0.442, - &-0.445,-0.447,-0.450,-0.452,-0.455,-0.457,-0.460,-0.462,-0.465, - &-0.467,-0.470,-0.472,-0.475,-0.477,-0.480,-0.483,-0.485,-0.488, - &-0.490,-0.493,-0.496,-0.498,-0.501,-0.503,-0.506,-0.509,-0.511, - &-0.514,-0.517,-0.519 - & / -C -C *** (2H,SO4) -C - DATA BNC07M/ - &-0.100,-0.219,-0.279,-0.321,-0.354,-0.382,-0.406,-0.427,-0.446, - &-0.463,-0.479,-0.493,-0.506,-0.519,-0.531,-0.542,-0.552,-0.562, - &-0.572,-0.581,-0.590,-0.598,-0.606,-0.614,-0.622,-0.629,-0.636, - &-0.643,-0.650,-0.656,-0.662,-0.668,-0.674,-0.680,-0.686,-0.692, - &-0.697,-0.702,-0.707,-0.713,-0.718,-0.722,-0.727,-0.732,-0.737, - &-0.741,-0.746,-0.750,-0.754,-0.759,-0.763,-0.767,-0.771,-0.775, - &-0.779,-0.783,-0.787,-0.791,-0.794,-0.798,-0.802,-0.805,-0.809, - &-0.813,-0.816,-0.820,-0.823,-0.826,-0.830,-0.833,-0.836,-0.840, - &-0.843,-0.846,-0.849,-0.852,-0.855,-0.859,-0.862,-0.865,-0.868, - &-0.871,-0.874,-0.877,-0.879,-0.882,-0.885,-0.888,-0.891,-0.894, - &-0.897,-0.899,-0.902,-0.905,-0.908,-0.910,-0.913,-0.916,-0.918, - &-0.921,-0.924,-0.926,-0.929,-0.932,-0.934,-0.937,-0.939,-0.942, - &-0.944,-0.947,-0.949,-0.952,-0.954,-0.957,-0.959,-0.962,-0.964, - &-0.967,-0.969,-0.971,-0.974,-0.976,-0.978,-0.981,-0.983,-0.985, - &-0.988,-0.990,-0.992,-0.995,-0.997,-0.999,-1.002,-1.004,-1.006, - &-1.008,-1.011,-1.013,-1.015,-1.017,-1.019,-1.022,-1.024,-1.026, - &-1.028,-1.030,-1.032,-1.034,-1.037,-1.039,-1.041,-1.043,-1.045, - &-1.047,-1.049,-1.051,-1.053,-1.056,-1.058,-1.060,-1.062,-1.064, - &-1.066,-1.068,-1.070,-1.072,-1.074,-1.076,-1.078,-1.080,-1.082, - &-1.084,-1.086,-1.088,-1.090,-1.092,-1.094,-1.096,-1.098,-1.099, - &-1.101,-1.103,-1.105,-1.107,-1.109,-1.111,-1.113,-1.115,-1.117, - &-1.119,-1.121,-1.122,-1.124,-1.126,-1.128,-1.130,-1.132,-1.134, - &-1.135,-1.137,-1.139,-1.141,-1.143,-1.145,-1.146,-1.148,-1.150, - &-1.152,-1.154,-1.156,-1.157,-1.159,-1.161,-1.163,-1.165,-1.166, - &-1.168,-1.170,-1.172,-1.173,-1.175,-1.177,-1.179,-1.180,-1.182, - &-1.184,-1.186,-1.187,-1.189,-1.191,-1.193,-1.194,-1.196,-1.198, - &-1.200,-1.201,-1.203,-1.205,-1.206,-1.208,-1.210,-1.212,-1.213, - &-1.215,-1.217,-1.218,-1.220,-1.222,-1.223,-1.225,-1.227,-1.228, - &-1.230,-1.232,-1.233,-1.235,-1.237,-1.238,-1.240,-1.242,-1.243, - &-1.245,-1.247,-1.248,-1.250,-1.251,-1.253,-1.255,-1.256,-1.258, - &-1.260,-1.261,-1.263,-1.264,-1.266,-1.268,-1.269,-1.271,-1.273, - &-1.274,-1.276,-1.277,-1.279,-1.280,-1.282,-1.284,-1.285,-1.287, - &-1.288,-1.290,-1.292,-1.293,-1.295,-1.296,-1.298,-1.299,-1.301, - &-1.303,-1.304,-1.306,-1.307,-1.309,-1.310,-1.312,-1.313,-1.315, - &-1.317,-1.318,-1.320,-1.321,-1.323,-1.324,-1.326,-1.327,-1.329, - &-1.330,-1.332,-1.333,-1.335,-1.337,-1.338,-1.340,-1.341,-1.343, - &-1.344,-1.346,-1.347,-1.349,-1.350,-1.352,-1.353,-1.355,-1.356, - &-1.358,-1.359,-1.361,-1.362,-1.364,-1.365,-1.367,-1.368,-1.370, - &-1.371,-1.373,-1.374,-1.376,-1.377,-1.379,-1.380,-1.381,-1.383, - &-1.384,-1.386,-1.387,-1.389,-1.390,-1.392,-1.393,-1.395,-1.396, - &-1.398,-1.399,-1.401,-1.402,-1.403,-1.405,-1.406,-1.408,-1.409, - &-1.411,-1.412,-1.414,-1.415,-1.416,-1.418,-1.419,-1.421,-1.422, - &-1.424,-1.425,-1.427,-1.428,-1.429,-1.431,-1.432,-1.434,-1.435, - &-1.437,-1.438,-1.439,-1.441,-1.442,-1.444,-1.445,-1.447,-1.448, - &-1.449,-1.451,-1.452,-1.454,-1.469,-1.483,-1.497,-1.510,-1.524, - &-1.537,-1.551,-1.564,-1.578,-1.591,-1.604,-1.617,-1.630,-1.643, - &-1.656,-1.669,-1.681,-1.694,-1.707,-1.719,-1.732,-1.744,-1.756, - &-1.769,-1.781,-1.793,-1.806,-1.818,-1.830,-1.842,-1.854,-1.866, - &-1.878,-1.890,-1.902,-1.914,-1.925,-1.937,-1.949,-1.961,-1.972, - &-1.984,-1.996,-2.007,-2.019,-2.030,-2.042,-2.053,-2.065,-2.076, - &-2.087,-2.099,-2.110,-2.121,-2.133,-2.144,-2.155,-2.166,-2.178, - &-2.189,-2.200,-2.211,-2.222,-2.233,-2.244,-2.255,-2.266,-2.277, - &-2.288,-2.299,-2.310,-2.321,-2.332,-2.343,-2.354,-2.365,-2.375, - &-2.386,-2.397,-2.408,-2.419,-2.429,-2.440,-2.451,-2.461,-2.472, - &-2.483,-2.494,-2.504,-2.515,-2.525,-2.536,-2.547,-2.557,-2.568, - &-2.578,-2.589,-2.599,-2.610,-2.620,-2.631,-2.641,-2.652,-2.662, - &-2.673,-2.683,-2.693,-2.704,-2.714,-2.725,-2.735,-2.745,-2.756, - &-2.766,-2.776,-2.787,-2.797,-2.807,-2.817,-2.828,-2.838,-2.848, - &-2.858,-2.869,-2.879,-2.889,-2.899,-2.909,-2.920,-2.930,-2.940, - &-2.950,-2.960,-2.970,-2.980,-2.991,-3.001,-3.011,-3.021,-3.031, - &-3.041,-3.051,-3.061,-3.071,-3.081,-3.091,-3.101,-3.111,-3.121, - &-3.131,-3.141,-3.151,-3.161,-3.171,-3.181,-3.191,-3.201,-3.211, - &-3.221,-3.231,-3.241 - & / -C -C *** (H,HSO4) -C - DATA BNC08M/ - &-0.047,-0.091,-0.109,-0.119,-0.125,-0.128,-0.130,-0.131,-0.130, - &-0.129,-0.128,-0.125,-0.122,-0.119,-0.115,-0.111,-0.107,-0.102, - &-0.097,-0.092,-0.086,-0.080,-0.074,-0.068,-0.062,-0.055,-0.048, - &-0.041,-0.034,-0.027,-0.019,-0.012,-0.004, 0.004, 0.012, 0.020, - & 0.028, 0.037, 0.045, 0.054, 0.063, 0.071, 0.080, 0.089, 0.098, - & 0.108, 0.117, 0.126, 0.136, 0.145, 0.155, 0.164, 0.174, 0.184, - & 0.193, 0.203, 0.213, 0.223, 0.233, 0.243, 0.253, 0.263, 0.274, - & 0.284, 0.294, 0.304, 0.315, 0.325, 0.336, 0.346, 0.357, 0.368, - & 0.378, 0.389, 0.400, 0.411, 0.421, 0.432, 0.443, 0.455, 0.466, - & 0.477, 0.488, 0.499, 0.511, 0.522, 0.534, 0.545, 0.557, 0.568, - & 0.580, 0.592, 0.604, 0.615, 0.627, 0.639, 0.651, 0.664, 0.676, - & 0.688, 0.700, 0.712, 0.725, 0.737, 0.749, 0.762, 0.774, 0.787, - & 0.799, 0.812, 0.824, 0.837, 0.849, 0.862, 0.875, 0.887, 0.900, - & 0.913, 0.925, 0.938, 0.951, 0.963, 0.976, 0.989, 1.001, 1.014, - & 1.027, 1.039, 1.052, 1.064, 1.077, 1.090, 1.102, 1.115, 1.127, - & 1.140, 1.152, 1.165, 1.177, 1.190, 1.202, 1.215, 1.227, 1.239, - & 1.252, 1.264, 1.276, 1.289, 1.301, 1.313, 1.325, 1.338, 1.350, - & 1.362, 1.374, 1.386, 1.398, 1.410, 1.422, 1.434, 1.446, 1.458, - & 1.470, 1.482, 1.494, 1.506, 1.518, 1.530, 1.541, 1.553, 1.565, - & 1.577, 1.588, 1.600, 1.612, 1.623, 1.635, 1.646, 1.658, 1.669, - & 1.681, 1.692, 1.704, 1.715, 1.727, 1.738, 1.749, 1.761, 1.772, - & 1.783, 1.794, 1.806, 1.817, 1.828, 1.839, 1.850, 1.861, 1.872, - & 1.883, 1.894, 1.905, 1.916, 1.927, 1.938, 1.949, 1.960, 1.971, - & 1.982, 1.992, 2.003, 2.014, 2.025, 2.035, 2.046, 2.057, 2.067, - & 2.078, 2.088, 2.099, 2.109, 2.120, 2.130, 2.141, 2.151, 2.162, - & 2.172, 2.182, 2.193, 2.203, 2.213, 2.224, 2.234, 2.244, 2.254, - & 2.265, 2.275, 2.285, 2.295, 2.305, 2.315, 2.325, 2.335, 2.345, - & 2.355, 2.365, 2.375, 2.385, 2.395, 2.405, 2.415, 2.424, 2.434, - & 2.444, 2.454, 2.464, 2.473, 2.483, 2.493, 2.502, 2.512, 2.522, - & 2.531, 2.541, 2.550, 2.560, 2.569, 2.579, 2.588, 2.598, 2.607, - & 2.617, 2.626, 2.635, 2.645, 2.654, 2.663, 2.673, 2.682, 2.691, - & 2.701, 2.710, 2.719, 2.728, 2.737, 2.746, 2.756, 2.765, 2.774, - & 2.783, 2.792, 2.801, 2.810, 2.819, 2.828, 2.837, 2.846, 2.855, - & 2.864, 2.873, 2.881, 2.890, 2.899, 2.908, 2.917, 2.925, 2.934, - & 2.943, 2.952, 2.960, 2.969, 2.978, 2.986, 2.995, 3.004, 3.012, - & 3.021, 3.029, 3.038, 3.047, 3.055, 3.064, 3.072, 3.080, 3.089, - & 3.097, 3.106, 3.114, 3.123, 3.131, 3.139, 3.148, 3.156, 3.164, - & 3.173, 3.181, 3.189, 3.197, 3.206, 3.214, 3.222, 3.230, 3.238, - & 3.246, 3.255, 3.263, 3.271, 3.279, 3.287, 3.295, 3.303, 3.311, - & 3.319, 3.327, 3.335, 3.343, 3.351, 3.359, 3.367, 3.375, 3.383, - & 3.390, 3.398, 3.406, 3.414, 3.422, 3.430, 3.437, 3.445, 3.453, - & 3.461, 3.468, 3.476, 3.484, 3.492, 3.499, 3.507, 3.515, 3.522, - & 3.530, 3.537, 3.545, 3.553, 3.560, 3.568, 3.575, 3.583, 3.590, - & 3.598, 3.605, 3.613, 3.620, 3.628, 3.635, 3.642, 3.650, 3.657, - & 3.665, 3.672, 3.679, 3.687, 3.765, 3.837, 3.907, 3.976, 4.044, - & 4.111, 4.176, 4.241, 4.305, 4.368, 4.429, 4.490, 4.550, 4.609, - & 4.668, 4.725, 4.782, 4.838, 4.893, 4.947, 5.001, 5.054, 5.106, - & 5.157, 5.208, 5.259, 5.308, 5.357, 5.406, 5.453, 5.501, 5.547, - & 5.593, 5.639, 5.684, 5.729, 5.773, 5.816, 5.859, 5.902, 5.944, - & 5.986, 6.027, 6.068, 6.108, 6.148, 6.188, 6.227, 6.265, 6.304, - & 6.342, 6.379, 6.416, 6.453, 6.490, 6.526, 6.562, 6.597, 6.632, - & 6.667, 6.701, 6.735, 6.769, 6.803, 6.836, 6.869, 6.901, 6.934, - & 6.966, 6.997, 7.029, 7.060, 7.091, 7.122, 7.152, 7.182, 7.212, - & 7.242, 7.271, 7.300, 7.329, 7.358, 7.386, 7.415, 7.443, 7.470, - & 7.498, 7.525, 7.552, 7.579, 7.606, 7.633, 7.659, 7.685, 7.711, - & 7.737, 7.762, 7.788, 7.813, 7.838, 7.862, 7.887, 7.912, 7.936, - & 7.960, 7.984, 8.008, 8.031, 8.055, 8.078, 8.101, 8.124, 8.147, - & 8.169, 8.192, 8.214, 8.236, 8.258, 8.280, 8.302, 8.323, 8.345, - & 8.366, 8.387, 8.408, 8.429, 8.450, 8.470, 8.491, 8.511, 8.531, - & 8.552, 8.572, 8.591, 8.611, 8.631, 8.650, 8.670, 8.689, 8.708, - & 8.727, 8.746, 8.765, 8.783, 8.802, 8.820, 8.839, 8.857, 8.875, - & 8.893, 8.911, 8.929, 8.946, 8.964, 8.981, 8.999, 9.016, 9.033, - & 9.050, 9.067, 9.084 - & / -C -C *** NH4HSO4 -C - DATA BNC09M/ - &-0.049,-0.104,-0.131,-0.149,-0.163,-0.174,-0.184,-0.192,-0.199, - &-0.205,-0.211,-0.216,-0.220,-0.224,-0.228,-0.231,-0.234,-0.236, - &-0.238,-0.240,-0.242,-0.244,-0.245,-0.247,-0.248,-0.248,-0.249, - &-0.250,-0.250,-0.250,-0.251,-0.251,-0.250,-0.250,-0.250,-0.249, - &-0.249,-0.248,-0.247,-0.247,-0.246,-0.245,-0.243,-0.242,-0.241, - &-0.240,-0.238,-0.237,-0.235,-0.233,-0.232,-0.230,-0.228,-0.226, - &-0.224,-0.222,-0.220,-0.218,-0.216,-0.214,-0.211,-0.209,-0.207, - &-0.204,-0.202,-0.199,-0.197,-0.194,-0.192,-0.189,-0.187,-0.184, - &-0.181,-0.178,-0.176,-0.173,-0.170,-0.167,-0.164,-0.161,-0.158, - &-0.155,-0.152,-0.149,-0.146,-0.142,-0.139,-0.136,-0.133,-0.129, - &-0.126,-0.123,-0.119,-0.116,-0.112,-0.109,-0.105,-0.102,-0.098, - &-0.095,-0.091,-0.088,-0.084,-0.080,-0.077,-0.073,-0.069,-0.066, - &-0.062,-0.058,-0.055,-0.051,-0.047,-0.043,-0.039,-0.036,-0.032, - &-0.028,-0.024,-0.020,-0.017,-0.013,-0.009,-0.005,-0.001, 0.002, - & 0.006, 0.010, 0.014, 0.018, 0.021, 0.025, 0.029, 0.033, 0.037, - & 0.040, 0.044, 0.048, 0.052, 0.055, 0.059, 0.063, 0.067, 0.070, - & 0.074, 0.078, 0.081, 0.085, 0.089, 0.093, 0.096, 0.100, 0.104, - & 0.107, 0.111, 0.114, 0.118, 0.122, 0.125, 0.129, 0.133, 0.136, - & 0.140, 0.143, 0.147, 0.150, 0.154, 0.157, 0.161, 0.165, 0.168, - & 0.172, 0.175, 0.178, 0.182, 0.185, 0.189, 0.192, 0.196, 0.199, - & 0.203, 0.206, 0.209, 0.213, 0.216, 0.220, 0.223, 0.226, 0.230, - & 0.233, 0.236, 0.240, 0.243, 0.246, 0.250, 0.253, 0.256, 0.259, - & 0.263, 0.266, 0.269, 0.272, 0.276, 0.279, 0.282, 0.285, 0.289, - & 0.292, 0.295, 0.298, 0.301, 0.304, 0.308, 0.311, 0.314, 0.317, - & 0.320, 0.323, 0.326, 0.329, 0.332, 0.336, 0.339, 0.342, 0.345, - & 0.348, 0.351, 0.354, 0.357, 0.360, 0.363, 0.366, 0.369, 0.372, - & 0.375, 0.378, 0.381, 0.384, 0.387, 0.390, 0.393, 0.395, 0.398, - & 0.401, 0.404, 0.407, 0.410, 0.413, 0.416, 0.419, 0.421, 0.424, - & 0.427, 0.430, 0.433, 0.436, 0.438, 0.441, 0.444, 0.447, 0.450, - & 0.452, 0.455, 0.458, 0.461, 0.464, 0.466, 0.469, 0.472, 0.475, - & 0.477, 0.480, 0.483, 0.485, 0.488, 0.491, 0.493, 0.496, 0.499, - & 0.501, 0.504, 0.507, 0.509, 0.512, 0.515, 0.517, 0.520, 0.523, - & 0.525, 0.528, 0.530, 0.533, 0.536, 0.538, 0.541, 0.543, 0.546, - & 0.548, 0.551, 0.554, 0.556, 0.559, 0.561, 0.564, 0.566, 0.569, - & 0.571, 0.574, 0.576, 0.579, 0.581, 0.584, 0.586, 0.589, 0.591, - & 0.594, 0.596, 0.598, 0.601, 0.603, 0.606, 0.608, 0.611, 0.613, - & 0.615, 0.618, 0.620, 0.623, 0.625, 0.627, 0.630, 0.632, 0.635, - & 0.637, 0.639, 0.642, 0.644, 0.646, 0.649, 0.651, 0.653, 0.656, - & 0.658, 0.660, 0.663, 0.665, 0.667, 0.670, 0.672, 0.674, 0.676, - & 0.679, 0.681, 0.683, 0.685, 0.688, 0.690, 0.692, 0.694, 0.697, - & 0.699, 0.701, 0.703, 0.706, 0.708, 0.710, 0.712, 0.714, 0.717, - & 0.719, 0.721, 0.723, 0.725, 0.728, 0.730, 0.732, 0.734, 0.736, - & 0.738, 0.741, 0.743, 0.745, 0.747, 0.749, 0.751, 0.753, 0.756, - & 0.758, 0.760, 0.762, 0.764, 0.766, 0.768, 0.770, 0.772, 0.774, - & 0.777, 0.779, 0.781, 0.783, 0.805, 0.825, 0.845, 0.864, 0.883, - & 0.901, 0.920, 0.938, 0.955, 0.973, 0.990, 1.006, 1.023, 1.039, - & 1.055, 1.071, 1.086, 1.101, 1.116, 1.131, 1.145, 1.160, 1.174, - & 1.188, 1.201, 1.215, 1.228, 1.241, 1.254, 1.266, 1.279, 1.291, - & 1.303, 1.315, 1.327, 1.339, 1.350, 1.361, 1.372, 1.383, 1.394, - & 1.405, 1.416, 1.426, 1.436, 1.446, 1.456, 1.466, 1.476, 1.486, - & 1.495, 1.505, 1.514, 1.523, 1.532, 1.541, 1.550, 1.559, 1.567, - & 1.576, 1.584, 1.592, 1.601, 1.609, 1.617, 1.625, 1.632, 1.640, - & 1.648, 1.655, 1.663, 1.670, 1.677, 1.684, 1.692, 1.699, 1.706, - & 1.712, 1.719, 1.726, 1.732, 1.739, 1.746, 1.752, 1.758, 1.765, - & 1.771, 1.777, 1.783, 1.789, 1.795, 1.801, 1.806, 1.812, 1.818, - & 1.823, 1.829, 1.834, 1.840, 1.845, 1.850, 1.856, 1.861, 1.866, - & 1.871, 1.876, 1.881, 1.886, 1.891, 1.896, 1.900, 1.905, 1.910, - & 1.914, 1.919, 1.923, 1.928, 1.932, 1.937, 1.941, 1.945, 1.949, - & 1.953, 1.958, 1.962, 1.966, 1.970, 1.974, 1.978, 1.981, 1.985, - & 1.989, 1.993, 1.996, 2.000, 2.004, 2.007, 2.011, 2.014, 2.018, - & 2.021, 2.025, 2.028, 2.031, 2.035, 2.038, 2.041, 2.044, 2.047, - & 2.050, 2.053, 2.056, 2.059, 2.062, 2.065, 2.068, 2.071, 2.074, - & 2.077, 2.080, 2.082 - & / -C -C *** (H,NO3) -C - DATA BNC10M/ - &-0.048,-0.100,-0.123,-0.137,-0.147,-0.155,-0.161,-0.165,-0.169, - &-0.172,-0.174,-0.175,-0.177,-0.177,-0.178,-0.178,-0.178,-0.177, - &-0.177,-0.176,-0.175,-0.174,-0.173,-0.172,-0.171,-0.169,-0.168, - &-0.166,-0.165,-0.163,-0.161,-0.159,-0.157,-0.156,-0.154,-0.152, - &-0.150,-0.148,-0.146,-0.144,-0.141,-0.139,-0.137,-0.135,-0.133, - &-0.131,-0.129,-0.127,-0.124,-0.122,-0.120,-0.118,-0.116,-0.113, - &-0.111,-0.109,-0.107,-0.105,-0.102,-0.100,-0.098,-0.096,-0.094, - &-0.091,-0.089,-0.087,-0.085,-0.082,-0.080,-0.078,-0.076,-0.073, - &-0.071,-0.069,-0.067,-0.064,-0.062,-0.060,-0.057,-0.055,-0.052, - &-0.050,-0.048,-0.045,-0.043,-0.040,-0.038,-0.035,-0.033,-0.030, - &-0.027,-0.025,-0.022,-0.020,-0.017,-0.014,-0.012,-0.009,-0.006, - &-0.004,-0.001, 0.002, 0.005, 0.007, 0.010, 0.013, 0.016, 0.019, - & 0.021, 0.024, 0.027, 0.030, 0.033, 0.036, 0.039, 0.041, 0.044, - & 0.047, 0.050, 0.053, 0.056, 0.059, 0.062, 0.065, 0.068, 0.071, - & 0.073, 0.076, 0.079, 0.082, 0.085, 0.088, 0.091, 0.094, 0.097, - & 0.100, 0.103, 0.105, 0.108, 0.111, 0.114, 0.117, 0.120, 0.123, - & 0.126, 0.129, 0.131, 0.134, 0.137, 0.140, 0.143, 0.146, 0.149, - & 0.152, 0.154, 0.157, 0.160, 0.163, 0.166, 0.169, 0.171, 0.174, - & 0.177, 0.180, 0.183, 0.186, 0.188, 0.191, 0.194, 0.197, 0.200, - & 0.202, 0.205, 0.208, 0.211, 0.213, 0.216, 0.219, 0.222, 0.224, - & 0.227, 0.230, 0.233, 0.235, 0.238, 0.241, 0.244, 0.246, 0.249, - & 0.252, 0.254, 0.257, 0.260, 0.263, 0.265, 0.268, 0.271, 0.273, - & 0.276, 0.279, 0.281, 0.284, 0.287, 0.289, 0.292, 0.294, 0.297, - & 0.300, 0.302, 0.305, 0.308, 0.310, 0.313, 0.315, 0.318, 0.321, - & 0.323, 0.326, 0.328, 0.331, 0.333, 0.336, 0.339, 0.341, 0.344, - & 0.346, 0.349, 0.351, 0.354, 0.356, 0.359, 0.361, 0.364, 0.366, - & 0.369, 0.372, 0.374, 0.376, 0.379, 0.381, 0.384, 0.386, 0.389, - & 0.391, 0.394, 0.396, 0.399, 0.401, 0.404, 0.406, 0.409, 0.411, - & 0.413, 0.416, 0.418, 0.421, 0.423, 0.425, 0.428, 0.430, 0.433, - & 0.435, 0.437, 0.440, 0.442, 0.445, 0.447, 0.449, 0.452, 0.454, - & 0.456, 0.459, 0.461, 0.463, 0.466, 0.468, 0.470, 0.473, 0.475, - & 0.477, 0.480, 0.482, 0.484, 0.486, 0.489, 0.491, 0.493, 0.496, - & 0.498, 0.500, 0.502, 0.505, 0.507, 0.509, 0.511, 0.514, 0.516, - & 0.518, 0.520, 0.523, 0.525, 0.527, 0.529, 0.531, 0.534, 0.536, - & 0.538, 0.540, 0.542, 0.545, 0.547, 0.549, 0.551, 0.553, 0.555, - & 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, 0.570, 0.573, 0.575, - & 0.577, 0.579, 0.581, 0.583, 0.585, 0.587, 0.590, 0.592, 0.594, - & 0.596, 0.598, 0.600, 0.602, 0.604, 0.606, 0.608, 0.610, 0.612, - & 0.614, 0.617, 0.619, 0.621, 0.623, 0.625, 0.627, 0.629, 0.631, - & 0.633, 0.635, 0.637, 0.639, 0.641, 0.643, 0.645, 0.647, 0.649, - & 0.651, 0.653, 0.655, 0.657, 0.659, 0.661, 0.663, 0.665, 0.667, - & 0.669, 0.671, 0.673, 0.674, 0.676, 0.678, 0.680, 0.682, 0.684, - & 0.686, 0.688, 0.690, 0.692, 0.694, 0.696, 0.698, 0.700, 0.701, - & 0.703, 0.705, 0.707, 0.709, 0.711, 0.713, 0.715, 0.716, 0.718, - & 0.720, 0.722, 0.724, 0.726, 0.746, 0.764, 0.781, 0.799, 0.816, - & 0.833, 0.849, 0.866, 0.882, 0.897, 0.913, 0.928, 0.943, 0.958, - & 0.972, 0.987, 1.001, 1.015, 1.028, 1.042, 1.055, 1.068, 1.081, - & 1.093, 1.106, 1.118, 1.130, 1.142, 1.154, 1.165, 1.177, 1.188, - & 1.199, 1.210, 1.221, 1.231, 1.242, 1.252, 1.262, 1.272, 1.282, - & 1.292, 1.301, 1.311, 1.320, 1.329, 1.338, 1.347, 1.356, 1.365, - & 1.374, 1.382, 1.391, 1.399, 1.407, 1.415, 1.423, 1.431, 1.439, - & 1.446, 1.454, 1.462, 1.469, 1.476, 1.483, 1.491, 1.498, 1.505, - & 1.511, 1.518, 1.525, 1.531, 1.538, 1.544, 1.551, 1.557, 1.563, - & 1.569, 1.576, 1.582, 1.587, 1.593, 1.599, 1.605, 1.610, 1.616, - & 1.622, 1.627, 1.632, 1.638, 1.643, 1.648, 1.653, 1.658, 1.663, - & 1.668, 1.673, 1.678, 1.683, 1.688, 1.692, 1.697, 1.701, 1.706, - & 1.710, 1.715, 1.719, 1.723, 1.728, 1.732, 1.736, 1.740, 1.744, - & 1.748, 1.752, 1.756, 1.760, 1.764, 1.768, 1.771, 1.775, 1.779, - & 1.782, 1.786, 1.789, 1.793, 1.796, 1.800, 1.803, 1.806, 1.810, - & 1.813, 1.816, 1.819, 1.822, 1.825, 1.828, 1.831, 1.834, 1.837, - & 1.840, 1.843, 1.846, 1.849, 1.852, 1.854, 1.857, 1.860, 1.862, - & 1.865, 1.867, 1.870, 1.872, 1.875, 1.877, 1.880, 1.882, 1.885, - & 1.887, 1.889, 1.891 - & / -C -C *** (H,Cl) -C - DATA BNC11M/ - &-0.047,-0.093,-0.111,-0.121,-0.127,-0.131,-0.133,-0.134,-0.133, - &-0.132,-0.131,-0.128,-0.126,-0.123,-0.119,-0.115,-0.111,-0.107, - &-0.102,-0.098,-0.093,-0.088,-0.082,-0.077,-0.071,-0.065,-0.060, - &-0.054,-0.048,-0.041,-0.035,-0.029,-0.022,-0.016,-0.009,-0.003, - & 0.004, 0.011, 0.018, 0.025, 0.032, 0.038, 0.045, 0.053, 0.060, - & 0.067, 0.074, 0.081, 0.088, 0.095, 0.103, 0.110, 0.117, 0.124, - & 0.132, 0.139, 0.146, 0.154, 0.161, 0.168, 0.176, 0.183, 0.191, - & 0.198, 0.206, 0.213, 0.221, 0.228, 0.236, 0.243, 0.251, 0.258, - & 0.266, 0.274, 0.281, 0.289, 0.297, 0.305, 0.312, 0.320, 0.328, - & 0.336, 0.344, 0.352, 0.360, 0.368, 0.376, 0.384, 0.393, 0.401, - & 0.409, 0.417, 0.426, 0.434, 0.443, 0.451, 0.460, 0.468, 0.477, - & 0.485, 0.494, 0.503, 0.511, 0.520, 0.529, 0.538, 0.546, 0.555, - & 0.564, 0.573, 0.582, 0.591, 0.600, 0.608, 0.617, 0.626, 0.635, - & 0.644, 0.653, 0.662, 0.671, 0.680, 0.689, 0.698, 0.707, 0.716, - & 0.725, 0.734, 0.743, 0.752, 0.761, 0.770, 0.779, 0.788, 0.796, - & 0.805, 0.814, 0.823, 0.832, 0.841, 0.850, 0.859, 0.867, 0.876, - & 0.885, 0.894, 0.903, 0.911, 0.920, 0.929, 0.937, 0.946, 0.955, - & 0.964, 0.972, 0.981, 0.989, 0.998, 1.007, 1.015, 1.024, 1.032, - & 1.041, 1.049, 1.058, 1.066, 1.075, 1.083, 1.092, 1.100, 1.109, - & 1.117, 1.125, 1.134, 1.142, 1.150, 1.159, 1.167, 1.175, 1.183, - & 1.192, 1.200, 1.208, 1.216, 1.224, 1.233, 1.241, 1.249, 1.257, - & 1.265, 1.273, 1.281, 1.289, 1.297, 1.305, 1.313, 1.321, 1.329, - & 1.337, 1.345, 1.353, 1.361, 1.369, 1.377, 1.384, 1.392, 1.400, - & 1.408, 1.416, 1.423, 1.431, 1.439, 1.447, 1.454, 1.462, 1.470, - & 1.477, 1.485, 1.493, 1.500, 1.508, 1.515, 1.523, 1.530, 1.538, - & 1.545, 1.553, 1.560, 1.568, 1.575, 1.583, 1.590, 1.598, 1.605, - & 1.612, 1.620, 1.627, 1.634, 1.642, 1.649, 1.656, 1.663, 1.671, - & 1.678, 1.685, 1.692, 1.699, 1.707, 1.714, 1.721, 1.728, 1.735, - & 1.742, 1.749, 1.756, 1.763, 1.770, 1.778, 1.785, 1.791, 1.798, - & 1.805, 1.812, 1.819, 1.826, 1.833, 1.840, 1.847, 1.854, 1.861, - & 1.867, 1.874, 1.881, 1.888, 1.895, 1.901, 1.908, 1.915, 1.922, - & 1.928, 1.935, 1.942, 1.948, 1.955, 1.962, 1.968, 1.975, 1.981, - & 1.988, 1.995, 2.001, 2.008, 2.014, 2.021, 2.027, 2.034, 2.040, - & 2.047, 2.053, 2.060, 2.066, 2.072, 2.079, 2.085, 2.092, 2.098, - & 2.104, 2.111, 2.117, 2.123, 2.130, 2.136, 2.142, 2.148, 2.155, - & 2.161, 2.167, 2.173, 2.180, 2.186, 2.192, 2.198, 2.204, 2.210, - & 2.216, 2.223, 2.229, 2.235, 2.241, 2.247, 2.253, 2.259, 2.265, - & 2.271, 2.277, 2.283, 2.289, 2.295, 2.301, 2.307, 2.313, 2.319, - & 2.325, 2.331, 2.337, 2.343, 2.348, 2.354, 2.360, 2.366, 2.372, - & 2.378, 2.383, 2.389, 2.395, 2.401, 2.407, 2.412, 2.418, 2.424, - & 2.430, 2.435, 2.441, 2.447, 2.452, 2.458, 2.464, 2.469, 2.475, - & 2.481, 2.486, 2.492, 2.497, 2.503, 2.509, 2.514, 2.520, 2.525, - & 2.531, 2.536, 2.542, 2.547, 2.553, 2.558, 2.564, 2.569, 2.575, - & 2.580, 2.586, 2.591, 2.597, 2.602, 2.607, 2.613, 2.618, 2.624, - & 2.629, 2.634, 2.640, 2.645, 2.702, 2.754, 2.805, 2.855, 2.904, - & 2.953, 3.001, 3.048, 3.094, 3.139, 3.184, 3.228, 3.272, 3.315, - & 3.357, 3.399, 3.440, 3.480, 3.520, 3.559, 3.598, 3.636, 3.674, - & 3.711, 3.748, 3.784, 3.820, 3.855, 3.890, 3.925, 3.959, 3.992, - & 4.026, 4.058, 4.091, 4.123, 4.155, 4.186, 4.217, 4.247, 4.278, - & 4.308, 4.337, 4.366, 4.395, 4.424, 4.452, 4.480, 4.508, 4.535, - & 4.562, 4.589, 4.616, 4.642, 4.668, 4.694, 4.719, 4.745, 4.770, - & 4.794, 4.819, 4.843, 4.867, 4.891, 4.915, 4.938, 4.961, 4.984, - & 5.007, 5.029, 5.052, 5.074, 5.096, 5.117, 5.139, 5.160, 5.181, - & 5.202, 5.223, 5.244, 5.264, 5.285, 5.305, 5.324, 5.344, 5.364, - & 5.383, 5.402, 5.422, 5.441, 5.459, 5.478, 5.496, 5.515, 5.533, - & 5.551, 5.569, 5.587, 5.604, 5.622, 5.639, 5.656, 5.673, 5.690, - & 5.707, 5.724, 5.740, 5.757, 5.773, 5.789, 5.806, 5.821, 5.837, - & 5.853, 5.869, 5.884, 5.900, 5.915, 5.930, 5.945, 5.960, 5.975, - & 5.990, 6.004, 6.019, 6.033, 6.048, 6.062, 6.076, 6.090, 6.104, - & 6.118, 6.132, 6.145, 6.159, 6.172, 6.186, 6.199, 6.212, 6.225, - & 6.238, 6.251, 6.264, 6.277, 6.290, 6.302, 6.315, 6.327, 6.340, - & 6.352, 6.364, 6.377, 6.389, 6.401, 6.413, 6.424, 6.436, 6.448, - & 6.459, 6.471, 6.482 - & / -C -C *** NaHSO4 -C - DATA BNC12M/ - &-0.048,-0.099,-0.122,-0.137,-0.148,-0.156,-0.163,-0.168,-0.172, - &-0.175,-0.178,-0.180,-0.182,-0.183,-0.184,-0.184,-0.184,-0.184, - &-0.184,-0.183,-0.182,-0.181,-0.180,-0.179,-0.177,-0.176,-0.174, - &-0.172,-0.170,-0.167,-0.165,-0.163,-0.160,-0.157,-0.155,-0.152, - &-0.149,-0.146,-0.143,-0.139,-0.136,-0.133,-0.129,-0.126,-0.122, - &-0.118,-0.115,-0.111,-0.107,-0.103,-0.099,-0.095,-0.091,-0.087, - &-0.083,-0.079,-0.075,-0.071,-0.066,-0.062,-0.058,-0.053,-0.049, - &-0.044,-0.040,-0.035,-0.031,-0.026,-0.022,-0.017,-0.012,-0.007, - &-0.003, 0.002, 0.007, 0.012, 0.017, 0.022, 0.027, 0.032, 0.037, - & 0.042, 0.047, 0.052, 0.058, 0.063, 0.068, 0.073, 0.079, 0.084, - & 0.090, 0.095, 0.101, 0.106, 0.112, 0.117, 0.123, 0.128, 0.134, - & 0.140, 0.146, 0.151, 0.157, 0.163, 0.169, 0.175, 0.180, 0.186, - & 0.192, 0.198, 0.204, 0.210, 0.216, 0.222, 0.228, 0.234, 0.240, - & 0.246, 0.252, 0.258, 0.264, 0.270, 0.276, 0.282, 0.288, 0.294, - & 0.300, 0.306, 0.312, 0.318, 0.323, 0.329, 0.335, 0.341, 0.347, - & 0.353, 0.359, 0.365, 0.371, 0.377, 0.383, 0.389, 0.394, 0.400, - & 0.406, 0.412, 0.418, 0.424, 0.429, 0.435, 0.441, 0.447, 0.453, - & 0.458, 0.464, 0.470, 0.476, 0.481, 0.487, 0.493, 0.498, 0.504, - & 0.510, 0.515, 0.521, 0.526, 0.532, 0.538, 0.543, 0.549, 0.554, - & 0.560, 0.565, 0.571, 0.576, 0.582, 0.587, 0.593, 0.598, 0.604, - & 0.609, 0.615, 0.620, 0.625, 0.631, 0.636, 0.641, 0.647, 0.652, - & 0.657, 0.663, 0.668, 0.673, 0.679, 0.684, 0.689, 0.694, 0.700, - & 0.705, 0.710, 0.715, 0.720, 0.726, 0.731, 0.736, 0.741, 0.746, - & 0.751, 0.756, 0.761, 0.766, 0.772, 0.777, 0.782, 0.787, 0.792, - & 0.797, 0.802, 0.807, 0.812, 0.817, 0.822, 0.826, 0.831, 0.836, - & 0.841, 0.846, 0.851, 0.856, 0.861, 0.866, 0.870, 0.875, 0.880, - & 0.885, 0.890, 0.894, 0.899, 0.904, 0.909, 0.914, 0.918, 0.923, - & 0.928, 0.932, 0.937, 0.942, 0.946, 0.951, 0.956, 0.960, 0.965, - & 0.970, 0.974, 0.979, 0.984, 0.988, 0.993, 0.997, 1.002, 1.006, - & 1.011, 1.015, 1.020, 1.024, 1.029, 1.033, 1.038, 1.042, 1.047, - & 1.051, 1.056, 1.060, 1.065, 1.069, 1.073, 1.078, 1.082, 1.087, - & 1.091, 1.095, 1.100, 1.104, 1.108, 1.113, 1.117, 1.121, 1.126, - & 1.130, 1.134, 1.138, 1.143, 1.147, 1.151, 1.155, 1.160, 1.164, - & 1.168, 1.172, 1.177, 1.181, 1.185, 1.189, 1.193, 1.197, 1.202, - & 1.206, 1.210, 1.214, 1.218, 1.222, 1.226, 1.230, 1.234, 1.238, - & 1.243, 1.247, 1.251, 1.255, 1.259, 1.263, 1.267, 1.271, 1.275, - & 1.279, 1.283, 1.287, 1.291, 1.295, 1.299, 1.303, 1.306, 1.310, - & 1.314, 1.318, 1.322, 1.326, 1.330, 1.334, 1.338, 1.342, 1.345, - & 1.349, 1.353, 1.357, 1.361, 1.365, 1.368, 1.372, 1.376, 1.380, - & 1.384, 1.387, 1.391, 1.395, 1.399, 1.403, 1.406, 1.410, 1.414, - & 1.418, 1.421, 1.425, 1.429, 1.432, 1.436, 1.440, 1.443, 1.447, - & 1.451, 1.454, 1.458, 1.462, 1.465, 1.469, 1.473, 1.476, 1.480, - & 1.484, 1.487, 1.491, 1.494, 1.498, 1.501, 1.505, 1.509, 1.512, - & 1.516, 1.519, 1.523, 1.526, 1.530, 1.533, 1.537, 1.540, 1.544, - & 1.547, 1.551, 1.554, 1.558, 1.595, 1.629, 1.662, 1.695, 1.727, - & 1.759, 1.790, 1.820, 1.850, 1.880, 1.909, 1.938, 1.966, 1.994, - & 2.022, 2.049, 2.076, 2.102, 2.128, 2.153, 2.179, 2.203, 2.228, - & 2.252, 2.276, 2.300, 2.323, 2.346, 2.368, 2.391, 2.413, 2.435, - & 2.456, 2.477, 2.498, 2.519, 2.539, 2.560, 2.580, 2.599, 2.619, - & 2.638, 2.657, 2.676, 2.695, 2.713, 2.731, 2.749, 2.767, 2.785, - & 2.802, 2.819, 2.836, 2.853, 2.870, 2.886, 2.902, 2.918, 2.934, - & 2.950, 2.966, 2.981, 2.997, 3.012, 3.027, 3.042, 3.056, 3.071, - & 3.085, 3.099, 3.114, 3.128, 3.141, 3.155, 3.169, 3.182, 3.195, - & 3.209, 3.222, 3.235, 3.247, 3.260, 3.273, 3.285, 3.298, 3.310, - & 3.322, 3.334, 3.346, 3.358, 3.369, 3.381, 3.392, 3.404, 3.415, - & 3.426, 3.437, 3.448, 3.459, 3.470, 3.481, 3.491, 3.502, 3.512, - & 3.523, 3.533, 3.543, 3.553, 3.563, 3.573, 3.583, 3.593, 3.603, - & 3.612, 3.622, 3.631, 3.640, 3.650, 3.659, 3.668, 3.677, 3.686, - & 3.695, 3.704, 3.713, 3.721, 3.730, 3.739, 3.747, 3.756, 3.764, - & 3.772, 3.781, 3.789, 3.797, 3.805, 3.813, 3.821, 3.829, 3.836, - & 3.844, 3.852, 3.860, 3.867, 3.875, 3.882, 3.889, 3.897, 3.904, - & 3.911, 3.919, 3.926, 3.933, 3.940, 3.947, 3.954, 3.961, 3.967, - & 3.974, 3.981, 3.988 - & / -C -C *** (NH4)3H(SO4)2 -C - DATA BNC13M/ - &-0.080,-0.174,-0.221,-0.254,-0.280,-0.302,-0.321,-0.337,-0.352, - &-0.365,-0.377,-0.388,-0.398,-0.408,-0.417,-0.425,-0.433,-0.440, - &-0.447,-0.454,-0.461,-0.467,-0.472,-0.478,-0.483,-0.488,-0.493, - &-0.498,-0.503,-0.507,-0.511,-0.515,-0.519,-0.523,-0.527,-0.530, - &-0.533,-0.537,-0.540,-0.543,-0.546,-0.549,-0.551,-0.554,-0.557, - &-0.559,-0.562,-0.564,-0.566,-0.569,-0.571,-0.573,-0.575,-0.577, - &-0.579,-0.580,-0.582,-0.584,-0.586,-0.587,-0.589,-0.590,-0.592, - &-0.593,-0.595,-0.596,-0.597,-0.599,-0.600,-0.601,-0.602,-0.603, - &-0.604,-0.605,-0.607,-0.608,-0.609,-0.609,-0.610,-0.611,-0.612, - &-0.613,-0.614,-0.614,-0.615,-0.616,-0.617,-0.617,-0.618,-0.619, - &-0.619,-0.620,-0.620,-0.621,-0.621,-0.622,-0.622,-0.623,-0.623, - &-0.624,-0.624,-0.624,-0.625,-0.625,-0.626,-0.626,-0.626,-0.626, - &-0.627,-0.627,-0.627,-0.628,-0.628,-0.628,-0.628,-0.628,-0.629, - &-0.629,-0.629,-0.629,-0.629,-0.629,-0.630,-0.630,-0.630,-0.630, - &-0.630,-0.630,-0.630,-0.630,-0.630,-0.631,-0.631,-0.631,-0.631, - &-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631, - &-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, - &-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.633,-0.633, - &-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633, - &-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633, - &-0.633,-0.633,-0.633,-0.633,-0.634,-0.634,-0.634,-0.634,-0.634, - &-0.634,-0.634,-0.634,-0.634,-0.634,-0.634,-0.634,-0.634,-0.634, - &-0.634,-0.634,-0.634,-0.634,-0.635,-0.635,-0.635,-0.635,-0.635, - &-0.635,-0.635,-0.635,-0.635,-0.635,-0.635,-0.635,-0.635,-0.635, - &-0.636,-0.636,-0.636,-0.636,-0.636,-0.636,-0.636,-0.636,-0.636, - &-0.636,-0.636,-0.636,-0.637,-0.637,-0.637,-0.637,-0.637,-0.637, - &-0.637,-0.637,-0.637,-0.637,-0.637,-0.638,-0.638,-0.638,-0.638, - &-0.638,-0.638,-0.638,-0.638,-0.638,-0.638,-0.639,-0.639,-0.639, - &-0.639,-0.639,-0.639,-0.639,-0.639,-0.639,-0.639,-0.640,-0.640, - &-0.640,-0.640,-0.640,-0.640,-0.640,-0.640,-0.640,-0.641,-0.641, - &-0.641,-0.641,-0.641,-0.641,-0.641,-0.641,-0.642,-0.642,-0.642, - &-0.642,-0.642,-0.642,-0.642,-0.642,-0.643,-0.643,-0.643,-0.643, - &-0.643,-0.643,-0.643,-0.643,-0.644,-0.644,-0.644,-0.644,-0.644, - &-0.644,-0.644,-0.645,-0.645,-0.645,-0.645,-0.645,-0.645,-0.645, - &-0.646,-0.646,-0.646,-0.646,-0.648,-0.649,-0.651,-0.652,-0.654, - &-0.656,-0.658,-0.660,-0.662,-0.664,-0.666,-0.668,-0.670,-0.673, - &-0.675,-0.677,-0.680,-0.682,-0.685,-0.687,-0.690,-0.693,-0.695, - &-0.698,-0.701,-0.704,-0.707,-0.709,-0.712,-0.715,-0.718,-0.722, - &-0.725,-0.728,-0.731,-0.734,-0.737,-0.741,-0.744,-0.747,-0.751, - &-0.754,-0.758,-0.761,-0.764,-0.768,-0.772,-0.775,-0.779,-0.782, - &-0.786,-0.790,-0.793,-0.797,-0.801,-0.805,-0.809,-0.812,-0.816, - &-0.820,-0.824,-0.828,-0.832,-0.836,-0.840,-0.844,-0.848,-0.852, - &-0.856,-0.860,-0.864,-0.868,-0.873,-0.877,-0.881,-0.885,-0.889, - &-0.894,-0.898,-0.902,-0.906,-0.911,-0.915,-0.919,-0.924,-0.928, - &-0.932,-0.937,-0.941,-0.946,-0.950,-0.955,-0.959,-0.964,-0.968, - &-0.973,-0.977,-0.982,-0.986,-0.991,-0.995,-1.000,-1.005,-1.009, - &-1.014,-1.019,-1.023,-1.028,-1.033,-1.037,-1.042,-1.047,-1.051, - &-1.056,-1.061,-1.066,-1.071,-1.075,-1.080,-1.085,-1.090,-1.095, - &-1.099,-1.104,-1.109,-1.114,-1.119,-1.124,-1.129,-1.134,-1.138, - &-1.143,-1.148,-1.153,-1.158,-1.163,-1.168,-1.173,-1.178,-1.183, - &-1.188,-1.193,-1.198,-1.203,-1.208,-1.213,-1.218,-1.223,-1.228, - &-1.233,-1.238,-1.244,-1.249,-1.254,-1.259,-1.264,-1.269,-1.274, - &-1.279,-1.284,-1.290 - & / -C -C *** CASO4 -C - DATA BNC14M/ - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000 - & / -C -C *** CANO32 -C - DATA BNC15M/ - &-0.099,-0.211,-0.264,-0.301,-0.329,-0.351,-0.370,-0.386,-0.399, - &-0.411,-0.422,-0.432,-0.440,-0.448,-0.455,-0.462,-0.468,-0.473, - &-0.478,-0.483,-0.487,-0.491,-0.495,-0.499,-0.502,-0.505,-0.508, - &-0.511,-0.513,-0.516,-0.518,-0.520,-0.522,-0.524,-0.526,-0.528, - &-0.529,-0.531,-0.532,-0.534,-0.535,-0.536,-0.537,-0.539,-0.540, - &-0.541,-0.542,-0.543,-0.544,-0.545,-0.545,-0.546,-0.547,-0.548, - &-0.549,-0.549,-0.550,-0.551,-0.551,-0.552,-0.552,-0.553,-0.553, - &-0.554,-0.554,-0.555,-0.555,-0.556,-0.556,-0.556,-0.557,-0.557, - &-0.557,-0.558,-0.558,-0.558,-0.558,-0.559,-0.559,-0.559,-0.559, - &-0.559,-0.559,-0.559,-0.559,-0.559,-0.559,-0.559,-0.559,-0.559, - &-0.559,-0.559,-0.559,-0.559,-0.558,-0.558,-0.558,-0.558,-0.557, - &-0.557,-0.557,-0.556,-0.556,-0.556,-0.555,-0.555,-0.555,-0.554, - &-0.554,-0.553,-0.553,-0.552,-0.552,-0.551,-0.551,-0.550,-0.550, - &-0.549,-0.549,-0.548,-0.548,-0.547,-0.547,-0.546,-0.545,-0.545, - &-0.544,-0.544,-0.543,-0.542,-0.542,-0.541,-0.541,-0.540,-0.539, - &-0.539,-0.538,-0.538,-0.537,-0.536,-0.536,-0.535,-0.534,-0.534, - &-0.533,-0.533,-0.532,-0.531,-0.531,-0.530,-0.529,-0.529,-0.528, - &-0.527,-0.527,-0.526,-0.525,-0.525,-0.524,-0.524,-0.523,-0.522, - &-0.522,-0.521,-0.520,-0.520,-0.519,-0.518,-0.518,-0.517,-0.516, - &-0.516,-0.515,-0.514,-0.514,-0.513,-0.513,-0.512,-0.511,-0.511, - &-0.510,-0.509,-0.509,-0.508,-0.507,-0.507,-0.506,-0.505,-0.505, - &-0.504,-0.504,-0.503,-0.502,-0.502,-0.501,-0.500,-0.500,-0.499, - &-0.499,-0.498,-0.497,-0.497,-0.496,-0.495,-0.495,-0.494,-0.494, - &-0.493,-0.492,-0.492,-0.491,-0.490,-0.490,-0.489,-0.489,-0.488, - &-0.487,-0.487,-0.486,-0.486,-0.485,-0.484,-0.484,-0.483,-0.483, - &-0.482,-0.481,-0.481,-0.480,-0.480,-0.479,-0.478,-0.478,-0.477, - &-0.477,-0.476,-0.475,-0.475,-0.474,-0.474,-0.473,-0.473,-0.472, - &-0.471,-0.471,-0.470,-0.470,-0.469,-0.469,-0.468,-0.468,-0.467, - &-0.466,-0.466,-0.465,-0.465,-0.464,-0.464,-0.463,-0.463,-0.462, - &-0.461,-0.461,-0.460,-0.460,-0.459,-0.459,-0.458,-0.458,-0.457, - &-0.457,-0.456,-0.456,-0.455,-0.455,-0.454,-0.453,-0.453,-0.452, - &-0.452,-0.451,-0.451,-0.450,-0.450,-0.449,-0.449,-0.448,-0.448, - &-0.447,-0.447,-0.446,-0.446,-0.445,-0.445,-0.444,-0.444,-0.443, - &-0.443,-0.442,-0.442,-0.441,-0.441,-0.440,-0.440,-0.440,-0.439, - &-0.439,-0.438,-0.438,-0.437,-0.437,-0.436,-0.436,-0.435,-0.435, - &-0.434,-0.434,-0.433,-0.433,-0.433,-0.432,-0.432,-0.431,-0.431, - &-0.430,-0.430,-0.429,-0.429,-0.429,-0.428,-0.428,-0.427,-0.427, - &-0.426,-0.426,-0.426,-0.425,-0.425,-0.424,-0.424,-0.423,-0.423, - &-0.423,-0.422,-0.422,-0.421,-0.421,-0.421,-0.420,-0.420,-0.419, - &-0.419,-0.419,-0.418,-0.418,-0.417,-0.417,-0.417,-0.416,-0.416, - &-0.415,-0.415,-0.415,-0.414,-0.414,-0.413,-0.413,-0.413,-0.412, - &-0.412,-0.412,-0.411,-0.411,-0.410,-0.410,-0.410,-0.409,-0.409, - &-0.409,-0.408,-0.408,-0.408,-0.407,-0.407,-0.407,-0.406,-0.406, - &-0.405,-0.405,-0.405,-0.404,-0.404,-0.404,-0.403,-0.403,-0.403, - &-0.402,-0.402,-0.402,-0.401,-0.398,-0.395,-0.392,-0.389,-0.386, - &-0.384,-0.381,-0.379,-0.377,-0.375,-0.373,-0.371,-0.369,-0.368, - &-0.366,-0.365,-0.364,-0.363,-0.362,-0.361,-0.360,-0.359,-0.358, - &-0.358,-0.357,-0.357,-0.357,-0.356,-0.356,-0.356,-0.356,-0.356, - &-0.356,-0.357,-0.357,-0.357,-0.358,-0.358,-0.359,-0.360,-0.361, - &-0.361,-0.362,-0.363,-0.364,-0.365,-0.367,-0.368,-0.369,-0.370, - &-0.372,-0.373,-0.375,-0.376,-0.378,-0.380,-0.381,-0.383,-0.385, - &-0.387,-0.389,-0.391,-0.393,-0.395,-0.397,-0.399,-0.401,-0.404, - &-0.406,-0.408,-0.411,-0.413,-0.416,-0.418,-0.421,-0.423,-0.426, - &-0.429,-0.431,-0.434,-0.437,-0.440,-0.442,-0.445,-0.448,-0.451, - &-0.454,-0.457,-0.460,-0.463,-0.467,-0.470,-0.473,-0.476,-0.480, - &-0.483,-0.486,-0.490,-0.493,-0.496,-0.500,-0.503,-0.507,-0.510, - &-0.514,-0.517,-0.521,-0.525,-0.528,-0.532,-0.536,-0.540,-0.543, - &-0.547,-0.551,-0.555,-0.559,-0.563,-0.566,-0.570,-0.574,-0.578, - &-0.582,-0.586,-0.590,-0.595,-0.599,-0.603,-0.607,-0.611,-0.615, - &-0.619,-0.624,-0.628,-0.632,-0.637,-0.641,-0.645,-0.650,-0.654, - &-0.658,-0.663,-0.667,-0.672,-0.676,-0.680,-0.685,-0.689,-0.694, - &-0.699,-0.703,-0.708,-0.712,-0.717,-0.722,-0.726,-0.731,-0.736, - &-0.740,-0.745,-0.750 - & / -C -C *** CACL2 -C - DATA BNC16M/ - &-0.097,-0.201,-0.247,-0.277,-0.298,-0.314,-0.327,-0.337,-0.345, - &-0.351,-0.356,-0.359,-0.362,-0.365,-0.366,-0.367,-0.367,-0.367, - &-0.367,-0.366,-0.365,-0.364,-0.362,-0.361,-0.359,-0.356,-0.354, - &-0.352,-0.349,-0.346,-0.343,-0.340,-0.337,-0.334,-0.331,-0.328, - &-0.324,-0.321,-0.317,-0.314,-0.310,-0.307,-0.303,-0.300,-0.296, - &-0.292,-0.289,-0.285,-0.281,-0.277,-0.274,-0.270,-0.266,-0.262, - &-0.259,-0.255,-0.251,-0.247,-0.244,-0.240,-0.236,-0.232,-0.228, - &-0.224,-0.221,-0.217,-0.213,-0.209,-0.205,-0.201,-0.197,-0.193, - &-0.189,-0.185,-0.181,-0.177,-0.173,-0.169,-0.165,-0.161,-0.157, - &-0.152,-0.148,-0.144,-0.139,-0.135,-0.131,-0.126,-0.122,-0.117, - &-0.113,-0.108,-0.104,-0.099,-0.095,-0.090,-0.085,-0.080,-0.076, - &-0.071,-0.066,-0.061,-0.056,-0.051,-0.047,-0.042,-0.037,-0.032, - &-0.027,-0.022,-0.017,-0.012,-0.006,-0.001, 0.004, 0.009, 0.014, - & 0.019, 0.024, 0.029, 0.034, 0.040, 0.045, 0.050, 0.055, 0.060, - & 0.065, 0.071, 0.076, 0.081, 0.086, 0.091, 0.096, 0.102, 0.107, - & 0.112, 0.117, 0.122, 0.127, 0.133, 0.138, 0.143, 0.148, 0.153, - & 0.158, 0.163, 0.168, 0.174, 0.179, 0.184, 0.189, 0.194, 0.199, - & 0.204, 0.209, 0.214, 0.219, 0.224, 0.229, 0.234, 0.239, 0.244, - & 0.249, 0.254, 0.259, 0.264, 0.269, 0.274, 0.279, 0.284, 0.289, - & 0.294, 0.299, 0.304, 0.309, 0.314, 0.319, 0.324, 0.329, 0.334, - & 0.338, 0.343, 0.348, 0.353, 0.358, 0.363, 0.368, 0.372, 0.377, - & 0.382, 0.387, 0.392, 0.396, 0.401, 0.406, 0.411, 0.415, 0.420, - & 0.425, 0.430, 0.434, 0.439, 0.444, 0.449, 0.453, 0.458, 0.463, - & 0.467, 0.472, 0.477, 0.481, 0.486, 0.491, 0.495, 0.500, 0.504, - & 0.509, 0.514, 0.518, 0.523, 0.527, 0.532, 0.536, 0.541, 0.545, - & 0.550, 0.555, 0.559, 0.564, 0.568, 0.573, 0.577, 0.581, 0.586, - & 0.590, 0.595, 0.599, 0.604, 0.608, 0.613, 0.617, 0.621, 0.626, - & 0.630, 0.635, 0.639, 0.643, 0.648, 0.652, 0.656, 0.661, 0.665, - & 0.669, 0.674, 0.678, 0.682, 0.686, 0.691, 0.695, 0.699, 0.703, - & 0.708, 0.712, 0.716, 0.720, 0.725, 0.729, 0.733, 0.737, 0.741, - & 0.746, 0.750, 0.754, 0.758, 0.762, 0.766, 0.770, 0.775, 0.779, - & 0.783, 0.787, 0.791, 0.795, 0.799, 0.803, 0.807, 0.811, 0.815, - & 0.819, 0.823, 0.827, 0.831, 0.835, 0.839, 0.843, 0.847, 0.851, - & 0.855, 0.859, 0.863, 0.867, 0.871, 0.875, 0.879, 0.883, 0.887, - & 0.891, 0.895, 0.899, 0.902, 0.906, 0.910, 0.914, 0.918, 0.922, - & 0.926, 0.929, 0.933, 0.937, 0.941, 0.945, 0.949, 0.952, 0.956, - & 0.960, 0.964, 0.967, 0.971, 0.975, 0.979, 0.982, 0.986, 0.990, - & 0.994, 0.997, 1.001, 1.005, 1.008, 1.012, 1.016, 1.019, 1.023, - & 1.027, 1.030, 1.034, 1.038, 1.041, 1.045, 1.049, 1.052, 1.056, - & 1.059, 1.063, 1.067, 1.070, 1.074, 1.077, 1.081, 1.084, 1.088, - & 1.091, 1.095, 1.098, 1.102, 1.106, 1.109, 1.113, 1.116, 1.119, - & 1.123, 1.126, 1.130, 1.133, 1.137, 1.140, 1.144, 1.147, 1.151, - & 1.154, 1.157, 1.161, 1.164, 1.168, 1.171, 1.174, 1.178, 1.181, - & 1.185, 1.188, 1.191, 1.195, 1.198, 1.201, 1.205, 1.208, 1.211, - & 1.215, 1.218, 1.221, 1.225, 1.260, 1.292, 1.323, 1.354, 1.385, - & 1.415, 1.444, 1.473, 1.501, 1.529, 1.557, 1.584, 1.610, 1.636, - & 1.662, 1.687, 1.712, 1.737, 1.761, 1.784, 1.808, 1.831, 1.853, - & 1.876, 1.898, 1.919, 1.940, 1.961, 1.982, 2.002, 2.022, 2.042, - & 2.062, 2.081, 2.100, 2.118, 2.137, 2.155, 2.172, 2.190, 2.207, - & 2.224, 2.241, 2.258, 2.274, 2.290, 2.306, 2.322, 2.337, 2.353, - & 2.368, 2.382, 2.397, 2.412, 2.426, 2.440, 2.454, 2.467, 2.481, - & 2.494, 2.507, 2.520, 2.533, 2.546, 2.558, 2.571, 2.583, 2.595, - & 2.606, 2.618, 2.630, 2.641, 2.652, 2.663, 2.674, 2.685, 2.696, - & 2.706, 2.717, 2.727, 2.737, 2.747, 2.757, 2.767, 2.776, 2.786, - & 2.795, 2.804, 2.813, 2.822, 2.831, 2.840, 2.849, 2.857, 2.866, - & 2.874, 2.882, 2.891, 2.899, 2.907, 2.914, 2.922, 2.930, 2.937, - & 2.945, 2.952, 2.959, 2.966, 2.973, 2.980, 2.987, 2.994, 3.001, - & 3.007, 3.014, 3.020, 3.027, 3.033, 3.039, 3.045, 3.051, 3.057, - & 3.063, 3.069, 3.075, 3.081, 3.086, 3.092, 3.097, 3.102, 3.108, - & 3.113, 3.118, 3.123, 3.128, 3.133, 3.138, 3.143, 3.147, 3.152, - & 3.157, 3.161, 3.166, 3.170, 3.175, 3.179, 3.183, 3.187, 3.191, - & 3.195, 3.199, 3.203, 3.207, 3.211, 3.215, 3.219, 3.222, 3.226, - & 3.229, 3.233, 3.236 - & / -C -C *** K2SO4 -C - DATA BNC17M/ - &-0.101,-0.220,-0.281,-0.324,-0.358,-0.387,-0.412,-0.434,-0.453, - &-0.471,-0.487,-0.503,-0.517,-0.530,-0.543,-0.555,-0.566,-0.577, - &-0.587,-0.597,-0.606,-0.615,-0.624,-0.632,-0.641,-0.649,-0.656, - &-0.664,-0.671,-0.678,-0.685,-0.692,-0.698,-0.705,-0.711,-0.717, - &-0.723,-0.729,-0.735,-0.740,-0.746,-0.752,-0.757,-0.762,-0.767, - &-0.772,-0.777,-0.782,-0.787,-0.792,-0.797,-0.801,-0.806,-0.810, - &-0.815,-0.819,-0.824,-0.828,-0.832,-0.836,-0.840,-0.844,-0.848, - &-0.852,-0.856,-0.860,-0.864,-0.868,-0.872,-0.876,-0.879,-0.883, - &-0.887,-0.890,-0.894,-0.897,-0.901,-0.904,-0.908,-0.911,-0.915, - &-0.918,-0.922,-0.925,-0.928,-0.932,-0.935,-0.938,-0.942,-0.945, - &-0.948,-0.951,-0.954,-0.958,-0.961,-0.964,-0.967,-0.970,-0.973, - &-0.976,-0.979,-0.982,-0.985,-0.988,-0.991,-0.994,-0.997,-1.000, - &-1.003,-1.006,-1.009,-1.012,-1.015,-1.018,-1.021,-1.024,-1.026, - &-1.029,-1.032,-1.035,-1.038,-1.040,-1.043,-1.046,-1.049,-1.051, - &-1.054,-1.057,-1.060,-1.062,-1.065,-1.068,-1.070,-1.073,-1.076, - &-1.078,-1.081,-1.083,-1.086,-1.089,-1.091,-1.094,-1.096,-1.099, - &-1.102,-1.104,-1.107,-1.109,-1.112,-1.114,-1.117,-1.119,-1.122, - &-1.124,-1.127,-1.129,-1.131,-1.134,-1.136,-1.139,-1.141,-1.144, - &-1.146,-1.148,-1.151,-1.153,-1.155,-1.158,-1.160,-1.163,-1.165, - &-1.167,-1.170,-1.172,-1.174,-1.177,-1.179,-1.181,-1.183,-1.186, - &-1.188,-1.190,-1.193,-1.195,-1.197,-1.199,-1.202,-1.204,-1.206, - &-1.208,-1.210,-1.213,-1.215,-1.217,-1.219,-1.221,-1.224,-1.226, - &-1.228,-1.230,-1.232,-1.235,-1.237,-1.239,-1.241,-1.243,-1.245, - &-1.247,-1.250,-1.252,-1.254,-1.256,-1.258,-1.260,-1.262,-1.264, - &-1.266,-1.269,-1.271,-1.273,-1.275,-1.277,-1.279,-1.281,-1.283, - &-1.285,-1.287,-1.289,-1.291,-1.293,-1.295,-1.297,-1.299,-1.301, - &-1.303,-1.305,-1.307,-1.309,-1.311,-1.313,-1.315,-1.317,-1.319, - &-1.321,-1.323,-1.325,-1.327,-1.329,-1.331,-1.333,-1.335,-1.337, - &-1.339,-1.341,-1.343,-1.345,-1.347,-1.349,-1.351,-1.353,-1.355, - &-1.357,-1.358,-1.360,-1.362,-1.364,-1.366,-1.368,-1.370,-1.372, - &-1.374,-1.376,-1.377,-1.379,-1.381,-1.383,-1.385,-1.387,-1.389, - &-1.391,-1.392,-1.394,-1.396,-1.398,-1.400,-1.402,-1.404,-1.405, - &-1.407,-1.409,-1.411,-1.413,-1.415,-1.417,-1.418,-1.420,-1.422, - &-1.424,-1.426,-1.427,-1.429,-1.431,-1.433,-1.435,-1.437,-1.438, - &-1.440,-1.442,-1.444,-1.445,-1.447,-1.449,-1.451,-1.453,-1.454, - &-1.456,-1.458,-1.460,-1.462,-1.463,-1.465,-1.467,-1.469,-1.470, - &-1.472,-1.474,-1.476,-1.477,-1.479,-1.481,-1.483,-1.484,-1.486, - &-1.488,-1.490,-1.491,-1.493,-1.495,-1.496,-1.498,-1.500,-1.502, - &-1.503,-1.505,-1.507,-1.509,-1.510,-1.512,-1.514,-1.515,-1.517, - &-1.519,-1.520,-1.522,-1.524,-1.526,-1.527,-1.529,-1.531,-1.532, - &-1.534,-1.536,-1.537,-1.539,-1.541,-1.542,-1.544,-1.546,-1.547, - &-1.549,-1.551,-1.552,-1.554,-1.556,-1.557,-1.559,-1.561,-1.562, - &-1.564,-1.566,-1.567,-1.569,-1.571,-1.572,-1.574,-1.576,-1.577, - &-1.579,-1.580,-1.582,-1.584,-1.585,-1.587,-1.589,-1.590,-1.592, - &-1.594,-1.595,-1.597,-1.598,-1.616,-1.632,-1.648,-1.663,-1.679, - &-1.694,-1.710,-1.725,-1.740,-1.755,-1.770,-1.785,-1.799,-1.814, - &-1.828,-1.843,-1.857,-1.871,-1.885,-1.900,-1.914,-1.928,-1.941, - &-1.955,-1.969,-1.983,-1.996,-2.010,-2.023,-2.037,-2.050,-2.063, - &-2.077,-2.090,-2.103,-2.116,-2.129,-2.142,-2.155,-2.168,-2.181, - &-2.194,-2.206,-2.219,-2.232,-2.244,-2.257,-2.269,-2.282,-2.294, - &-2.307,-2.319,-2.332,-2.344,-2.356,-2.369,-2.381,-2.393,-2.405, - &-2.417,-2.429,-2.441,-2.454,-2.466,-2.478,-2.489,-2.501,-2.513, - &-2.525,-2.537,-2.549,-2.561,-2.572,-2.584,-2.596,-2.608,-2.619, - &-2.631,-2.642,-2.654,-2.666,-2.677,-2.689,-2.700,-2.712,-2.723, - &-2.735,-2.746,-2.757,-2.769,-2.780,-2.792,-2.803,-2.814,-2.825, - &-2.837,-2.848,-2.859,-2.870,-2.882,-2.893,-2.904,-2.915,-2.926, - &-2.937,-2.948,-2.959,-2.971,-2.982,-2.993,-3.004,-3.015,-3.026, - &-3.037,-3.048,-3.058,-3.069,-3.080,-3.091,-3.102,-3.113,-3.124, - &-3.135,-3.145,-3.156,-3.167,-3.178,-3.189,-3.199,-3.210,-3.221, - &-3.232,-3.242,-3.253,-3.264,-3.274,-3.285,-3.296,-3.306,-3.317, - &-3.327,-3.338,-3.349,-3.359,-3.370,-3.380,-3.391,-3.401,-3.412, - &-3.422,-3.433,-3.443,-3.454,-3.464,-3.475,-3.485,-3.496,-3.506, - &-3.517,-3.527,-3.537 - & / -C -C *** KHSO4 -C - DATA BNC18M/ - &-0.049,-0.104,-0.130,-0.148,-0.162,-0.173,-0.182,-0.190,-0.197, - &-0.203,-0.208,-0.213,-0.217,-0.221,-0.224,-0.227,-0.230,-0.232, - &-0.234,-0.236,-0.238,-0.239,-0.240,-0.241,-0.242,-0.243,-0.243, - &-0.244,-0.244,-0.244,-0.244,-0.244,-0.243,-0.243,-0.242,-0.242, - &-0.241,-0.240,-0.239,-0.238,-0.237,-0.236,-0.235,-0.233,-0.232, - &-0.230,-0.229,-0.227,-0.225,-0.223,-0.222,-0.220,-0.218,-0.216, - &-0.214,-0.211,-0.209,-0.207,-0.205,-0.202,-0.200,-0.197,-0.195, - &-0.192,-0.190,-0.187,-0.185,-0.182,-0.179,-0.176,-0.174,-0.171, - &-0.168,-0.165,-0.162,-0.159,-0.156,-0.153,-0.150,-0.147,-0.143, - &-0.140,-0.137,-0.134,-0.131,-0.127,-0.124,-0.120,-0.117,-0.114, - &-0.110,-0.107,-0.103,-0.100,-0.096,-0.092,-0.089,-0.085,-0.081, - &-0.078,-0.074,-0.070,-0.066,-0.063,-0.059,-0.055,-0.051,-0.047, - &-0.043,-0.040,-0.036,-0.032,-0.028,-0.024,-0.020,-0.016,-0.012, - &-0.008,-0.004, 0.000, 0.004, 0.008, 0.012, 0.015, 0.019, 0.023, - & 0.027, 0.031, 0.035, 0.039, 0.043, 0.047, 0.051, 0.055, 0.059, - & 0.063, 0.067, 0.071, 0.075, 0.078, 0.082, 0.086, 0.090, 0.094, - & 0.098, 0.102, 0.106, 0.109, 0.113, 0.117, 0.121, 0.125, 0.128, - & 0.132, 0.136, 0.140, 0.144, 0.147, 0.151, 0.155, 0.159, 0.162, - & 0.166, 0.170, 0.173, 0.177, 0.181, 0.184, 0.188, 0.192, 0.195, - & 0.199, 0.203, 0.206, 0.210, 0.213, 0.217, 0.221, 0.224, 0.228, - & 0.231, 0.235, 0.238, 0.242, 0.245, 0.249, 0.252, 0.256, 0.259, - & 0.263, 0.266, 0.270, 0.273, 0.277, 0.280, 0.284, 0.287, 0.290, - & 0.294, 0.297, 0.301, 0.304, 0.307, 0.311, 0.314, 0.317, 0.321, - & 0.324, 0.327, 0.331, 0.334, 0.337, 0.340, 0.344, 0.347, 0.350, - & 0.353, 0.357, 0.360, 0.363, 0.366, 0.369, 0.373, 0.376, 0.379, - & 0.382, 0.385, 0.389, 0.392, 0.395, 0.398, 0.401, 0.404, 0.407, - & 0.410, 0.413, 0.417, 0.420, 0.423, 0.426, 0.429, 0.432, 0.435, - & 0.438, 0.441, 0.444, 0.447, 0.450, 0.453, 0.456, 0.459, 0.462, - & 0.465, 0.468, 0.471, 0.474, 0.477, 0.480, 0.482, 0.485, 0.488, - & 0.491, 0.494, 0.497, 0.500, 0.503, 0.506, 0.508, 0.511, 0.514, - & 0.517, 0.520, 0.523, 0.525, 0.528, 0.531, 0.534, 0.537, 0.539, - & 0.542, 0.545, 0.548, 0.551, 0.553, 0.556, 0.559, 0.562, 0.564, - & 0.567, 0.570, 0.572, 0.575, 0.578, 0.581, 0.583, 0.586, 0.589, - & 0.591, 0.594, 0.597, 0.599, 0.602, 0.604, 0.607, 0.610, 0.612, - & 0.615, 0.618, 0.620, 0.623, 0.625, 0.628, 0.631, 0.633, 0.636, - & 0.638, 0.641, 0.643, 0.646, 0.648, 0.651, 0.654, 0.656, 0.659, - & 0.661, 0.664, 0.666, 0.669, 0.671, 0.674, 0.676, 0.679, 0.681, - & 0.684, 0.686, 0.688, 0.691, 0.693, 0.696, 0.698, 0.701, 0.703, - & 0.706, 0.708, 0.710, 0.713, 0.715, 0.718, 0.720, 0.722, 0.725, - & 0.727, 0.729, 0.732, 0.734, 0.737, 0.739, 0.741, 0.744, 0.746, - & 0.748, 0.751, 0.753, 0.755, 0.758, 0.760, 0.762, 0.764, 0.767, - & 0.769, 0.771, 0.774, 0.776, 0.778, 0.780, 0.783, 0.785, 0.787, - & 0.789, 0.792, 0.794, 0.796, 0.798, 0.801, 0.803, 0.805, 0.807, - & 0.810, 0.812, 0.814, 0.816, 0.818, 0.821, 0.823, 0.825, 0.827, - & 0.829, 0.831, 0.834, 0.836, 0.859, 0.880, 0.900, 0.921, 0.940, - & 0.960, 0.979, 0.998, 1.016, 1.034, 1.052, 1.070, 1.087, 1.104, - & 1.121, 1.137, 1.154, 1.169, 1.185, 1.201, 1.216, 1.231, 1.246, - & 1.260, 1.274, 1.289, 1.302, 1.316, 1.330, 1.343, 1.356, 1.369, - & 1.382, 1.394, 1.407, 1.419, 1.431, 1.443, 1.455, 1.466, 1.478, - & 1.489, 1.500, 1.511, 1.522, 1.533, 1.543, 1.554, 1.564, 1.574, - & 1.584, 1.594, 1.604, 1.614, 1.623, 1.633, 1.642, 1.651, 1.660, - & 1.670, 1.678, 1.687, 1.696, 1.704, 1.713, 1.721, 1.730, 1.738, - & 1.746, 1.754, 1.762, 1.770, 1.777, 1.785, 1.793, 1.800, 1.807, - & 1.815, 1.822, 1.829, 1.836, 1.843, 1.850, 1.857, 1.864, 1.870, - & 1.877, 1.883, 1.890, 1.896, 1.903, 1.909, 1.915, 1.921, 1.927, - & 1.933, 1.939, 1.945, 1.951, 1.957, 1.962, 1.968, 1.973, 1.979, - & 1.984, 1.990, 1.995, 2.000, 2.006, 2.011, 2.016, 2.021, 2.026, - & 2.031, 2.036, 2.041, 2.045, 2.050, 2.055, 2.059, 2.064, 2.069, - & 2.073, 2.078, 2.082, 2.086, 2.091, 2.095, 2.099, 2.103, 2.108, - & 2.112, 2.116, 2.120, 2.124, 2.128, 2.132, 2.135, 2.139, 2.143, - & 2.147, 2.150, 2.154, 2.158, 2.161, 2.165, 2.168, 2.172, 2.175, - & 2.179, 2.182, 2.185, 2.189, 2.192, 2.195, 2.198, 2.201, 2.205, - & 2.208, 2.211, 2.214 - & / -C -C *** KNO3 -C - DATA BNC19M/ - &-0.052,-0.120,-0.158,-0.187,-0.211,-0.232,-0.251,-0.269,-0.285, - &-0.300,-0.315,-0.329,-0.342,-0.354,-0.367,-0.378,-0.390,-0.401, - &-0.412,-0.422,-0.432,-0.443,-0.452,-0.462,-0.471,-0.481,-0.490, - &-0.498,-0.507,-0.516,-0.524,-0.532,-0.540,-0.548,-0.556,-0.564, - &-0.572,-0.579,-0.587,-0.594,-0.601,-0.608,-0.615,-0.622,-0.629, - &-0.636,-0.642,-0.649,-0.655,-0.661,-0.668,-0.674,-0.680,-0.686, - &-0.692,-0.698,-0.704,-0.710,-0.715,-0.721,-0.727,-0.732,-0.738, - &-0.743,-0.749,-0.754,-0.759,-0.765,-0.770,-0.775,-0.780,-0.785, - &-0.790,-0.796,-0.801,-0.806,-0.811,-0.816,-0.820,-0.825,-0.830, - &-0.835,-0.840,-0.845,-0.850,-0.854,-0.859,-0.864,-0.869,-0.873, - &-0.878,-0.883,-0.888,-0.892,-0.897,-0.902,-0.906,-0.911,-0.916, - &-0.920,-0.925,-0.929,-0.934,-0.938,-0.943,-0.948,-0.952,-0.957, - &-0.961,-0.966,-0.970,-0.974,-0.979,-0.983,-0.988,-0.992,-0.996, - &-1.001,-1.005,-1.009,-1.014,-1.018,-1.022,-1.026,-1.031,-1.035, - &-1.039,-1.043,-1.047,-1.052,-1.056,-1.060,-1.064,-1.068,-1.072, - &-1.076,-1.080,-1.084,-1.088,-1.092,-1.096,-1.100,-1.104,-1.108, - &-1.112,-1.115,-1.119,-1.123,-1.127,-1.131,-1.134,-1.138,-1.142, - &-1.146,-1.149,-1.153,-1.157,-1.160,-1.164,-1.168,-1.171,-1.175, - &-1.178,-1.182,-1.185,-1.189,-1.192,-1.196,-1.199,-1.203,-1.206, - &-1.210,-1.213,-1.217,-1.220,-1.223,-1.227,-1.230,-1.234,-1.237, - &-1.240,-1.243,-1.247,-1.250,-1.253,-1.257,-1.260,-1.263,-1.266, - &-1.269,-1.273,-1.276,-1.279,-1.282,-1.285,-1.288,-1.291,-1.295, - &-1.298,-1.301,-1.304,-1.307,-1.310,-1.313,-1.316,-1.319,-1.322, - &-1.325,-1.328,-1.331,-1.334,-1.337,-1.340,-1.342,-1.345,-1.348, - &-1.351,-1.354,-1.357,-1.360,-1.362,-1.365,-1.368,-1.371,-1.374, - &-1.376,-1.379,-1.382,-1.385,-1.387,-1.390,-1.393,-1.396,-1.398, - &-1.401,-1.404,-1.406,-1.409,-1.412,-1.414,-1.417,-1.420,-1.422, - &-1.425,-1.427,-1.430,-1.432,-1.435,-1.438,-1.440,-1.443,-1.445, - &-1.448,-1.450,-1.453,-1.455,-1.458,-1.460,-1.463,-1.465,-1.468, - &-1.470,-1.472,-1.475,-1.477,-1.480,-1.482,-1.484,-1.487,-1.489, - &-1.492,-1.494,-1.496,-1.499,-1.501,-1.503,-1.506,-1.508,-1.510, - &-1.512,-1.515,-1.517,-1.519,-1.522,-1.524,-1.526,-1.528,-1.531, - &-1.533,-1.535,-1.537,-1.539,-1.542,-1.544,-1.546,-1.548,-1.550, - &-1.552,-1.555,-1.557,-1.559,-1.561,-1.563,-1.565,-1.567,-1.569, - &-1.572,-1.574,-1.576,-1.578,-1.580,-1.582,-1.584,-1.586,-1.588, - &-1.590,-1.592,-1.594,-1.596,-1.598,-1.600,-1.602,-1.604,-1.606, - &-1.608,-1.610,-1.612,-1.614,-1.616,-1.618,-1.620,-1.622,-1.624, - &-1.626,-1.628,-1.630,-1.632,-1.633,-1.635,-1.637,-1.639,-1.641, - &-1.643,-1.645,-1.647,-1.648,-1.650,-1.652,-1.654,-1.656,-1.658, - &-1.660,-1.661,-1.663,-1.665,-1.667,-1.669,-1.670,-1.672,-1.674, - &-1.676,-1.678,-1.679,-1.681,-1.683,-1.685,-1.686,-1.688,-1.690, - &-1.692,-1.693,-1.695,-1.697,-1.698,-1.700,-1.702,-1.704,-1.705, - &-1.707,-1.709,-1.710,-1.712,-1.714,-1.715,-1.717,-1.719,-1.720, - &-1.722,-1.724,-1.725,-1.727,-1.729,-1.730,-1.732,-1.733,-1.735, - &-1.737,-1.738,-1.740,-1.741,-1.758,-1.774,-1.789,-1.803,-1.817, - &-1.831,-1.845,-1.858,-1.871,-1.884,-1.896,-1.908,-1.920,-1.932, - &-1.943,-1.954,-1.965,-1.976,-1.987,-1.997,-2.008,-2.018,-2.028, - &-2.037,-2.047,-2.056,-2.066,-2.075,-2.084,-2.093,-2.102,-2.111, - &-2.119,-2.128,-2.136,-2.144,-2.152,-2.161,-2.169,-2.176,-2.184, - &-2.192,-2.200,-2.207,-2.215,-2.222,-2.230,-2.237,-2.244,-2.251, - &-2.259,-2.266,-2.273,-2.280,-2.287,-2.293,-2.300,-2.307,-2.314, - &-2.320,-2.327,-2.334,-2.340,-2.347,-2.353,-2.360,-2.366,-2.372, - &-2.379,-2.385,-2.391,-2.397,-2.403,-2.410,-2.416,-2.422,-2.428, - &-2.434,-2.440,-2.446,-2.452,-2.458,-2.464,-2.470,-2.475,-2.481, - &-2.487,-2.493,-2.499,-2.504,-2.510,-2.516,-2.522,-2.527,-2.533, - &-2.539,-2.544,-2.550,-2.555,-2.561,-2.566,-2.572,-2.578,-2.583, - &-2.588,-2.594,-2.599,-2.605,-2.610,-2.616,-2.621,-2.627,-2.632, - &-2.637,-2.643,-2.648,-2.653,-2.659,-2.664,-2.669,-2.675,-2.680, - &-2.685,-2.690,-2.696,-2.701,-2.706,-2.711,-2.716,-2.722,-2.727, - &-2.732,-2.737,-2.742,-2.748,-2.753,-2.758,-2.763,-2.768,-2.773, - &-2.778,-2.783,-2.788,-2.794,-2.799,-2.804,-2.809,-2.814,-2.819, - &-2.824,-2.829,-2.834,-2.839,-2.844,-2.849,-2.854,-2.859,-2.864, - &-2.869,-2.874,-2.879 - & / -C -C *** KCL -C - DATA BNC20M/ - &-0.049,-0.105,-0.132,-0.151,-0.164,-0.176,-0.185,-0.193,-0.200, - &-0.206,-0.211,-0.216,-0.221,-0.224,-0.228,-0.231,-0.234,-0.237, - &-0.240,-0.242,-0.244,-0.246,-0.248,-0.250,-0.252,-0.253,-0.255, - &-0.256,-0.257,-0.258,-0.260,-0.261,-0.262,-0.263,-0.264,-0.265, - &-0.265,-0.266,-0.267,-0.268,-0.268,-0.269,-0.270,-0.270,-0.271, - &-0.271,-0.272,-0.272,-0.273,-0.273,-0.274,-0.274,-0.275,-0.275, - &-0.275,-0.276,-0.276,-0.276,-0.277,-0.277,-0.277,-0.278,-0.278, - &-0.278,-0.278,-0.279,-0.279,-0.279,-0.279,-0.280,-0.280,-0.280, - &-0.280,-0.280,-0.280,-0.280,-0.281,-0.281,-0.281,-0.281,-0.281, - &-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, - &-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.280,-0.280, - &-0.280,-0.280,-0.280,-0.280,-0.280,-0.279,-0.279,-0.279,-0.279, - &-0.279,-0.278,-0.278,-0.278,-0.278,-0.278,-0.277,-0.277,-0.277, - &-0.277,-0.276,-0.276,-0.276,-0.276,-0.275,-0.275,-0.275,-0.275, - &-0.274,-0.274,-0.274,-0.273,-0.273,-0.273,-0.273,-0.272,-0.272, - &-0.272,-0.271,-0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.269, - &-0.269,-0.269,-0.268,-0.268,-0.268,-0.267,-0.267,-0.267,-0.267, - &-0.266,-0.266,-0.266,-0.265,-0.265,-0.265,-0.264,-0.264,-0.264, - &-0.263,-0.263,-0.263,-0.262,-0.262,-0.262,-0.262,-0.261,-0.261, - &-0.261,-0.260,-0.260,-0.260,-0.259,-0.259,-0.259,-0.258,-0.258, - &-0.258,-0.258,-0.257,-0.257,-0.257,-0.256,-0.256,-0.256,-0.255, - &-0.255,-0.255,-0.254,-0.254,-0.254,-0.254,-0.253,-0.253,-0.253, - &-0.252,-0.252,-0.252,-0.251,-0.251,-0.251,-0.251,-0.250,-0.250, - &-0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.248,-0.247, - &-0.247,-0.247,-0.246,-0.246,-0.246,-0.246,-0.245,-0.245,-0.245, - &-0.244,-0.244,-0.244,-0.244,-0.243,-0.243,-0.243,-0.242,-0.242, - &-0.242,-0.242,-0.241,-0.241,-0.241,-0.241,-0.240,-0.240,-0.240, - &-0.239,-0.239,-0.239,-0.239,-0.238,-0.238,-0.238,-0.238,-0.237, - &-0.237,-0.237,-0.236,-0.236,-0.236,-0.236,-0.235,-0.235,-0.235, - &-0.235,-0.234,-0.234,-0.234,-0.234,-0.233,-0.233,-0.233,-0.233, - &-0.232,-0.232,-0.232,-0.232,-0.231,-0.231,-0.231,-0.231,-0.230, - &-0.230,-0.230,-0.230,-0.229,-0.229,-0.229,-0.229,-0.228,-0.228, - &-0.228,-0.228,-0.227,-0.227,-0.227,-0.227,-0.226,-0.226,-0.226, - &-0.226,-0.226,-0.225,-0.225,-0.225,-0.225,-0.224,-0.224,-0.224, - &-0.224,-0.223,-0.223,-0.223,-0.223,-0.223,-0.222,-0.222,-0.222, - &-0.222,-0.221,-0.221,-0.221,-0.221,-0.221,-0.220,-0.220,-0.220, - &-0.220,-0.220,-0.219,-0.219,-0.219,-0.219,-0.218,-0.218,-0.218, - &-0.218,-0.218,-0.217,-0.217,-0.217,-0.217,-0.217,-0.216,-0.216, - &-0.216,-0.216,-0.216,-0.215,-0.215,-0.215,-0.215,-0.215,-0.215, - &-0.214,-0.214,-0.214,-0.214,-0.214,-0.213,-0.213,-0.213,-0.213, - &-0.213,-0.212,-0.212,-0.212,-0.212,-0.212,-0.212,-0.211,-0.211, - &-0.211,-0.211,-0.211,-0.210,-0.210,-0.210,-0.210,-0.210,-0.210, - &-0.209,-0.209,-0.209,-0.209,-0.209,-0.209,-0.208,-0.208,-0.208, - &-0.208,-0.208,-0.208,-0.207,-0.207,-0.207,-0.207,-0.207,-0.207, - &-0.206,-0.206,-0.206,-0.206,-0.204,-0.203,-0.202,-0.200,-0.199, - &-0.198,-0.197,-0.196,-0.195,-0.194,-0.193,-0.192,-0.191,-0.190, - &-0.190,-0.189,-0.189,-0.188,-0.188,-0.187,-0.187,-0.187,-0.186, - &-0.186,-0.186,-0.186,-0.186,-0.186,-0.186,-0.186,-0.186,-0.186, - &-0.186,-0.186,-0.187,-0.187,-0.187,-0.187,-0.188,-0.188,-0.189, - &-0.189,-0.190,-0.190,-0.191,-0.191,-0.192,-0.193,-0.193,-0.194, - &-0.195,-0.196,-0.196,-0.197,-0.198,-0.199,-0.200,-0.201,-0.202, - &-0.203,-0.204,-0.205,-0.206,-0.207,-0.208,-0.209,-0.210,-0.212, - &-0.213,-0.214,-0.215,-0.217,-0.218,-0.219,-0.220,-0.222,-0.223, - &-0.225,-0.226,-0.227,-0.229,-0.230,-0.232,-0.233,-0.235,-0.236, - &-0.238,-0.239,-0.241,-0.243,-0.244,-0.246,-0.247,-0.249,-0.251, - &-0.252,-0.254,-0.256,-0.258,-0.259,-0.261,-0.263,-0.265,-0.266, - &-0.268,-0.270,-0.272,-0.274,-0.276,-0.278,-0.280,-0.281,-0.283, - &-0.285,-0.287,-0.289,-0.291,-0.293,-0.295,-0.297,-0.299,-0.301, - &-0.303,-0.305,-0.307,-0.309,-0.311,-0.314,-0.316,-0.318,-0.320, - &-0.322,-0.324,-0.326,-0.329,-0.331,-0.333,-0.335,-0.337,-0.340, - &-0.342,-0.344,-0.346,-0.348,-0.351,-0.353,-0.355,-0.358,-0.360, - &-0.362,-0.364,-0.367,-0.369,-0.371,-0.374,-0.376,-0.379,-0.381, - &-0.383,-0.386,-0.388 - & / -C -C *** MGSO4 -C - DATA BNC21M/ - &-0.200,-0.434,-0.550,-0.632,-0.696,-0.748,-0.793,-0.833,-0.868, - &-0.900,-0.928,-0.955,-0.979,-1.002,-1.023,-1.043,-1.062,-1.079, - &-1.096,-1.112,-1.127,-1.142,-1.156,-1.170,-1.182,-1.195,-1.207, - &-1.218,-1.230,-1.241,-1.251,-1.261,-1.271,-1.281,-1.290,-1.300, - &-1.309,-1.317,-1.326,-1.334,-1.342,-1.350,-1.358,-1.366,-1.373, - &-1.381,-1.388,-1.395,-1.402,-1.409,-1.416,-1.422,-1.429,-1.435, - &-1.442,-1.448,-1.454,-1.460,-1.466,-1.472,-1.478,-1.484,-1.489, - &-1.495,-1.500,-1.506,-1.511,-1.517,-1.522,-1.527,-1.532,-1.537, - &-1.542,-1.547,-1.552,-1.557,-1.562,-1.567,-1.571,-1.576,-1.581, - &-1.585,-1.590,-1.594,-1.599,-1.603,-1.608,-1.612,-1.616,-1.620, - &-1.625,-1.629,-1.633,-1.637,-1.641,-1.645,-1.649,-1.653,-1.657, - &-1.661,-1.665,-1.669,-1.672,-1.676,-1.680,-1.684,-1.687,-1.691, - &-1.695,-1.698,-1.702,-1.706,-1.709,-1.713,-1.716,-1.720,-1.723, - &-1.727,-1.730,-1.733,-1.737,-1.740,-1.744,-1.747,-1.750,-1.753, - &-1.757,-1.760,-1.763,-1.766,-1.770,-1.773,-1.776,-1.779,-1.782, - &-1.786,-1.789,-1.792,-1.795,-1.798,-1.801,-1.804,-1.807,-1.810, - &-1.813,-1.816,-1.819,-1.822,-1.825,-1.828,-1.831,-1.834,-1.837, - &-1.840,-1.843,-1.846,-1.849,-1.851,-1.854,-1.857,-1.860,-1.863, - &-1.866,-1.868,-1.871,-1.874,-1.877,-1.880,-1.882,-1.885,-1.888, - &-1.891,-1.894,-1.896,-1.899,-1.902,-1.904,-1.907,-1.910,-1.913, - &-1.915,-1.918,-1.921,-1.923,-1.926,-1.929,-1.931,-1.934,-1.936, - &-1.939,-1.942,-1.944,-1.947,-1.950,-1.952,-1.955,-1.957,-1.960, - &-1.962,-1.965,-1.968,-1.970,-1.973,-1.975,-1.978,-1.980,-1.983, - &-1.985,-1.988,-1.990,-1.993,-1.995,-1.998,-2.000,-2.003,-2.005, - &-2.008,-2.010,-2.013,-2.015,-2.018,-2.020,-2.023,-2.025,-2.028, - &-2.030,-2.032,-2.035,-2.037,-2.040,-2.042,-2.044,-2.047,-2.049, - &-2.052,-2.054,-2.057,-2.059,-2.061,-2.064,-2.066,-2.068,-2.071, - &-2.073,-2.076,-2.078,-2.080,-2.083,-2.085,-2.087,-2.090,-2.092, - &-2.094,-2.097,-2.099,-2.101,-2.104,-2.106,-2.108,-2.111,-2.113, - &-2.115,-2.118,-2.120,-2.122,-2.124,-2.127,-2.129,-2.131,-2.134, - &-2.136,-2.138,-2.141,-2.143,-2.145,-2.147,-2.150,-2.152,-2.154, - &-2.156,-2.159,-2.161,-2.163,-2.165,-2.168,-2.170,-2.172,-2.174, - &-2.177,-2.179,-2.181,-2.183,-2.186,-2.188,-2.190,-2.192,-2.195, - &-2.197,-2.199,-2.201,-2.203,-2.206,-2.208,-2.210,-2.212,-2.214, - &-2.217,-2.219,-2.221,-2.223,-2.225,-2.228,-2.230,-2.232,-2.234, - &-2.236,-2.239,-2.241,-2.243,-2.245,-2.247,-2.249,-2.252,-2.254, - &-2.256,-2.258,-2.260,-2.262,-2.265,-2.267,-2.269,-2.271,-2.273, - &-2.275,-2.278,-2.280,-2.282,-2.284,-2.286,-2.288,-2.290,-2.293, - &-2.295,-2.297,-2.299,-2.301,-2.303,-2.305,-2.308,-2.310,-2.312, - &-2.314,-2.316,-2.318,-2.320,-2.322,-2.325,-2.327,-2.329,-2.331, - &-2.333,-2.335,-2.337,-2.339,-2.341,-2.344,-2.346,-2.348,-2.350, - &-2.352,-2.354,-2.356,-2.358,-2.360,-2.362,-2.365,-2.367,-2.369, - &-2.371,-2.373,-2.375,-2.377,-2.379,-2.381,-2.383,-2.385,-2.388, - &-2.390,-2.392,-2.394,-2.396,-2.398,-2.400,-2.402,-2.404,-2.406, - &-2.408,-2.410,-2.412,-2.415,-2.437,-2.457,-2.478,-2.498,-2.518, - &-2.539,-2.559,-2.579,-2.599,-2.619,-2.638,-2.658,-2.678,-2.698, - &-2.717,-2.737,-2.756,-2.776,-2.795,-2.815,-2.834,-2.854,-2.873, - &-2.892,-2.911,-2.931,-2.950,-2.969,-2.988,-3.007,-3.026,-3.045, - &-3.064,-3.083,-3.102,-3.121,-3.140,-3.159,-3.178,-3.197,-3.215, - &-3.234,-3.253,-3.272,-3.291,-3.309,-3.328,-3.347,-3.365,-3.384, - &-3.403,-3.421,-3.440,-3.459,-3.477,-3.496,-3.514,-3.533,-3.551, - &-3.570,-3.588,-3.607,-3.625,-3.644,-3.662,-3.681,-3.699,-3.718, - &-3.736,-3.754,-3.773,-3.791,-3.810,-3.828,-3.846,-3.865,-3.883, - &-3.901,-3.920,-3.938,-3.956,-3.974,-3.993,-4.011,-4.029,-4.047, - &-4.066,-4.084,-4.102,-4.120,-4.139,-4.157,-4.175,-4.193,-4.211, - &-4.229,-4.248,-4.266,-4.284,-4.302,-4.320,-4.338,-4.356,-4.374, - &-4.392,-4.411,-4.429,-4.447,-4.465,-4.483,-4.501,-4.519,-4.537, - &-4.555,-4.573,-4.591,-4.609,-4.627,-4.645,-4.663,-4.681,-4.699, - &-4.717,-4.735,-4.753,-4.771,-4.789,-4.807,-4.825,-4.842,-4.860, - &-4.878,-4.896,-4.914,-4.932,-4.950,-4.968,-4.986,-5.004,-5.021, - &-5.039,-5.057,-5.075,-5.093,-5.111,-5.129,-5.146,-5.164,-5.182, - &-5.200,-5.218,-5.235,-5.253,-5.271,-5.289,-5.307,-5.324,-5.342, - &-5.360,-5.378,-5.395 - & / -C -C *** MGNO32 -C - DATA BNC22M/ - &-0.097,-0.201,-0.248,-0.278,-0.300,-0.316,-0.329,-0.339,-0.347, - &-0.354,-0.359,-0.363,-0.366,-0.369,-0.370,-0.372,-0.372,-0.373, - &-0.372,-0.372,-0.371,-0.370,-0.369,-0.367,-0.366,-0.364,-0.362, - &-0.359,-0.357,-0.354,-0.352,-0.349,-0.346,-0.344,-0.341,-0.338, - &-0.334,-0.331,-0.328,-0.325,-0.322,-0.318,-0.315,-0.312,-0.308, - &-0.305,-0.301,-0.298,-0.294,-0.291,-0.287,-0.284,-0.280,-0.277, - &-0.273,-0.270,-0.266,-0.263,-0.259,-0.256,-0.252,-0.248,-0.245, - &-0.241,-0.238,-0.234,-0.230,-0.227,-0.223,-0.219,-0.216,-0.212, - &-0.208,-0.204,-0.201,-0.197,-0.193,-0.189,-0.185,-0.181,-0.177, - &-0.173,-0.169,-0.165,-0.161,-0.157,-0.153,-0.149,-0.145,-0.141, - &-0.136,-0.132,-0.128,-0.123,-0.119,-0.115,-0.110,-0.106,-0.101, - &-0.097,-0.092,-0.087,-0.083,-0.078,-0.073,-0.069,-0.064,-0.059, - &-0.055,-0.050,-0.045,-0.040,-0.035,-0.031,-0.026,-0.021,-0.016, - &-0.011,-0.006,-0.001, 0.003, 0.008, 0.013, 0.018, 0.023, 0.028, - & 0.033, 0.038, 0.043, 0.048, 0.052, 0.057, 0.062, 0.067, 0.072, - & 0.077, 0.082, 0.087, 0.092, 0.097, 0.101, 0.106, 0.111, 0.116, - & 0.121, 0.126, 0.131, 0.135, 0.140, 0.145, 0.150, 0.155, 0.160, - & 0.164, 0.169, 0.174, 0.179, 0.184, 0.188, 0.193, 0.198, 0.203, - & 0.207, 0.212, 0.217, 0.222, 0.226, 0.231, 0.236, 0.241, 0.245, - & 0.250, 0.255, 0.259, 0.264, 0.269, 0.273, 0.278, 0.283, 0.287, - & 0.292, 0.297, 0.301, 0.306, 0.311, 0.315, 0.320, 0.324, 0.329, - & 0.333, 0.338, 0.343, 0.347, 0.352, 0.356, 0.361, 0.365, 0.370, - & 0.374, 0.379, 0.383, 0.388, 0.392, 0.397, 0.401, 0.406, 0.410, - & 0.414, 0.419, 0.423, 0.428, 0.432, 0.437, 0.441, 0.445, 0.450, - & 0.454, 0.458, 0.463, 0.467, 0.472, 0.476, 0.480, 0.484, 0.489, - & 0.493, 0.497, 0.502, 0.506, 0.510, 0.514, 0.519, 0.523, 0.527, - & 0.531, 0.536, 0.540, 0.544, 0.548, 0.553, 0.557, 0.561, 0.565, - & 0.569, 0.573, 0.578, 0.582, 0.586, 0.590, 0.594, 0.598, 0.602, - & 0.606, 0.610, 0.615, 0.619, 0.623, 0.627, 0.631, 0.635, 0.639, - & 0.643, 0.647, 0.651, 0.655, 0.659, 0.663, 0.667, 0.671, 0.675, - & 0.679, 0.683, 0.687, 0.691, 0.695, 0.699, 0.703, 0.706, 0.710, - & 0.714, 0.718, 0.722, 0.726, 0.730, 0.734, 0.738, 0.741, 0.745, - & 0.749, 0.753, 0.757, 0.761, 0.764, 0.768, 0.772, 0.776, 0.779, - & 0.783, 0.787, 0.791, 0.795, 0.798, 0.802, 0.806, 0.809, 0.813, - & 0.817, 0.821, 0.824, 0.828, 0.832, 0.835, 0.839, 0.843, 0.846, - & 0.850, 0.854, 0.857, 0.861, 0.865, 0.868, 0.872, 0.875, 0.879, - & 0.883, 0.886, 0.890, 0.893, 0.897, 0.900, 0.904, 0.907, 0.911, - & 0.915, 0.918, 0.922, 0.925, 0.929, 0.932, 0.936, 0.939, 0.943, - & 0.946, 0.950, 0.953, 0.956, 0.960, 0.963, 0.967, 0.970, 0.974, - & 0.977, 0.980, 0.984, 0.987, 0.991, 0.994, 0.997, 1.001, 1.004, - & 1.007, 1.011, 1.014, 1.018, 1.021, 1.024, 1.028, 1.031, 1.034, - & 1.037, 1.041, 1.044, 1.047, 1.051, 1.054, 1.057, 1.060, 1.064, - & 1.067, 1.070, 1.073, 1.077, 1.080, 1.083, 1.086, 1.090, 1.093, - & 1.096, 1.099, 1.102, 1.106, 1.109, 1.112, 1.115, 1.118, 1.121, - & 1.125, 1.128, 1.131, 1.134, 1.167, 1.198, 1.228, 1.257, 1.286, - & 1.314, 1.342, 1.370, 1.397, 1.423, 1.449, 1.475, 1.500, 1.525, - & 1.549, 1.573, 1.597, 1.620, 1.643, 1.665, 1.687, 1.709, 1.730, - & 1.751, 1.772, 1.793, 1.813, 1.833, 1.852, 1.871, 1.890, 1.909, - & 1.927, 1.945, 1.963, 1.981, 1.998, 2.015, 2.032, 2.049, 2.065, - & 2.081, 2.097, 2.112, 2.128, 2.143, 2.158, 2.173, 2.187, 2.202, - & 2.216, 2.230, 2.244, 2.257, 2.271, 2.284, 2.297, 2.310, 2.322, - & 2.335, 2.347, 2.359, 2.371, 2.383, 2.395, 2.406, 2.418, 2.429, - & 2.440, 2.451, 2.462, 2.472, 2.483, 2.493, 2.503, 2.513, 2.523, - & 2.533, 2.543, 2.552, 2.562, 2.571, 2.580, 2.589, 2.598, 2.607, - & 2.616, 2.624, 2.633, 2.641, 2.650, 2.658, 2.666, 2.674, 2.681, - & 2.689, 2.697, 2.704, 2.712, 2.719, 2.726, 2.733, 2.740, 2.747, - & 2.754, 2.761, 2.768, 2.774, 2.781, 2.787, 2.793, 2.800, 2.806, - & 2.812, 2.818, 2.824, 2.830, 2.835, 2.841, 2.847, 2.852, 2.858, - & 2.863, 2.868, 2.873, 2.879, 2.884, 2.889, 2.893, 2.898, 2.903, - & 2.908, 2.912, 2.917, 2.922, 2.926, 2.930, 2.935, 2.939, 2.943, - & 2.947, 2.951, 2.955, 2.959, 2.963, 2.967, 2.971, 2.974, 2.978, - & 2.982, 2.985, 2.989, 2.992, 2.996, 2.999, 3.002, 3.005, 3.009, - & 3.012, 3.015, 3.018 - & / -C -C *** MGCL2 -C - DATA BNC23M/ - &-0.096,-0.198,-0.242,-0.270,-0.290,-0.304,-0.315,-0.323,-0.329, - &-0.333,-0.337,-0.339,-0.340,-0.341,-0.340,-0.340,-0.339,-0.337, - &-0.335,-0.333,-0.330,-0.327,-0.324,-0.320,-0.317,-0.313,-0.309, - &-0.305,-0.301,-0.296,-0.292,-0.287,-0.283,-0.278,-0.273,-0.268, - &-0.263,-0.258,-0.253,-0.248,-0.243,-0.238,-0.233,-0.228,-0.222, - &-0.217,-0.212,-0.207,-0.202,-0.196,-0.191,-0.186,-0.180,-0.175, - &-0.170,-0.164,-0.159,-0.154,-0.149,-0.143,-0.138,-0.133,-0.127, - &-0.122,-0.117,-0.111,-0.106,-0.100,-0.095,-0.090,-0.084,-0.079, - &-0.073,-0.068,-0.062,-0.057,-0.051,-0.045,-0.040,-0.034,-0.028, - &-0.023,-0.017,-0.011,-0.005, 0.001, 0.007, 0.013, 0.019, 0.025, - & 0.031, 0.037, 0.043, 0.049, 0.055, 0.062, 0.068, 0.074, 0.081, - & 0.087, 0.094, 0.100, 0.107, 0.113, 0.120, 0.126, 0.133, 0.140, - & 0.146, 0.153, 0.160, 0.166, 0.173, 0.180, 0.187, 0.193, 0.200, - & 0.207, 0.214, 0.220, 0.227, 0.234, 0.241, 0.248, 0.255, 0.261, - & 0.268, 0.275, 0.282, 0.289, 0.296, 0.302, 0.309, 0.316, 0.323, - & 0.330, 0.337, 0.343, 0.350, 0.357, 0.364, 0.371, 0.377, 0.384, - & 0.391, 0.398, 0.404, 0.411, 0.418, 0.425, 0.431, 0.438, 0.445, - & 0.451, 0.458, 0.465, 0.471, 0.478, 0.485, 0.491, 0.498, 0.505, - & 0.511, 0.518, 0.524, 0.531, 0.537, 0.544, 0.551, 0.557, 0.564, - & 0.570, 0.577, 0.583, 0.590, 0.596, 0.603, 0.609, 0.616, 0.622, - & 0.628, 0.635, 0.641, 0.648, 0.654, 0.660, 0.667, 0.673, 0.679, - & 0.686, 0.692, 0.698, 0.705, 0.711, 0.717, 0.724, 0.730, 0.736, - & 0.742, 0.749, 0.755, 0.761, 0.767, 0.773, 0.780, 0.786, 0.792, - & 0.798, 0.804, 0.810, 0.816, 0.823, 0.829, 0.835, 0.841, 0.847, - & 0.853, 0.859, 0.865, 0.871, 0.877, 0.883, 0.889, 0.895, 0.901, - & 0.907, 0.913, 0.919, 0.925, 0.931, 0.937, 0.942, 0.948, 0.954, - & 0.960, 0.966, 0.972, 0.978, 0.983, 0.989, 0.995, 1.001, 1.007, - & 1.012, 1.018, 1.024, 1.030, 1.035, 1.041, 1.047, 1.052, 1.058, - & 1.064, 1.069, 1.075, 1.081, 1.086, 1.092, 1.098, 1.103, 1.109, - & 1.114, 1.120, 1.125, 1.131, 1.136, 1.142, 1.148, 1.153, 1.159, - & 1.164, 1.169, 1.175, 1.180, 1.186, 1.191, 1.197, 1.202, 1.208, - & 1.213, 1.218, 1.224, 1.229, 1.234, 1.240, 1.245, 1.250, 1.256, - & 1.261, 1.266, 1.272, 1.277, 1.282, 1.287, 1.293, 1.298, 1.303, - & 1.308, 1.314, 1.319, 1.324, 1.329, 1.334, 1.339, 1.345, 1.350, - & 1.355, 1.360, 1.365, 1.370, 1.375, 1.380, 1.385, 1.390, 1.396, - & 1.401, 1.406, 1.411, 1.416, 1.421, 1.426, 1.431, 1.436, 1.441, - & 1.446, 1.451, 1.456, 1.460, 1.465, 1.470, 1.475, 1.480, 1.485, - & 1.490, 1.495, 1.500, 1.504, 1.509, 1.514, 1.519, 1.524, 1.529, - & 1.533, 1.538, 1.543, 1.548, 1.553, 1.557, 1.562, 1.567, 1.572, - & 1.576, 1.581, 1.586, 1.590, 1.595, 1.600, 1.604, 1.609, 1.614, - & 1.618, 1.623, 1.628, 1.632, 1.637, 1.642, 1.646, 1.651, 1.655, - & 1.660, 1.664, 1.669, 1.674, 1.678, 1.683, 1.687, 1.692, 1.696, - & 1.701, 1.705, 1.710, 1.714, 1.719, 1.723, 1.728, 1.732, 1.736, - & 1.741, 1.745, 1.750, 1.754, 1.759, 1.763, 1.767, 1.772, 1.776, - & 1.780, 1.785, 1.789, 1.793, 1.840, 1.882, 1.923, 1.964, 2.004, - & 2.044, 2.082, 2.120, 2.158, 2.195, 2.231, 2.267, 2.302, 2.336, - & 2.370, 2.404, 2.437, 2.469, 2.501, 2.533, 2.564, 2.594, 2.624, - & 2.654, 2.683, 2.712, 2.741, 2.768, 2.796, 2.823, 2.850, 2.877, - & 2.903, 2.928, 2.954, 2.979, 3.003, 3.028, 3.052, 3.076, 3.099, - & 3.122, 3.145, 3.167, 3.190, 3.211, 3.233, 3.254, 3.276, 3.296, - & 3.317, 3.337, 3.357, 3.377, 3.397, 3.416, 3.435, 3.454, 3.473, - & 3.491, 3.509, 3.527, 3.545, 3.563, 3.580, 3.597, 3.614, 3.631, - & 3.647, 3.664, 3.680, 3.696, 3.712, 3.727, 3.743, 3.758, 3.773, - & 3.788, 3.803, 3.817, 3.832, 3.846, 3.860, 3.874, 3.888, 3.902, - & 3.915, 3.928, 3.942, 3.955, 3.968, 3.980, 3.993, 4.006, 4.018, - & 4.030, 4.042, 4.054, 4.066, 4.078, 4.089, 4.101, 4.112, 4.123, - & 4.134, 4.145, 4.156, 4.167, 4.178, 4.188, 4.199, 4.209, 4.219, - & 4.229, 4.239, 4.249, 4.259, 4.269, 4.278, 4.288, 4.297, 4.306, - & 4.316, 4.325, 4.334, 4.343, 4.351, 4.360, 4.369, 4.377, 4.386, - & 4.394, 4.402, 4.411, 4.419, 4.427, 4.435, 4.442, 4.450, 4.458, - & 4.466, 4.473, 4.480, 4.488, 4.495, 4.502, 4.510, 4.517, 4.524, - & 4.531, 4.537, 4.544, 4.551, 4.558, 4.564, 4.571, 4.577, 4.583, - & 4.590, 4.596, 4.602 - & / - END -C -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE KM248 (IONIC, BINARR) -C -C *** Common block definition -C - COMMON /KMC248/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL Binarr (23), Ionic -C -C *** Find position in arrays for bincoef -C - IF (Ionic.LE. 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) -C -C *** Assign values to return array -C - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) -C -C *** Return point ; End of subroutine -C - RETURN - END - - - BLOCK DATA KMCF248 -C -C *** Common block definition -C - COMMON /KMC248/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - -C -C *** NaCl -C - DATA BNC01M/ - &-0.047,-0.099,-0.122,-0.137,-0.148,-0.156,-0.163,-0.168,-0.172, - &-0.176,-0.178,-0.181,-0.182,-0.184,-0.185,-0.186,-0.186,-0.187, - &-0.187,-0.187,-0.187,-0.187,-0.186,-0.186,-0.185,-0.184,-0.184, - &-0.183,-0.182,-0.181,-0.180,-0.179,-0.178,-0.176,-0.175,-0.174, - &-0.173,-0.171,-0.170,-0.168,-0.167,-0.166,-0.164,-0.163,-0.161, - &-0.160,-0.158,-0.157,-0.155,-0.154,-0.152,-0.151,-0.149,-0.148, - &-0.146,-0.145,-0.143,-0.141,-0.140,-0.138,-0.137,-0.135,-0.134, - &-0.132,-0.130,-0.129,-0.127,-0.126,-0.124,-0.122,-0.121,-0.119, - &-0.117,-0.116,-0.114,-0.112,-0.111,-0.109,-0.107,-0.105,-0.104, - &-0.102,-0.100,-0.098,-0.096,-0.095,-0.093,-0.091,-0.089,-0.087, - &-0.085,-0.083,-0.081,-0.079,-0.077,-0.075,-0.073,-0.071,-0.069, - &-0.067,-0.065,-0.063,-0.061,-0.059,-0.057,-0.055,-0.053,-0.051, - &-0.048,-0.046,-0.044,-0.042,-0.040,-0.038,-0.036,-0.033,-0.031, - &-0.029,-0.027,-0.025,-0.022,-0.020,-0.018,-0.016,-0.014,-0.011, - &-0.009,-0.007,-0.005,-0.003, 0.000, 0.002, 0.004, 0.006, 0.008, - & 0.011, 0.013, 0.015, 0.017, 0.020, 0.022, 0.024, 0.026, 0.028, - & 0.030, 0.033, 0.035, 0.037, 0.039, 0.041, 0.044, 0.046, 0.048, - & 0.050, 0.052, 0.054, 0.057, 0.059, 0.061, 0.063, 0.065, 0.067, - & 0.070, 0.072, 0.074, 0.076, 0.078, 0.080, 0.082, 0.085, 0.087, - & 0.089, 0.091, 0.093, 0.095, 0.097, 0.099, 0.102, 0.104, 0.106, - & 0.108, 0.110, 0.112, 0.114, 0.116, 0.118, 0.120, 0.122, 0.125, - & 0.127, 0.129, 0.131, 0.133, 0.135, 0.137, 0.139, 0.141, 0.143, - & 0.145, 0.147, 0.149, 0.151, 0.153, 0.155, 0.157, 0.159, 0.161, - & 0.163, 0.165, 0.167, 0.169, 0.171, 0.173, 0.175, 0.177, 0.179, - & 0.181, 0.183, 0.185, 0.187, 0.189, 0.191, 0.193, 0.195, 0.197, - & 0.199, 0.201, 0.203, 0.205, 0.207, 0.209, 0.211, 0.213, 0.215, - & 0.217, 0.219, 0.221, 0.223, 0.224, 0.226, 0.228, 0.230, 0.232, - & 0.234, 0.236, 0.238, 0.240, 0.242, 0.243, 0.245, 0.247, 0.249, - & 0.251, 0.253, 0.255, 0.257, 0.258, 0.260, 0.262, 0.264, 0.266, - & 0.268, 0.270, 0.271, 0.273, 0.275, 0.277, 0.279, 0.281, 0.282, - & 0.284, 0.286, 0.288, 0.290, 0.291, 0.293, 0.295, 0.297, 0.299, - & 0.300, 0.302, 0.304, 0.306, 0.308, 0.309, 0.311, 0.313, 0.315, - & 0.316, 0.318, 0.320, 0.322, 0.323, 0.325, 0.327, 0.329, 0.330, - & 0.332, 0.334, 0.336, 0.337, 0.339, 0.341, 0.342, 0.344, 0.346, - & 0.348, 0.349, 0.351, 0.353, 0.354, 0.356, 0.358, 0.359, 0.361, - & 0.363, 0.364, 0.366, 0.368, 0.370, 0.371, 0.373, 0.374, 0.376, - & 0.378, 0.379, 0.381, 0.383, 0.384, 0.386, 0.388, 0.389, 0.391, - & 0.393, 0.394, 0.396, 0.397, 0.399, 0.401, 0.402, 0.404, 0.406, - & 0.407, 0.409, 0.410, 0.412, 0.414, 0.415, 0.417, 0.418, 0.420, - & 0.421, 0.423, 0.425, 0.426, 0.428, 0.429, 0.431, 0.433, 0.434, - & 0.436, 0.437, 0.439, 0.440, 0.442, 0.443, 0.445, 0.446, 0.448, - & 0.450, 0.451, 0.453, 0.454, 0.456, 0.457, 0.459, 0.460, 0.462, - & 0.463, 0.465, 0.466, 0.468, 0.469, 0.471, 0.472, 0.474, 0.475, - & 0.477, 0.478, 0.480, 0.481, 0.483, 0.484, 0.486, 0.487, 0.489, - & 0.490, 0.491, 0.493, 0.494, 0.510, 0.524, 0.538, 0.552, 0.566, - & 0.579, 0.592, 0.605, 0.618, 0.630, 0.642, 0.655, 0.667, 0.678, - & 0.690, 0.701, 0.713, 0.724, 0.735, 0.745, 0.756, 0.766, 0.777, - & 0.787, 0.797, 0.807, 0.817, 0.826, 0.836, 0.845, 0.854, 0.864, - & 0.873, 0.881, 0.890, 0.899, 0.907, 0.916, 0.924, 0.932, 0.940, - & 0.948, 0.956, 0.964, 0.972, 0.979, 0.987, 0.994, 1.002, 1.009, - & 1.016, 1.023, 1.030, 1.037, 1.044, 1.051, 1.057, 1.064, 1.070, - & 1.077, 1.083, 1.089, 1.096, 1.102, 1.108, 1.114, 1.120, 1.126, - & 1.132, 1.137, 1.143, 1.149, 1.154, 1.160, 1.165, 1.170, 1.176, - & 1.181, 1.186, 1.191, 1.196, 1.201, 1.206, 1.211, 1.216, 1.221, - & 1.226, 1.231, 1.235, 1.240, 1.244, 1.249, 1.253, 1.258, 1.262, - & 1.267, 1.271, 1.275, 1.279, 1.284, 1.288, 1.292, 1.296, 1.300, - & 1.304, 1.308, 1.312, 1.315, 1.319, 1.323, 1.327, 1.330, 1.334, - & 1.338, 1.341, 1.345, 1.348, 1.352, 1.355, 1.358, 1.362, 1.365, - & 1.368, 1.372, 1.375, 1.378, 1.381, 1.384, 1.388, 1.391, 1.394, - & 1.397, 1.400, 1.403, 1.406, 1.409, 1.411, 1.414, 1.417, 1.420, - & 1.423, 1.425, 1.428, 1.431, 1.433, 1.436, 1.439, 1.441, 1.444, - & 1.446, 1.449, 1.451, 1.454, 1.456, 1.458, 1.461, 1.463, 1.466, - & 1.468, 1.470, 1.472 - & / -C -C *** Na2SO4 -C - DATA BNC02M/ - &-0.098,-0.214,-0.272,-0.313,-0.346,-0.373,-0.396,-0.417,-0.435, - &-0.452,-0.467,-0.481,-0.494,-0.506,-0.518,-0.529,-0.539,-0.549, - &-0.558,-0.567,-0.575,-0.583,-0.591,-0.599,-0.606,-0.613,-0.620, - &-0.627,-0.633,-0.639,-0.645,-0.651,-0.657,-0.662,-0.668,-0.673, - &-0.678,-0.683,-0.688,-0.693,-0.698,-0.703,-0.707,-0.712,-0.716, - &-0.721,-0.725,-0.729,-0.733,-0.737,-0.741,-0.745,-0.749,-0.753, - &-0.756,-0.760,-0.764,-0.767,-0.771,-0.774,-0.778,-0.781,-0.784, - &-0.788,-0.791,-0.794,-0.797,-0.801,-0.804,-0.807,-0.810,-0.813, - &-0.816,-0.819,-0.822,-0.825,-0.827,-0.830,-0.833,-0.836,-0.839, - &-0.841,-0.844,-0.847,-0.850,-0.852,-0.855,-0.858,-0.860,-0.863, - &-0.865,-0.868,-0.871,-0.873,-0.876,-0.878,-0.881,-0.883,-0.885, - &-0.888,-0.890,-0.893,-0.895,-0.897,-0.900,-0.902,-0.905,-0.907, - &-0.909,-0.911,-0.914,-0.916,-0.918,-0.921,-0.923,-0.925,-0.927, - &-0.929,-0.932,-0.934,-0.936,-0.938,-0.940,-0.942,-0.945,-0.947, - &-0.949,-0.951,-0.953,-0.955,-0.957,-0.959,-0.961,-0.963,-0.965, - &-0.967,-0.969,-0.971,-0.973,-0.975,-0.977,-0.979,-0.981,-0.983, - &-0.985,-0.987,-0.989,-0.991,-0.993,-0.995,-0.997,-0.999,-1.001, - &-1.002,-1.004,-1.006,-1.008,-1.010,-1.012,-1.014,-1.015,-1.017, - &-1.019,-1.021,-1.023,-1.025,-1.026,-1.028,-1.030,-1.032,-1.033, - &-1.035,-1.037,-1.039,-1.040,-1.042,-1.044,-1.046,-1.047,-1.049, - &-1.051,-1.053,-1.054,-1.056,-1.058,-1.059,-1.061,-1.063,-1.064, - &-1.066,-1.068,-1.069,-1.071,-1.073,-1.074,-1.076,-1.078,-1.079, - &-1.081,-1.082,-1.084,-1.086,-1.087,-1.089,-1.090,-1.092,-1.094, - &-1.095,-1.097,-1.098,-1.100,-1.102,-1.103,-1.105,-1.106,-1.108, - &-1.109,-1.111,-1.112,-1.114,-1.116,-1.117,-1.119,-1.120,-1.122, - &-1.123,-1.125,-1.126,-1.128,-1.129,-1.131,-1.132,-1.134,-1.135, - &-1.137,-1.138,-1.140,-1.141,-1.143,-1.144,-1.146,-1.147,-1.148, - &-1.150,-1.151,-1.153,-1.154,-1.156,-1.157,-1.159,-1.160,-1.161, - &-1.163,-1.164,-1.166,-1.167,-1.169,-1.170,-1.171,-1.173,-1.174, - &-1.176,-1.177,-1.178,-1.180,-1.181,-1.183,-1.184,-1.185,-1.187, - &-1.188,-1.190,-1.191,-1.192,-1.194,-1.195,-1.196,-1.198,-1.199, - &-1.201,-1.202,-1.203,-1.205,-1.206,-1.207,-1.209,-1.210,-1.211, - &-1.213,-1.214,-1.215,-1.217,-1.218,-1.219,-1.221,-1.222,-1.223, - &-1.225,-1.226,-1.227,-1.229,-1.230,-1.231,-1.233,-1.234,-1.235, - &-1.236,-1.238,-1.239,-1.240,-1.242,-1.243,-1.244,-1.246,-1.247, - &-1.248,-1.249,-1.251,-1.252,-1.253,-1.255,-1.256,-1.257,-1.258, - &-1.260,-1.261,-1.262,-1.263,-1.265,-1.266,-1.267,-1.268,-1.270, - &-1.271,-1.272,-1.273,-1.275,-1.276,-1.277,-1.278,-1.280,-1.281, - &-1.282,-1.283,-1.285,-1.286,-1.287,-1.288,-1.290,-1.291,-1.292, - &-1.293,-1.294,-1.296,-1.297,-1.298,-1.299,-1.301,-1.302,-1.303, - &-1.304,-1.305,-1.307,-1.308,-1.309,-1.310,-1.311,-1.313,-1.314, - &-1.315,-1.316,-1.317,-1.319,-1.320,-1.321,-1.322,-1.323,-1.324, - &-1.326,-1.327,-1.328,-1.329,-1.330,-1.332,-1.333,-1.334,-1.335, - &-1.336,-1.337,-1.339,-1.340,-1.341,-1.342,-1.343,-1.344,-1.346, - &-1.347,-1.348,-1.349,-1.350,-1.363,-1.374,-1.385,-1.396,-1.407, - &-1.418,-1.429,-1.440,-1.451,-1.461,-1.472,-1.482,-1.492,-1.503, - &-1.513,-1.523,-1.533,-1.543,-1.553,-1.563,-1.573,-1.582,-1.592, - &-1.602,-1.611,-1.621,-1.630,-1.640,-1.649,-1.658,-1.668,-1.677, - &-1.686,-1.695,-1.704,-1.714,-1.723,-1.732,-1.741,-1.750,-1.758, - &-1.767,-1.776,-1.785,-1.794,-1.802,-1.811,-1.820,-1.828,-1.837, - &-1.846,-1.854,-1.863,-1.871,-1.880,-1.888,-1.897,-1.905,-1.913, - &-1.922,-1.930,-1.938,-1.947,-1.955,-1.963,-1.971,-1.979,-1.988, - &-1.996,-2.004,-2.012,-2.020,-2.028,-2.036,-2.044,-2.052,-2.060, - &-2.068,-2.076,-2.084,-2.092,-2.100,-2.108,-2.116,-2.124,-2.131, - &-2.139,-2.147,-2.155,-2.163,-2.170,-2.178,-2.186,-2.194,-2.201, - &-2.209,-2.217,-2.224,-2.232,-2.240,-2.247,-2.255,-2.262,-2.270, - &-2.278,-2.285,-2.293,-2.300,-2.308,-2.315,-2.323,-2.330,-2.338, - &-2.345,-2.353,-2.360,-2.368,-2.375,-2.382,-2.390,-2.397,-2.405, - &-2.412,-2.419,-2.427,-2.434,-2.441,-2.449,-2.456,-2.463,-2.471, - &-2.478,-2.485,-2.492,-2.500,-2.507,-2.514,-2.521,-2.529,-2.536, - &-2.543,-2.550,-2.557,-2.565,-2.572,-2.579,-2.586,-2.593,-2.600, - &-2.608,-2.615,-2.622,-2.629,-2.636,-2.643,-2.650,-2.657,-2.664, - &-2.671,-2.679,-2.686 - & / -C -C *** NaNO3 -C - DATA BNC03M/ - &-0.049,-0.108,-0.137,-0.159,-0.175,-0.190,-0.202,-0.212,-0.222, - &-0.231,-0.239,-0.247,-0.254,-0.260,-0.266,-0.272,-0.278,-0.283, - &-0.288,-0.293,-0.298,-0.302,-0.306,-0.311,-0.315,-0.319,-0.322, - &-0.326,-0.330,-0.333,-0.337,-0.340,-0.343,-0.346,-0.349,-0.352, - &-0.355,-0.358,-0.361,-0.364,-0.367,-0.369,-0.372,-0.374,-0.377, - &-0.379,-0.382,-0.384,-0.387,-0.389,-0.391,-0.394,-0.396,-0.398, - &-0.400,-0.402,-0.404,-0.406,-0.408,-0.410,-0.412,-0.414,-0.416, - &-0.418,-0.420,-0.422,-0.424,-0.426,-0.428,-0.429,-0.431,-0.433, - &-0.435,-0.436,-0.438,-0.440,-0.442,-0.443,-0.445,-0.447,-0.448, - &-0.450,-0.452,-0.453,-0.455,-0.456,-0.458,-0.459,-0.461,-0.463, - &-0.464,-0.466,-0.467,-0.469,-0.470,-0.472,-0.473,-0.475,-0.476, - &-0.478,-0.479,-0.481,-0.482,-0.483,-0.485,-0.486,-0.488,-0.489, - &-0.491,-0.492,-0.493,-0.495,-0.496,-0.498,-0.499,-0.500,-0.502, - &-0.503,-0.504,-0.506,-0.507,-0.508,-0.510,-0.511,-0.512,-0.514, - &-0.515,-0.516,-0.518,-0.519,-0.520,-0.521,-0.523,-0.524,-0.525, - &-0.526,-0.528,-0.529,-0.530,-0.531,-0.533,-0.534,-0.535,-0.536, - &-0.537,-0.539,-0.540,-0.541,-0.542,-0.543,-0.545,-0.546,-0.547, - &-0.548,-0.549,-0.550,-0.552,-0.553,-0.554,-0.555,-0.556,-0.557, - &-0.558,-0.559,-0.561,-0.562,-0.563,-0.564,-0.565,-0.566,-0.567, - &-0.568,-0.569,-0.570,-0.572,-0.573,-0.574,-0.575,-0.576,-0.577, - &-0.578,-0.579,-0.580,-0.581,-0.582,-0.583,-0.584,-0.585,-0.586, - &-0.587,-0.588,-0.589,-0.590,-0.592,-0.593,-0.594,-0.595,-0.596, - &-0.597,-0.598,-0.599,-0.600,-0.601,-0.602,-0.603,-0.604,-0.605, - &-0.606,-0.607,-0.607,-0.608,-0.609,-0.610,-0.611,-0.612,-0.613, - &-0.614,-0.615,-0.616,-0.617,-0.618,-0.619,-0.620,-0.621,-0.622, - &-0.623,-0.624,-0.625,-0.626,-0.627,-0.627,-0.628,-0.629,-0.630, - &-0.631,-0.632,-0.633,-0.634,-0.635,-0.636,-0.637,-0.638,-0.638, - &-0.639,-0.640,-0.641,-0.642,-0.643,-0.644,-0.645,-0.646,-0.646, - &-0.647,-0.648,-0.649,-0.650,-0.651,-0.652,-0.653,-0.654,-0.654, - &-0.655,-0.656,-0.657,-0.658,-0.659,-0.660,-0.660,-0.661,-0.662, - &-0.663,-0.664,-0.665,-0.666,-0.666,-0.667,-0.668,-0.669,-0.670, - &-0.671,-0.671,-0.672,-0.673,-0.674,-0.675,-0.676,-0.676,-0.677, - &-0.678,-0.679,-0.680,-0.681,-0.681,-0.682,-0.683,-0.684,-0.685, - &-0.685,-0.686,-0.687,-0.688,-0.689,-0.689,-0.690,-0.691,-0.692, - &-0.693,-0.693,-0.694,-0.695,-0.696,-0.697,-0.697,-0.698,-0.699, - &-0.700,-0.701,-0.701,-0.702,-0.703,-0.704,-0.704,-0.705,-0.706, - &-0.707,-0.708,-0.708,-0.709,-0.710,-0.711,-0.711,-0.712,-0.713, - &-0.714,-0.714,-0.715,-0.716,-0.717,-0.718,-0.718,-0.719,-0.720, - &-0.721,-0.721,-0.722,-0.723,-0.724,-0.724,-0.725,-0.726,-0.727, - &-0.727,-0.728,-0.729,-0.729,-0.730,-0.731,-0.732,-0.732,-0.733, - &-0.734,-0.735,-0.735,-0.736,-0.737,-0.738,-0.738,-0.739,-0.740, - &-0.740,-0.741,-0.742,-0.743,-0.743,-0.744,-0.745,-0.746,-0.746, - &-0.747,-0.748,-0.748,-0.749,-0.750,-0.751,-0.751,-0.752,-0.753, - &-0.753,-0.754,-0.755,-0.756,-0.756,-0.757,-0.758,-0.758,-0.759, - &-0.760,-0.760,-0.761,-0.762,-0.769,-0.776,-0.783,-0.790,-0.796, - &-0.803,-0.809,-0.816,-0.822,-0.828,-0.835,-0.841,-0.847,-0.853, - &-0.859,-0.865,-0.871,-0.877,-0.883,-0.888,-0.894,-0.900,-0.905, - &-0.911,-0.917,-0.922,-0.928,-0.933,-0.939,-0.944,-0.949,-0.955, - &-0.960,-0.965,-0.971,-0.976,-0.981,-0.986,-0.991,-0.997,-1.002, - &-1.007,-1.012,-1.017,-1.022,-1.027,-1.032,-1.037,-1.042,-1.046, - &-1.051,-1.056,-1.061,-1.066,-1.071,-1.075,-1.080,-1.085,-1.089, - &-1.094,-1.099,-1.104,-1.108,-1.113,-1.117,-1.122,-1.127,-1.131, - &-1.136,-1.140,-1.145,-1.149,-1.154,-1.158,-1.163,-1.167,-1.172, - &-1.176,-1.180,-1.185,-1.189,-1.194,-1.198,-1.202,-1.207,-1.211, - &-1.215,-1.220,-1.224,-1.228,-1.232,-1.237,-1.241,-1.245,-1.249, - &-1.254,-1.258,-1.262,-1.266,-1.270,-1.275,-1.279,-1.283,-1.287, - &-1.291,-1.295,-1.299,-1.304,-1.308,-1.312,-1.316,-1.320,-1.324, - &-1.328,-1.332,-1.336,-1.340,-1.344,-1.348,-1.352,-1.356,-1.360, - &-1.364,-1.368,-1.372,-1.376,-1.380,-1.384,-1.388,-1.392,-1.396, - &-1.400,-1.404,-1.408,-1.412,-1.415,-1.419,-1.423,-1.427,-1.431, - &-1.435,-1.439,-1.443,-1.446,-1.450,-1.454,-1.458,-1.462,-1.466, - &-1.469,-1.473,-1.477,-1.481,-1.485,-1.488,-1.492,-1.496,-1.500, - &-1.504,-1.507,-1.511 - & / -C -C *** (NH4)2SO4 -C - DATA BNC04M/ - &-0.098,-0.214,-0.273,-0.315,-0.347,-0.375,-0.399,-0.419,-0.438, - &-0.455,-0.470,-0.485,-0.498,-0.511,-0.522,-0.533,-0.544,-0.554, - &-0.563,-0.572,-0.581,-0.590,-0.598,-0.605,-0.613,-0.620,-0.627, - &-0.634,-0.641,-0.647,-0.653,-0.660,-0.666,-0.671,-0.677,-0.683, - &-0.688,-0.693,-0.698,-0.703,-0.708,-0.713,-0.718,-0.723,-0.727, - &-0.732,-0.736,-0.741,-0.745,-0.749,-0.753,-0.757,-0.762,-0.765, - &-0.769,-0.773,-0.777,-0.781,-0.784,-0.788,-0.792,-0.795,-0.799, - &-0.802,-0.806,-0.809,-0.812,-0.816,-0.819,-0.822,-0.825,-0.829, - &-0.832,-0.835,-0.838,-0.841,-0.844,-0.847,-0.850,-0.853,-0.856, - &-0.859,-0.862,-0.865,-0.867,-0.870,-0.873,-0.876,-0.879,-0.881, - &-0.884,-0.887,-0.890,-0.892,-0.895,-0.898,-0.900,-0.903,-0.905, - &-0.908,-0.911,-0.913,-0.916,-0.918,-0.921,-0.923,-0.926,-0.928, - &-0.931,-0.933,-0.936,-0.938,-0.940,-0.943,-0.945,-0.948,-0.950, - &-0.952,-0.955,-0.957,-0.959,-0.962,-0.964,-0.966,-0.969,-0.971, - &-0.973,-0.975,-0.978,-0.980,-0.982,-0.984,-0.986,-0.989,-0.991, - &-0.993,-0.995,-0.997,-0.999,-1.002,-1.004,-1.006,-1.008,-1.010, - &-1.012,-1.014,-1.016,-1.018,-1.020,-1.022,-1.024,-1.026,-1.028, - &-1.030,-1.032,-1.034,-1.036,-1.038,-1.040,-1.042,-1.044,-1.046, - &-1.048,-1.050,-1.052,-1.054,-1.056,-1.058,-1.060,-1.062,-1.064, - &-1.066,-1.067,-1.069,-1.071,-1.073,-1.075,-1.077,-1.079,-1.080, - &-1.082,-1.084,-1.086,-1.088,-1.090,-1.091,-1.093,-1.095,-1.097, - &-1.099,-1.100,-1.102,-1.104,-1.106,-1.107,-1.109,-1.111,-1.113, - &-1.114,-1.116,-1.118,-1.120,-1.121,-1.123,-1.125,-1.127,-1.128, - &-1.130,-1.132,-1.133,-1.135,-1.137,-1.138,-1.140,-1.142,-1.143, - &-1.145,-1.147,-1.148,-1.150,-1.152,-1.153,-1.155,-1.157,-1.158, - &-1.160,-1.162,-1.163,-1.165,-1.166,-1.168,-1.170,-1.171,-1.173, - &-1.174,-1.176,-1.178,-1.179,-1.181,-1.182,-1.184,-1.185,-1.187, - &-1.189,-1.190,-1.192,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201, - &-1.203,-1.204,-1.206,-1.207,-1.209,-1.210,-1.212,-1.213,-1.215, - &-1.216,-1.218,-1.219,-1.221,-1.222,-1.224,-1.225,-1.227,-1.228, - &-1.230,-1.231,-1.233,-1.234,-1.236,-1.237,-1.238,-1.240,-1.241, - &-1.243,-1.244,-1.246,-1.247,-1.249,-1.250,-1.252,-1.253,-1.254, - &-1.256,-1.257,-1.259,-1.260,-1.262,-1.263,-1.264,-1.266,-1.267, - &-1.269,-1.270,-1.271,-1.273,-1.274,-1.276,-1.277,-1.278,-1.280, - &-1.281,-1.283,-1.284,-1.285,-1.287,-1.288,-1.290,-1.291,-1.292, - &-1.294,-1.295,-1.296,-1.298,-1.299,-1.301,-1.302,-1.303,-1.305, - &-1.306,-1.307,-1.309,-1.310,-1.311,-1.313,-1.314,-1.315,-1.317, - &-1.318,-1.319,-1.321,-1.322,-1.323,-1.325,-1.326,-1.327,-1.329, - &-1.330,-1.331,-1.333,-1.334,-1.335,-1.337,-1.338,-1.339,-1.341, - &-1.342,-1.343,-1.344,-1.346,-1.347,-1.348,-1.350,-1.351,-1.352, - &-1.354,-1.355,-1.356,-1.357,-1.359,-1.360,-1.361,-1.363,-1.364, - &-1.365,-1.366,-1.368,-1.369,-1.370,-1.371,-1.373,-1.374,-1.375, - &-1.376,-1.378,-1.379,-1.380,-1.381,-1.383,-1.384,-1.385,-1.387, - &-1.388,-1.389,-1.390,-1.391,-1.393,-1.394,-1.395,-1.396,-1.398, - &-1.399,-1.400,-1.401,-1.403,-1.416,-1.428,-1.440,-1.452,-1.463, - &-1.475,-1.487,-1.498,-1.509,-1.520,-1.532,-1.543,-1.554,-1.564, - &-1.575,-1.586,-1.596,-1.607,-1.617,-1.628,-1.638,-1.648,-1.659, - &-1.669,-1.679,-1.689,-1.699,-1.709,-1.719,-1.729,-1.738,-1.748, - &-1.758,-1.767,-1.777,-1.786,-1.796,-1.805,-1.815,-1.824,-1.833, - &-1.843,-1.852,-1.861,-1.870,-1.879,-1.888,-1.897,-1.906,-1.915, - &-1.924,-1.933,-1.942,-1.951,-1.960,-1.969,-1.977,-1.986,-1.995, - &-2.004,-2.012,-2.021,-2.029,-2.038,-2.047,-2.055,-2.064,-2.072, - &-2.081,-2.089,-2.097,-2.106,-2.114,-2.123,-2.131,-2.139,-2.147, - &-2.156,-2.164,-2.172,-2.180,-2.189,-2.197,-2.205,-2.213,-2.221, - &-2.229,-2.237,-2.245,-2.253,-2.261,-2.269,-2.277,-2.285,-2.293, - &-2.301,-2.309,-2.317,-2.325,-2.333,-2.341,-2.349,-2.356,-2.364, - &-2.372,-2.380,-2.388,-2.395,-2.403,-2.411,-2.419,-2.426,-2.434, - &-2.442,-2.449,-2.457,-2.465,-2.472,-2.480,-2.488,-2.495,-2.503, - &-2.510,-2.518,-2.525,-2.533,-2.541,-2.548,-2.556,-2.563,-2.571, - &-2.578,-2.586,-2.593,-2.600,-2.608,-2.615,-2.623,-2.630,-2.638, - &-2.645,-2.652,-2.660,-2.667,-2.674,-2.682,-2.689,-2.696,-2.704, - &-2.711,-2.718,-2.726,-2.733,-2.740,-2.747,-2.755,-2.762,-2.769, - &-2.776,-2.784,-2.791 - & / -C -C *** NH4NO3 -C - DATA BNC05M/ - &-0.050,-0.111,-0.143,-0.166,-0.185,-0.202,-0.216,-0.229,-0.240, - &-0.251,-0.261,-0.271,-0.279,-0.288,-0.296,-0.304,-0.311,-0.318, - &-0.325,-0.331,-0.338,-0.344,-0.350,-0.356,-0.361,-0.367,-0.372, - &-0.378,-0.383,-0.388,-0.393,-0.398,-0.402,-0.407,-0.412,-0.416, - &-0.420,-0.425,-0.429,-0.433,-0.437,-0.441,-0.445,-0.449,-0.453, - &-0.457,-0.460,-0.464,-0.468,-0.471,-0.475,-0.478,-0.482,-0.485, - &-0.488,-0.491,-0.495,-0.498,-0.501,-0.504,-0.507,-0.510,-0.513, - &-0.516,-0.519,-0.522,-0.525,-0.528,-0.531,-0.534,-0.537,-0.539, - &-0.542,-0.545,-0.548,-0.550,-0.553,-0.556,-0.558,-0.561,-0.564, - &-0.566,-0.569,-0.572,-0.574,-0.577,-0.579,-0.582,-0.584,-0.587, - &-0.589,-0.592,-0.594,-0.597,-0.599,-0.602,-0.604,-0.607,-0.609, - &-0.612,-0.614,-0.617,-0.619,-0.621,-0.624,-0.626,-0.629,-0.631, - &-0.633,-0.636,-0.638,-0.640,-0.643,-0.645,-0.647,-0.650,-0.652, - &-0.654,-0.656,-0.659,-0.661,-0.663,-0.665,-0.668,-0.670,-0.672, - &-0.674,-0.677,-0.679,-0.681,-0.683,-0.685,-0.687,-0.690,-0.692, - &-0.694,-0.696,-0.698,-0.700,-0.702,-0.704,-0.706,-0.709,-0.711, - &-0.713,-0.715,-0.717,-0.719,-0.721,-0.723,-0.725,-0.727,-0.729, - &-0.731,-0.733,-0.735,-0.737,-0.739,-0.741,-0.742,-0.744,-0.746, - &-0.748,-0.750,-0.752,-0.754,-0.756,-0.758,-0.760,-0.761,-0.763, - &-0.765,-0.767,-0.769,-0.771,-0.772,-0.774,-0.776,-0.778,-0.780, - &-0.782,-0.783,-0.785,-0.787,-0.789,-0.790,-0.792,-0.794,-0.796, - &-0.797,-0.799,-0.801,-0.803,-0.804,-0.806,-0.808,-0.809,-0.811, - &-0.813,-0.814,-0.816,-0.818,-0.820,-0.821,-0.823,-0.824,-0.826, - &-0.828,-0.829,-0.831,-0.833,-0.834,-0.836,-0.838,-0.839,-0.841, - &-0.842,-0.844,-0.846,-0.847,-0.849,-0.850,-0.852,-0.853,-0.855, - &-0.857,-0.858,-0.860,-0.861,-0.863,-0.864,-0.866,-0.867,-0.869, - &-0.870,-0.872,-0.873,-0.875,-0.876,-0.878,-0.879,-0.881,-0.882, - &-0.884,-0.885,-0.887,-0.888,-0.890,-0.891,-0.893,-0.894,-0.896, - &-0.897,-0.898,-0.900,-0.901,-0.903,-0.904,-0.906,-0.907,-0.908, - &-0.910,-0.911,-0.913,-0.914,-0.915,-0.917,-0.918,-0.920,-0.921, - &-0.922,-0.924,-0.925,-0.926,-0.928,-0.929,-0.931,-0.932,-0.933, - &-0.935,-0.936,-0.937,-0.939,-0.940,-0.941,-0.943,-0.944,-0.945, - &-0.947,-0.948,-0.949,-0.951,-0.952,-0.953,-0.954,-0.956,-0.957, - &-0.958,-0.960,-0.961,-0.962,-0.963,-0.965,-0.966,-0.967,-0.969, - &-0.970,-0.971,-0.972,-0.974,-0.975,-0.976,-0.977,-0.979,-0.980, - &-0.981,-0.982,-0.984,-0.985,-0.986,-0.987,-0.988,-0.990,-0.991, - &-0.992,-0.993,-0.995,-0.996,-0.997,-0.998,-0.999,-1.001,-1.002, - &-1.003,-1.004,-1.005,-1.007,-1.008,-1.009,-1.010,-1.011,-1.012, - &-1.014,-1.015,-1.016,-1.017,-1.018,-1.019,-1.021,-1.022,-1.023, - &-1.024,-1.025,-1.026,-1.027,-1.029,-1.030,-1.031,-1.032,-1.033, - &-1.034,-1.035,-1.037,-1.038,-1.039,-1.040,-1.041,-1.042,-1.043, - &-1.044,-1.045,-1.047,-1.048,-1.049,-1.050,-1.051,-1.052,-1.053, - &-1.054,-1.055,-1.056,-1.058,-1.059,-1.060,-1.061,-1.062,-1.063, - &-1.064,-1.065,-1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.072, - &-1.074,-1.075,-1.076,-1.077,-1.088,-1.098,-1.108,-1.118,-1.128, - &-1.137,-1.147,-1.156,-1.165,-1.174,-1.183,-1.192,-1.200,-1.209, - &-1.217,-1.225,-1.233,-1.241,-1.249,-1.257,-1.265,-1.273,-1.280, - &-1.288,-1.295,-1.303,-1.310,-1.317,-1.324,-1.331,-1.338,-1.345, - &-1.352,-1.359,-1.365,-1.372,-1.379,-1.385,-1.392,-1.398,-1.404, - &-1.411,-1.417,-1.423,-1.429,-1.435,-1.441,-1.447,-1.453,-1.459, - &-1.465,-1.471,-1.477,-1.483,-1.488,-1.494,-1.500,-1.505,-1.511, - &-1.516,-1.522,-1.527,-1.533,-1.538,-1.544,-1.549,-1.554,-1.560, - &-1.565,-1.570,-1.575,-1.580,-1.586,-1.591,-1.596,-1.601,-1.606, - &-1.611,-1.616,-1.621,-1.626,-1.631,-1.635,-1.640,-1.645,-1.650, - &-1.655,-1.660,-1.664,-1.669,-1.674,-1.679,-1.683,-1.688,-1.693, - &-1.697,-1.702,-1.706,-1.711,-1.716,-1.720,-1.725,-1.729,-1.734, - &-1.738,-1.743,-1.747,-1.751,-1.756,-1.760,-1.765,-1.769,-1.773, - &-1.778,-1.782,-1.786,-1.791,-1.795,-1.799,-1.803,-1.808,-1.812, - &-1.816,-1.820,-1.825,-1.829,-1.833,-1.837,-1.841,-1.845,-1.850, - &-1.854,-1.858,-1.862,-1.866,-1.870,-1.874,-1.878,-1.882,-1.886, - &-1.890,-1.894,-1.898,-1.902,-1.906,-1.910,-1.914,-1.918,-1.922, - &-1.926,-1.930,-1.934,-1.938,-1.942,-1.946,-1.950,-1.954,-1.958, - &-1.961,-1.965,-1.969 - & / -C -C *** NH4Cl -C - DATA BNC06M/ - &-0.048,-0.103,-0.130,-0.148,-0.161,-0.173,-0.182,-0.190,-0.197, - &-0.203,-0.208,-0.213,-0.217,-0.221,-0.225,-0.228,-0.231,-0.234, - &-0.237,-0.239,-0.241,-0.243,-0.245,-0.247,-0.249,-0.251,-0.252, - &-0.254,-0.255,-0.256,-0.257,-0.259,-0.260,-0.261,-0.262,-0.263, - &-0.263,-0.264,-0.265,-0.266,-0.267,-0.267,-0.268,-0.269,-0.269, - &-0.270,-0.270,-0.271,-0.272,-0.272,-0.273,-0.273,-0.273,-0.274, - &-0.274,-0.275,-0.275,-0.275,-0.276,-0.276,-0.277,-0.277,-0.277, - &-0.277,-0.278,-0.278,-0.278,-0.279,-0.279,-0.279,-0.279,-0.279, - &-0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.281,-0.281, - &-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, - &-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, - &-0.281,-0.281,-0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.280, - &-0.279,-0.279,-0.279,-0.279,-0.279,-0.279,-0.278,-0.278,-0.278, - &-0.278,-0.278,-0.277,-0.277,-0.277,-0.277,-0.277,-0.276,-0.276, - &-0.276,-0.276,-0.275,-0.275,-0.275,-0.275,-0.274,-0.274,-0.274, - &-0.274,-0.273,-0.273,-0.273,-0.273,-0.272,-0.272,-0.272,-0.272, - &-0.271,-0.271,-0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.269, - &-0.269,-0.269,-0.269,-0.268,-0.268,-0.268,-0.267,-0.267,-0.267, - &-0.267,-0.266,-0.266,-0.266,-0.266,-0.265,-0.265,-0.265,-0.264, - &-0.264,-0.264,-0.264,-0.263,-0.263,-0.263,-0.263,-0.262,-0.262, - &-0.262,-0.261,-0.261,-0.261,-0.261,-0.260,-0.260,-0.260,-0.259, - &-0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.258,-0.257,-0.257, - &-0.257,-0.256,-0.256,-0.256,-0.256,-0.255,-0.255,-0.255,-0.255, - &-0.254,-0.254,-0.254,-0.253,-0.253,-0.253,-0.253,-0.252,-0.252, - &-0.252,-0.252,-0.251,-0.251,-0.251,-0.250,-0.250,-0.250,-0.250, - &-0.249,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.247,-0.247, - &-0.247,-0.247,-0.246,-0.246,-0.246,-0.246,-0.245,-0.245,-0.245, - &-0.245,-0.244,-0.244,-0.244,-0.244,-0.243,-0.243,-0.243,-0.243, - &-0.242,-0.242,-0.242,-0.241,-0.241,-0.241,-0.241,-0.240,-0.240, - &-0.240,-0.240,-0.239,-0.239,-0.239,-0.239,-0.238,-0.238,-0.238, - &-0.238,-0.237,-0.237,-0.237,-0.237,-0.236,-0.236,-0.236,-0.236, - &-0.236,-0.235,-0.235,-0.235,-0.235,-0.234,-0.234,-0.234,-0.234, - &-0.233,-0.233,-0.233,-0.233,-0.232,-0.232,-0.232,-0.232,-0.231, - &-0.231,-0.231,-0.231,-0.231,-0.230,-0.230,-0.230,-0.230,-0.229, - &-0.229,-0.229,-0.229,-0.228,-0.228,-0.228,-0.228,-0.228,-0.227, - &-0.227,-0.227,-0.227,-0.226,-0.226,-0.226,-0.226,-0.226,-0.225, - &-0.225,-0.225,-0.225,-0.224,-0.224,-0.224,-0.224,-0.224,-0.223, - &-0.223,-0.223,-0.223,-0.223,-0.222,-0.222,-0.222,-0.222,-0.221, - &-0.221,-0.221,-0.221,-0.221,-0.220,-0.220,-0.220,-0.220,-0.220, - &-0.219,-0.219,-0.219,-0.219,-0.219,-0.218,-0.218,-0.218,-0.218, - &-0.218,-0.217,-0.217,-0.217,-0.217,-0.217,-0.216,-0.216,-0.216, - &-0.216,-0.216,-0.215,-0.215,-0.215,-0.215,-0.215,-0.215,-0.214, - &-0.214,-0.214,-0.214,-0.214,-0.213,-0.213,-0.213,-0.213,-0.213, - &-0.212,-0.212,-0.212,-0.212,-0.212,-0.212,-0.211,-0.211,-0.211, - &-0.211,-0.211,-0.210,-0.210,-0.208,-0.207,-0.205,-0.203,-0.202, - &-0.200,-0.199,-0.198,-0.196,-0.195,-0.194,-0.192,-0.191,-0.190, - &-0.189,-0.188,-0.187,-0.186,-0.185,-0.184,-0.183,-0.182,-0.182, - &-0.181,-0.180,-0.179,-0.179,-0.178,-0.178,-0.177,-0.176,-0.176, - &-0.176,-0.175,-0.175,-0.174,-0.174,-0.174,-0.173,-0.173,-0.173, - &-0.173,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172, - &-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.173, - &-0.173,-0.173,-0.173,-0.173,-0.174,-0.174,-0.174,-0.175,-0.175, - &-0.175,-0.176,-0.176,-0.176,-0.177,-0.177,-0.178,-0.178,-0.179, - &-0.179,-0.180,-0.180,-0.181,-0.181,-0.182,-0.183,-0.183,-0.184, - &-0.184,-0.185,-0.186,-0.186,-0.187,-0.188,-0.188,-0.189,-0.190, - &-0.191,-0.191,-0.192,-0.193,-0.194,-0.194,-0.195,-0.196,-0.197, - &-0.198,-0.199,-0.200,-0.200,-0.201,-0.202,-0.203,-0.204,-0.205, - &-0.206,-0.207,-0.208,-0.209,-0.210,-0.211,-0.212,-0.213,-0.214, - &-0.215,-0.216,-0.217,-0.218,-0.219,-0.220,-0.221,-0.222,-0.223, - &-0.224,-0.226,-0.227,-0.228,-0.229,-0.230,-0.231,-0.232,-0.234, - &-0.235,-0.236,-0.237,-0.238,-0.239,-0.241,-0.242,-0.243,-0.244, - &-0.246,-0.247,-0.248,-0.249,-0.251,-0.252,-0.253,-0.254,-0.256, - &-0.257,-0.258,-0.260 - & / -C -C *** (2H,SO4) -C - DATA BNC07M/ - &-0.098,-0.213,-0.271,-0.312,-0.344,-0.370,-0.393,-0.413,-0.431, - &-0.448,-0.462,-0.476,-0.489,-0.500,-0.511,-0.522,-0.532,-0.541, - &-0.550,-0.558,-0.567,-0.574,-0.582,-0.589,-0.596,-0.603,-0.609, - &-0.615,-0.621,-0.627,-0.633,-0.638,-0.644,-0.649,-0.654,-0.659, - &-0.664,-0.669,-0.674,-0.678,-0.683,-0.687,-0.691,-0.695,-0.700, - &-0.704,-0.708,-0.711,-0.715,-0.719,-0.723,-0.726,-0.730,-0.733, - &-0.737,-0.740,-0.744,-0.747,-0.750,-0.753,-0.757,-0.760,-0.763, - &-0.766,-0.769,-0.772,-0.775,-0.778,-0.781,-0.784,-0.786,-0.789, - &-0.792,-0.795,-0.797,-0.800,-0.803,-0.805,-0.808,-0.811,-0.813, - &-0.816,-0.818,-0.821,-0.823,-0.825,-0.828,-0.830,-0.833,-0.835, - &-0.837,-0.840,-0.842,-0.844,-0.847,-0.849,-0.851,-0.853,-0.856, - &-0.858,-0.860,-0.862,-0.864,-0.867,-0.869,-0.871,-0.873,-0.875, - &-0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.889,-0.891,-0.893, - &-0.895,-0.897,-0.899,-0.901,-0.903,-0.905,-0.907,-0.909,-0.911, - &-0.913,-0.915,-0.916,-0.918,-0.920,-0.922,-0.924,-0.926,-0.928, - &-0.929,-0.931,-0.933,-0.935,-0.936,-0.938,-0.940,-0.942,-0.944, - &-0.945,-0.947,-0.949,-0.950,-0.952,-0.954,-0.956,-0.957,-0.959, - &-0.961,-0.962,-0.964,-0.966,-0.967,-0.969,-0.971,-0.972,-0.974, - &-0.975,-0.977,-0.979,-0.980,-0.982,-0.983,-0.985,-0.987,-0.988, - &-0.990,-0.991,-0.993,-0.994,-0.996,-0.998,-0.999,-1.001,-1.002, - &-1.004,-1.005,-1.007,-1.008,-1.010,-1.011,-1.013,-1.014,-1.016, - &-1.017,-1.019,-1.020,-1.022,-1.023,-1.024,-1.026,-1.027,-1.029, - &-1.030,-1.032,-1.033,-1.035,-1.036,-1.037,-1.039,-1.040,-1.042, - &-1.043,-1.045,-1.046,-1.047,-1.049,-1.050,-1.052,-1.053,-1.054, - &-1.056,-1.057,-1.058,-1.060,-1.061,-1.063,-1.064,-1.065,-1.067, - &-1.068,-1.069,-1.071,-1.072,-1.073,-1.075,-1.076,-1.077,-1.079, - &-1.080,-1.081,-1.083,-1.084,-1.085,-1.087,-1.088,-1.089,-1.090, - &-1.092,-1.093,-1.094,-1.096,-1.097,-1.098,-1.100,-1.101,-1.102, - &-1.103,-1.105,-1.106,-1.107,-1.108,-1.110,-1.111,-1.112,-1.113, - &-1.115,-1.116,-1.117,-1.118,-1.120,-1.121,-1.122,-1.123,-1.125, - &-1.126,-1.127,-1.128,-1.130,-1.131,-1.132,-1.133,-1.134,-1.136, - &-1.137,-1.138,-1.139,-1.141,-1.142,-1.143,-1.144,-1.145,-1.147, - &-1.148,-1.149,-1.150,-1.151,-1.153,-1.154,-1.155,-1.156,-1.157, - &-1.158,-1.160,-1.161,-1.162,-1.163,-1.164,-1.165,-1.167,-1.168, - &-1.169,-1.170,-1.171,-1.172,-1.174,-1.175,-1.176,-1.177,-1.178, - &-1.179,-1.181,-1.182,-1.183,-1.184,-1.185,-1.186,-1.187,-1.189, - &-1.190,-1.191,-1.192,-1.193,-1.194,-1.195,-1.196,-1.198,-1.199, - &-1.200,-1.201,-1.202,-1.203,-1.204,-1.205,-1.207,-1.208,-1.209, - &-1.210,-1.211,-1.212,-1.213,-1.214,-1.215,-1.216,-1.218,-1.219, - &-1.220,-1.221,-1.222,-1.223,-1.224,-1.225,-1.226,-1.227,-1.228, - &-1.230,-1.231,-1.232,-1.233,-1.234,-1.235,-1.236,-1.237,-1.238, - &-1.239,-1.240,-1.241,-1.242,-1.244,-1.245,-1.246,-1.247,-1.248, - &-1.249,-1.250,-1.251,-1.252,-1.253,-1.254,-1.255,-1.256,-1.257, - &-1.258,-1.259,-1.261,-1.262,-1.263,-1.264,-1.265,-1.266,-1.267, - &-1.268,-1.269,-1.270,-1.271,-1.282,-1.292,-1.303,-1.313,-1.323, - &-1.332,-1.342,-1.352,-1.362,-1.371,-1.381,-1.390,-1.400,-1.409, - &-1.418,-1.427,-1.437,-1.446,-1.455,-1.464,-1.473,-1.482,-1.491, - &-1.499,-1.508,-1.517,-1.526,-1.534,-1.543,-1.552,-1.560,-1.569, - &-1.577,-1.586,-1.594,-1.602,-1.611,-1.619,-1.627,-1.636,-1.644, - &-1.652,-1.660,-1.668,-1.677,-1.685,-1.693,-1.701,-1.709,-1.717, - &-1.725,-1.733,-1.741,-1.749,-1.757,-1.764,-1.772,-1.780,-1.788, - &-1.796,-1.804,-1.811,-1.819,-1.827,-1.835,-1.842,-1.850,-1.858, - &-1.865,-1.873,-1.880,-1.888,-1.896,-1.903,-1.911,-1.918,-1.926, - &-1.933,-1.941,-1.948,-1.956,-1.963,-1.971,-1.978,-1.986,-1.993, - &-2.000,-2.008,-2.015,-2.022,-2.030,-2.037,-2.044,-2.052,-2.059, - &-2.066,-2.074,-2.081,-2.088,-2.095,-2.103,-2.110,-2.117,-2.124, - &-2.131,-2.139,-2.146,-2.153,-2.160,-2.167,-2.174,-2.181,-2.189, - &-2.196,-2.203,-2.210,-2.217,-2.224,-2.231,-2.238,-2.245,-2.252, - &-2.259,-2.266,-2.273,-2.280,-2.287,-2.294,-2.301,-2.308,-2.315, - &-2.322,-2.329,-2.336,-2.343,-2.350,-2.357,-2.364,-2.371,-2.378, - &-2.385,-2.391,-2.398,-2.405,-2.412,-2.419,-2.426,-2.433,-2.439, - &-2.446,-2.453,-2.460,-2.467,-2.474,-2.480,-2.487,-2.494,-2.501, - &-2.508,-2.514,-2.521 - & / -C -C *** (H,HSO4) -C - DATA BNC08M/ - &-0.046,-0.090,-0.108,-0.118,-0.124,-0.128,-0.130,-0.132,-0.132, - &-0.131,-0.130,-0.128,-0.125,-0.122,-0.119,-0.116,-0.112,-0.108, - &-0.103,-0.098,-0.093,-0.088,-0.083,-0.077,-0.071,-0.065,-0.059, - &-0.053,-0.046,-0.040,-0.033,-0.026,-0.019,-0.012,-0.004, 0.003, - & 0.011, 0.018, 0.026, 0.034, 0.042, 0.050, 0.058, 0.066, 0.075, - & 0.083, 0.091, 0.100, 0.109, 0.117, 0.126, 0.135, 0.144, 0.153, - & 0.162, 0.171, 0.180, 0.189, 0.198, 0.207, 0.216, 0.226, 0.235, - & 0.244, 0.254, 0.263, 0.273, 0.282, 0.292, 0.302, 0.311, 0.321, - & 0.331, 0.341, 0.351, 0.361, 0.371, 0.381, 0.391, 0.401, 0.411, - & 0.421, 0.432, 0.442, 0.452, 0.463, 0.473, 0.484, 0.495, 0.505, - & 0.516, 0.527, 0.538, 0.549, 0.560, 0.571, 0.582, 0.593, 0.604, - & 0.615, 0.626, 0.638, 0.649, 0.660, 0.672, 0.683, 0.694, 0.706, - & 0.717, 0.729, 0.740, 0.752, 0.763, 0.775, 0.787, 0.798, 0.810, - & 0.821, 0.833, 0.845, 0.856, 0.868, 0.879, 0.891, 0.903, 0.914, - & 0.926, 0.937, 0.949, 0.961, 0.972, 0.984, 0.995, 1.007, 1.018, - & 1.030, 1.041, 1.053, 1.064, 1.076, 1.087, 1.099, 1.110, 1.121, - & 1.133, 1.144, 1.155, 1.167, 1.178, 1.189, 1.200, 1.212, 1.223, - & 1.234, 1.245, 1.256, 1.267, 1.278, 1.289, 1.300, 1.311, 1.322, - & 1.333, 1.344, 1.355, 1.366, 1.377, 1.388, 1.399, 1.409, 1.420, - & 1.431, 1.442, 1.452, 1.463, 1.474, 1.485, 1.495, 1.506, 1.516, - & 1.527, 1.537, 1.548, 1.558, 1.569, 1.579, 1.590, 1.600, 1.611, - & 1.621, 1.631, 1.642, 1.652, 1.662, 1.672, 1.683, 1.693, 1.703, - & 1.713, 1.723, 1.733, 1.743, 1.753, 1.763, 1.774, 1.784, 1.793, - & 1.803, 1.813, 1.823, 1.833, 1.843, 1.853, 1.863, 1.872, 1.882, - & 1.892, 1.902, 1.911, 1.921, 1.931, 1.940, 1.950, 1.960, 1.969, - & 1.979, 1.988, 1.998, 2.007, 2.017, 2.026, 2.036, 2.045, 2.055, - & 2.064, 2.073, 2.083, 2.092, 2.101, 2.111, 2.120, 2.129, 2.138, - & 2.147, 2.157, 2.166, 2.175, 2.184, 2.193, 2.202, 2.211, 2.220, - & 2.229, 2.238, 2.247, 2.256, 2.265, 2.274, 2.283, 2.292, 2.301, - & 2.310, 2.318, 2.327, 2.336, 2.345, 2.354, 2.362, 2.371, 2.380, - & 2.388, 2.397, 2.406, 2.414, 2.423, 2.432, 2.440, 2.449, 2.457, - & 2.466, 2.474, 2.483, 2.491, 2.500, 2.508, 2.517, 2.525, 2.533, - & 2.542, 2.550, 2.558, 2.567, 2.575, 2.583, 2.591, 2.600, 2.608, - & 2.616, 2.624, 2.633, 2.641, 2.649, 2.657, 2.665, 2.673, 2.681, - & 2.689, 2.697, 2.705, 2.713, 2.721, 2.729, 2.737, 2.745, 2.753, - & 2.761, 2.769, 2.777, 2.785, 2.793, 2.801, 2.809, 2.816, 2.824, - & 2.832, 2.840, 2.847, 2.855, 2.863, 2.871, 2.878, 2.886, 2.894, - & 2.901, 2.909, 2.917, 2.924, 2.932, 2.939, 2.947, 2.955, 2.962, - & 2.970, 2.977, 2.985, 2.992, 3.000, 3.007, 3.014, 3.022, 3.029, - & 3.037, 3.044, 3.051, 3.059, 3.066, 3.074, 3.081, 3.088, 3.095, - & 3.103, 3.110, 3.117, 3.125, 3.132, 3.139, 3.146, 3.153, 3.161, - & 3.168, 3.175, 3.182, 3.189, 3.196, 3.203, 3.210, 3.217, 3.225, - & 3.232, 3.239, 3.246, 3.253, 3.260, 3.267, 3.274, 3.281, 3.288, - & 3.294, 3.301, 3.308, 3.315, 3.322, 3.329, 3.336, 3.343, 3.350, - & 3.356, 3.363, 3.370, 3.377, 3.450, 3.516, 3.581, 3.645, 3.708, - & 3.770, 3.831, 3.891, 3.950, 4.008, 4.065, 4.122, 4.178, 4.233, - & 4.287, 4.340, 4.393, 4.445, 4.496, 4.547, 4.597, 4.646, 4.695, - & 4.743, 4.790, 4.837, 4.884, 4.929, 4.974, 5.019, 5.063, 5.107, - & 5.150, 5.193, 5.235, 5.277, 5.318, 5.359, 5.399, 5.439, 5.478, - & 5.517, 5.556, 5.594, 5.632, 5.670, 5.707, 5.743, 5.780, 5.816, - & 5.852, 5.887, 5.922, 5.956, 5.991, 6.025, 6.058, 6.092, 6.125, - & 6.158, 6.190, 6.222, 6.254, 6.286, 6.317, 6.348, 6.379, 6.410, - & 6.440, 6.470, 6.500, 6.529, 6.559, 6.588, 6.616, 6.645, 6.673, - & 6.701, 6.729, 6.757, 6.784, 6.812, 6.839, 6.865, 6.892, 6.919, - & 6.945, 6.971, 6.997, 7.022, 7.048, 7.073, 7.098, 7.123, 7.148, - & 7.172, 7.196, 7.221, 7.245, 7.269, 7.292, 7.316, 7.339, 7.362, - & 7.385, 7.408, 7.431, 7.454, 7.476, 7.498, 7.520, 7.542, 7.564, - & 7.586, 7.607, 7.629, 7.650, 7.671, 7.692, 7.713, 7.734, 7.755, - & 7.775, 7.795, 7.816, 7.836, 7.856, 7.876, 7.895, 7.915, 7.935, - & 7.954, 7.973, 7.992, 8.012, 8.030, 8.049, 8.068, 8.087, 8.105, - & 8.124, 8.142, 8.160, 8.178, 8.196, 8.214, 8.232, 8.250, 8.267, - & 8.285, 8.302, 8.319, 8.337, 8.354, 8.371, 8.388, 8.404, 8.421, - & 8.438, 8.454, 8.471 - & / -C -C *** NH4HSO4 -C - DATA BNC09M/ - &-0.048,-0.102,-0.128,-0.146,-0.159,-0.170,-0.179,-0.187,-0.194, - &-0.200,-0.205,-0.210,-0.214,-0.218,-0.221,-0.224,-0.227,-0.230, - &-0.232,-0.234,-0.235,-0.237,-0.238,-0.239,-0.240,-0.241,-0.242, - &-0.242,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.242,-0.242, - &-0.241,-0.241,-0.240,-0.239,-0.238,-0.237,-0.236,-0.235,-0.234, - &-0.233,-0.231,-0.230,-0.228,-0.227,-0.225,-0.224,-0.222,-0.220, - &-0.218,-0.216,-0.214,-0.212,-0.210,-0.208,-0.206,-0.204,-0.202, - &-0.199,-0.197,-0.195,-0.192,-0.190,-0.188,-0.185,-0.183,-0.180, - &-0.178,-0.175,-0.172,-0.170,-0.167,-0.164,-0.161,-0.159,-0.156, - &-0.153,-0.150,-0.147,-0.144,-0.141,-0.138,-0.135,-0.132,-0.129, - &-0.126,-0.123,-0.119,-0.116,-0.113,-0.110,-0.106,-0.103,-0.100, - &-0.096,-0.093,-0.090,-0.086,-0.083,-0.080,-0.076,-0.073,-0.069, - &-0.066,-0.062,-0.059,-0.055,-0.052,-0.048,-0.045,-0.041,-0.037, - &-0.034,-0.030,-0.027,-0.023,-0.020,-0.016,-0.012,-0.009,-0.005, - &-0.002, 0.002, 0.005, 0.009, 0.013, 0.016, 0.020, 0.023, 0.027, - & 0.030, 0.034, 0.037, 0.041, 0.044, 0.048, 0.051, 0.055, 0.058, - & 0.062, 0.065, 0.069, 0.072, 0.076, 0.079, 0.083, 0.086, 0.090, - & 0.093, 0.097, 0.100, 0.103, 0.107, 0.110, 0.114, 0.117, 0.120, - & 0.124, 0.127, 0.130, 0.134, 0.137, 0.140, 0.144, 0.147, 0.150, - & 0.154, 0.157, 0.160, 0.164, 0.167, 0.170, 0.173, 0.177, 0.180, - & 0.183, 0.186, 0.189, 0.193, 0.196, 0.199, 0.202, 0.205, 0.209, - & 0.212, 0.215, 0.218, 0.221, 0.224, 0.227, 0.231, 0.234, 0.237, - & 0.240, 0.243, 0.246, 0.249, 0.252, 0.255, 0.258, 0.261, 0.264, - & 0.267, 0.270, 0.273, 0.276, 0.279, 0.282, 0.285, 0.288, 0.291, - & 0.294, 0.297, 0.300, 0.303, 0.306, 0.309, 0.312, 0.315, 0.317, - & 0.320, 0.323, 0.326, 0.329, 0.332, 0.335, 0.338, 0.340, 0.343, - & 0.346, 0.349, 0.352, 0.354, 0.357, 0.360, 0.363, 0.366, 0.368, - & 0.371, 0.374, 0.377, 0.379, 0.382, 0.385, 0.388, 0.390, 0.393, - & 0.396, 0.398, 0.401, 0.404, 0.407, 0.409, 0.412, 0.415, 0.417, - & 0.420, 0.422, 0.425, 0.428, 0.430, 0.433, 0.436, 0.438, 0.441, - & 0.443, 0.446, 0.449, 0.451, 0.454, 0.456, 0.459, 0.461, 0.464, - & 0.467, 0.469, 0.472, 0.474, 0.477, 0.479, 0.482, 0.484, 0.487, - & 0.489, 0.492, 0.494, 0.497, 0.499, 0.502, 0.504, 0.507, 0.509, - & 0.511, 0.514, 0.516, 0.519, 0.521, 0.524, 0.526, 0.528, 0.531, - & 0.533, 0.536, 0.538, 0.540, 0.543, 0.545, 0.548, 0.550, 0.552, - & 0.555, 0.557, 0.559, 0.562, 0.564, 0.566, 0.569, 0.571, 0.573, - & 0.576, 0.578, 0.580, 0.583, 0.585, 0.587, 0.589, 0.592, 0.594, - & 0.596, 0.599, 0.601, 0.603, 0.605, 0.608, 0.610, 0.612, 0.614, - & 0.617, 0.619, 0.621, 0.623, 0.625, 0.628, 0.630, 0.632, 0.634, - & 0.636, 0.639, 0.641, 0.643, 0.645, 0.647, 0.649, 0.652, 0.654, - & 0.656, 0.658, 0.660, 0.662, 0.665, 0.667, 0.669, 0.671, 0.673, - & 0.675, 0.677, 0.679, 0.681, 0.684, 0.686, 0.688, 0.690, 0.692, - & 0.694, 0.696, 0.698, 0.700, 0.702, 0.704, 0.706, 0.708, 0.710, - & 0.713, 0.715, 0.717, 0.719, 0.721, 0.723, 0.725, 0.727, 0.729, - & 0.731, 0.733, 0.735, 0.737, 0.758, 0.778, 0.797, 0.815, 0.834, - & 0.852, 0.870, 0.887, 0.905, 0.922, 0.938, 0.955, 0.971, 0.987, - & 1.003, 1.018, 1.033, 1.048, 1.063, 1.078, 1.092, 1.106, 1.120, - & 1.134, 1.148, 1.161, 1.174, 1.187, 1.200, 1.213, 1.225, 1.238, - & 1.250, 1.262, 1.274, 1.286, 1.297, 1.309, 1.320, 1.331, 1.342, - & 1.353, 1.364, 1.374, 1.385, 1.395, 1.406, 1.416, 1.426, 1.436, - & 1.446, 1.455, 1.465, 1.475, 1.484, 1.493, 1.502, 1.512, 1.521, - & 1.529, 1.538, 1.547, 1.556, 1.564, 1.572, 1.581, 1.589, 1.597, - & 1.605, 1.613, 1.621, 1.629, 1.637, 1.645, 1.652, 1.660, 1.667, - & 1.675, 1.682, 1.689, 1.696, 1.704, 1.711, 1.718, 1.725, 1.731, - & 1.738, 1.745, 1.752, 1.758, 1.765, 1.771, 1.778, 1.784, 1.790, - & 1.796, 1.803, 1.809, 1.815, 1.821, 1.827, 1.833, 1.839, 1.844, - & 1.850, 1.856, 1.861, 1.867, 1.873, 1.878, 1.884, 1.889, 1.894, - & 1.900, 1.905, 1.910, 1.915, 1.920, 1.926, 1.931, 1.936, 1.941, - & 1.946, 1.950, 1.955, 1.960, 1.965, 1.970, 1.974, 1.979, 1.983, - & 1.988, 1.993, 1.997, 2.001, 2.006, 2.010, 2.015, 2.019, 2.023, - & 2.027, 2.032, 2.036, 2.040, 2.044, 2.048, 2.052, 2.056, 2.060, - & 2.064, 2.068, 2.072, 2.076, 2.080, 2.083, 2.087, 2.091, 2.095, - & 2.098, 2.102, 2.106 - & / -C -C *** (H,NO3) -C - DATA BNC10M/ - &-0.047,-0.098,-0.120,-0.135,-0.145,-0.153,-0.158,-0.163,-0.167, - &-0.169,-0.172,-0.173,-0.175,-0.176,-0.176,-0.176,-0.176,-0.176, - &-0.176,-0.175,-0.175,-0.174,-0.173,-0.172,-0.170,-0.169,-0.168, - &-0.166,-0.165,-0.163,-0.162,-0.160,-0.159,-0.157,-0.155,-0.153, - &-0.151,-0.149,-0.148,-0.146,-0.144,-0.142,-0.140,-0.138,-0.136, - &-0.134,-0.132,-0.130,-0.128,-0.126,-0.124,-0.122,-0.120,-0.118, - &-0.115,-0.113,-0.111,-0.109,-0.107,-0.105,-0.103,-0.101,-0.099, - &-0.097,-0.095,-0.093,-0.090,-0.088,-0.086,-0.084,-0.082,-0.080, - &-0.078,-0.075,-0.073,-0.071,-0.069,-0.067,-0.064,-0.062,-0.060, - &-0.057,-0.055,-0.053,-0.051,-0.048,-0.046,-0.043,-0.041,-0.039, - &-0.036,-0.034,-0.031,-0.029,-0.026,-0.024,-0.021,-0.019,-0.016, - &-0.014,-0.011,-0.008,-0.006,-0.003, 0.000, 0.002, 0.005, 0.007, - & 0.010, 0.013, 0.016, 0.018, 0.021, 0.024, 0.026, 0.029, 0.032, - & 0.035, 0.037, 0.040, 0.043, 0.046, 0.048, 0.051, 0.054, 0.057, - & 0.059, 0.062, 0.065, 0.068, 0.070, 0.073, 0.076, 0.079, 0.081, - & 0.084, 0.087, 0.090, 0.092, 0.095, 0.098, 0.101, 0.103, 0.106, - & 0.109, 0.112, 0.114, 0.117, 0.120, 0.123, 0.125, 0.128, 0.131, - & 0.133, 0.136, 0.139, 0.142, 0.144, 0.147, 0.150, 0.152, 0.155, - & 0.158, 0.160, 0.163, 0.166, 0.168, 0.171, 0.174, 0.176, 0.179, - & 0.182, 0.184, 0.187, 0.190, 0.192, 0.195, 0.198, 0.200, 0.203, - & 0.205, 0.208, 0.211, 0.213, 0.216, 0.218, 0.221, 0.224, 0.226, - & 0.229, 0.231, 0.234, 0.236, 0.239, 0.242, 0.244, 0.247, 0.249, - & 0.252, 0.254, 0.257, 0.259, 0.262, 0.264, 0.267, 0.269, 0.272, - & 0.275, 0.277, 0.280, 0.282, 0.285, 0.287, 0.289, 0.292, 0.294, - & 0.297, 0.299, 0.302, 0.304, 0.307, 0.309, 0.312, 0.314, 0.317, - & 0.319, 0.321, 0.324, 0.326, 0.329, 0.331, 0.334, 0.336, 0.338, - & 0.341, 0.343, 0.346, 0.348, 0.350, 0.353, 0.355, 0.357, 0.360, - & 0.362, 0.364, 0.367, 0.369, 0.372, 0.374, 0.376, 0.379, 0.381, - & 0.383, 0.386, 0.388, 0.390, 0.392, 0.395, 0.397, 0.399, 0.402, - & 0.404, 0.406, 0.409, 0.411, 0.413, 0.415, 0.418, 0.420, 0.422, - & 0.424, 0.427, 0.429, 0.431, 0.433, 0.436, 0.438, 0.440, 0.442, - & 0.445, 0.447, 0.449, 0.451, 0.453, 0.456, 0.458, 0.460, 0.462, - & 0.464, 0.467, 0.469, 0.471, 0.473, 0.475, 0.477, 0.480, 0.482, - & 0.484, 0.486, 0.488, 0.490, 0.492, 0.495, 0.497, 0.499, 0.501, - & 0.503, 0.505, 0.507, 0.509, 0.511, 0.514, 0.516, 0.518, 0.520, - & 0.522, 0.524, 0.526, 0.528, 0.530, 0.532, 0.534, 0.536, 0.539, - & 0.541, 0.543, 0.545, 0.547, 0.549, 0.551, 0.553, 0.555, 0.557, - & 0.559, 0.561, 0.563, 0.565, 0.567, 0.569, 0.571, 0.573, 0.575, - & 0.577, 0.579, 0.581, 0.583, 0.585, 0.587, 0.589, 0.591, 0.593, - & 0.595, 0.597, 0.599, 0.601, 0.603, 0.604, 0.606, 0.608, 0.610, - & 0.612, 0.614, 0.616, 0.618, 0.620, 0.622, 0.624, 0.626, 0.628, - & 0.629, 0.631, 0.633, 0.635, 0.637, 0.639, 0.641, 0.643, 0.645, - & 0.646, 0.648, 0.650, 0.652, 0.654, 0.656, 0.658, 0.659, 0.661, - & 0.663, 0.665, 0.667, 0.669, 0.671, 0.672, 0.674, 0.676, 0.678, - & 0.680, 0.681, 0.683, 0.685, 0.704, 0.722, 0.739, 0.756, 0.773, - & 0.790, 0.806, 0.822, 0.838, 0.853, 0.869, 0.884, 0.899, 0.913, - & 0.928, 0.942, 0.956, 0.970, 0.983, 0.996, 1.010, 1.023, 1.036, - & 1.048, 1.061, 1.073, 1.085, 1.097, 1.109, 1.121, 1.132, 1.144, - & 1.155, 1.166, 1.177, 1.188, 1.198, 1.209, 1.219, 1.230, 1.240, - & 1.250, 1.260, 1.270, 1.279, 1.289, 1.298, 1.308, 1.317, 1.326, - & 1.335, 1.344, 1.353, 1.362, 1.370, 1.379, 1.387, 1.396, 1.404, - & 1.412, 1.420, 1.428, 1.436, 1.444, 1.451, 1.459, 1.467, 1.474, - & 1.481, 1.489, 1.496, 1.503, 1.510, 1.517, 1.524, 1.531, 1.538, - & 1.545, 1.551, 1.558, 1.565, 1.571, 1.578, 1.584, 1.590, 1.596, - & 1.603, 1.609, 1.615, 1.621, 1.627, 1.632, 1.638, 1.644, 1.650, - & 1.655, 1.661, 1.667, 1.672, 1.678, 1.683, 1.688, 1.694, 1.699, - & 1.704, 1.709, 1.714, 1.719, 1.724, 1.729, 1.734, 1.739, 1.744, - & 1.749, 1.753, 1.758, 1.763, 1.767, 1.772, 1.776, 1.781, 1.785, - & 1.790, 1.794, 1.799, 1.803, 1.807, 1.811, 1.815, 1.820, 1.824, - & 1.828, 1.832, 1.836, 1.840, 1.844, 1.848, 1.852, 1.855, 1.859, - & 1.863, 1.867, 1.870, 1.874, 1.878, 1.881, 1.885, 1.888, 1.892, - & 1.895, 1.899, 1.902, 1.906, 1.909, 1.913, 1.916, 1.919, 1.922, - & 1.926, 1.929, 1.932 - & / -C -C *** (H,Cl) -C - DATA BNC11M/ - &-0.046,-0.091,-0.110,-0.120,-0.127,-0.131,-0.133,-0.134,-0.134, - &-0.134,-0.132,-0.131,-0.128,-0.126,-0.123,-0.120,-0.116,-0.112, - &-0.108,-0.104,-0.099,-0.095,-0.090,-0.085,-0.080,-0.075,-0.070, - &-0.064,-0.059,-0.053,-0.047,-0.042,-0.036,-0.030,-0.024,-0.018, - &-0.011,-0.005, 0.001, 0.007, 0.014, 0.020, 0.026, 0.033, 0.039, - & 0.046, 0.052, 0.059, 0.065, 0.072, 0.079, 0.085, 0.092, 0.099, - & 0.105, 0.112, 0.119, 0.126, 0.132, 0.139, 0.146, 0.153, 0.160, - & 0.166, 0.173, 0.180, 0.187, 0.194, 0.201, 0.208, 0.215, 0.222, - & 0.229, 0.236, 0.243, 0.250, 0.257, 0.264, 0.272, 0.279, 0.286, - & 0.293, 0.301, 0.308, 0.316, 0.323, 0.330, 0.338, 0.346, 0.353, - & 0.361, 0.368, 0.376, 0.384, 0.392, 0.399, 0.407, 0.415, 0.423, - & 0.431, 0.439, 0.447, 0.455, 0.463, 0.471, 0.479, 0.487, 0.495, - & 0.503, 0.512, 0.520, 0.528, 0.536, 0.544, 0.553, 0.561, 0.569, - & 0.577, 0.586, 0.594, 0.602, 0.610, 0.619, 0.627, 0.635, 0.643, - & 0.652, 0.660, 0.668, 0.676, 0.685, 0.693, 0.701, 0.709, 0.718, - & 0.726, 0.734, 0.742, 0.750, 0.759, 0.767, 0.775, 0.783, 0.791, - & 0.799, 0.807, 0.815, 0.823, 0.832, 0.840, 0.848, 0.856, 0.864, - & 0.872, 0.880, 0.888, 0.896, 0.903, 0.911, 0.919, 0.927, 0.935, - & 0.943, 0.951, 0.959, 0.966, 0.974, 0.982, 0.990, 0.998, 1.005, - & 1.013, 1.021, 1.029, 1.036, 1.044, 1.052, 1.059, 1.067, 1.075, - & 1.082, 1.090, 1.097, 1.105, 1.112, 1.120, 1.128, 1.135, 1.143, - & 1.150, 1.157, 1.165, 1.172, 1.180, 1.187, 1.195, 1.202, 1.209, - & 1.217, 1.224, 1.231, 1.239, 1.246, 1.253, 1.260, 1.268, 1.275, - & 1.282, 1.289, 1.296, 1.303, 1.311, 1.318, 1.325, 1.332, 1.339, - & 1.346, 1.353, 1.360, 1.367, 1.374, 1.381, 1.388, 1.395, 1.402, - & 1.409, 1.416, 1.423, 1.430, 1.437, 1.444, 1.451, 1.457, 1.464, - & 1.471, 1.478, 1.485, 1.491, 1.498, 1.505, 1.512, 1.518, 1.525, - & 1.532, 1.538, 1.545, 1.552, 1.558, 1.565, 1.572, 1.578, 1.585, - & 1.591, 1.598, 1.604, 1.611, 1.617, 1.624, 1.630, 1.637, 1.643, - & 1.650, 1.656, 1.663, 1.669, 1.675, 1.682, 1.688, 1.695, 1.701, - & 1.707, 1.714, 1.720, 1.726, 1.732, 1.739, 1.745, 1.751, 1.757, - & 1.764, 1.770, 1.776, 1.782, 1.788, 1.795, 1.801, 1.807, 1.813, - & 1.819, 1.825, 1.831, 1.837, 1.843, 1.849, 1.855, 1.861, 1.867, - & 1.873, 1.879, 1.885, 1.891, 1.897, 1.903, 1.909, 1.915, 1.921, - & 1.927, 1.933, 1.939, 1.945, 1.950, 1.956, 1.962, 1.968, 1.974, - & 1.979, 1.985, 1.991, 1.997, 2.003, 2.008, 2.014, 2.020, 2.025, - & 2.031, 2.037, 2.042, 2.048, 2.054, 2.059, 2.065, 2.071, 2.076, - & 2.082, 2.087, 2.093, 2.099, 2.104, 2.110, 2.115, 2.121, 2.126, - & 2.132, 2.137, 2.143, 2.148, 2.154, 2.159, 2.165, 2.170, 2.175, - & 2.181, 2.186, 2.192, 2.197, 2.202, 2.208, 2.213, 2.219, 2.224, - & 2.229, 2.235, 2.240, 2.245, 2.250, 2.256, 2.261, 2.266, 2.271, - & 2.277, 2.282, 2.287, 2.292, 2.298, 2.303, 2.308, 2.313, 2.318, - & 2.323, 2.329, 2.334, 2.339, 2.344, 2.349, 2.354, 2.359, 2.364, - & 2.369, 2.375, 2.380, 2.385, 2.390, 2.395, 2.400, 2.405, 2.410, - & 2.415, 2.420, 2.425, 2.430, 2.483, 2.531, 2.579, 2.626, 2.672, - & 2.717, 2.762, 2.806, 2.849, 2.891, 2.933, 2.975, 3.015, 3.056, - & 3.095, 3.134, 3.173, 3.211, 3.248, 3.285, 3.322, 3.358, 3.393, - & 3.428, 3.463, 3.497, 3.531, 3.564, 3.597, 3.629, 3.662, 3.693, - & 3.725, 3.756, 3.786, 3.817, 3.847, 3.876, 3.906, 3.935, 3.963, - & 3.992, 4.020, 4.048, 4.075, 4.102, 4.129, 4.156, 4.182, 4.208, - & 4.234, 4.260, 4.285, 4.310, 4.335, 4.359, 4.384, 4.408, 4.432, - & 4.456, 4.479, 4.502, 4.525, 4.548, 4.571, 4.593, 4.615, 4.637, - & 4.659, 4.681, 4.702, 4.724, 4.745, 4.766, 4.786, 4.807, 4.827, - & 4.847, 4.868, 4.887, 4.907, 4.927, 4.946, 4.965, 4.984, 5.003, - & 5.022, 5.041, 5.059, 5.078, 5.096, 5.114, 5.132, 5.150, 5.168, - & 5.185, 5.203, 5.220, 5.237, 5.254, 5.271, 5.288, 5.304, 5.321, - & 5.337, 5.354, 5.370, 5.386, 5.402, 5.418, 5.434, 5.449, 5.465, - & 5.480, 5.496, 5.511, 5.526, 5.541, 5.556, 5.571, 5.586, 5.600, - & 5.615, 5.629, 5.644, 5.658, 5.672, 5.686, 5.700, 5.714, 5.728, - & 5.742, 5.755, 5.769, 5.782, 5.796, 5.809, 5.822, 5.835, 5.848, - & 5.861, 5.874, 5.887, 5.900, 5.913, 5.925, 5.938, 5.950, 5.963, - & 5.975, 5.987, 5.999, 6.011, 6.023, 6.035, 6.047, 6.059, 6.071, - & 6.083, 6.094, 6.106 - & / -C -C *** NaHSO4 -C - DATA BNC12M/ - &-0.047,-0.097,-0.120,-0.135,-0.146,-0.154,-0.160,-0.165,-0.170, - &-0.173,-0.176,-0.178,-0.179,-0.181,-0.181,-0.182,-0.182,-0.182, - &-0.182,-0.182,-0.181,-0.180,-0.179,-0.178,-0.176,-0.175,-0.173, - &-0.172,-0.170,-0.168,-0.165,-0.163,-0.161,-0.158,-0.156,-0.153, - &-0.150,-0.148,-0.145,-0.142,-0.139,-0.136,-0.132,-0.129,-0.126, - &-0.123,-0.119,-0.116,-0.112,-0.109,-0.105,-0.101,-0.098,-0.094, - &-0.090,-0.086,-0.082,-0.078,-0.074,-0.070,-0.066,-0.062,-0.058, - &-0.054,-0.050,-0.046,-0.041,-0.037,-0.033,-0.028,-0.024,-0.020, - &-0.015,-0.011,-0.006,-0.002, 0.003, 0.007, 0.012, 0.017, 0.021, - & 0.026, 0.031, 0.036, 0.041, 0.045, 0.050, 0.055, 0.060, 0.065, - & 0.070, 0.075, 0.080, 0.086, 0.091, 0.096, 0.101, 0.106, 0.112, - & 0.117, 0.122, 0.128, 0.133, 0.138, 0.144, 0.149, 0.154, 0.160, - & 0.165, 0.171, 0.176, 0.182, 0.187, 0.193, 0.198, 0.204, 0.209, - & 0.215, 0.221, 0.226, 0.232, 0.237, 0.243, 0.248, 0.254, 0.259, - & 0.265, 0.271, 0.276, 0.282, 0.287, 0.293, 0.298, 0.304, 0.309, - & 0.315, 0.320, 0.326, 0.331, 0.337, 0.342, 0.348, 0.353, 0.358, - & 0.364, 0.369, 0.375, 0.380, 0.386, 0.391, 0.396, 0.402, 0.407, - & 0.412, 0.418, 0.423, 0.428, 0.434, 0.439, 0.444, 0.449, 0.455, - & 0.460, 0.465, 0.470, 0.476, 0.481, 0.486, 0.491, 0.496, 0.502, - & 0.507, 0.512, 0.517, 0.522, 0.527, 0.532, 0.537, 0.542, 0.548, - & 0.553, 0.558, 0.563, 0.568, 0.573, 0.578, 0.583, 0.588, 0.593, - & 0.598, 0.603, 0.607, 0.612, 0.617, 0.622, 0.627, 0.632, 0.637, - & 0.642, 0.647, 0.651, 0.656, 0.661, 0.666, 0.671, 0.675, 0.680, - & 0.685, 0.690, 0.694, 0.699, 0.704, 0.709, 0.713, 0.718, 0.723, - & 0.727, 0.732, 0.737, 0.741, 0.746, 0.751, 0.755, 0.760, 0.764, - & 0.769, 0.773, 0.778, 0.783, 0.787, 0.792, 0.796, 0.801, 0.805, - & 0.810, 0.814, 0.819, 0.823, 0.828, 0.832, 0.836, 0.841, 0.845, - & 0.850, 0.854, 0.858, 0.863, 0.867, 0.872, 0.876, 0.880, 0.885, - & 0.889, 0.893, 0.898, 0.902, 0.906, 0.910, 0.915, 0.919, 0.923, - & 0.928, 0.932, 0.936, 0.940, 0.944, 0.949, 0.953, 0.957, 0.961, - & 0.965, 0.969, 0.974, 0.978, 0.982, 0.986, 0.990, 0.994, 0.998, - & 1.002, 1.007, 1.011, 1.015, 1.019, 1.023, 1.027, 1.031, 1.035, - & 1.039, 1.043, 1.047, 1.051, 1.055, 1.059, 1.063, 1.067, 1.071, - & 1.075, 1.079, 1.083, 1.087, 1.091, 1.094, 1.098, 1.102, 1.106, - & 1.110, 1.114, 1.118, 1.122, 1.125, 1.129, 1.133, 1.137, 1.141, - & 1.145, 1.148, 1.152, 1.156, 1.160, 1.164, 1.167, 1.171, 1.175, - & 1.179, 1.182, 1.186, 1.190, 1.194, 1.197, 1.201, 1.205, 1.208, - & 1.212, 1.216, 1.219, 1.223, 1.227, 1.230, 1.234, 1.238, 1.241, - & 1.245, 1.249, 1.252, 1.256, 1.259, 1.263, 1.267, 1.270, 1.274, - & 1.277, 1.281, 1.284, 1.288, 1.292, 1.295, 1.299, 1.302, 1.306, - & 1.309, 1.313, 1.316, 1.320, 1.323, 1.327, 1.330, 1.334, 1.337, - & 1.341, 1.344, 1.347, 1.351, 1.354, 1.358, 1.361, 1.365, 1.368, - & 1.371, 1.375, 1.378, 1.382, 1.385, 1.388, 1.392, 1.395, 1.398, - & 1.402, 1.405, 1.408, 1.412, 1.415, 1.418, 1.422, 1.425, 1.428, - & 1.432, 1.435, 1.438, 1.441, 1.477, 1.509, 1.540, 1.571, 1.601, - & 1.631, 1.661, 1.690, 1.718, 1.747, 1.774, 1.802, 1.829, 1.855, - & 1.881, 1.907, 1.933, 1.958, 1.983, 2.007, 2.031, 2.055, 2.079, - & 2.102, 2.125, 2.147, 2.170, 2.192, 2.213, 2.235, 2.256, 2.277, - & 2.298, 2.318, 2.339, 2.359, 2.378, 2.398, 2.417, 2.436, 2.455, - & 2.474, 2.493, 2.511, 2.529, 2.547, 2.565, 2.582, 2.599, 2.617, - & 2.634, 2.650, 2.667, 2.684, 2.700, 2.716, 2.732, 2.748, 2.763, - & 2.779, 2.794, 2.810, 2.825, 2.840, 2.854, 2.869, 2.884, 2.898, - & 2.912, 2.926, 2.940, 2.954, 2.968, 2.982, 2.995, 3.008, 3.022, - & 3.035, 3.048, 3.061, 3.074, 3.086, 3.099, 3.111, 3.124, 3.136, - & 3.148, 3.160, 3.172, 3.184, 3.196, 3.208, 3.219, 3.231, 3.242, - & 3.254, 3.265, 3.276, 3.287, 3.298, 3.309, 3.320, 3.330, 3.341, - & 3.352, 3.362, 3.373, 3.383, 3.393, 3.403, 3.413, 3.423, 3.433, - & 3.443, 3.453, 3.463, 3.472, 3.482, 3.491, 3.501, 3.510, 3.520, - & 3.529, 3.538, 3.547, 3.556, 3.565, 3.574, 3.583, 3.592, 3.601, - & 3.609, 3.618, 3.626, 3.635, 3.643, 3.652, 3.660, 3.668, 3.677, - & 3.685, 3.693, 3.701, 3.709, 3.717, 3.725, 3.733, 3.741, 3.748, - & 3.756, 3.764, 3.771, 3.779, 3.786, 3.794, 3.801, 3.809, 3.816, - & 3.823, 3.830, 3.838 - & / -C -C *** (NH4)3H(SO4)2 -C - DATA BNC13M/ - &-0.078,-0.169,-0.215,-0.247,-0.272,-0.293,-0.311,-0.326,-0.340, - &-0.353,-0.364,-0.375,-0.384,-0.393,-0.402,-0.410,-0.417,-0.424, - &-0.431,-0.437,-0.443,-0.448,-0.454,-0.459,-0.464,-0.469,-0.473, - &-0.477,-0.482,-0.486,-0.489,-0.493,-0.497,-0.500,-0.503,-0.506, - &-0.509,-0.512,-0.515,-0.518,-0.520,-0.523,-0.525,-0.528,-0.530, - &-0.532,-0.534,-0.536,-0.538,-0.540,-0.542,-0.544,-0.546,-0.547, - &-0.549,-0.550,-0.552,-0.553,-0.555,-0.556,-0.557,-0.559,-0.560, - &-0.561,-0.562,-0.563,-0.564,-0.565,-0.566,-0.567,-0.568,-0.569, - &-0.570,-0.571,-0.572,-0.572,-0.573,-0.574,-0.575,-0.575,-0.576, - &-0.576,-0.577,-0.578,-0.578,-0.579,-0.579,-0.580,-0.580,-0.580, - &-0.581,-0.581,-0.582,-0.582,-0.582,-0.582,-0.583,-0.583,-0.583, - &-0.583,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.585, - &-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585, - &-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585, - &-0.585,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584, - &-0.584,-0.584,-0.583,-0.583,-0.583,-0.583,-0.583,-0.583,-0.583, - &-0.582,-0.582,-0.582,-0.582,-0.582,-0.582,-0.582,-0.581,-0.581, - &-0.581,-0.581,-0.581,-0.581,-0.580,-0.580,-0.580,-0.580,-0.580, - &-0.579,-0.579,-0.579,-0.579,-0.579,-0.579,-0.578,-0.578,-0.578, - &-0.578,-0.578,-0.577,-0.577,-0.577,-0.577,-0.577,-0.577,-0.576, - &-0.576,-0.576,-0.576,-0.576,-0.575,-0.575,-0.575,-0.575,-0.575, - &-0.574,-0.574,-0.574,-0.574,-0.574,-0.574,-0.573,-0.573,-0.573, - &-0.573,-0.573,-0.572,-0.572,-0.572,-0.572,-0.572,-0.571,-0.571, - &-0.571,-0.571,-0.571,-0.571,-0.570,-0.570,-0.570,-0.570,-0.570, - &-0.569,-0.569,-0.569,-0.569,-0.569,-0.569,-0.568,-0.568,-0.568, - &-0.568,-0.568,-0.567,-0.567,-0.567,-0.567,-0.567,-0.567,-0.566, - &-0.566,-0.566,-0.566,-0.566,-0.566,-0.565,-0.565,-0.565,-0.565, - &-0.565,-0.565,-0.564,-0.564,-0.564,-0.564,-0.564,-0.564,-0.563, - &-0.563,-0.563,-0.563,-0.563,-0.563,-0.562,-0.562,-0.562,-0.562, - &-0.562,-0.562,-0.561,-0.561,-0.561,-0.561,-0.561,-0.561,-0.561, - &-0.560,-0.560,-0.560,-0.560,-0.560,-0.560,-0.560,-0.559,-0.559, - &-0.559,-0.559,-0.559,-0.559,-0.559,-0.558,-0.558,-0.558,-0.558, - &-0.558,-0.558,-0.558,-0.557,-0.557,-0.557,-0.557,-0.557,-0.557, - &-0.557,-0.556,-0.556,-0.556,-0.556,-0.556,-0.556,-0.556,-0.556, - &-0.555,-0.555,-0.555,-0.555,-0.555,-0.555,-0.555,-0.555,-0.554, - &-0.554,-0.554,-0.554,-0.554,-0.554,-0.554,-0.554,-0.554,-0.553, - &-0.553,-0.553,-0.553,-0.553,-0.553,-0.553,-0.553,-0.553,-0.552, - &-0.552,-0.552,-0.552,-0.552,-0.552,-0.552,-0.552,-0.552,-0.552, - &-0.551,-0.551,-0.551,-0.551,-0.551,-0.551,-0.551,-0.551,-0.551, - &-0.551,-0.550,-0.550,-0.550,-0.550,-0.550,-0.550,-0.550,-0.550, - &-0.550,-0.550,-0.550,-0.549,-0.549,-0.549,-0.549,-0.549,-0.549, - &-0.549,-0.549,-0.549,-0.549,-0.549,-0.549,-0.549,-0.548,-0.548, - &-0.548,-0.548,-0.548,-0.548,-0.548,-0.548,-0.548,-0.548,-0.548, - &-0.548,-0.548,-0.547,-0.547,-0.547,-0.547,-0.547,-0.547,-0.547, - &-0.547,-0.547,-0.547,-0.547,-0.546,-0.546,-0.545,-0.545,-0.544, - &-0.544,-0.544,-0.544,-0.544,-0.544,-0.544,-0.544,-0.544,-0.544, - &-0.544,-0.544,-0.545,-0.545,-0.545,-0.546,-0.546,-0.547,-0.547, - &-0.548,-0.548,-0.549,-0.550,-0.550,-0.551,-0.552,-0.553,-0.554, - &-0.555,-0.556,-0.557,-0.558,-0.559,-0.560,-0.561,-0.562,-0.563, - &-0.564,-0.566,-0.567,-0.568,-0.569,-0.571,-0.572,-0.573,-0.575, - &-0.576,-0.578,-0.579,-0.581,-0.582,-0.584,-0.586,-0.587,-0.589, - &-0.590,-0.592,-0.594,-0.595,-0.597,-0.599,-0.601,-0.603,-0.604, - &-0.606,-0.608,-0.610,-0.612,-0.614,-0.616,-0.618,-0.620,-0.622, - &-0.624,-0.626,-0.628,-0.630,-0.632,-0.634,-0.636,-0.638,-0.640, - &-0.642,-0.644,-0.647,-0.649,-0.651,-0.653,-0.655,-0.658,-0.660, - &-0.662,-0.664,-0.667,-0.669,-0.671,-0.674,-0.676,-0.678,-0.681, - &-0.683,-0.686,-0.688,-0.690,-0.693,-0.695,-0.698,-0.700,-0.703, - &-0.705,-0.708,-0.710,-0.713,-0.715,-0.718,-0.720,-0.723,-0.725, - &-0.728,-0.731,-0.733,-0.736,-0.738,-0.741,-0.744,-0.746,-0.749, - &-0.752,-0.754,-0.757,-0.760,-0.762,-0.765,-0.768,-0.770,-0.773, - &-0.776,-0.779,-0.781,-0.784,-0.787,-0.790,-0.793,-0.795,-0.798, - &-0.801,-0.804,-0.807,-0.809,-0.812,-0.815,-0.818,-0.821,-0.824, - &-0.827,-0.829,-0.832 - & / -C -C *** CASO4 -C - DATA BNC14M/ - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000 - & / -C -C *** CANO32 -C - DATA BNC15M/ - &-0.096,-0.206,-0.258,-0.293,-0.321,-0.342,-0.360,-0.376,-0.389, - &-0.401,-0.411,-0.420,-0.429,-0.436,-0.443,-0.449,-0.455,-0.460, - &-0.465,-0.469,-0.473,-0.477,-0.481,-0.484,-0.487,-0.490,-0.493, - &-0.495,-0.497,-0.500,-0.502,-0.504,-0.505,-0.507,-0.509,-0.510, - &-0.512,-0.513,-0.514,-0.515,-0.517,-0.518,-0.519,-0.520,-0.520, - &-0.521,-0.522,-0.523,-0.524,-0.524,-0.525,-0.526,-0.526,-0.527, - &-0.527,-0.528,-0.528,-0.529,-0.529,-0.530,-0.530,-0.530,-0.531, - &-0.531,-0.531,-0.531,-0.532,-0.532,-0.532,-0.532,-0.532,-0.532, - &-0.533,-0.533,-0.533,-0.533,-0.533,-0.533,-0.533,-0.533,-0.533, - &-0.532,-0.532,-0.532,-0.532,-0.532,-0.532,-0.531,-0.531,-0.531, - &-0.530,-0.530,-0.530,-0.529,-0.529,-0.529,-0.528,-0.528,-0.527, - &-0.527,-0.526,-0.526,-0.525,-0.525,-0.524,-0.524,-0.523,-0.523, - &-0.522,-0.521,-0.521,-0.520,-0.519,-0.519,-0.518,-0.517,-0.517, - &-0.516,-0.515,-0.515,-0.514,-0.513,-0.512,-0.512,-0.511,-0.510, - &-0.509,-0.509,-0.508,-0.507,-0.506,-0.506,-0.505,-0.504,-0.503, - &-0.503,-0.502,-0.501,-0.500,-0.499,-0.499,-0.498,-0.497,-0.496, - &-0.495,-0.495,-0.494,-0.493,-0.492,-0.491,-0.491,-0.490,-0.489, - &-0.488,-0.487,-0.486,-0.486,-0.485,-0.484,-0.483,-0.482,-0.482, - &-0.481,-0.480,-0.479,-0.478,-0.477,-0.477,-0.476,-0.475,-0.474, - &-0.473,-0.472,-0.472,-0.471,-0.470,-0.469,-0.468,-0.468,-0.467, - &-0.466,-0.465,-0.464,-0.463,-0.463,-0.462,-0.461,-0.460,-0.459, - &-0.459,-0.458,-0.457,-0.456,-0.455,-0.455,-0.454,-0.453,-0.452, - &-0.451,-0.450,-0.450,-0.449,-0.448,-0.447,-0.446,-0.446,-0.445, - &-0.444,-0.443,-0.442,-0.442,-0.441,-0.440,-0.439,-0.438,-0.438, - &-0.437,-0.436,-0.435,-0.435,-0.434,-0.433,-0.432,-0.431,-0.431, - &-0.430,-0.429,-0.428,-0.427,-0.427,-0.426,-0.425,-0.424,-0.424, - &-0.423,-0.422,-0.421,-0.421,-0.420,-0.419,-0.418,-0.417,-0.417, - &-0.416,-0.415,-0.414,-0.414,-0.413,-0.412,-0.411,-0.411,-0.410, - &-0.409,-0.408,-0.408,-0.407,-0.406,-0.405,-0.405,-0.404,-0.403, - &-0.402,-0.402,-0.401,-0.400,-0.400,-0.399,-0.398,-0.397,-0.397, - &-0.396,-0.395,-0.394,-0.394,-0.393,-0.392,-0.392,-0.391,-0.390, - &-0.389,-0.389,-0.388,-0.387,-0.387,-0.386,-0.385,-0.385,-0.384, - &-0.383,-0.382,-0.382,-0.381,-0.380,-0.380,-0.379,-0.378,-0.378, - &-0.377,-0.376,-0.376,-0.375,-0.374,-0.374,-0.373,-0.372,-0.371, - &-0.371,-0.370,-0.369,-0.369,-0.368,-0.367,-0.367,-0.366,-0.365, - &-0.365,-0.364,-0.364,-0.363,-0.362,-0.362,-0.361,-0.360,-0.360, - &-0.359,-0.358,-0.358,-0.357,-0.356,-0.356,-0.355,-0.354,-0.354, - &-0.353,-0.353,-0.352,-0.351,-0.351,-0.350,-0.349,-0.349,-0.348, - &-0.348,-0.347,-0.346,-0.346,-0.345,-0.344,-0.344,-0.343,-0.343, - &-0.342,-0.341,-0.341,-0.340,-0.340,-0.339,-0.338,-0.338,-0.337, - &-0.337,-0.336,-0.335,-0.335,-0.334,-0.334,-0.333,-0.332,-0.332, - &-0.331,-0.331,-0.330,-0.330,-0.329,-0.328,-0.328,-0.327,-0.327, - &-0.326,-0.326,-0.325,-0.324,-0.324,-0.323,-0.323,-0.322,-0.322, - &-0.321,-0.320,-0.320,-0.319,-0.319,-0.318,-0.318,-0.317,-0.317, - &-0.316,-0.316,-0.315,-0.314,-0.309,-0.303,-0.298,-0.293,-0.288, - &-0.284,-0.279,-0.275,-0.270,-0.266,-0.262,-0.258,-0.254,-0.250, - &-0.246,-0.242,-0.239,-0.235,-0.232,-0.229,-0.226,-0.223,-0.219, - &-0.217,-0.214,-0.211,-0.208,-0.206,-0.203,-0.201,-0.198,-0.196, - &-0.194,-0.192,-0.190,-0.188,-0.186,-0.184,-0.182,-0.180,-0.179, - &-0.177,-0.175,-0.174,-0.173,-0.171,-0.170,-0.169,-0.167,-0.166, - &-0.165,-0.164,-0.163,-0.162,-0.161,-0.161,-0.160,-0.159,-0.158, - &-0.158,-0.157,-0.157,-0.156,-0.156,-0.155,-0.155,-0.155,-0.154, - &-0.154,-0.154,-0.154,-0.154,-0.153,-0.153,-0.153,-0.153,-0.153, - &-0.154,-0.154,-0.154,-0.154,-0.154,-0.155,-0.155,-0.155,-0.156, - &-0.156,-0.157,-0.157,-0.158,-0.158,-0.159,-0.159,-0.160,-0.161, - &-0.161,-0.162,-0.163,-0.164,-0.164,-0.165,-0.166,-0.167,-0.168, - &-0.169,-0.170,-0.171,-0.172,-0.173,-0.174,-0.175,-0.176,-0.177, - &-0.179,-0.180,-0.181,-0.182,-0.183,-0.185,-0.186,-0.187,-0.189, - &-0.190,-0.192,-0.193,-0.194,-0.196,-0.197,-0.199,-0.200,-0.202, - &-0.203,-0.205,-0.207,-0.208,-0.210,-0.212,-0.213,-0.215,-0.217, - &-0.218,-0.220,-0.222,-0.224,-0.225,-0.227,-0.229,-0.231,-0.233, - &-0.235,-0.237,-0.239,-0.240,-0.242,-0.244,-0.246,-0.248,-0.250, - &-0.252,-0.254,-0.256 - & / -C -C *** CACL2 -C - DATA BNC16M/ - &-0.095,-0.197,-0.242,-0.272,-0.293,-0.309,-0.321,-0.331,-0.339, - &-0.345,-0.351,-0.355,-0.358,-0.360,-0.362,-0.363,-0.363,-0.364, - &-0.364,-0.363,-0.362,-0.361,-0.360,-0.358,-0.357,-0.355,-0.353, - &-0.350,-0.348,-0.345,-0.343,-0.340,-0.337,-0.334,-0.331,-0.328, - &-0.325,-0.322,-0.319,-0.316,-0.312,-0.309,-0.306,-0.302,-0.299, - &-0.295,-0.292,-0.289,-0.285,-0.282,-0.278,-0.274,-0.271,-0.267, - &-0.264,-0.260,-0.257,-0.253,-0.249,-0.246,-0.242,-0.239,-0.235, - &-0.231,-0.228,-0.224,-0.220,-0.217,-0.213,-0.209,-0.205,-0.202, - &-0.198,-0.194,-0.190,-0.186,-0.182,-0.178,-0.175,-0.171,-0.167, - &-0.163,-0.158,-0.154,-0.150,-0.146,-0.142,-0.138,-0.134,-0.129, - &-0.125,-0.121,-0.116,-0.112,-0.107,-0.103,-0.099,-0.094,-0.090, - &-0.085,-0.080,-0.076,-0.071,-0.066,-0.062,-0.057,-0.052,-0.048, - &-0.043,-0.038,-0.033,-0.028,-0.024,-0.019,-0.014,-0.009,-0.004, - & 0.001, 0.006, 0.010, 0.015, 0.020, 0.025, 0.030, 0.035, 0.040, - & 0.045, 0.050, 0.055, 0.060, 0.064, 0.069, 0.074, 0.079, 0.084, - & 0.089, 0.094, 0.099, 0.104, 0.109, 0.114, 0.119, 0.123, 0.128, - & 0.133, 0.138, 0.143, 0.148, 0.153, 0.158, 0.162, 0.167, 0.172, - & 0.177, 0.182, 0.187, 0.191, 0.196, 0.201, 0.206, 0.211, 0.215, - & 0.220, 0.225, 0.230, 0.235, 0.239, 0.244, 0.249, 0.254, 0.258, - & 0.263, 0.268, 0.272, 0.277, 0.282, 0.287, 0.291, 0.296, 0.301, - & 0.305, 0.310, 0.315, 0.319, 0.324, 0.329, 0.333, 0.338, 0.342, - & 0.347, 0.352, 0.356, 0.361, 0.365, 0.370, 0.375, 0.379, 0.384, - & 0.388, 0.393, 0.397, 0.402, 0.406, 0.411, 0.415, 0.420, 0.424, - & 0.429, 0.433, 0.438, 0.442, 0.447, 0.451, 0.456, 0.460, 0.464, - & 0.469, 0.473, 0.478, 0.482, 0.487, 0.491, 0.495, 0.500, 0.504, - & 0.508, 0.513, 0.517, 0.521, 0.526, 0.530, 0.534, 0.539, 0.543, - & 0.547, 0.552, 0.556, 0.560, 0.564, 0.569, 0.573, 0.577, 0.581, - & 0.586, 0.590, 0.594, 0.598, 0.602, 0.607, 0.611, 0.615, 0.619, - & 0.623, 0.627, 0.632, 0.636, 0.640, 0.644, 0.648, 0.652, 0.656, - & 0.660, 0.664, 0.669, 0.673, 0.677, 0.681, 0.685, 0.689, 0.693, - & 0.697, 0.701, 0.705, 0.709, 0.713, 0.717, 0.721, 0.725, 0.729, - & 0.733, 0.737, 0.741, 0.745, 0.749, 0.753, 0.757, 0.761, 0.765, - & 0.768, 0.772, 0.776, 0.780, 0.784, 0.788, 0.792, 0.796, 0.799, - & 0.803, 0.807, 0.811, 0.815, 0.819, 0.823, 0.826, 0.830, 0.834, - & 0.838, 0.842, 0.845, 0.849, 0.853, 0.857, 0.860, 0.864, 0.868, - & 0.872, 0.875, 0.879, 0.883, 0.886, 0.890, 0.894, 0.898, 0.901, - & 0.905, 0.909, 0.912, 0.916, 0.920, 0.923, 0.927, 0.930, 0.934, - & 0.938, 0.941, 0.945, 0.949, 0.952, 0.956, 0.959, 0.963, 0.966, - & 0.970, 0.974, 0.977, 0.981, 0.984, 0.988, 0.991, 0.995, 0.998, - & 1.002, 1.005, 1.009, 1.012, 1.016, 1.019, 1.023, 1.026, 1.030, - & 1.033, 1.037, 1.040, 1.044, 1.047, 1.050, 1.054, 1.057, 1.061, - & 1.064, 1.067, 1.071, 1.074, 1.078, 1.081, 1.084, 1.088, 1.091, - & 1.094, 1.098, 1.101, 1.105, 1.108, 1.111, 1.115, 1.118, 1.121, - & 1.124, 1.128, 1.131, 1.134, 1.138, 1.141, 1.144, 1.147, 1.151, - & 1.154, 1.157, 1.160, 1.164, 1.198, 1.230, 1.261, 1.292, 1.322, - & 1.351, 1.380, 1.409, 1.437, 1.465, 1.492, 1.519, 1.546, 1.572, - & 1.598, 1.623, 1.648, 1.673, 1.697, 1.721, 1.745, 1.768, 1.791, - & 1.814, 1.836, 1.858, 1.880, 1.901, 1.922, 1.943, 1.964, 1.984, - & 2.004, 2.024, 2.044, 2.063, 2.082, 2.101, 2.119, 2.138, 2.156, - & 2.174, 2.191, 2.209, 2.226, 2.243, 2.260, 2.276, 2.293, 2.309, - & 2.325, 2.341, 2.357, 2.372, 2.387, 2.403, 2.418, 2.432, 2.447, - & 2.461, 2.476, 2.490, 2.504, 2.518, 2.531, 2.545, 2.558, 2.571, - & 2.585, 2.597, 2.610, 2.623, 2.635, 2.648, 2.660, 2.672, 2.684, - & 2.696, 2.708, 2.720, 2.731, 2.742, 2.754, 2.765, 2.776, 2.787, - & 2.798, 2.808, 2.819, 2.830, 2.840, 2.850, 2.860, 2.871, 2.881, - & 2.890, 2.900, 2.910, 2.920, 2.929, 2.938, 2.948, 2.957, 2.966, - & 2.975, 2.984, 2.993, 3.002, 3.011, 3.019, 3.028, 3.036, 3.045, - & 3.053, 3.061, 3.069, 3.077, 3.085, 3.093, 3.101, 3.109, 3.117, - & 3.124, 3.132, 3.139, 3.147, 3.154, 3.161, 3.168, 3.176, 3.183, - & 3.190, 3.197, 3.203, 3.210, 3.217, 3.224, 3.230, 3.237, 3.243, - & 3.250, 3.256, 3.263, 3.269, 3.275, 3.281, 3.287, 3.293, 3.299, - & 3.305, 3.311, 3.317, 3.323, 3.329, 3.334, 3.340, 3.345, 3.351, - & 3.356, 3.362, 3.367 - & / -C -C *** K2SO4 -C - DATA BNC17M/ - &-0.098,-0.214,-0.273,-0.315,-0.347,-0.375,-0.399,-0.419,-0.438, - &-0.455,-0.470,-0.485,-0.498,-0.511,-0.522,-0.533,-0.544,-0.554, - &-0.563,-0.572,-0.581,-0.590,-0.598,-0.605,-0.613,-0.620,-0.627, - &-0.634,-0.641,-0.647,-0.653,-0.660,-0.666,-0.671,-0.677,-0.683, - &-0.688,-0.693,-0.698,-0.703,-0.708,-0.713,-0.718,-0.723,-0.727, - &-0.732,-0.736,-0.741,-0.745,-0.749,-0.753,-0.757,-0.762,-0.765, - &-0.769,-0.773,-0.777,-0.781,-0.784,-0.788,-0.792,-0.795,-0.799, - &-0.802,-0.806,-0.809,-0.812,-0.816,-0.819,-0.822,-0.825,-0.829, - &-0.832,-0.835,-0.838,-0.841,-0.844,-0.847,-0.850,-0.853,-0.856, - &-0.859,-0.862,-0.865,-0.867,-0.870,-0.873,-0.876,-0.879,-0.881, - &-0.884,-0.887,-0.890,-0.892,-0.895,-0.898,-0.900,-0.903,-0.905, - &-0.908,-0.911,-0.913,-0.916,-0.918,-0.921,-0.923,-0.926,-0.928, - &-0.931,-0.933,-0.936,-0.938,-0.940,-0.943,-0.945,-0.948,-0.950, - &-0.952,-0.955,-0.957,-0.959,-0.962,-0.964,-0.966,-0.969,-0.971, - &-0.973,-0.975,-0.978,-0.980,-0.982,-0.984,-0.986,-0.989,-0.991, - &-0.993,-0.995,-0.997,-0.999,-1.002,-1.004,-1.006,-1.008,-1.010, - &-1.012,-1.014,-1.016,-1.018,-1.020,-1.022,-1.024,-1.026,-1.028, - &-1.030,-1.032,-1.034,-1.036,-1.038,-1.040,-1.042,-1.044,-1.046, - &-1.048,-1.050,-1.052,-1.054,-1.056,-1.058,-1.060,-1.062,-1.064, - &-1.066,-1.067,-1.069,-1.071,-1.073,-1.075,-1.077,-1.079,-1.080, - &-1.082,-1.084,-1.086,-1.088,-1.090,-1.091,-1.093,-1.095,-1.097, - &-1.099,-1.100,-1.102,-1.104,-1.106,-1.107,-1.109,-1.111,-1.113, - &-1.114,-1.116,-1.118,-1.120,-1.121,-1.123,-1.125,-1.127,-1.128, - &-1.130,-1.132,-1.133,-1.135,-1.137,-1.138,-1.140,-1.142,-1.143, - &-1.145,-1.147,-1.148,-1.150,-1.152,-1.153,-1.155,-1.157,-1.158, - &-1.160,-1.162,-1.163,-1.165,-1.166,-1.168,-1.170,-1.171,-1.173, - &-1.174,-1.176,-1.178,-1.179,-1.181,-1.182,-1.184,-1.185,-1.187, - &-1.189,-1.190,-1.192,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201, - &-1.203,-1.204,-1.206,-1.207,-1.209,-1.210,-1.212,-1.213,-1.215, - &-1.216,-1.218,-1.219,-1.221,-1.222,-1.224,-1.225,-1.227,-1.228, - &-1.230,-1.231,-1.233,-1.234,-1.236,-1.237,-1.238,-1.240,-1.241, - &-1.243,-1.244,-1.246,-1.247,-1.249,-1.250,-1.252,-1.253,-1.254, - &-1.256,-1.257,-1.259,-1.260,-1.262,-1.263,-1.264,-1.266,-1.267, - &-1.269,-1.270,-1.271,-1.273,-1.274,-1.276,-1.277,-1.278,-1.280, - &-1.281,-1.283,-1.284,-1.285,-1.287,-1.288,-1.290,-1.291,-1.292, - &-1.294,-1.295,-1.296,-1.298,-1.299,-1.301,-1.302,-1.303,-1.305, - &-1.306,-1.307,-1.309,-1.310,-1.311,-1.313,-1.314,-1.315,-1.317, - &-1.318,-1.319,-1.321,-1.322,-1.323,-1.325,-1.326,-1.327,-1.329, - &-1.330,-1.331,-1.333,-1.334,-1.335,-1.337,-1.338,-1.339,-1.341, - &-1.342,-1.343,-1.344,-1.346,-1.347,-1.348,-1.350,-1.351,-1.352, - &-1.354,-1.355,-1.356,-1.357,-1.359,-1.360,-1.361,-1.363,-1.364, - &-1.365,-1.366,-1.368,-1.369,-1.370,-1.371,-1.373,-1.374,-1.375, - &-1.376,-1.378,-1.379,-1.380,-1.381,-1.383,-1.384,-1.385,-1.387, - &-1.388,-1.389,-1.390,-1.391,-1.393,-1.394,-1.395,-1.396,-1.398, - &-1.399,-1.400,-1.401,-1.403,-1.416,-1.428,-1.440,-1.452,-1.463, - &-1.475,-1.487,-1.498,-1.509,-1.520,-1.532,-1.543,-1.554,-1.564, - &-1.575,-1.586,-1.596,-1.607,-1.617,-1.628,-1.638,-1.648,-1.659, - &-1.669,-1.679,-1.689,-1.699,-1.709,-1.719,-1.729,-1.738,-1.748, - &-1.758,-1.767,-1.777,-1.786,-1.796,-1.805,-1.815,-1.824,-1.833, - &-1.843,-1.852,-1.861,-1.870,-1.879,-1.888,-1.897,-1.906,-1.915, - &-1.924,-1.933,-1.942,-1.951,-1.960,-1.969,-1.977,-1.986,-1.995, - &-2.004,-2.012,-2.021,-2.029,-2.038,-2.047,-2.055,-2.064,-2.072, - &-2.081,-2.089,-2.097,-2.106,-2.114,-2.123,-2.131,-2.139,-2.147, - &-2.156,-2.164,-2.172,-2.180,-2.189,-2.197,-2.205,-2.213,-2.221, - &-2.229,-2.237,-2.245,-2.253,-2.261,-2.269,-2.277,-2.285,-2.293, - &-2.301,-2.309,-2.317,-2.325,-2.333,-2.341,-2.349,-2.356,-2.364, - &-2.372,-2.380,-2.388,-2.395,-2.403,-2.411,-2.419,-2.426,-2.434, - &-2.442,-2.449,-2.457,-2.465,-2.472,-2.480,-2.488,-2.495,-2.503, - &-2.510,-2.518,-2.525,-2.533,-2.541,-2.548,-2.556,-2.563,-2.571, - &-2.578,-2.586,-2.593,-2.600,-2.608,-2.615,-2.623,-2.630,-2.638, - &-2.645,-2.652,-2.660,-2.667,-2.674,-2.682,-2.689,-2.696,-2.704, - &-2.711,-2.718,-2.726,-2.733,-2.740,-2.747,-2.755,-2.762,-2.769, - &-2.776,-2.784,-2.791 - & / -C -C *** KHSO4 -C - DATA BNC18M/ - &-0.048,-0.102,-0.127,-0.145,-0.158,-0.169,-0.178,-0.185,-0.192, - &-0.198,-0.203,-0.207,-0.211,-0.215,-0.218,-0.221,-0.224,-0.226, - &-0.228,-0.230,-0.231,-0.232,-0.234,-0.235,-0.235,-0.236,-0.237, - &-0.237,-0.237,-0.237,-0.237,-0.237,-0.237,-0.236,-0.236,-0.235, - &-0.234,-0.234,-0.233,-0.232,-0.231,-0.230,-0.228,-0.227,-0.226, - &-0.224,-0.223,-0.221,-0.220,-0.218,-0.216,-0.214,-0.212,-0.210, - &-0.208,-0.206,-0.204,-0.202,-0.200,-0.198,-0.196,-0.193,-0.191, - &-0.189,-0.186,-0.184,-0.181,-0.179,-0.176,-0.173,-0.171,-0.168, - &-0.165,-0.163,-0.160,-0.157,-0.154,-0.151,-0.148,-0.146,-0.143, - &-0.140,-0.137,-0.133,-0.130,-0.127,-0.124,-0.121,-0.118,-0.115, - &-0.111,-0.108,-0.105,-0.101,-0.098,-0.095,-0.091,-0.088,-0.084, - &-0.081,-0.077,-0.074,-0.070,-0.067,-0.063,-0.060,-0.056,-0.052, - &-0.049,-0.045,-0.042,-0.038,-0.034,-0.031,-0.027,-0.023,-0.020, - &-0.016,-0.012,-0.008,-0.005,-0.001, 0.003, 0.006, 0.010, 0.014, - & 0.018, 0.021, 0.025, 0.029, 0.032, 0.036, 0.040, 0.043, 0.047, - & 0.051, 0.054, 0.058, 0.062, 0.065, 0.069, 0.073, 0.076, 0.080, - & 0.084, 0.087, 0.091, 0.094, 0.098, 0.102, 0.105, 0.109, 0.112, - & 0.116, 0.119, 0.123, 0.127, 0.130, 0.134, 0.137, 0.141, 0.144, - & 0.148, 0.151, 0.155, 0.158, 0.162, 0.165, 0.168, 0.172, 0.175, - & 0.179, 0.182, 0.186, 0.189, 0.192, 0.196, 0.199, 0.202, 0.206, - & 0.209, 0.212, 0.216, 0.219, 0.222, 0.226, 0.229, 0.232, 0.236, - & 0.239, 0.242, 0.245, 0.249, 0.252, 0.255, 0.258, 0.262, 0.265, - & 0.268, 0.271, 0.274, 0.278, 0.281, 0.284, 0.287, 0.290, 0.293, - & 0.297, 0.300, 0.303, 0.306, 0.309, 0.312, 0.315, 0.318, 0.321, - & 0.324, 0.327, 0.330, 0.334, 0.337, 0.340, 0.343, 0.346, 0.349, - & 0.352, 0.355, 0.358, 0.361, 0.364, 0.367, 0.369, 0.372, 0.375, - & 0.378, 0.381, 0.384, 0.387, 0.390, 0.393, 0.396, 0.399, 0.402, - & 0.404, 0.407, 0.410, 0.413, 0.416, 0.419, 0.422, 0.424, 0.427, - & 0.430, 0.433, 0.436, 0.438, 0.441, 0.444, 0.447, 0.450, 0.452, - & 0.455, 0.458, 0.461, 0.463, 0.466, 0.469, 0.471, 0.474, 0.477, - & 0.480, 0.482, 0.485, 0.488, 0.490, 0.493, 0.496, 0.498, 0.501, - & 0.504, 0.506, 0.509, 0.512, 0.514, 0.517, 0.519, 0.522, 0.525, - & 0.527, 0.530, 0.532, 0.535, 0.538, 0.540, 0.543, 0.545, 0.548, - & 0.550, 0.553, 0.555, 0.558, 0.560, 0.563, 0.566, 0.568, 0.571, - & 0.573, 0.576, 0.578, 0.581, 0.583, 0.585, 0.588, 0.590, 0.593, - & 0.595, 0.598, 0.600, 0.603, 0.605, 0.607, 0.610, 0.612, 0.615, - & 0.617, 0.620, 0.622, 0.624, 0.627, 0.629, 0.632, 0.634, 0.636, - & 0.639, 0.641, 0.643, 0.646, 0.648, 0.650, 0.653, 0.655, 0.657, - & 0.660, 0.662, 0.664, 0.667, 0.669, 0.671, 0.674, 0.676, 0.678, - & 0.680, 0.683, 0.685, 0.687, 0.689, 0.692, 0.694, 0.696, 0.699, - & 0.701, 0.703, 0.705, 0.707, 0.710, 0.712, 0.714, 0.716, 0.719, - & 0.721, 0.723, 0.725, 0.727, 0.730, 0.732, 0.734, 0.736, 0.738, - & 0.740, 0.743, 0.745, 0.747, 0.749, 0.751, 0.753, 0.755, 0.758, - & 0.760, 0.762, 0.764, 0.766, 0.768, 0.770, 0.772, 0.775, 0.777, - & 0.779, 0.781, 0.783, 0.785, 0.807, 0.828, 0.848, 0.867, 0.886, - & 0.905, 0.924, 0.942, 0.960, 0.978, 0.995, 1.013, 1.029, 1.046, - & 1.062, 1.079, 1.095, 1.110, 1.126, 1.141, 1.156, 1.171, 1.185, - & 1.200, 1.214, 1.228, 1.242, 1.256, 1.269, 1.282, 1.295, 1.308, - & 1.321, 1.334, 1.346, 1.359, 1.371, 1.383, 1.395, 1.406, 1.418, - & 1.429, 1.441, 1.452, 1.463, 1.474, 1.485, 1.495, 1.506, 1.516, - & 1.527, 1.537, 1.547, 1.557, 1.567, 1.577, 1.586, 1.596, 1.605, - & 1.615, 1.624, 1.633, 1.642, 1.651, 1.660, 1.669, 1.678, 1.686, - & 1.695, 1.703, 1.711, 1.720, 1.728, 1.736, 1.744, 1.752, 1.760, - & 1.768, 1.775, 1.783, 1.791, 1.798, 1.806, 1.813, 1.820, 1.828, - & 1.835, 1.842, 1.849, 1.856, 1.863, 1.870, 1.876, 1.883, 1.890, - & 1.896, 1.903, 1.909, 1.916, 1.922, 1.928, 1.935, 1.941, 1.947, - & 1.953, 1.959, 1.965, 1.971, 1.977, 1.983, 1.989, 1.994, 2.000, - & 2.006, 2.011, 2.017, 2.022, 2.028, 2.033, 2.039, 2.044, 2.049, - & 2.054, 2.060, 2.065, 2.070, 2.075, 2.080, 2.085, 2.090, 2.095, - & 2.100, 2.104, 2.109, 2.114, 2.119, 2.123, 2.128, 2.132, 2.137, - & 2.142, 2.146, 2.150, 2.155, 2.159, 2.164, 2.168, 2.172, 2.176, - & 2.181, 2.185, 2.189, 2.193, 2.197, 2.201, 2.205, 2.209, 2.213, - & 2.217, 2.221, 2.225 - & / -C -C *** KNO3 -C - DATA BNC19M/ - &-0.051,-0.116,-0.152,-0.180,-0.203,-0.223,-0.241,-0.257,-0.272, - &-0.286,-0.300,-0.313,-0.325,-0.336,-0.348,-0.359,-0.369,-0.379, - &-0.389,-0.399,-0.408,-0.417,-0.426,-0.435,-0.444,-0.452,-0.460, - &-0.468,-0.476,-0.484,-0.492,-0.499,-0.507,-0.514,-0.521,-0.528, - &-0.535,-0.542,-0.548,-0.555,-0.562,-0.568,-0.574,-0.580,-0.587, - &-0.593,-0.599,-0.604,-0.610,-0.616,-0.622,-0.627,-0.633,-0.638, - &-0.644,-0.649,-0.654,-0.659,-0.664,-0.670,-0.675,-0.680,-0.684, - &-0.689,-0.694,-0.699,-0.704,-0.708,-0.713,-0.718,-0.722,-0.727, - &-0.731,-0.736,-0.740,-0.745,-0.749,-0.754,-0.758,-0.763,-0.767, - &-0.771,-0.776,-0.780,-0.784,-0.788,-0.793,-0.797,-0.801,-0.805, - &-0.810,-0.814,-0.818,-0.822,-0.826,-0.830,-0.834,-0.839,-0.843, - &-0.847,-0.851,-0.855,-0.859,-0.863,-0.867,-0.871,-0.875,-0.879, - &-0.883,-0.887,-0.891,-0.895,-0.899,-0.903,-0.907,-0.910,-0.914, - &-0.918,-0.922,-0.926,-0.930,-0.933,-0.937,-0.941,-0.945,-0.948, - &-0.952,-0.956,-0.959,-0.963,-0.967,-0.970,-0.974,-0.977,-0.981, - &-0.985,-0.988,-0.992,-0.995,-0.999,-1.002,-1.006,-1.009,-1.012, - &-1.016,-1.019,-1.023,-1.026,-1.029,-1.033,-1.036,-1.039,-1.042, - &-1.046,-1.049,-1.052,-1.055,-1.059,-1.062,-1.065,-1.068,-1.071, - &-1.074,-1.078,-1.081,-1.084,-1.087,-1.090,-1.093,-1.096,-1.099, - &-1.102,-1.105,-1.108,-1.111,-1.114,-1.117,-1.120,-1.123,-1.126, - &-1.129,-1.131,-1.134,-1.137,-1.140,-1.143,-1.146,-1.149,-1.151, - &-1.154,-1.157,-1.160,-1.162,-1.165,-1.168,-1.171,-1.173,-1.176, - &-1.179,-1.181,-1.184,-1.187,-1.189,-1.192,-1.195,-1.197,-1.200, - &-1.202,-1.205,-1.207,-1.210,-1.213,-1.215,-1.218,-1.220,-1.223, - &-1.225,-1.228,-1.230,-1.233,-1.235,-1.237,-1.240,-1.242,-1.245, - &-1.247,-1.250,-1.252,-1.254,-1.257,-1.259,-1.261,-1.264,-1.266, - &-1.268,-1.271,-1.273,-1.275,-1.278,-1.280,-1.282,-1.284,-1.287, - &-1.289,-1.291,-1.293,-1.296,-1.298,-1.300,-1.302,-1.304,-1.307, - &-1.309,-1.311,-1.313,-1.315,-1.317,-1.319,-1.322,-1.324,-1.326, - &-1.328,-1.330,-1.332,-1.334,-1.336,-1.338,-1.340,-1.342,-1.344, - &-1.346,-1.348,-1.350,-1.352,-1.354,-1.356,-1.358,-1.360,-1.362, - &-1.364,-1.366,-1.368,-1.370,-1.372,-1.374,-1.376,-1.378,-1.380, - &-1.382,-1.384,-1.385,-1.387,-1.389,-1.391,-1.393,-1.395,-1.397, - &-1.398,-1.400,-1.402,-1.404,-1.406,-1.408,-1.409,-1.411,-1.413, - &-1.415,-1.417,-1.418,-1.420,-1.422,-1.424,-1.425,-1.427,-1.429, - &-1.431,-1.432,-1.434,-1.436,-1.437,-1.439,-1.441,-1.443,-1.444, - &-1.446,-1.448,-1.449,-1.451,-1.453,-1.454,-1.456,-1.458,-1.459, - &-1.461,-1.462,-1.464,-1.466,-1.467,-1.469,-1.470,-1.472,-1.474, - &-1.475,-1.477,-1.478,-1.480,-1.482,-1.483,-1.485,-1.486,-1.488, - &-1.489,-1.491,-1.492,-1.494,-1.495,-1.497,-1.498,-1.500,-1.501, - &-1.503,-1.504,-1.506,-1.507,-1.509,-1.510,-1.512,-1.513,-1.515, - &-1.516,-1.518,-1.519,-1.521,-1.522,-1.523,-1.525,-1.526,-1.528, - &-1.529,-1.530,-1.532,-1.533,-1.535,-1.536,-1.537,-1.539,-1.540, - &-1.542,-1.543,-1.544,-1.546,-1.547,-1.548,-1.550,-1.551,-1.553, - &-1.554,-1.555,-1.557,-1.558,-1.572,-1.585,-1.597,-1.609,-1.621, - &-1.632,-1.643,-1.654,-1.665,-1.675,-1.685,-1.695,-1.705,-1.714, - &-1.723,-1.732,-1.741,-1.750,-1.758,-1.766,-1.774,-1.782,-1.790, - &-1.798,-1.805,-1.813,-1.820,-1.827,-1.834,-1.841,-1.848,-1.855, - &-1.861,-1.868,-1.874,-1.881,-1.887,-1.893,-1.899,-1.905,-1.911, - &-1.917,-1.923,-1.929,-1.934,-1.940,-1.945,-1.951,-1.956,-1.962, - &-1.967,-1.972,-1.977,-1.982,-1.988,-1.993,-1.998,-2.003,-2.008, - &-2.012,-2.017,-2.022,-2.027,-2.032,-2.036,-2.041,-2.046,-2.050, - &-2.055,-2.059,-2.064,-2.068,-2.073,-2.077,-2.082,-2.086,-2.090, - &-2.095,-2.099,-2.103,-2.108,-2.112,-2.116,-2.120,-2.124,-2.128, - &-2.133,-2.137,-2.141,-2.145,-2.149,-2.153,-2.157,-2.161,-2.165, - &-2.169,-2.173,-2.177,-2.181,-2.185,-2.189,-2.192,-2.196,-2.200, - &-2.204,-2.208,-2.212,-2.216,-2.219,-2.223,-2.227,-2.231,-2.234, - &-2.238,-2.242,-2.246,-2.249,-2.253,-2.257,-2.260,-2.264,-2.268, - &-2.271,-2.275,-2.279,-2.282,-2.286,-2.289,-2.293,-2.297,-2.300, - &-2.304,-2.307,-2.311,-2.315,-2.318,-2.322,-2.325,-2.329,-2.332, - &-2.336,-2.339,-2.343,-2.346,-2.350,-2.353,-2.357,-2.360,-2.364, - &-2.367,-2.370,-2.374,-2.377,-2.381,-2.384,-2.388,-2.391,-2.395, - &-2.398,-2.401,-2.405 - & / -C -C *** KCL -C - DATA BNC20M/ - &-0.048,-0.103,-0.129,-0.147,-0.160,-0.171,-0.180,-0.188,-0.195, - &-0.201,-0.206,-0.210,-0.215,-0.218,-0.222,-0.225,-0.228,-0.230, - &-0.233,-0.235,-0.237,-0.239,-0.241,-0.242,-0.244,-0.245,-0.247, - &-0.248,-0.249,-0.250,-0.251,-0.252,-0.253,-0.254,-0.255,-0.256, - &-0.256,-0.257,-0.258,-0.258,-0.259,-0.260,-0.260,-0.261,-0.261, - &-0.261,-0.262,-0.262,-0.263,-0.263,-0.263,-0.264,-0.264,-0.264, - &-0.265,-0.265,-0.265,-0.265,-0.266,-0.266,-0.266,-0.266,-0.266, - &-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267, - &-0.267,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268, - &-0.268,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267, - &-0.267,-0.267,-0.266,-0.266,-0.266,-0.266,-0.266,-0.265,-0.265, - &-0.265,-0.265,-0.265,-0.264,-0.264,-0.264,-0.264,-0.263,-0.263, - &-0.263,-0.262,-0.262,-0.262,-0.261,-0.261,-0.261,-0.260,-0.260, - &-0.260,-0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.257,-0.257, - &-0.257,-0.256,-0.256,-0.256,-0.255,-0.255,-0.254,-0.254,-0.254, - &-0.253,-0.253,-0.253,-0.252,-0.252,-0.251,-0.251,-0.251,-0.250, - &-0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.247,-0.247,-0.247, - &-0.246,-0.246,-0.246,-0.245,-0.245,-0.244,-0.244,-0.244,-0.243, - &-0.243,-0.242,-0.242,-0.242,-0.241,-0.241,-0.240,-0.240,-0.240, - &-0.239,-0.239,-0.238,-0.238,-0.238,-0.237,-0.237,-0.236,-0.236, - &-0.236,-0.235,-0.235,-0.234,-0.234,-0.234,-0.233,-0.233,-0.232, - &-0.232,-0.232,-0.231,-0.231,-0.230,-0.230,-0.230,-0.229,-0.229, - &-0.228,-0.228,-0.228,-0.227,-0.227,-0.227,-0.226,-0.226,-0.225, - &-0.225,-0.225,-0.224,-0.224,-0.223,-0.223,-0.223,-0.222,-0.222, - &-0.221,-0.221,-0.221,-0.220,-0.220,-0.220,-0.219,-0.219,-0.218, - &-0.218,-0.218,-0.217,-0.217,-0.217,-0.216,-0.216,-0.215,-0.215, - &-0.215,-0.214,-0.214,-0.214,-0.213,-0.213,-0.212,-0.212,-0.212, - &-0.211,-0.211,-0.211,-0.210,-0.210,-0.209,-0.209,-0.209,-0.208, - &-0.208,-0.208,-0.207,-0.207,-0.207,-0.206,-0.206,-0.205,-0.205, - &-0.205,-0.204,-0.204,-0.204,-0.203,-0.203,-0.203,-0.202,-0.202, - &-0.202,-0.201,-0.201,-0.201,-0.200,-0.200,-0.199,-0.199,-0.199, - &-0.198,-0.198,-0.198,-0.197,-0.197,-0.197,-0.196,-0.196,-0.196, - &-0.195,-0.195,-0.195,-0.194,-0.194,-0.194,-0.193,-0.193,-0.193, - &-0.192,-0.192,-0.192,-0.191,-0.191,-0.191,-0.190,-0.190,-0.190, - &-0.189,-0.189,-0.189,-0.188,-0.188,-0.188,-0.187,-0.187,-0.187, - &-0.186,-0.186,-0.186,-0.186,-0.185,-0.185,-0.185,-0.184,-0.184, - &-0.184,-0.183,-0.183,-0.183,-0.182,-0.182,-0.182,-0.181,-0.181, - &-0.181,-0.181,-0.180,-0.180,-0.180,-0.179,-0.179,-0.179,-0.178, - &-0.178,-0.178,-0.178,-0.177,-0.177,-0.177,-0.176,-0.176,-0.176, - &-0.175,-0.175,-0.175,-0.175,-0.174,-0.174,-0.174,-0.173,-0.173, - &-0.173,-0.173,-0.172,-0.172,-0.172,-0.171,-0.171,-0.171,-0.171, - &-0.170,-0.170,-0.170,-0.169,-0.169,-0.169,-0.169,-0.168,-0.168, - &-0.168,-0.167,-0.167,-0.167,-0.167,-0.166,-0.166,-0.166,-0.166, - &-0.165,-0.165,-0.165,-0.164,-0.164,-0.164,-0.164,-0.163,-0.163, - &-0.163,-0.163,-0.162,-0.162,-0.159,-0.157,-0.154,-0.152,-0.149, - &-0.147,-0.145,-0.143,-0.141,-0.139,-0.137,-0.135,-0.133,-0.131, - &-0.129,-0.127,-0.126,-0.124,-0.122,-0.121,-0.119,-0.118,-0.116, - &-0.115,-0.114,-0.112,-0.111,-0.110,-0.109,-0.107,-0.106,-0.105, - &-0.104,-0.103,-0.102,-0.101,-0.100,-0.099,-0.099,-0.098,-0.097, - &-0.096,-0.095,-0.095,-0.094,-0.093,-0.093,-0.092,-0.092,-0.091, - &-0.091,-0.090,-0.090,-0.089,-0.089,-0.089,-0.088,-0.088,-0.088, - &-0.087,-0.087,-0.087,-0.087,-0.087,-0.086,-0.086,-0.086,-0.086, - &-0.086,-0.086,-0.086,-0.086,-0.086,-0.086,-0.086,-0.086,-0.086, - &-0.086,-0.086,-0.086,-0.087,-0.087,-0.087,-0.087,-0.087,-0.088, - &-0.088,-0.088,-0.088,-0.089,-0.089,-0.089,-0.090,-0.090,-0.090, - &-0.091,-0.091,-0.092,-0.092,-0.092,-0.093,-0.093,-0.094,-0.094, - &-0.095,-0.095,-0.096,-0.096,-0.097,-0.098,-0.098,-0.099,-0.099, - &-0.100,-0.101,-0.101,-0.102,-0.103,-0.103,-0.104,-0.105,-0.105, - &-0.106,-0.107,-0.107,-0.108,-0.109,-0.110,-0.111,-0.111,-0.112, - &-0.113,-0.114,-0.115,-0.115,-0.116,-0.117,-0.118,-0.119,-0.120, - &-0.121,-0.122,-0.122,-0.123,-0.124,-0.125,-0.126,-0.127,-0.128, - &-0.129,-0.130,-0.131,-0.132,-0.133,-0.134,-0.135,-0.136,-0.137, - &-0.138,-0.139,-0.140 - & / -C -C *** MGSO4 -C - DATA BNC21M/ - &-0.195,-0.422,-0.535,-0.614,-0.676,-0.727,-0.770,-0.808,-0.841, - &-0.871,-0.898,-0.923,-0.946,-0.968,-0.988,-1.006,-1.024,-1.041, - &-1.056,-1.071,-1.085,-1.099,-1.112,-1.124,-1.136,-1.148,-1.159, - &-1.169,-1.179,-1.189,-1.199,-1.208,-1.217,-1.226,-1.234,-1.243, - &-1.251,-1.258,-1.266,-1.273,-1.281,-1.288,-1.295,-1.302,-1.308, - &-1.315,-1.321,-1.327,-1.333,-1.339,-1.345,-1.351,-1.357,-1.362, - &-1.368,-1.373,-1.379,-1.384,-1.389,-1.394,-1.399,-1.404,-1.409, - &-1.413,-1.418,-1.423,-1.427,-1.432,-1.436,-1.441,-1.445,-1.449, - &-1.454,-1.458,-1.462,-1.466,-1.470,-1.474,-1.478,-1.482,-1.486, - &-1.489,-1.493,-1.497,-1.500,-1.504,-1.508,-1.511,-1.515,-1.518, - &-1.522,-1.525,-1.528,-1.532,-1.535,-1.538,-1.541,-1.545,-1.548, - &-1.551,-1.554,-1.557,-1.560,-1.563,-1.566,-1.569,-1.572,-1.575, - &-1.578,-1.581,-1.584,-1.586,-1.589,-1.592,-1.595,-1.598,-1.600, - &-1.603,-1.606,-1.608,-1.611,-1.614,-1.616,-1.619,-1.621,-1.624, - &-1.626,-1.629,-1.631,-1.634,-1.636,-1.639,-1.641,-1.644,-1.646, - &-1.649,-1.651,-1.653,-1.656,-1.658,-1.660,-1.663,-1.665,-1.667, - &-1.670,-1.672,-1.674,-1.676,-1.679,-1.681,-1.683,-1.685,-1.688, - &-1.690,-1.692,-1.694,-1.696,-1.698,-1.701,-1.703,-1.705,-1.707, - &-1.709,-1.711,-1.713,-1.715,-1.717,-1.720,-1.722,-1.724,-1.726, - &-1.728,-1.730,-1.732,-1.734,-1.736,-1.738,-1.740,-1.742,-1.744, - &-1.746,-1.748,-1.750,-1.752,-1.754,-1.756,-1.757,-1.759,-1.761, - &-1.763,-1.765,-1.767,-1.769,-1.771,-1.773,-1.775,-1.776,-1.778, - &-1.780,-1.782,-1.784,-1.786,-1.788,-1.789,-1.791,-1.793,-1.795, - &-1.797,-1.799,-1.800,-1.802,-1.804,-1.806,-1.808,-1.809,-1.811, - &-1.813,-1.815,-1.816,-1.818,-1.820,-1.822,-1.823,-1.825,-1.827, - &-1.829,-1.830,-1.832,-1.834,-1.836,-1.837,-1.839,-1.841,-1.842, - &-1.844,-1.846,-1.848,-1.849,-1.851,-1.853,-1.854,-1.856,-1.858, - &-1.859,-1.861,-1.863,-1.864,-1.866,-1.868,-1.869,-1.871,-1.873, - &-1.874,-1.876,-1.878,-1.879,-1.881,-1.882,-1.884,-1.886,-1.887, - &-1.889,-1.891,-1.892,-1.894,-1.895,-1.897,-1.899,-1.900,-1.902, - &-1.903,-1.905,-1.907,-1.908,-1.910,-1.911,-1.913,-1.915,-1.916, - &-1.918,-1.919,-1.921,-1.922,-1.924,-1.925,-1.927,-1.929,-1.930, - &-1.932,-1.933,-1.935,-1.936,-1.938,-1.939,-1.941,-1.943,-1.944, - &-1.946,-1.947,-1.949,-1.950,-1.952,-1.953,-1.955,-1.956,-1.958, - &-1.959,-1.961,-1.962,-1.964,-1.965,-1.967,-1.968,-1.970,-1.971, - &-1.973,-1.974,-1.976,-1.977,-1.979,-1.980,-1.982,-1.983,-1.985, - &-1.986,-1.988,-1.989,-1.991,-1.992,-1.994,-1.995,-1.997,-1.998, - &-2.000,-2.001,-2.003,-2.004,-2.006,-2.007,-2.008,-2.010,-2.011, - &-2.013,-2.014,-2.016,-2.017,-2.019,-2.020,-2.022,-2.023,-2.024, - &-2.026,-2.027,-2.029,-2.030,-2.032,-2.033,-2.035,-2.036,-2.037, - &-2.039,-2.040,-2.042,-2.043,-2.045,-2.046,-2.047,-2.049,-2.050, - &-2.052,-2.053,-2.055,-2.056,-2.057,-2.059,-2.060,-2.062,-2.063, - &-2.065,-2.066,-2.067,-2.069,-2.070,-2.072,-2.073,-2.074,-2.076, - &-2.077,-2.079,-2.080,-2.081,-2.083,-2.084,-2.086,-2.087,-2.088, - &-2.090,-2.091,-2.093,-2.094,-2.109,-2.123,-2.137,-2.150,-2.164, - &-2.177,-2.191,-2.204,-2.217,-2.231,-2.244,-2.257,-2.270,-2.283, - &-2.296,-2.309,-2.322,-2.335,-2.348,-2.361,-2.374,-2.386,-2.399, - &-2.412,-2.425,-2.437,-2.450,-2.463,-2.475,-2.488,-2.500,-2.513, - &-2.525,-2.538,-2.550,-2.563,-2.575,-2.588,-2.600,-2.612,-2.625, - &-2.637,-2.650,-2.662,-2.674,-2.686,-2.699,-2.711,-2.723,-2.736, - &-2.748,-2.760,-2.772,-2.784,-2.797,-2.809,-2.821,-2.833,-2.845, - &-2.857,-2.870,-2.882,-2.894,-2.906,-2.918,-2.930,-2.942,-2.954, - &-2.966,-2.978,-2.991,-3.003,-3.015,-3.027,-3.039,-3.051,-3.063, - &-3.075,-3.087,-3.099,-3.111,-3.123,-3.135,-3.147,-3.159,-3.171, - &-3.182,-3.194,-3.206,-3.218,-3.230,-3.242,-3.254,-3.266,-3.278, - &-3.290,-3.302,-3.314,-3.325,-3.337,-3.349,-3.361,-3.373,-3.385, - &-3.397,-3.409,-3.420,-3.432,-3.444,-3.456,-3.468,-3.480,-3.491, - &-3.503,-3.515,-3.527,-3.539,-3.551,-3.562,-3.574,-3.586,-3.598, - &-3.609,-3.621,-3.633,-3.645,-3.657,-3.668,-3.680,-3.692,-3.704, - &-3.715,-3.727,-3.739,-3.751,-3.762,-3.774,-3.786,-3.798,-3.809, - &-3.821,-3.833,-3.844,-3.856,-3.868,-3.880,-3.891,-3.903,-3.915, - &-3.926,-3.938,-3.950,-3.961,-3.973,-3.985,-3.997,-4.008,-4.020, - &-4.032,-4.043,-4.055 - & / -C -C *** MGNO32 -C - DATA BNC22M/ - &-0.095,-0.197,-0.243,-0.273,-0.294,-0.311,-0.323,-0.333,-0.342, - &-0.348,-0.353,-0.358,-0.361,-0.364,-0.366,-0.367,-0.368,-0.368, - &-0.368,-0.368,-0.368,-0.367,-0.366,-0.364,-0.363,-0.361,-0.359, - &-0.357,-0.355,-0.353,-0.351,-0.348,-0.346,-0.343,-0.340,-0.337, - &-0.335,-0.332,-0.329,-0.326,-0.323,-0.320,-0.316,-0.313,-0.310, - &-0.307,-0.304,-0.300,-0.297,-0.294,-0.290,-0.287,-0.284,-0.280, - &-0.277,-0.274,-0.270,-0.267,-0.264,-0.260,-0.257,-0.253,-0.250, - &-0.247,-0.243,-0.240,-0.236,-0.233,-0.229,-0.226,-0.222,-0.219, - &-0.215,-0.211,-0.208,-0.204,-0.200,-0.197,-0.193,-0.189,-0.186, - &-0.182,-0.178,-0.174,-0.170,-0.166,-0.162,-0.158,-0.154,-0.150, - &-0.146,-0.142,-0.138,-0.134,-0.130,-0.125,-0.121,-0.117,-0.113, - &-0.108,-0.104,-0.100,-0.095,-0.091,-0.086,-0.082,-0.077,-0.073, - &-0.068,-0.064,-0.059,-0.055,-0.050,-0.045,-0.041,-0.036,-0.032, - &-0.027,-0.022,-0.018,-0.013,-0.008,-0.004, 0.001, 0.006, 0.010, - & 0.015, 0.020, 0.024, 0.029, 0.034, 0.039, 0.043, 0.048, 0.053, - & 0.057, 0.062, 0.067, 0.071, 0.076, 0.081, 0.085, 0.090, 0.095, - & 0.099, 0.104, 0.109, 0.113, 0.118, 0.122, 0.127, 0.132, 0.136, - & 0.141, 0.145, 0.150, 0.155, 0.159, 0.164, 0.168, 0.173, 0.178, - & 0.182, 0.187, 0.191, 0.196, 0.200, 0.205, 0.209, 0.214, 0.218, - & 0.223, 0.227, 0.232, 0.236, 0.241, 0.245, 0.250, 0.254, 0.259, - & 0.263, 0.268, 0.272, 0.276, 0.281, 0.285, 0.290, 0.294, 0.299, - & 0.303, 0.307, 0.312, 0.316, 0.320, 0.325, 0.329, 0.333, 0.338, - & 0.342, 0.346, 0.351, 0.355, 0.359, 0.364, 0.368, 0.372, 0.377, - & 0.381, 0.385, 0.389, 0.394, 0.398, 0.402, 0.406, 0.411, 0.415, - & 0.419, 0.423, 0.427, 0.432, 0.436, 0.440, 0.444, 0.448, 0.452, - & 0.457, 0.461, 0.465, 0.469, 0.473, 0.477, 0.481, 0.485, 0.490, - & 0.494, 0.498, 0.502, 0.506, 0.510, 0.514, 0.518, 0.522, 0.526, - & 0.530, 0.534, 0.538, 0.542, 0.546, 0.550, 0.554, 0.558, 0.562, - & 0.566, 0.570, 0.574, 0.578, 0.582, 0.586, 0.590, 0.594, 0.598, - & 0.602, 0.605, 0.609, 0.613, 0.617, 0.621, 0.625, 0.629, 0.633, - & 0.636, 0.640, 0.644, 0.648, 0.652, 0.656, 0.659, 0.663, 0.667, - & 0.671, 0.674, 0.678, 0.682, 0.686, 0.690, 0.693, 0.697, 0.701, - & 0.704, 0.708, 0.712, 0.716, 0.719, 0.723, 0.727, 0.730, 0.734, - & 0.738, 0.741, 0.745, 0.749, 0.752, 0.756, 0.760, 0.763, 0.767, - & 0.771, 0.774, 0.778, 0.781, 0.785, 0.789, 0.792, 0.796, 0.799, - & 0.803, 0.806, 0.810, 0.813, 0.817, 0.821, 0.824, 0.828, 0.831, - & 0.835, 0.838, 0.842, 0.845, 0.849, 0.852, 0.856, 0.859, 0.862, - & 0.866, 0.869, 0.873, 0.876, 0.880, 0.883, 0.886, 0.890, 0.893, - & 0.897, 0.900, 0.903, 0.907, 0.910, 0.914, 0.917, 0.920, 0.924, - & 0.927, 0.930, 0.934, 0.937, 0.940, 0.944, 0.947, 0.950, 0.954, - & 0.957, 0.960, 0.963, 0.967, 0.970, 0.973, 0.977, 0.980, 0.983, - & 0.986, 0.990, 0.993, 0.996, 0.999, 1.003, 1.006, 1.009, 1.012, - & 1.015, 1.019, 1.022, 1.025, 1.028, 1.031, 1.034, 1.038, 1.041, - & 1.044, 1.047, 1.050, 1.053, 1.056, 1.060, 1.063, 1.066, 1.069, - & 1.072, 1.075, 1.078, 1.081, 1.114, 1.144, 1.174, 1.203, 1.232, - & 1.260, 1.288, 1.315, 1.342, 1.369, 1.395, 1.420, 1.446, 1.471, - & 1.495, 1.519, 1.543, 1.567, 1.590, 1.613, 1.635, 1.657, 1.679, - & 1.701, 1.722, 1.743, 1.764, 1.784, 1.804, 1.824, 1.844, 1.863, - & 1.882, 1.901, 1.920, 1.938, 1.956, 1.974, 1.992, 2.009, 2.026, - & 2.043, 2.060, 2.077, 2.093, 2.109, 2.125, 2.141, 2.157, 2.172, - & 2.187, 2.202, 2.217, 2.232, 2.246, 2.261, 2.275, 2.289, 2.303, - & 2.317, 2.330, 2.344, 2.357, 2.370, 2.383, 2.396, 2.408, 2.421, - & 2.433, 2.445, 2.458, 2.470, 2.481, 2.493, 2.505, 2.516, 2.528, - & 2.539, 2.550, 2.561, 2.572, 2.583, 2.593, 2.604, 2.614, 2.625, - & 2.635, 2.645, 2.655, 2.665, 2.675, 2.684, 2.694, 2.704, 2.713, - & 2.722, 2.732, 2.741, 2.750, 2.759, 2.768, 2.776, 2.785, 2.794, - & 2.802, 2.811, 2.819, 2.827, 2.835, 2.843, 2.851, 2.859, 2.867, - & 2.875, 2.883, 2.890, 2.898, 2.906, 2.913, 2.920, 2.928, 2.935, - & 2.942, 2.949, 2.956, 2.963, 2.970, 2.977, 2.983, 2.990, 2.997, - & 3.003, 3.010, 3.016, 3.022, 3.029, 3.035, 3.041, 3.047, 3.053, - & 3.059, 3.065, 3.071, 3.077, 3.083, 3.089, 3.094, 3.100, 3.105, - & 3.111, 3.116, 3.122, 3.127, 3.133, 3.138, 3.143, 3.148, 3.153, - & 3.158, 3.163, 3.168 - & / -C -C *** MGCL2 -C - DATA BNC23M/ - &-0.094,-0.194,-0.238,-0.266,-0.285,-0.299,-0.310,-0.319,-0.325, - &-0.330,-0.333,-0.336,-0.337,-0.338,-0.338,-0.338,-0.337,-0.336, - &-0.334,-0.332,-0.330,-0.328,-0.325,-0.322,-0.319,-0.315,-0.312, - &-0.308,-0.304,-0.300,-0.296,-0.292,-0.288,-0.283,-0.279,-0.274, - &-0.270,-0.265,-0.261,-0.256,-0.251,-0.247,-0.242,-0.237,-0.232, - &-0.227,-0.222,-0.218,-0.213,-0.208,-0.203,-0.198,-0.193,-0.188, - &-0.183,-0.178,-0.173,-0.168,-0.163,-0.158,-0.153,-0.148,-0.143, - &-0.138,-0.133,-0.128,-0.123,-0.118,-0.113,-0.108,-0.103,-0.097, - &-0.092,-0.087,-0.082,-0.077,-0.071,-0.066,-0.061,-0.055,-0.050, - &-0.045,-0.039,-0.034,-0.028,-0.023,-0.017,-0.011,-0.006, 0.000, - & 0.006, 0.011, 0.017, 0.023, 0.029, 0.035, 0.041, 0.047, 0.053, - & 0.059, 0.065, 0.071, 0.077, 0.083, 0.089, 0.096, 0.102, 0.108, - & 0.114, 0.121, 0.127, 0.133, 0.140, 0.146, 0.152, 0.159, 0.165, - & 0.171, 0.178, 0.184, 0.191, 0.197, 0.203, 0.210, 0.216, 0.223, - & 0.229, 0.236, 0.242, 0.249, 0.255, 0.261, 0.268, 0.274, 0.281, - & 0.287, 0.293, 0.300, 0.306, 0.313, 0.319, 0.325, 0.332, 0.338, - & 0.345, 0.351, 0.357, 0.364, 0.370, 0.376, 0.383, 0.389, 0.395, - & 0.402, 0.408, 0.414, 0.421, 0.427, 0.433, 0.439, 0.446, 0.452, - & 0.458, 0.464, 0.471, 0.477, 0.483, 0.489, 0.495, 0.502, 0.508, - & 0.514, 0.520, 0.526, 0.532, 0.538, 0.545, 0.551, 0.557, 0.563, - & 0.569, 0.575, 0.581, 0.587, 0.593, 0.599, 0.605, 0.611, 0.617, - & 0.623, 0.629, 0.635, 0.641, 0.647, 0.653, 0.659, 0.665, 0.671, - & 0.677, 0.683, 0.689, 0.694, 0.700, 0.706, 0.712, 0.718, 0.724, - & 0.730, 0.735, 0.741, 0.747, 0.753, 0.759, 0.764, 0.770, 0.776, - & 0.782, 0.787, 0.793, 0.799, 0.804, 0.810, 0.816, 0.822, 0.827, - & 0.833, 0.838, 0.844, 0.850, 0.855, 0.861, 0.867, 0.872, 0.878, - & 0.883, 0.889, 0.894, 0.900, 0.905, 0.911, 0.916, 0.922, 0.927, - & 0.933, 0.938, 0.944, 0.949, 0.955, 0.960, 0.966, 0.971, 0.976, - & 0.982, 0.987, 0.993, 0.998, 1.003, 1.009, 1.014, 1.019, 1.025, - & 1.030, 1.035, 1.041, 1.046, 1.051, 1.056, 1.062, 1.067, 1.072, - & 1.077, 1.083, 1.088, 1.093, 1.098, 1.103, 1.109, 1.114, 1.119, - & 1.124, 1.129, 1.134, 1.139, 1.144, 1.150, 1.155, 1.160, 1.165, - & 1.170, 1.175, 1.180, 1.185, 1.190, 1.195, 1.200, 1.205, 1.210, - & 1.215, 1.220, 1.225, 1.230, 1.235, 1.240, 1.245, 1.250, 1.255, - & 1.260, 1.264, 1.269, 1.274, 1.279, 1.284, 1.289, 1.294, 1.299, - & 1.303, 1.308, 1.313, 1.318, 1.323, 1.327, 1.332, 1.337, 1.342, - & 1.346, 1.351, 1.356, 1.361, 1.365, 1.370, 1.375, 1.380, 1.384, - & 1.389, 1.394, 1.398, 1.403, 1.408, 1.412, 1.417, 1.421, 1.426, - & 1.431, 1.435, 1.440, 1.444, 1.449, 1.454, 1.458, 1.463, 1.467, - & 1.472, 1.476, 1.481, 1.485, 1.490, 1.494, 1.499, 1.503, 1.508, - & 1.512, 1.517, 1.521, 1.526, 1.530, 1.535, 1.539, 1.543, 1.548, - & 1.552, 1.557, 1.561, 1.565, 1.570, 1.574, 1.578, 1.583, 1.587, - & 1.591, 1.596, 1.600, 1.604, 1.609, 1.613, 1.617, 1.622, 1.626, - & 1.630, 1.634, 1.639, 1.643, 1.647, 1.651, 1.656, 1.660, 1.664, - & 1.668, 1.672, 1.677, 1.681, 1.726, 1.766, 1.807, 1.846, 1.885, - & 1.923, 1.961, 1.998, 2.034, 2.070, 2.105, 2.140, 2.175, 2.208, - & 2.242, 2.275, 2.307, 2.339, 2.370, 2.401, 2.432, 2.462, 2.492, - & 2.521, 2.550, 2.579, 2.607, 2.635, 2.662, 2.690, 2.716, 2.743, - & 2.769, 2.795, 2.820, 2.845, 2.870, 2.895, 2.919, 2.943, 2.966, - & 2.990, 3.013, 3.036, 3.058, 3.081, 3.103, 3.124, 3.146, 3.167, - & 3.188, 3.209, 3.230, 3.250, 3.270, 3.290, 3.310, 3.329, 3.349, - & 3.368, 3.387, 3.405, 3.424, 3.442, 3.460, 3.478, 3.496, 3.513, - & 3.531, 3.548, 3.565, 3.582, 3.599, 3.615, 3.631, 3.648, 3.664, - & 3.680, 3.695, 3.711, 3.726, 3.742, 3.757, 3.772, 3.787, 3.801, - & 3.816, 3.830, 3.845, 3.859, 3.873, 3.887, 3.901, 3.914, 3.928, - & 3.941, 3.955, 3.968, 3.981, 3.994, 4.007, 4.019, 4.032, 4.044, - & 4.057, 4.069, 4.081, 4.093, 4.105, 4.117, 4.129, 4.141, 4.152, - & 4.164, 4.175, 4.186, 4.197, 4.209, 4.220, 4.230, 4.241, 4.252, - & 4.263, 4.273, 4.284, 4.294, 4.304, 4.314, 4.324, 4.335, 4.344, - & 4.354, 4.364, 4.374, 4.383, 4.393, 4.402, 4.412, 4.421, 4.430, - & 4.440, 4.449, 4.458, 4.467, 4.476, 4.484, 4.493, 4.502, 4.510, - & 4.519, 4.527, 4.536, 4.544, 4.553, 4.561, 4.569, 4.577, 4.585, - & 4.593, 4.601, 4.609 - & / - END -C -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE KM273 (IONIC, BINARR) -C -C *** Common block definition -C - COMMON /KMC273/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL Binarr (23), Ionic -C -C *** Find position in arrays for bincoef -C - IF (Ionic.LE. 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) -C -C *** Assign values to return array -C - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) -C -C *** Return point ; End of subroutine -C - RETURN - END - - - BLOCK DATA KMCF273 -C -C *** Common block definition -C - COMMON /KMC273/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - -C -C *** NaCl -C - DATA BNC01M/ - &-0.046,-0.097,-0.119,-0.134,-0.145,-0.153,-0.160,-0.165,-0.169, - &-0.173,-0.176,-0.178,-0.180,-0.181,-0.182,-0.183,-0.184,-0.184, - &-0.185,-0.185,-0.185,-0.185,-0.184,-0.184,-0.183,-0.183,-0.182, - &-0.181,-0.181,-0.180,-0.179,-0.178,-0.177,-0.176,-0.174,-0.173, - &-0.172,-0.171,-0.170,-0.168,-0.167,-0.166,-0.164,-0.163,-0.162, - &-0.160,-0.159,-0.157,-0.156,-0.155,-0.153,-0.152,-0.150,-0.149, - &-0.147,-0.146,-0.144,-0.143,-0.141,-0.140,-0.138,-0.137,-0.135, - &-0.134,-0.132,-0.131,-0.129,-0.128,-0.126,-0.124,-0.123,-0.121, - &-0.120,-0.118,-0.116,-0.115,-0.113,-0.112,-0.110,-0.108,-0.107, - &-0.105,-0.103,-0.101,-0.100,-0.098,-0.096,-0.094,-0.093,-0.091, - &-0.089,-0.087,-0.085,-0.083,-0.081,-0.080,-0.078,-0.076,-0.074, - &-0.072,-0.070,-0.068,-0.066,-0.064,-0.062,-0.060,-0.058,-0.056, - &-0.054,-0.052,-0.050,-0.048,-0.046,-0.044,-0.042,-0.039,-0.037, - &-0.035,-0.033,-0.031,-0.029,-0.027,-0.025,-0.023,-0.021,-0.018, - &-0.016,-0.014,-0.012,-0.010,-0.008,-0.006,-0.004,-0.002, 0.001, - & 0.003, 0.005, 0.007, 0.009, 0.011, 0.013, 0.015, 0.017, 0.019, - & 0.022, 0.024, 0.026, 0.028, 0.030, 0.032, 0.034, 0.036, 0.038, - & 0.040, 0.042, 0.045, 0.047, 0.049, 0.051, 0.053, 0.055, 0.057, - & 0.059, 0.061, 0.063, 0.065, 0.067, 0.069, 0.071, 0.073, 0.075, - & 0.078, 0.080, 0.082, 0.084, 0.086, 0.088, 0.090, 0.092, 0.094, - & 0.096, 0.098, 0.100, 0.102, 0.104, 0.106, 0.108, 0.110, 0.112, - & 0.114, 0.116, 0.118, 0.120, 0.122, 0.124, 0.126, 0.128, 0.130, - & 0.132, 0.134, 0.136, 0.138, 0.140, 0.142, 0.143, 0.145, 0.147, - & 0.149, 0.151, 0.153, 0.155, 0.157, 0.159, 0.161, 0.163, 0.165, - & 0.167, 0.169, 0.171, 0.172, 0.174, 0.176, 0.178, 0.180, 0.182, - & 0.184, 0.186, 0.188, 0.190, 0.191, 0.193, 0.195, 0.197, 0.199, - & 0.201, 0.203, 0.205, 0.206, 0.208, 0.210, 0.212, 0.214, 0.216, - & 0.218, 0.219, 0.221, 0.223, 0.225, 0.227, 0.229, 0.230, 0.232, - & 0.234, 0.236, 0.238, 0.239, 0.241, 0.243, 0.245, 0.247, 0.248, - & 0.250, 0.252, 0.254, 0.256, 0.257, 0.259, 0.261, 0.263, 0.265, - & 0.266, 0.268, 0.270, 0.272, 0.273, 0.275, 0.277, 0.279, 0.280, - & 0.282, 0.284, 0.286, 0.287, 0.289, 0.291, 0.292, 0.294, 0.296, - & 0.298, 0.299, 0.301, 0.303, 0.305, 0.306, 0.308, 0.310, 0.311, - & 0.313, 0.315, 0.316, 0.318, 0.320, 0.321, 0.323, 0.325, 0.326, - & 0.328, 0.330, 0.331, 0.333, 0.335, 0.336, 0.338, 0.340, 0.341, - & 0.343, 0.345, 0.346, 0.348, 0.350, 0.351, 0.353, 0.355, 0.356, - & 0.358, 0.359, 0.361, 0.363, 0.364, 0.366, 0.367, 0.369, 0.371, - & 0.372, 0.374, 0.375, 0.377, 0.379, 0.380, 0.382, 0.383, 0.385, - & 0.387, 0.388, 0.390, 0.391, 0.393, 0.394, 0.396, 0.398, 0.399, - & 0.401, 0.402, 0.404, 0.405, 0.407, 0.408, 0.410, 0.412, 0.413, - & 0.415, 0.416, 0.418, 0.419, 0.421, 0.422, 0.424, 0.425, 0.427, - & 0.428, 0.430, 0.431, 0.433, 0.434, 0.436, 0.437, 0.439, 0.440, - & 0.442, 0.443, 0.445, 0.446, 0.448, 0.449, 0.451, 0.452, 0.454, - & 0.455, 0.457, 0.458, 0.460, 0.461, 0.463, 0.464, 0.465, 0.467, - & 0.468, 0.470, 0.471, 0.473, 0.488, 0.502, 0.516, 0.530, 0.544, - & 0.557, 0.570, 0.583, 0.596, 0.608, 0.621, 0.633, 0.645, 0.657, - & 0.669, 0.680, 0.692, 0.703, 0.714, 0.725, 0.736, 0.747, 0.758, - & 0.768, 0.778, 0.789, 0.799, 0.809, 0.819, 0.828, 0.838, 0.847, - & 0.857, 0.866, 0.875, 0.884, 0.893, 0.902, 0.911, 0.920, 0.928, - & 0.937, 0.945, 0.954, 0.962, 0.970, 0.978, 0.986, 0.994, 1.002, - & 1.010, 1.017, 1.025, 1.032, 1.040, 1.047, 1.054, 1.062, 1.069, - & 1.076, 1.083, 1.090, 1.097, 1.103, 1.110, 1.117, 1.124, 1.130, - & 1.137, 1.143, 1.149, 1.156, 1.162, 1.168, 1.174, 1.181, 1.187, - & 1.193, 1.199, 1.205, 1.210, 1.216, 1.222, 1.228, 1.233, 1.239, - & 1.245, 1.250, 1.255, 1.261, 1.266, 1.272, 1.277, 1.282, 1.287, - & 1.293, 1.298, 1.303, 1.308, 1.313, 1.318, 1.323, 1.328, 1.333, - & 1.337, 1.342, 1.347, 1.352, 1.356, 1.361, 1.366, 1.370, 1.375, - & 1.379, 1.384, 1.388, 1.392, 1.397, 1.401, 1.406, 1.410, 1.414, - & 1.418, 1.422, 1.427, 1.431, 1.435, 1.439, 1.443, 1.447, 1.451, - & 1.455, 1.459, 1.463, 1.467, 1.470, 1.474, 1.478, 1.482, 1.486, - & 1.489, 1.493, 1.497, 1.500, 1.504, 1.508, 1.511, 1.515, 1.518, - & 1.522, 1.525, 1.529, 1.532, 1.536, 1.539, 1.542, 1.546, 1.549, - & 1.552, 1.556, 1.559 - & / -C -C *** Na2SO4 -C - DATA BNC02M/ - &-0.096,-0.208,-0.264,-0.304,-0.335,-0.361,-0.383,-0.403,-0.420, - &-0.436,-0.450,-0.464,-0.476,-0.487,-0.498,-0.508,-0.517,-0.526, - &-0.535,-0.543,-0.551,-0.558,-0.566,-0.572,-0.579,-0.586,-0.592, - &-0.598,-0.603,-0.609,-0.614,-0.620,-0.625,-0.630,-0.635,-0.639, - &-0.644,-0.649,-0.653,-0.657,-0.661,-0.666,-0.670,-0.674,-0.677, - &-0.681,-0.685,-0.689,-0.692,-0.696,-0.699,-0.702,-0.706,-0.709, - &-0.712,-0.715,-0.718,-0.721,-0.725,-0.727,-0.730,-0.733,-0.736, - &-0.739,-0.742,-0.744,-0.747,-0.750,-0.752,-0.755,-0.757,-0.760, - &-0.763,-0.765,-0.767,-0.770,-0.772,-0.775,-0.777,-0.779,-0.782, - &-0.784,-0.786,-0.788,-0.791,-0.793,-0.795,-0.797,-0.799,-0.801, - &-0.803,-0.806,-0.808,-0.810,-0.812,-0.814,-0.816,-0.818,-0.820, - &-0.822,-0.824,-0.826,-0.827,-0.829,-0.831,-0.833,-0.835,-0.837, - &-0.839,-0.841,-0.842,-0.844,-0.846,-0.848,-0.850,-0.851,-0.853, - &-0.855,-0.857,-0.858,-0.860,-0.862,-0.863,-0.865,-0.867,-0.868, - &-0.870,-0.872,-0.873,-0.875,-0.877,-0.878,-0.880,-0.881,-0.883, - &-0.885,-0.886,-0.888,-0.889,-0.891,-0.892,-0.894,-0.895,-0.897, - &-0.898,-0.900,-0.901,-0.903,-0.904,-0.906,-0.907,-0.909,-0.910, - &-0.912,-0.913,-0.915,-0.916,-0.917,-0.919,-0.920,-0.922,-0.923, - &-0.924,-0.926,-0.927,-0.928,-0.930,-0.931,-0.933,-0.934,-0.935, - &-0.937,-0.938,-0.939,-0.941,-0.942,-0.943,-0.944,-0.946,-0.947, - &-0.948,-0.950,-0.951,-0.952,-0.953,-0.955,-0.956,-0.957,-0.958, - &-0.960,-0.961,-0.962,-0.963,-0.965,-0.966,-0.967,-0.968,-0.969, - &-0.971,-0.972,-0.973,-0.974,-0.975,-0.977,-0.978,-0.979,-0.980, - &-0.981,-0.982,-0.984,-0.985,-0.986,-0.987,-0.988,-0.989,-0.990, - &-0.992,-0.993,-0.994,-0.995,-0.996,-0.997,-0.998,-0.999,-1.001, - &-1.002,-1.003,-1.004,-1.005,-1.006,-1.007,-1.008,-1.009,-1.010, - &-1.011,-1.012,-1.014,-1.015,-1.016,-1.017,-1.018,-1.019,-1.020, - &-1.021,-1.022,-1.023,-1.024,-1.025,-1.026,-1.027,-1.028,-1.029, - &-1.030,-1.031,-1.032,-1.033,-1.034,-1.035,-1.036,-1.037,-1.038, - &-1.039,-1.040,-1.041,-1.042,-1.043,-1.044,-1.045,-1.046,-1.047, - &-1.048,-1.049,-1.050,-1.051,-1.052,-1.053,-1.054,-1.055,-1.056, - &-1.057,-1.058,-1.059,-1.060,-1.061,-1.062,-1.063,-1.064,-1.065, - &-1.066,-1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.072,-1.073, - &-1.074,-1.075,-1.076,-1.077,-1.078,-1.079,-1.079,-1.080,-1.081, - &-1.082,-1.083,-1.084,-1.085,-1.086,-1.087,-1.088,-1.088,-1.089, - &-1.090,-1.091,-1.092,-1.093,-1.094,-1.095,-1.096,-1.096,-1.097, - &-1.098,-1.099,-1.100,-1.101,-1.102,-1.102,-1.103,-1.104,-1.105, - &-1.106,-1.107,-1.108,-1.109,-1.109,-1.110,-1.111,-1.112,-1.113, - &-1.114,-1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.120,-1.120, - &-1.121,-1.122,-1.123,-1.124,-1.124,-1.125,-1.126,-1.127,-1.128, - &-1.129,-1.129,-1.130,-1.131,-1.132,-1.133,-1.134,-1.134,-1.135, - &-1.136,-1.137,-1.138,-1.138,-1.139,-1.140,-1.141,-1.142,-1.142, - &-1.143,-1.144,-1.145,-1.146,-1.146,-1.147,-1.148,-1.149,-1.150, - &-1.150,-1.151,-1.152,-1.153,-1.153,-1.154,-1.155,-1.156,-1.157, - &-1.157,-1.158,-1.159,-1.160,-1.168,-1.175,-1.183,-1.190,-1.198, - &-1.205,-1.212,-1.219,-1.226,-1.233,-1.239,-1.246,-1.253,-1.259, - &-1.266,-1.272,-1.279,-1.285,-1.291,-1.298,-1.304,-1.310,-1.316, - &-1.322,-1.328,-1.334,-1.340,-1.346,-1.352,-1.357,-1.363,-1.369, - &-1.374,-1.380,-1.386,-1.391,-1.397,-1.402,-1.408,-1.413,-1.419, - &-1.424,-1.429,-1.435,-1.440,-1.445,-1.450,-1.456,-1.461,-1.466, - &-1.471,-1.476,-1.481,-1.486,-1.491,-1.496,-1.501,-1.506,-1.511, - &-1.516,-1.521,-1.526,-1.531,-1.536,-1.541,-1.545,-1.550,-1.555, - &-1.560,-1.564,-1.569,-1.574,-1.579,-1.583,-1.588,-1.593,-1.597, - &-1.602,-1.606,-1.611,-1.616,-1.620,-1.625,-1.629,-1.634,-1.638, - &-1.643,-1.647,-1.652,-1.656,-1.661,-1.665,-1.670,-1.674,-1.678, - &-1.683,-1.687,-1.692,-1.696,-1.700,-1.705,-1.709,-1.713,-1.718, - &-1.722,-1.726,-1.730,-1.735,-1.739,-1.743,-1.747,-1.752,-1.756, - &-1.760,-1.764,-1.768,-1.773,-1.777,-1.781,-1.785,-1.789,-1.793, - &-1.798,-1.802,-1.806,-1.810,-1.814,-1.818,-1.822,-1.826,-1.830, - &-1.834,-1.838,-1.843,-1.847,-1.851,-1.855,-1.859,-1.863,-1.867, - &-1.871,-1.875,-1.879,-1.883,-1.887,-1.891,-1.895,-1.899,-1.902, - &-1.906,-1.910,-1.914,-1.918,-1.922,-1.926,-1.930,-1.934,-1.938, - &-1.942,-1.946,-1.949 - & / -C -C *** NaNO3 -C - DATA BNC03M/ - &-0.048,-0.105,-0.133,-0.154,-0.170,-0.183,-0.195,-0.205,-0.214, - &-0.223,-0.230,-0.237,-0.244,-0.250,-0.256,-0.261,-0.266,-0.271, - &-0.276,-0.280,-0.284,-0.289,-0.292,-0.296,-0.300,-0.304,-0.307, - &-0.310,-0.314,-0.317,-0.320,-0.323,-0.326,-0.328,-0.331,-0.334, - &-0.337,-0.339,-0.342,-0.344,-0.347,-0.349,-0.351,-0.353,-0.356, - &-0.358,-0.360,-0.362,-0.364,-0.366,-0.368,-0.370,-0.372,-0.374, - &-0.376,-0.378,-0.379,-0.381,-0.383,-0.385,-0.386,-0.388,-0.390, - &-0.391,-0.393,-0.395,-0.396,-0.398,-0.399,-0.401,-0.402,-0.404, - &-0.405,-0.407,-0.408,-0.410,-0.411,-0.413,-0.414,-0.415,-0.417, - &-0.418,-0.420,-0.421,-0.422,-0.424,-0.425,-0.426,-0.427,-0.429, - &-0.430,-0.431,-0.433,-0.434,-0.435,-0.436,-0.438,-0.439,-0.440, - &-0.441,-0.442,-0.444,-0.445,-0.446,-0.447,-0.448,-0.449,-0.451, - &-0.452,-0.453,-0.454,-0.455,-0.456,-0.457,-0.459,-0.460,-0.461, - &-0.462,-0.463,-0.464,-0.465,-0.466,-0.467,-0.468,-0.469,-0.470, - &-0.472,-0.473,-0.474,-0.475,-0.476,-0.477,-0.478,-0.479,-0.480, - &-0.481,-0.482,-0.483,-0.484,-0.485,-0.486,-0.487,-0.488,-0.489, - &-0.490,-0.490,-0.491,-0.492,-0.493,-0.494,-0.495,-0.496,-0.497, - &-0.498,-0.499,-0.500,-0.501,-0.502,-0.503,-0.503,-0.504,-0.505, - &-0.506,-0.507,-0.508,-0.509,-0.510,-0.510,-0.511,-0.512,-0.513, - &-0.514,-0.515,-0.516,-0.516,-0.517,-0.518,-0.519,-0.520,-0.521, - &-0.521,-0.522,-0.523,-0.524,-0.525,-0.526,-0.526,-0.527,-0.528, - &-0.529,-0.530,-0.530,-0.531,-0.532,-0.533,-0.534,-0.534,-0.535, - &-0.536,-0.537,-0.537,-0.538,-0.539,-0.540,-0.540,-0.541,-0.542, - &-0.543,-0.543,-0.544,-0.545,-0.546,-0.546,-0.547,-0.548,-0.549, - &-0.549,-0.550,-0.551,-0.552,-0.552,-0.553,-0.554,-0.554,-0.555, - &-0.556,-0.557,-0.557,-0.558,-0.559,-0.559,-0.560,-0.561,-0.562, - &-0.562,-0.563,-0.564,-0.564,-0.565,-0.566,-0.566,-0.567,-0.568, - &-0.568,-0.569,-0.570,-0.570,-0.571,-0.572,-0.572,-0.573,-0.574, - &-0.574,-0.575,-0.576,-0.576,-0.577,-0.578,-0.578,-0.579,-0.580, - &-0.580,-0.581,-0.582,-0.582,-0.583,-0.584,-0.584,-0.585,-0.585, - &-0.586,-0.587,-0.587,-0.588,-0.589,-0.589,-0.590,-0.591,-0.591, - &-0.592,-0.592,-0.593,-0.594,-0.594,-0.595,-0.595,-0.596,-0.597, - &-0.597,-0.598,-0.599,-0.599,-0.600,-0.600,-0.601,-0.602,-0.602, - &-0.603,-0.603,-0.604,-0.604,-0.605,-0.606,-0.606,-0.607,-0.607, - &-0.608,-0.609,-0.609,-0.610,-0.610,-0.611,-0.612,-0.612,-0.613, - &-0.613,-0.614,-0.614,-0.615,-0.616,-0.616,-0.617,-0.617,-0.618, - &-0.618,-0.619,-0.619,-0.620,-0.621,-0.621,-0.622,-0.622,-0.623, - &-0.623,-0.624,-0.624,-0.625,-0.626,-0.626,-0.627,-0.627,-0.628, - &-0.628,-0.629,-0.629,-0.630,-0.630,-0.631,-0.632,-0.632,-0.633, - &-0.633,-0.634,-0.634,-0.635,-0.635,-0.636,-0.636,-0.637,-0.637, - &-0.638,-0.638,-0.639,-0.640,-0.640,-0.641,-0.641,-0.642,-0.642, - &-0.643,-0.643,-0.644,-0.644,-0.645,-0.645,-0.646,-0.646,-0.647, - &-0.647,-0.648,-0.648,-0.649,-0.649,-0.650,-0.650,-0.651,-0.651, - &-0.652,-0.652,-0.653,-0.653,-0.654,-0.654,-0.655,-0.655,-0.656, - &-0.656,-0.657,-0.657,-0.658,-0.663,-0.668,-0.673,-0.677,-0.682, - &-0.687,-0.691,-0.696,-0.700,-0.704,-0.709,-0.713,-0.717,-0.721, - &-0.725,-0.729,-0.733,-0.737,-0.741,-0.745,-0.749,-0.753,-0.757, - &-0.760,-0.764,-0.768,-0.771,-0.775,-0.779,-0.782,-0.786,-0.789, - &-0.793,-0.796,-0.799,-0.803,-0.806,-0.810,-0.813,-0.816,-0.819, - &-0.823,-0.826,-0.829,-0.832,-0.836,-0.839,-0.842,-0.845,-0.848, - &-0.851,-0.854,-0.857,-0.860,-0.863,-0.866,-0.869,-0.872,-0.875, - &-0.878,-0.881,-0.884,-0.887,-0.890,-0.893,-0.895,-0.898,-0.901, - &-0.904,-0.907,-0.909,-0.912,-0.915,-0.918,-0.920,-0.923,-0.926, - &-0.929,-0.931,-0.934,-0.937,-0.939,-0.942,-0.945,-0.947,-0.950, - &-0.952,-0.955,-0.958,-0.960,-0.963,-0.965,-0.968,-0.971,-0.973, - &-0.976,-0.978,-0.981,-0.983,-0.986,-0.988,-0.991,-0.993,-0.996, - &-0.998,-1.000,-1.003,-1.005,-1.008,-1.010,-1.013,-1.015,-1.017, - &-1.020,-1.022,-1.025,-1.027,-1.029,-1.032,-1.034,-1.036,-1.039, - &-1.041,-1.043,-1.046,-1.048,-1.050,-1.053,-1.055,-1.057,-1.060, - &-1.062,-1.064,-1.067,-1.069,-1.071,-1.073,-1.076,-1.078,-1.080, - &-1.082,-1.085,-1.087,-1.089,-1.091,-1.093,-1.096,-1.098,-1.100, - &-1.102,-1.105,-1.107,-1.109,-1.111,-1.113,-1.115,-1.118,-1.120, - &-1.122,-1.124,-1.126 - & / -C -C *** (NH4)2SO4 -C - DATA BNC04M/ - &-0.096,-0.208,-0.265,-0.305,-0.337,-0.363,-0.385,-0.405,-0.423, - &-0.439,-0.453,-0.467,-0.479,-0.491,-0.502,-0.512,-0.522,-0.531, - &-0.540,-0.548,-0.556,-0.564,-0.571,-0.578,-0.585,-0.592,-0.598, - &-0.605,-0.610,-0.616,-0.622,-0.627,-0.633,-0.638,-0.643,-0.648, - &-0.653,-0.657,-0.662,-0.666,-0.671,-0.675,-0.679,-0.683,-0.688, - &-0.691,-0.695,-0.699,-0.703,-0.707,-0.710,-0.714,-0.717,-0.721, - &-0.724,-0.727,-0.731,-0.734,-0.737,-0.740,-0.743,-0.746,-0.749, - &-0.752,-0.755,-0.758,-0.761,-0.763,-0.766,-0.769,-0.772,-0.774, - &-0.777,-0.780,-0.782,-0.785,-0.787,-0.790,-0.792,-0.795,-0.797, - &-0.799,-0.802,-0.804,-0.807,-0.809,-0.811,-0.814,-0.816,-0.818, - &-0.820,-0.823,-0.825,-0.827,-0.829,-0.831,-0.833,-0.836,-0.838, - &-0.840,-0.842,-0.844,-0.846,-0.848,-0.850,-0.852,-0.854,-0.856, - &-0.858,-0.860,-0.862,-0.864,-0.866,-0.868,-0.870,-0.872,-0.874, - &-0.875,-0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.888,-0.890, - &-0.892,-0.894,-0.895,-0.897,-0.899,-0.901,-0.902,-0.904,-0.906, - &-0.908,-0.909,-0.911,-0.913,-0.914,-0.916,-0.918,-0.919,-0.921, - &-0.923,-0.924,-0.926,-0.927,-0.929,-0.931,-0.932,-0.934,-0.935, - &-0.937,-0.938,-0.940,-0.942,-0.943,-0.945,-0.946,-0.948,-0.949, - &-0.951,-0.952,-0.954,-0.955,-0.957,-0.958,-0.960,-0.961,-0.962, - &-0.964,-0.965,-0.967,-0.968,-0.970,-0.971,-0.972,-0.974,-0.975, - &-0.977,-0.978,-0.979,-0.981,-0.982,-0.984,-0.985,-0.986,-0.988, - &-0.989,-0.990,-0.992,-0.993,-0.994,-0.996,-0.997,-0.998,-1.000, - &-1.001,-1.002,-1.004,-1.005,-1.006,-1.007,-1.009,-1.010,-1.011, - &-1.013,-1.014,-1.015,-1.016,-1.018,-1.019,-1.020,-1.021,-1.023, - &-1.024,-1.025,-1.026,-1.027,-1.029,-1.030,-1.031,-1.032,-1.034, - &-1.035,-1.036,-1.037,-1.038,-1.039,-1.041,-1.042,-1.043,-1.044, - &-1.045,-1.047,-1.048,-1.049,-1.050,-1.051,-1.052,-1.053,-1.055, - &-1.056,-1.057,-1.058,-1.059,-1.060,-1.061,-1.063,-1.064,-1.065, - &-1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.073,-1.074,-1.075, - &-1.076,-1.077,-1.078,-1.079,-1.080,-1.081,-1.082,-1.083,-1.084, - &-1.086,-1.087,-1.088,-1.089,-1.090,-1.091,-1.092,-1.093,-1.094, - &-1.095,-1.096,-1.097,-1.098,-1.099,-1.100,-1.101,-1.102,-1.103, - &-1.104,-1.105,-1.106,-1.107,-1.108,-1.109,-1.110,-1.111,-1.112, - &-1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.119,-1.120,-1.121, - &-1.122,-1.123,-1.124,-1.125,-1.126,-1.127,-1.128,-1.129,-1.130, - &-1.131,-1.132,-1.133,-1.134,-1.135,-1.136,-1.137,-1.138,-1.139, - &-1.140,-1.141,-1.142,-1.143,-1.144,-1.145,-1.146,-1.147,-1.147, - &-1.148,-1.149,-1.150,-1.151,-1.152,-1.153,-1.154,-1.155,-1.156, - &-1.157,-1.158,-1.159,-1.160,-1.160,-1.161,-1.162,-1.163,-1.164, - &-1.165,-1.166,-1.167,-1.168,-1.169,-1.169,-1.170,-1.171,-1.172, - &-1.173,-1.174,-1.175,-1.176,-1.177,-1.178,-1.178,-1.179,-1.180, - &-1.181,-1.182,-1.183,-1.184,-1.185,-1.185,-1.186,-1.187,-1.188, - &-1.189,-1.190,-1.191,-1.191,-1.192,-1.193,-1.194,-1.195,-1.196, - &-1.197,-1.198,-1.198,-1.199,-1.200,-1.201,-1.202,-1.203,-1.203, - &-1.204,-1.205,-1.206,-1.207,-1.216,-1.224,-1.232,-1.240,-1.248, - &-1.256,-1.263,-1.271,-1.279,-1.286,-1.293,-1.301,-1.308,-1.315, - &-1.322,-1.329,-1.336,-1.343,-1.349,-1.356,-1.363,-1.369,-1.376, - &-1.382,-1.389,-1.395,-1.402,-1.408,-1.414,-1.420,-1.427,-1.433, - &-1.439,-1.445,-1.451,-1.457,-1.463,-1.468,-1.474,-1.480,-1.486, - &-1.492,-1.497,-1.503,-1.509,-1.514,-1.520,-1.525,-1.531,-1.536, - &-1.542,-1.547,-1.553,-1.558,-1.563,-1.569,-1.574,-1.579,-1.585, - &-1.590,-1.595,-1.600,-1.605,-1.611,-1.616,-1.621,-1.626,-1.631, - &-1.636,-1.641,-1.646,-1.651,-1.656,-1.661,-1.666,-1.671,-1.676, - &-1.681,-1.685,-1.690,-1.695,-1.700,-1.705,-1.710,-1.714,-1.719, - &-1.724,-1.729,-1.733,-1.738,-1.743,-1.747,-1.752,-1.757,-1.761, - &-1.766,-1.770,-1.775,-1.780,-1.784,-1.789,-1.793,-1.798,-1.802, - &-1.807,-1.811,-1.816,-1.820,-1.825,-1.829,-1.834,-1.838,-1.842, - &-1.847,-1.851,-1.856,-1.860,-1.864,-1.869,-1.873,-1.877,-1.882, - &-1.886,-1.890,-1.895,-1.899,-1.903,-1.908,-1.912,-1.916,-1.920, - &-1.925,-1.929,-1.933,-1.937,-1.941,-1.946,-1.950,-1.954,-1.958, - &-1.962,-1.966,-1.971,-1.975,-1.979,-1.983,-1.987,-1.991,-1.995, - &-2.000,-2.004,-2.008,-2.012,-2.016,-2.020,-2.024,-2.028,-2.032, - &-2.036,-2.040,-2.044 - & / -C -C *** NH4NO3 -C - DATA BNC05M/ - &-0.048,-0.108,-0.138,-0.161,-0.179,-0.194,-0.208,-0.220,-0.231, - &-0.241,-0.250,-0.259,-0.267,-0.275,-0.282,-0.289,-0.296,-0.302, - &-0.309,-0.315,-0.321,-0.326,-0.332,-0.337,-0.342,-0.347,-0.352, - &-0.357,-0.361,-0.366,-0.370,-0.375,-0.379,-0.383,-0.387,-0.391, - &-0.395,-0.399,-0.403,-0.406,-0.410,-0.414,-0.417,-0.421,-0.424, - &-0.427,-0.431,-0.434,-0.437,-0.440,-0.443,-0.446,-0.449,-0.452, - &-0.455,-0.458,-0.461,-0.464,-0.466,-0.469,-0.472,-0.475,-0.477, - &-0.480,-0.482,-0.485,-0.487,-0.490,-0.492,-0.495,-0.497,-0.500, - &-0.502,-0.505,-0.507,-0.509,-0.512,-0.514,-0.516,-0.518,-0.521, - &-0.523,-0.525,-0.527,-0.530,-0.532,-0.534,-0.536,-0.538,-0.541, - &-0.543,-0.545,-0.547,-0.549,-0.551,-0.553,-0.555,-0.558,-0.560, - &-0.562,-0.564,-0.566,-0.568,-0.570,-0.572,-0.574,-0.576,-0.578, - &-0.580,-0.582,-0.584,-0.586,-0.588,-0.590,-0.592,-0.594,-0.596, - &-0.598,-0.600,-0.602,-0.604,-0.606,-0.608,-0.609,-0.611,-0.613, - &-0.615,-0.617,-0.619,-0.621,-0.622,-0.624,-0.626,-0.628,-0.630, - &-0.631,-0.633,-0.635,-0.637,-0.639,-0.640,-0.642,-0.644,-0.646, - &-0.647,-0.649,-0.651,-0.652,-0.654,-0.656,-0.657,-0.659,-0.661, - &-0.662,-0.664,-0.666,-0.667,-0.669,-0.671,-0.672,-0.674,-0.675, - &-0.677,-0.679,-0.680,-0.682,-0.683,-0.685,-0.686,-0.688,-0.690, - &-0.691,-0.693,-0.694,-0.696,-0.697,-0.699,-0.700,-0.702,-0.703, - &-0.705,-0.706,-0.708,-0.709,-0.711,-0.712,-0.713,-0.715,-0.716, - &-0.718,-0.719,-0.721,-0.722,-0.723,-0.725,-0.726,-0.728,-0.729, - &-0.730,-0.732,-0.733,-0.735,-0.736,-0.737,-0.739,-0.740,-0.741, - &-0.743,-0.744,-0.745,-0.747,-0.748,-0.749,-0.751,-0.752,-0.753, - &-0.755,-0.756,-0.757,-0.759,-0.760,-0.761,-0.762,-0.764,-0.765, - &-0.766,-0.768,-0.769,-0.770,-0.771,-0.773,-0.774,-0.775,-0.776, - &-0.778,-0.779,-0.780,-0.781,-0.782,-0.784,-0.785,-0.786,-0.787, - &-0.788,-0.790,-0.791,-0.792,-0.793,-0.794,-0.796,-0.797,-0.798, - &-0.799,-0.800,-0.801,-0.803,-0.804,-0.805,-0.806,-0.807,-0.808, - &-0.809,-0.811,-0.812,-0.813,-0.814,-0.815,-0.816,-0.817,-0.818, - &-0.820,-0.821,-0.822,-0.823,-0.824,-0.825,-0.826,-0.827,-0.828, - &-0.829,-0.830,-0.832,-0.833,-0.834,-0.835,-0.836,-0.837,-0.838, - &-0.839,-0.840,-0.841,-0.842,-0.843,-0.844,-0.845,-0.846,-0.847, - &-0.848,-0.849,-0.850,-0.851,-0.852,-0.853,-0.854,-0.855,-0.857, - &-0.858,-0.859,-0.860,-0.861,-0.862,-0.863,-0.863,-0.864,-0.865, - &-0.866,-0.867,-0.868,-0.869,-0.870,-0.871,-0.872,-0.873,-0.874, - &-0.875,-0.876,-0.877,-0.878,-0.879,-0.880,-0.881,-0.882,-0.883, - &-0.884,-0.885,-0.886,-0.887,-0.887,-0.888,-0.889,-0.890,-0.891, - &-0.892,-0.893,-0.894,-0.895,-0.896,-0.897,-0.898,-0.898,-0.899, - &-0.900,-0.901,-0.902,-0.903,-0.904,-0.905,-0.906,-0.907,-0.907, - &-0.908,-0.909,-0.910,-0.911,-0.912,-0.913,-0.914,-0.914,-0.915, - &-0.916,-0.917,-0.918,-0.919,-0.920,-0.920,-0.921,-0.922,-0.923, - &-0.924,-0.925,-0.926,-0.926,-0.927,-0.928,-0.929,-0.930,-0.931, - &-0.931,-0.932,-0.933,-0.934,-0.935,-0.936,-0.936,-0.937,-0.938, - &-0.939,-0.940,-0.940,-0.941,-0.950,-0.958,-0.965,-0.973,-0.980, - &-0.988,-0.995,-1.002,-1.009,-1.015,-1.022,-1.029,-1.035,-1.041, - &-1.047,-1.054,-1.060,-1.066,-1.071,-1.077,-1.083,-1.088,-1.094, - &-1.099,-1.105,-1.110,-1.115,-1.120,-1.125,-1.130,-1.135,-1.140, - &-1.145,-1.150,-1.155,-1.159,-1.164,-1.168,-1.173,-1.177,-1.182, - &-1.186,-1.191,-1.195,-1.199,-1.203,-1.207,-1.212,-1.216,-1.220, - &-1.224,-1.228,-1.232,-1.235,-1.239,-1.243,-1.247,-1.251,-1.254, - &-1.258,-1.262,-1.265,-1.269,-1.273,-1.276,-1.280,-1.283,-1.287, - &-1.290,-1.293,-1.297,-1.300,-1.304,-1.307,-1.310,-1.313,-1.317, - &-1.320,-1.323,-1.326,-1.330,-1.333,-1.336,-1.339,-1.342,-1.345, - &-1.348,-1.351,-1.354,-1.357,-1.360,-1.363,-1.366,-1.369,-1.372, - &-1.375,-1.378,-1.381,-1.383,-1.386,-1.389,-1.392,-1.395,-1.397, - &-1.400,-1.403,-1.406,-1.408,-1.411,-1.414,-1.417,-1.419,-1.422, - &-1.425,-1.427,-1.430,-1.432,-1.435,-1.438,-1.440,-1.443,-1.445, - &-1.448,-1.450,-1.453,-1.456,-1.458,-1.461,-1.463,-1.466,-1.468, - &-1.470,-1.473,-1.475,-1.478,-1.480,-1.483,-1.485,-1.487,-1.490, - &-1.492,-1.495,-1.497,-1.499,-1.502,-1.504,-1.506,-1.509,-1.511, - &-1.513,-1.516,-1.518,-1.520,-1.523,-1.525,-1.527,-1.529,-1.532, - &-1.534,-1.536,-1.538 - & / -C -C *** NH4Cl -C - DATA BNC06M/ - &-0.047,-0.101,-0.126,-0.144,-0.157,-0.168,-0.177,-0.185,-0.191, - &-0.197,-0.202,-0.207,-0.211,-0.215,-0.218,-0.221,-0.224,-0.227, - &-0.229,-0.232,-0.234,-0.236,-0.238,-0.239,-0.241,-0.242,-0.244, - &-0.245,-0.246,-0.247,-0.249,-0.250,-0.251,-0.251,-0.252,-0.253, - &-0.254,-0.255,-0.255,-0.256,-0.257,-0.257,-0.258,-0.258,-0.259, - &-0.259,-0.260,-0.260,-0.261,-0.261,-0.261,-0.262,-0.262,-0.262, - &-0.263,-0.263,-0.263,-0.263,-0.264,-0.264,-0.264,-0.264,-0.265, - &-0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.266,-0.266,-0.266, - &-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266, - &-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.265, - &-0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.264,-0.264,-0.264, - &-0.264,-0.264,-0.263,-0.263,-0.263,-0.263,-0.263,-0.262,-0.262, - &-0.262,-0.262,-0.261,-0.261,-0.261,-0.260,-0.260,-0.260,-0.260, - &-0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.257,-0.257,-0.257, - &-0.256,-0.256,-0.256,-0.255,-0.255,-0.255,-0.254,-0.254,-0.254, - &-0.253,-0.253,-0.253,-0.252,-0.252,-0.252,-0.251,-0.251,-0.251, - &-0.250,-0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.247, - &-0.247,-0.247,-0.246,-0.246,-0.245,-0.245,-0.245,-0.244,-0.244, - &-0.244,-0.243,-0.243,-0.242,-0.242,-0.242,-0.241,-0.241,-0.241, - &-0.240,-0.240,-0.239,-0.239,-0.239,-0.238,-0.238,-0.238,-0.237, - &-0.237,-0.236,-0.236,-0.236,-0.235,-0.235,-0.235,-0.234,-0.234, - &-0.233,-0.233,-0.233,-0.232,-0.232,-0.231,-0.231,-0.231,-0.230, - &-0.230,-0.230,-0.229,-0.229,-0.228,-0.228,-0.228,-0.227,-0.227, - &-0.227,-0.226,-0.226,-0.225,-0.225,-0.225,-0.224,-0.224,-0.224, - &-0.223,-0.223,-0.222,-0.222,-0.222,-0.221,-0.221,-0.221,-0.220, - &-0.220,-0.219,-0.219,-0.219,-0.218,-0.218,-0.218,-0.217,-0.217, - &-0.216,-0.216,-0.216,-0.215,-0.215,-0.215,-0.214,-0.214,-0.214, - &-0.213,-0.213,-0.212,-0.212,-0.212,-0.211,-0.211,-0.211,-0.210, - &-0.210,-0.210,-0.209,-0.209,-0.208,-0.208,-0.208,-0.207,-0.207, - &-0.207,-0.206,-0.206,-0.206,-0.205,-0.205,-0.204,-0.204,-0.204, - &-0.203,-0.203,-0.203,-0.202,-0.202,-0.202,-0.201,-0.201,-0.201, - &-0.200,-0.200,-0.200,-0.199,-0.199,-0.198,-0.198,-0.198,-0.197, - &-0.197,-0.197,-0.196,-0.196,-0.196,-0.195,-0.195,-0.195,-0.194, - &-0.194,-0.194,-0.193,-0.193,-0.193,-0.192,-0.192,-0.192,-0.191, - &-0.191,-0.191,-0.190,-0.190,-0.190,-0.189,-0.189,-0.189,-0.188, - &-0.188,-0.188,-0.187,-0.187,-0.187,-0.186,-0.186,-0.186,-0.185, - &-0.185,-0.185,-0.184,-0.184,-0.184,-0.183,-0.183,-0.183,-0.182, - &-0.182,-0.182,-0.181,-0.181,-0.181,-0.180,-0.180,-0.180,-0.179, - &-0.179,-0.179,-0.178,-0.178,-0.178,-0.177,-0.177,-0.177,-0.176, - &-0.176,-0.176,-0.176,-0.175,-0.175,-0.175,-0.174,-0.174,-0.174, - &-0.173,-0.173,-0.173,-0.172,-0.172,-0.172,-0.171,-0.171,-0.171, - &-0.171,-0.170,-0.170,-0.170,-0.169,-0.169,-0.169,-0.168,-0.168, - &-0.168,-0.167,-0.167,-0.167,-0.167,-0.166,-0.166,-0.166,-0.165, - &-0.165,-0.165,-0.164,-0.164,-0.164,-0.164,-0.163,-0.163,-0.163, - &-0.162,-0.162,-0.162,-0.161,-0.158,-0.155,-0.153,-0.150,-0.147, - &-0.144,-0.142,-0.139,-0.137,-0.134,-0.132,-0.129,-0.127,-0.125, - &-0.122,-0.120,-0.118,-0.116,-0.113,-0.111,-0.109,-0.107,-0.105, - &-0.103,-0.101,-0.099,-0.097,-0.095,-0.093,-0.092,-0.090,-0.088, - &-0.086,-0.085,-0.083,-0.081,-0.080,-0.078,-0.077,-0.075,-0.073, - &-0.072,-0.071,-0.069,-0.068,-0.066,-0.065,-0.064,-0.062,-0.061, - &-0.060,-0.058,-0.057,-0.056,-0.055,-0.053,-0.052,-0.051,-0.050, - &-0.049,-0.048,-0.047,-0.046,-0.044,-0.043,-0.042,-0.041,-0.040, - &-0.039,-0.039,-0.038,-0.037,-0.036,-0.035,-0.034,-0.033,-0.032, - &-0.032,-0.031,-0.030,-0.029,-0.028,-0.028,-0.027,-0.026,-0.025, - &-0.025,-0.024,-0.023,-0.023,-0.022,-0.021,-0.021,-0.020,-0.019, - &-0.019,-0.018,-0.018,-0.017,-0.017,-0.016,-0.016,-0.015,-0.015, - &-0.014,-0.014,-0.013,-0.013,-0.012,-0.012,-0.011,-0.011,-0.010, - &-0.010,-0.010,-0.009,-0.009,-0.008,-0.008,-0.008,-0.007,-0.007, - &-0.007,-0.006,-0.006,-0.006,-0.005,-0.005,-0.005,-0.005,-0.004, - &-0.004,-0.004,-0.004,-0.003,-0.003,-0.003,-0.003,-0.003,-0.002, - &-0.002,-0.002,-0.002,-0.002,-0.002,-0.001,-0.001,-0.001,-0.001, - &-0.001,-0.001,-0.001,-0.001, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000 - & / -C -C *** (2H,SO4) -C - DATA BNC07M/ - &-0.095,-0.207,-0.263,-0.303,-0.333,-0.359,-0.381,-0.400,-0.417, - &-0.432,-0.446,-0.459,-0.471,-0.482,-0.492,-0.502,-0.511,-0.520, - &-0.528,-0.536,-0.543,-0.550,-0.557,-0.564,-0.570,-0.576,-0.582, - &-0.588,-0.593,-0.598,-0.603,-0.608,-0.613,-0.618,-0.622,-0.627, - &-0.631,-0.635,-0.640,-0.644,-0.648,-0.651,-0.655,-0.659,-0.662, - &-0.666,-0.669,-0.673,-0.676,-0.679,-0.682,-0.686,-0.689,-0.692, - &-0.695,-0.698,-0.700,-0.703,-0.706,-0.709,-0.712,-0.714,-0.717, - &-0.719,-0.722,-0.724,-0.727,-0.729,-0.732,-0.734,-0.736,-0.739, - &-0.741,-0.743,-0.746,-0.748,-0.750,-0.752,-0.754,-0.756,-0.758, - &-0.761,-0.763,-0.765,-0.767,-0.769,-0.771,-0.773,-0.774,-0.776, - &-0.778,-0.780,-0.782,-0.784,-0.786,-0.787,-0.789,-0.791,-0.793, - &-0.795,-0.796,-0.798,-0.800,-0.802,-0.803,-0.805,-0.807,-0.808, - &-0.810,-0.811,-0.813,-0.815,-0.816,-0.818,-0.819,-0.821,-0.823, - &-0.824,-0.826,-0.827,-0.829,-0.830,-0.832,-0.833,-0.835,-0.836, - &-0.838,-0.839,-0.841,-0.842,-0.843,-0.845,-0.846,-0.848,-0.849, - &-0.850,-0.852,-0.853,-0.854,-0.856,-0.857,-0.858,-0.860,-0.861, - &-0.862,-0.864,-0.865,-0.866,-0.868,-0.869,-0.870,-0.871,-0.873, - &-0.874,-0.875,-0.876,-0.878,-0.879,-0.880,-0.881,-0.883,-0.884, - &-0.885,-0.886,-0.887,-0.889,-0.890,-0.891,-0.892,-0.893,-0.894, - &-0.896,-0.897,-0.898,-0.899,-0.900,-0.901,-0.902,-0.904,-0.905, - &-0.906,-0.907,-0.908,-0.909,-0.910,-0.911,-0.912,-0.914,-0.915, - &-0.916,-0.917,-0.918,-0.919,-0.920,-0.921,-0.922,-0.923,-0.924, - &-0.925,-0.926,-0.927,-0.928,-0.929,-0.930,-0.931,-0.932,-0.933, - &-0.934,-0.935,-0.936,-0.937,-0.938,-0.939,-0.940,-0.941,-0.942, - &-0.943,-0.944,-0.945,-0.946,-0.947,-0.948,-0.949,-0.950,-0.951, - &-0.952,-0.953,-0.954,-0.955,-0.956,-0.957,-0.958,-0.959,-0.960, - &-0.960,-0.961,-0.962,-0.963,-0.964,-0.965,-0.966,-0.967,-0.968, - &-0.969,-0.970,-0.970,-0.971,-0.972,-0.973,-0.974,-0.975,-0.976, - &-0.977,-0.978,-0.978,-0.979,-0.980,-0.981,-0.982,-0.983,-0.984, - &-0.985,-0.985,-0.986,-0.987,-0.988,-0.989,-0.990,-0.991,-0.991, - &-0.992,-0.993,-0.994,-0.995,-0.996,-0.996,-0.997,-0.998,-0.999, - &-1.000,-1.001,-1.001,-1.002,-1.003,-1.004,-1.005,-1.005,-1.006, - &-1.007,-1.008,-1.009,-1.010,-1.010,-1.011,-1.012,-1.013,-1.014, - &-1.014,-1.015,-1.016,-1.017,-1.017,-1.018,-1.019,-1.020,-1.021, - &-1.021,-1.022,-1.023,-1.024,-1.025,-1.025,-1.026,-1.027,-1.028, - &-1.028,-1.029,-1.030,-1.031,-1.031,-1.032,-1.033,-1.034,-1.034, - &-1.035,-1.036,-1.037,-1.037,-1.038,-1.039,-1.040,-1.040,-1.041, - &-1.042,-1.043,-1.043,-1.044,-1.045,-1.046,-1.046,-1.047,-1.048, - &-1.049,-1.049,-1.050,-1.051,-1.051,-1.052,-1.053,-1.054,-1.054, - &-1.055,-1.056,-1.057,-1.057,-1.058,-1.059,-1.059,-1.060,-1.061, - &-1.061,-1.062,-1.063,-1.064,-1.064,-1.065,-1.066,-1.066,-1.067, - &-1.068,-1.069,-1.069,-1.070,-1.071,-1.071,-1.072,-1.073,-1.073, - &-1.074,-1.075,-1.075,-1.076,-1.077,-1.078,-1.078,-1.079,-1.080, - &-1.080,-1.081,-1.082,-1.082,-1.083,-1.084,-1.084,-1.085,-1.086, - &-1.086,-1.087,-1.088,-1.088,-1.096,-1.102,-1.109,-1.115,-1.121, - &-1.127,-1.134,-1.140,-1.146,-1.152,-1.158,-1.163,-1.169,-1.175, - &-1.181,-1.186,-1.192,-1.198,-1.203,-1.209,-1.214,-1.219,-1.225, - &-1.230,-1.235,-1.241,-1.246,-1.251,-1.256,-1.261,-1.266,-1.271, - &-1.276,-1.281,-1.286,-1.291,-1.296,-1.301,-1.306,-1.311,-1.315, - &-1.320,-1.325,-1.330,-1.334,-1.339,-1.344,-1.348,-1.353,-1.358, - &-1.362,-1.367,-1.371,-1.376,-1.380,-1.385,-1.389,-1.394,-1.398, - &-1.403,-1.407,-1.412,-1.416,-1.420,-1.425,-1.429,-1.434,-1.438, - &-1.442,-1.447,-1.451,-1.455,-1.459,-1.464,-1.468,-1.472,-1.476, - &-1.480,-1.485,-1.489,-1.493,-1.497,-1.501,-1.505,-1.510,-1.514, - &-1.518,-1.522,-1.526,-1.530,-1.534,-1.538,-1.542,-1.546,-1.550, - &-1.554,-1.558,-1.562,-1.566,-1.570,-1.574,-1.578,-1.582,-1.586, - &-1.590,-1.594,-1.598,-1.602,-1.606,-1.610,-1.614,-1.618,-1.622, - &-1.625,-1.629,-1.633,-1.637,-1.641,-1.645,-1.649,-1.652,-1.656, - &-1.660,-1.664,-1.668,-1.672,-1.675,-1.679,-1.683,-1.687,-1.690, - &-1.694,-1.698,-1.702,-1.706,-1.709,-1.713,-1.717,-1.721,-1.724, - &-1.728,-1.732,-1.735,-1.739,-1.743,-1.747,-1.750,-1.754,-1.758, - &-1.761,-1.765,-1.769,-1.772,-1.776,-1.780,-1.783,-1.787,-1.791, - &-1.794,-1.798,-1.801 - & / -C -C *** (H,HSO4) -C - DATA BNC08M/ - &-0.045,-0.089,-0.107,-0.117,-0.124,-0.128,-0.131,-0.132,-0.133, - &-0.132,-0.132,-0.130,-0.128,-0.126,-0.123,-0.120,-0.117,-0.113, - &-0.109,-0.105,-0.101,-0.096,-0.091,-0.086,-0.081,-0.076,-0.070, - &-0.065,-0.059,-0.053,-0.047,-0.040,-0.034,-0.027,-0.021,-0.014, - &-0.007, 0.000, 0.007, 0.014, 0.021, 0.028, 0.036, 0.043, 0.051, - & 0.058, 0.066, 0.074, 0.082, 0.089, 0.097, 0.105, 0.113, 0.121, - & 0.130, 0.138, 0.146, 0.154, 0.163, 0.171, 0.179, 0.188, 0.196, - & 0.205, 0.214, 0.222, 0.231, 0.240, 0.248, 0.257, 0.266, 0.275, - & 0.284, 0.293, 0.302, 0.311, 0.320, 0.329, 0.338, 0.347, 0.357, - & 0.366, 0.375, 0.385, 0.394, 0.404, 0.413, 0.423, 0.433, 0.442, - & 0.452, 0.462, 0.472, 0.482, 0.492, 0.502, 0.512, 0.522, 0.532, - & 0.542, 0.552, 0.563, 0.573, 0.583, 0.594, 0.604, 0.614, 0.625, - & 0.635, 0.646, 0.656, 0.667, 0.677, 0.688, 0.698, 0.709, 0.719, - & 0.730, 0.741, 0.751, 0.762, 0.772, 0.783, 0.794, 0.804, 0.815, - & 0.825, 0.836, 0.846, 0.857, 0.867, 0.878, 0.888, 0.899, 0.909, - & 0.920, 0.930, 0.941, 0.951, 0.962, 0.972, 0.982, 0.993, 1.003, - & 1.014, 1.024, 1.034, 1.044, 1.055, 1.065, 1.075, 1.085, 1.096, - & 1.106, 1.116, 1.126, 1.136, 1.146, 1.156, 1.166, 1.176, 1.186, - & 1.196, 1.206, 1.216, 1.226, 1.236, 1.246, 1.256, 1.266, 1.276, - & 1.285, 1.295, 1.305, 1.315, 1.325, 1.334, 1.344, 1.354, 1.363, - & 1.373, 1.383, 1.392, 1.402, 1.411, 1.421, 1.430, 1.440, 1.449, - & 1.459, 1.468, 1.478, 1.487, 1.496, 1.506, 1.515, 1.524, 1.534, - & 1.543, 1.552, 1.561, 1.571, 1.580, 1.589, 1.598, 1.607, 1.616, - & 1.625, 1.634, 1.643, 1.652, 1.661, 1.670, 1.679, 1.688, 1.697, - & 1.706, 1.715, 1.724, 1.733, 1.742, 1.750, 1.759, 1.768, 1.777, - & 1.786, 1.794, 1.803, 1.812, 1.820, 1.829, 1.838, 1.846, 1.855, - & 1.863, 1.872, 1.880, 1.889, 1.897, 1.906, 1.914, 1.923, 1.931, - & 1.940, 1.948, 1.956, 1.965, 1.973, 1.981, 1.990, 1.998, 2.006, - & 2.015, 2.023, 2.031, 2.039, 2.047, 2.056, 2.064, 2.072, 2.080, - & 2.088, 2.096, 2.104, 2.112, 2.120, 2.128, 2.136, 2.144, 2.152, - & 2.160, 2.168, 2.176, 2.184, 2.192, 2.200, 2.207, 2.215, 2.223, - & 2.231, 2.239, 2.246, 2.254, 2.262, 2.270, 2.277, 2.285, 2.293, - & 2.300, 2.308, 2.316, 2.323, 2.331, 2.339, 2.346, 2.354, 2.361, - & 2.369, 2.376, 2.384, 2.391, 2.399, 2.406, 2.414, 2.421, 2.428, - & 2.436, 2.443, 2.451, 2.458, 2.465, 2.473, 2.480, 2.487, 2.494, - & 2.502, 2.509, 2.516, 2.523, 2.531, 2.538, 2.545, 2.552, 2.559, - & 2.566, 2.574, 2.581, 2.588, 2.595, 2.602, 2.609, 2.616, 2.623, - & 2.630, 2.637, 2.644, 2.651, 2.658, 2.665, 2.672, 2.679, 2.686, - & 2.693, 2.700, 2.707, 2.713, 2.720, 2.727, 2.734, 2.741, 2.748, - & 2.754, 2.761, 2.768, 2.775, 2.781, 2.788, 2.795, 2.802, 2.808, - & 2.815, 2.822, 2.828, 2.835, 2.842, 2.848, 2.855, 2.862, 2.868, - & 2.875, 2.881, 2.888, 2.894, 2.901, 2.907, 2.914, 2.920, 2.927, - & 2.933, 2.940, 2.946, 2.953, 2.959, 2.966, 2.972, 2.978, 2.985, - & 2.991, 2.998, 3.004, 3.010, 3.017, 3.023, 3.029, 3.036, 3.042, - & 3.048, 3.054, 3.061, 3.067, 3.134, 3.195, 3.254, 3.313, 3.371, - & 3.428, 3.485, 3.540, 3.595, 3.648, 3.701, 3.754, 3.805, 3.856, - & 3.906, 3.955, 4.004, 4.052, 4.100, 4.147, 4.193, 4.239, 4.284, - & 4.328, 4.372, 4.416, 4.459, 4.501, 4.543, 4.585, 4.626, 4.666, - & 4.707, 4.746, 4.786, 4.824, 4.863, 4.901, 4.938, 4.976, 5.013, - & 5.049, 5.085, 5.121, 5.156, 5.191, 5.226, 5.260, 5.294, 5.328, - & 5.361, 5.395, 5.427, 5.460, 5.492, 5.524, 5.555, 5.587, 5.618, - & 5.649, 5.679, 5.709, 5.739, 5.769, 5.799, 5.828, 5.857, 5.886, - & 5.914, 5.942, 5.971, 5.998, 6.026, 6.053, 6.081, 6.108, 6.134, - & 6.161, 6.187, 6.214, 6.240, 6.265, 6.291, 6.316, 6.342, 6.367, - & 6.392, 6.416, 6.441, 6.465, 6.489, 6.513, 6.537, 6.561, 6.584, - & 6.608, 6.631, 6.654, 6.677, 6.699, 6.722, 6.744, 6.767, 6.789, - & 6.811, 6.833, 6.854, 6.876, 6.897, 6.919, 6.940, 6.961, 6.982, - & 7.003, 7.023, 7.044, 7.064, 7.085, 7.105, 7.125, 7.145, 7.165, - & 7.184, 7.204, 7.223, 7.243, 7.262, 7.281, 7.300, 7.319, 7.338, - & 7.356, 7.375, 7.394, 7.412, 7.430, 7.448, 7.467, 7.485, 7.502, - & 7.520, 7.538, 7.556, 7.573, 7.591, 7.608, 7.625, 7.642, 7.659, - & 7.676, 7.693, 7.710, 7.727, 7.743, 7.760, 7.776, 7.793, 7.809, - & 7.825, 7.841, 7.858 - & / -C -C *** NH4HSO4 -C - DATA BNC09M/ - &-0.047,-0.099,-0.125,-0.142,-0.155,-0.166,-0.175,-0.182,-0.189, - &-0.195,-0.200,-0.204,-0.208,-0.212,-0.215,-0.218,-0.221,-0.223, - &-0.225,-0.227,-0.228,-0.230,-0.231,-0.232,-0.233,-0.234,-0.235, - &-0.235,-0.235,-0.236,-0.236,-0.236,-0.236,-0.235,-0.235,-0.235, - &-0.234,-0.233,-0.233,-0.232,-0.231,-0.230,-0.229,-0.228,-0.227, - &-0.226,-0.224,-0.223,-0.222,-0.220,-0.219,-0.217,-0.215,-0.214, - &-0.212,-0.210,-0.208,-0.207,-0.205,-0.203,-0.201,-0.199,-0.197, - &-0.195,-0.192,-0.190,-0.188,-0.186,-0.183,-0.181,-0.179,-0.176, - &-0.174,-0.171,-0.169,-0.166,-0.164,-0.161,-0.159,-0.156,-0.153, - &-0.151,-0.148,-0.145,-0.143,-0.140,-0.137,-0.134,-0.131,-0.128, - &-0.125,-0.122,-0.120,-0.117,-0.114,-0.110,-0.107,-0.104,-0.101, - &-0.098,-0.095,-0.092,-0.089,-0.085,-0.082,-0.079,-0.076,-0.073, - &-0.069,-0.066,-0.063,-0.060,-0.056,-0.053,-0.050,-0.046,-0.043, - &-0.040,-0.036,-0.033,-0.030,-0.026,-0.023,-0.020,-0.016,-0.013, - &-0.010,-0.006,-0.003, 0.000, 0.004, 0.007, 0.010, 0.014, 0.017, - & 0.020, 0.024, 0.027, 0.030, 0.034, 0.037, 0.040, 0.043, 0.047, - & 0.050, 0.053, 0.056, 0.060, 0.063, 0.066, 0.069, 0.073, 0.076, - & 0.079, 0.082, 0.086, 0.089, 0.092, 0.095, 0.098, 0.101, 0.105, - & 0.108, 0.111, 0.114, 0.117, 0.120, 0.123, 0.127, 0.130, 0.133, - & 0.136, 0.139, 0.142, 0.145, 0.148, 0.151, 0.154, 0.157, 0.160, - & 0.163, 0.166, 0.170, 0.173, 0.176, 0.179, 0.182, 0.184, 0.187, - & 0.190, 0.193, 0.196, 0.199, 0.202, 0.205, 0.208, 0.211, 0.214, - & 0.217, 0.220, 0.223, 0.226, 0.228, 0.231, 0.234, 0.237, 0.240, - & 0.243, 0.246, 0.248, 0.251, 0.254, 0.257, 0.260, 0.262, 0.265, - & 0.268, 0.271, 0.274, 0.276, 0.279, 0.282, 0.285, 0.287, 0.290, - & 0.293, 0.296, 0.298, 0.301, 0.304, 0.306, 0.309, 0.312, 0.315, - & 0.317, 0.320, 0.323, 0.325, 0.328, 0.330, 0.333, 0.336, 0.338, - & 0.341, 0.344, 0.346, 0.349, 0.351, 0.354, 0.357, 0.359, 0.362, - & 0.364, 0.367, 0.369, 0.372, 0.375, 0.377, 0.380, 0.382, 0.385, - & 0.387, 0.390, 0.392, 0.395, 0.397, 0.400, 0.402, 0.405, 0.407, - & 0.410, 0.412, 0.415, 0.417, 0.419, 0.422, 0.424, 0.427, 0.429, - & 0.432, 0.434, 0.437, 0.439, 0.441, 0.444, 0.446, 0.449, 0.451, - & 0.453, 0.456, 0.458, 0.460, 0.463, 0.465, 0.467, 0.470, 0.472, - & 0.474, 0.477, 0.479, 0.481, 0.484, 0.486, 0.488, 0.491, 0.493, - & 0.495, 0.498, 0.500, 0.502, 0.504, 0.507, 0.509, 0.511, 0.513, - & 0.516, 0.518, 0.520, 0.522, 0.525, 0.527, 0.529, 0.531, 0.534, - & 0.536, 0.538, 0.540, 0.542, 0.545, 0.547, 0.549, 0.551, 0.553, - & 0.556, 0.558, 0.560, 0.562, 0.564, 0.566, 0.569, 0.571, 0.573, - & 0.575, 0.577, 0.579, 0.581, 0.584, 0.586, 0.588, 0.590, 0.592, - & 0.594, 0.596, 0.598, 0.600, 0.602, 0.605, 0.607, 0.609, 0.611, - & 0.613, 0.615, 0.617, 0.619, 0.621, 0.623, 0.625, 0.627, 0.629, - & 0.631, 0.633, 0.635, 0.637, 0.639, 0.642, 0.644, 0.646, 0.648, - & 0.650, 0.652, 0.654, 0.656, 0.658, 0.660, 0.662, 0.663, 0.665, - & 0.667, 0.669, 0.671, 0.673, 0.675, 0.677, 0.679, 0.681, 0.683, - & 0.685, 0.687, 0.689, 0.691, 0.712, 0.730, 0.749, 0.767, 0.785, - & 0.803, 0.820, 0.837, 0.854, 0.871, 0.887, 0.903, 0.919, 0.935, - & 0.950, 0.965, 0.980, 0.995, 1.010, 1.024, 1.039, 1.053, 1.067, - & 1.080, 1.094, 1.107, 1.120, 1.133, 1.146, 1.159, 1.172, 1.184, - & 1.196, 1.209, 1.221, 1.232, 1.244, 1.256, 1.267, 1.279, 1.290, - & 1.301, 1.312, 1.323, 1.334, 1.344, 1.355, 1.365, 1.376, 1.386, - & 1.396, 1.406, 1.416, 1.426, 1.436, 1.445, 1.455, 1.464, 1.474, - & 1.483, 1.492, 1.501, 1.511, 1.519, 1.528, 1.537, 1.546, 1.555, - & 1.563, 1.572, 1.580, 1.588, 1.597, 1.605, 1.613, 1.621, 1.629, - & 1.637, 1.645, 1.653, 1.660, 1.668, 1.676, 1.683, 1.691, 1.698, - & 1.706, 1.713, 1.720, 1.727, 1.734, 1.742, 1.749, 1.756, 1.763, - & 1.769, 1.776, 1.783, 1.790, 1.796, 1.803, 1.810, 1.816, 1.823, - & 1.829, 1.835, 1.842, 1.848, 1.854, 1.861, 1.867, 1.873, 1.879, - & 1.885, 1.891, 1.897, 1.903, 1.909, 1.915, 1.920, 1.926, 1.932, - & 1.938, 1.943, 1.949, 1.954, 1.960, 1.965, 1.971, 1.976, 1.982, - & 1.987, 1.992, 1.998, 2.003, 2.008, 2.013, 2.018, 2.024, 2.029, - & 2.034, 2.039, 2.044, 2.049, 2.054, 2.059, 2.063, 2.068, 2.073, - & 2.078, 2.083, 2.087, 2.092, 2.097, 2.101, 2.106, 2.111, 2.115, - & 2.120, 2.124, 2.129 - & / -C -C *** (H,NO3) -C - DATA BNC10M/ - &-0.046,-0.096,-0.118,-0.132,-0.142,-0.150,-0.156,-0.161,-0.164, - &-0.167,-0.170,-0.171,-0.173,-0.174,-0.174,-0.175,-0.175,-0.175, - &-0.175,-0.174,-0.174,-0.173,-0.172,-0.171,-0.170,-0.169,-0.168, - &-0.167,-0.165,-0.164,-0.163,-0.161,-0.160,-0.158,-0.156,-0.155, - &-0.153,-0.151,-0.150,-0.148,-0.146,-0.144,-0.142,-0.141,-0.139, - &-0.137,-0.135,-0.133,-0.131,-0.129,-0.127,-0.125,-0.124,-0.122, - &-0.120,-0.118,-0.116,-0.114,-0.112,-0.110,-0.108,-0.106,-0.104, - &-0.102,-0.100,-0.098,-0.096,-0.094,-0.092,-0.090,-0.088,-0.086, - &-0.084,-0.082,-0.080,-0.078,-0.076,-0.074,-0.071,-0.069,-0.067, - &-0.065,-0.063,-0.061,-0.058,-0.056,-0.054,-0.052,-0.049,-0.047, - &-0.045,-0.043,-0.040,-0.038,-0.035,-0.033,-0.031,-0.028,-0.026, - &-0.023,-0.021,-0.019,-0.016,-0.014,-0.011,-0.009,-0.006,-0.004, - &-0.001, 0.001, 0.004, 0.007, 0.009, 0.012, 0.014, 0.017, 0.019, - & 0.022, 0.025, 0.027, 0.030, 0.032, 0.035, 0.038, 0.040, 0.043, - & 0.045, 0.048, 0.051, 0.053, 0.056, 0.058, 0.061, 0.064, 0.066, - & 0.069, 0.071, 0.074, 0.077, 0.079, 0.082, 0.084, 0.087, 0.090, - & 0.092, 0.095, 0.097, 0.100, 0.103, 0.105, 0.108, 0.110, 0.113, - & 0.115, 0.118, 0.121, 0.123, 0.126, 0.128, 0.131, 0.133, 0.136, - & 0.138, 0.141, 0.143, 0.146, 0.148, 0.151, 0.154, 0.156, 0.159, - & 0.161, 0.164, 0.166, 0.169, 0.171, 0.174, 0.176, 0.179, 0.181, - & 0.184, 0.186, 0.189, 0.191, 0.193, 0.196, 0.198, 0.201, 0.203, - & 0.206, 0.208, 0.211, 0.213, 0.216, 0.218, 0.220, 0.223, 0.225, - & 0.228, 0.230, 0.232, 0.235, 0.237, 0.240, 0.242, 0.245, 0.247, - & 0.249, 0.252, 0.254, 0.256, 0.259, 0.261, 0.264, 0.266, 0.268, - & 0.271, 0.273, 0.275, 0.278, 0.280, 0.282, 0.285, 0.287, 0.289, - & 0.292, 0.294, 0.296, 0.299, 0.301, 0.303, 0.306, 0.308, 0.310, - & 0.312, 0.315, 0.317, 0.319, 0.322, 0.324, 0.326, 0.328, 0.331, - & 0.333, 0.335, 0.337, 0.340, 0.342, 0.344, 0.346, 0.349, 0.351, - & 0.353, 0.355, 0.357, 0.360, 0.362, 0.364, 0.366, 0.369, 0.371, - & 0.373, 0.375, 0.377, 0.379, 0.382, 0.384, 0.386, 0.388, 0.390, - & 0.393, 0.395, 0.397, 0.399, 0.401, 0.403, 0.405, 0.408, 0.410, - & 0.412, 0.414, 0.416, 0.418, 0.420, 0.422, 0.425, 0.427, 0.429, - & 0.431, 0.433, 0.435, 0.437, 0.439, 0.441, 0.443, 0.445, 0.448, - & 0.450, 0.452, 0.454, 0.456, 0.458, 0.460, 0.462, 0.464, 0.466, - & 0.468, 0.470, 0.472, 0.474, 0.476, 0.478, 0.480, 0.482, 0.484, - & 0.486, 0.488, 0.490, 0.492, 0.494, 0.496, 0.498, 0.500, 0.502, - & 0.504, 0.506, 0.508, 0.510, 0.512, 0.514, 0.516, 0.518, 0.520, - & 0.522, 0.524, 0.526, 0.528, 0.530, 0.532, 0.534, 0.536, 0.537, - & 0.539, 0.541, 0.543, 0.545, 0.547, 0.549, 0.551, 0.553, 0.555, - & 0.557, 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, 0.570, 0.572, - & 0.574, 0.575, 0.577, 0.579, 0.581, 0.583, 0.585, 0.587, 0.588, - & 0.590, 0.592, 0.594, 0.596, 0.598, 0.599, 0.601, 0.603, 0.605, - & 0.607, 0.609, 0.610, 0.612, 0.614, 0.616, 0.618, 0.619, 0.621, - & 0.623, 0.625, 0.627, 0.628, 0.630, 0.632, 0.634, 0.635, 0.637, - & 0.639, 0.641, 0.643, 0.644, 0.663, 0.680, 0.697, 0.714, 0.730, - & 0.747, 0.763, 0.778, 0.794, 0.809, 0.824, 0.839, 0.854, 0.868, - & 0.883, 0.897, 0.911, 0.924, 0.938, 0.951, 0.965, 0.978, 0.990, - & 1.003, 1.016, 1.028, 1.040, 1.053, 1.065, 1.076, 1.088, 1.100, - & 1.111, 1.122, 1.133, 1.145, 1.155, 1.166, 1.177, 1.188, 1.198, - & 1.208, 1.219, 1.229, 1.239, 1.249, 1.258, 1.268, 1.278, 1.287, - & 1.297, 1.306, 1.315, 1.324, 1.333, 1.342, 1.351, 1.360, 1.369, - & 1.377, 1.386, 1.394, 1.403, 1.411, 1.419, 1.428, 1.436, 1.444, - & 1.452, 1.459, 1.467, 1.475, 1.483, 1.490, 1.498, 1.505, 1.513, - & 1.520, 1.527, 1.535, 1.542, 1.549, 1.556, 1.563, 1.570, 1.577, - & 1.584, 1.590, 1.597, 1.604, 1.610, 1.617, 1.623, 1.630, 1.636, - & 1.643, 1.649, 1.655, 1.661, 1.667, 1.674, 1.680, 1.686, 1.692, - & 1.698, 1.703, 1.709, 1.715, 1.721, 1.727, 1.732, 1.738, 1.744, - & 1.749, 1.755, 1.760, 1.766, 1.771, 1.776, 1.782, 1.787, 1.792, - & 1.797, 1.803, 1.808, 1.813, 1.818, 1.823, 1.828, 1.833, 1.838, - & 1.843, 1.848, 1.853, 1.857, 1.862, 1.867, 1.872, 1.876, 1.881, - & 1.886, 1.890, 1.895, 1.899, 1.904, 1.908, 1.913, 1.917, 1.922, - & 1.926, 1.930, 1.935, 1.939, 1.943, 1.948, 1.952, 1.956, 1.960, - & 1.964, 1.968, 1.973 - & / -C -C *** (H,Cl) -C - DATA BNC11M/ - &-0.045,-0.090,-0.108,-0.119,-0.126,-0.130,-0.133,-0.135,-0.135, - &-0.135,-0.134,-0.133,-0.131,-0.129,-0.126,-0.124,-0.121,-0.117, - &-0.114,-0.110,-0.106,-0.102,-0.098,-0.093,-0.089,-0.084,-0.079, - &-0.075,-0.070,-0.065,-0.059,-0.054,-0.049,-0.044,-0.038,-0.033, - &-0.027,-0.022,-0.016,-0.010,-0.004, 0.001, 0.007, 0.013, 0.019, - & 0.025, 0.031, 0.037, 0.043, 0.049, 0.055, 0.061, 0.067, 0.073, - & 0.079, 0.085, 0.091, 0.098, 0.104, 0.110, 0.116, 0.122, 0.129, - & 0.135, 0.141, 0.147, 0.154, 0.160, 0.166, 0.173, 0.179, 0.185, - & 0.192, 0.198, 0.205, 0.211, 0.218, 0.224, 0.231, 0.238, 0.244, - & 0.251, 0.258, 0.264, 0.271, 0.278, 0.285, 0.292, 0.298, 0.305, - & 0.312, 0.319, 0.326, 0.333, 0.341, 0.348, 0.355, 0.362, 0.369, - & 0.377, 0.384, 0.391, 0.398, 0.406, 0.413, 0.421, 0.428, 0.435, - & 0.443, 0.450, 0.458, 0.465, 0.473, 0.480, 0.488, 0.495, 0.503, - & 0.510, 0.518, 0.526, 0.533, 0.541, 0.548, 0.556, 0.563, 0.571, - & 0.578, 0.586, 0.594, 0.601, 0.609, 0.616, 0.624, 0.631, 0.639, - & 0.646, 0.654, 0.661, 0.669, 0.676, 0.684, 0.691, 0.699, 0.706, - & 0.713, 0.721, 0.728, 0.736, 0.743, 0.750, 0.758, 0.765, 0.772, - & 0.780, 0.787, 0.794, 0.802, 0.809, 0.816, 0.823, 0.831, 0.838, - & 0.845, 0.852, 0.859, 0.867, 0.874, 0.881, 0.888, 0.895, 0.902, - & 0.909, 0.916, 0.924, 0.931, 0.938, 0.945, 0.952, 0.959, 0.966, - & 0.973, 0.980, 0.987, 0.994, 1.000, 1.007, 1.014, 1.021, 1.028, - & 1.035, 1.042, 1.049, 1.055, 1.062, 1.069, 1.076, 1.082, 1.089, - & 1.096, 1.103, 1.109, 1.116, 1.123, 1.129, 1.136, 1.143, 1.149, - & 1.156, 1.163, 1.169, 1.176, 1.182, 1.189, 1.195, 1.202, 1.208, - & 1.215, 1.221, 1.228, 1.234, 1.241, 1.247, 1.254, 1.260, 1.266, - & 1.273, 1.279, 1.286, 1.292, 1.298, 1.305, 1.311, 1.317, 1.323, - & 1.330, 1.336, 1.342, 1.348, 1.355, 1.361, 1.367, 1.373, 1.379, - & 1.386, 1.392, 1.398, 1.404, 1.410, 1.416, 1.422, 1.428, 1.434, - & 1.440, 1.446, 1.452, 1.458, 1.464, 1.470, 1.476, 1.482, 1.488, - & 1.494, 1.500, 1.506, 1.512, 1.518, 1.524, 1.530, 1.535, 1.541, - & 1.547, 1.553, 1.559, 1.564, 1.570, 1.576, 1.582, 1.588, 1.593, - & 1.599, 1.605, 1.610, 1.616, 1.622, 1.628, 1.633, 1.639, 1.644, - & 1.650, 1.656, 1.661, 1.667, 1.672, 1.678, 1.684, 1.689, 1.695, - & 1.700, 1.706, 1.711, 1.717, 1.722, 1.728, 1.733, 1.739, 1.744, - & 1.750, 1.755, 1.760, 1.766, 1.771, 1.777, 1.782, 1.787, 1.793, - & 1.798, 1.803, 1.809, 1.814, 1.819, 1.825, 1.830, 1.835, 1.840, - & 1.846, 1.851, 1.856, 1.861, 1.867, 1.872, 1.877, 1.882, 1.887, - & 1.893, 1.898, 1.903, 1.908, 1.913, 1.918, 1.923, 1.929, 1.934, - & 1.939, 1.944, 1.949, 1.954, 1.959, 1.964, 1.969, 1.974, 1.979, - & 1.984, 1.989, 1.994, 1.999, 2.004, 2.009, 2.014, 2.019, 2.024, - & 2.029, 2.034, 2.039, 2.044, 2.048, 2.053, 2.058, 2.063, 2.068, - & 2.073, 2.078, 2.082, 2.087, 2.092, 2.097, 2.102, 2.107, 2.111, - & 2.116, 2.121, 2.126, 2.130, 2.135, 2.140, 2.145, 2.149, 2.154, - & 2.159, 2.163, 2.168, 2.173, 2.177, 2.182, 2.187, 2.191, 2.196, - & 2.201, 2.205, 2.210, 2.215, 2.264, 2.309, 2.353, 2.396, 2.439, - & 2.481, 2.523, 2.564, 2.604, 2.643, 2.683, 2.721, 2.759, 2.797, - & 2.834, 2.870, 2.906, 2.941, 2.976, 3.011, 3.045, 3.079, 3.112, - & 3.145, 3.177, 3.210, 3.241, 3.273, 3.304, 3.334, 3.364, 3.394, - & 3.424, 3.453, 3.482, 3.511, 3.539, 3.567, 3.595, 3.622, 3.649, - & 3.676, 3.702, 3.729, 3.755, 3.781, 3.806, 3.831, 3.856, 3.881, - & 3.906, 3.930, 3.954, 3.978, 4.002, 4.025, 4.048, 4.071, 4.094, - & 4.117, 4.139, 4.161, 4.183, 4.205, 4.227, 4.248, 4.270, 4.291, - & 4.312, 4.332, 4.353, 4.373, 4.394, 4.414, 4.434, 4.453, 4.473, - & 4.493, 4.512, 4.531, 4.550, 4.569, 4.588, 4.606, 4.625, 4.643, - & 4.661, 4.679, 4.697, 4.715, 4.733, 4.750, 4.768, 4.785, 4.802, - & 4.819, 4.836, 4.853, 4.870, 4.886, 4.903, 4.919, 4.936, 4.952, - & 4.968, 4.984, 5.000, 5.015, 5.031, 5.046, 5.062, 5.077, 5.093, - & 5.108, 5.123, 5.138, 5.153, 5.167, 5.182, 5.197, 5.211, 5.226, - & 5.240, 5.254, 5.268, 5.282, 5.296, 5.310, 5.324, 5.338, 5.352, - & 5.365, 5.379, 5.392, 5.406, 5.419, 5.432, 5.445, 5.458, 5.471, - & 5.484, 5.497, 5.510, 5.523, 5.535, 5.548, 5.560, 5.573, 5.585, - & 5.598, 5.610, 5.622, 5.634, 5.646, 5.658, 5.670, 5.682, 5.694, - & 5.706, 5.717, 5.729 - & / -C -C *** NaHSO4 -C - DATA BNC12M/ - &-0.046,-0.096,-0.118,-0.132,-0.143,-0.151,-0.158,-0.163,-0.167, - &-0.170,-0.173,-0.175,-0.177,-0.178,-0.179,-0.180,-0.180,-0.180, - &-0.180,-0.180,-0.179,-0.179,-0.178,-0.177,-0.176,-0.174,-0.173, - &-0.171,-0.170,-0.168,-0.166,-0.164,-0.162,-0.159,-0.157,-0.155, - &-0.152,-0.150,-0.147,-0.144,-0.142,-0.139,-0.136,-0.133,-0.130, - &-0.127,-0.124,-0.120,-0.117,-0.114,-0.110,-0.107,-0.104,-0.100, - &-0.097,-0.093,-0.090,-0.086,-0.082,-0.079,-0.075,-0.071,-0.067, - &-0.064,-0.060,-0.056,-0.052,-0.048,-0.044,-0.040,-0.036,-0.032, - &-0.028,-0.024,-0.020,-0.015,-0.011,-0.007,-0.003, 0.002, 0.006, - & 0.010, 0.015, 0.019, 0.024, 0.028, 0.033, 0.037, 0.042, 0.046, - & 0.051, 0.056, 0.060, 0.065, 0.070, 0.075, 0.079, 0.084, 0.089, - & 0.094, 0.099, 0.104, 0.109, 0.114, 0.119, 0.124, 0.129, 0.134, - & 0.139, 0.144, 0.149, 0.154, 0.159, 0.164, 0.169, 0.174, 0.179, - & 0.184, 0.189, 0.195, 0.200, 0.205, 0.210, 0.215, 0.220, 0.225, - & 0.230, 0.236, 0.241, 0.246, 0.251, 0.256, 0.261, 0.266, 0.271, - & 0.276, 0.281, 0.286, 0.291, 0.297, 0.302, 0.307, 0.312, 0.317, - & 0.322, 0.327, 0.332, 0.337, 0.342, 0.347, 0.352, 0.357, 0.361, - & 0.366, 0.371, 0.376, 0.381, 0.386, 0.391, 0.396, 0.401, 0.406, - & 0.410, 0.415, 0.420, 0.425, 0.430, 0.434, 0.439, 0.444, 0.449, - & 0.454, 0.458, 0.463, 0.468, 0.473, 0.477, 0.482, 0.487, 0.491, - & 0.496, 0.501, 0.505, 0.510, 0.515, 0.519, 0.524, 0.529, 0.533, - & 0.538, 0.542, 0.547, 0.551, 0.556, 0.560, 0.565, 0.570, 0.574, - & 0.579, 0.583, 0.588, 0.592, 0.596, 0.601, 0.605, 0.610, 0.614, - & 0.619, 0.623, 0.627, 0.632, 0.636, 0.641, 0.645, 0.649, 0.654, - & 0.658, 0.662, 0.667, 0.671, 0.675, 0.680, 0.684, 0.688, 0.692, - & 0.697, 0.701, 0.705, 0.709, 0.714, 0.718, 0.722, 0.726, 0.730, - & 0.735, 0.739, 0.743, 0.747, 0.751, 0.755, 0.759, 0.764, 0.768, - & 0.772, 0.776, 0.780, 0.784, 0.788, 0.792, 0.796, 0.800, 0.804, - & 0.808, 0.812, 0.816, 0.820, 0.824, 0.828, 0.832, 0.836, 0.840, - & 0.844, 0.848, 0.852, 0.856, 0.860, 0.864, 0.868, 0.872, 0.875, - & 0.879, 0.883, 0.887, 0.891, 0.895, 0.899, 0.902, 0.906, 0.910, - & 0.914, 0.918, 0.922, 0.925, 0.929, 0.933, 0.937, 0.940, 0.944, - & 0.948, 0.952, 0.955, 0.959, 0.963, 0.967, 0.970, 0.974, 0.978, - & 0.981, 0.985, 0.989, 0.992, 0.996, 1.000, 1.003, 1.007, 1.011, - & 1.014, 1.018, 1.022, 1.025, 1.029, 1.032, 1.036, 1.040, 1.043, - & 1.047, 1.050, 1.054, 1.057, 1.061, 1.064, 1.068, 1.071, 1.075, - & 1.079, 1.082, 1.086, 1.089, 1.092, 1.096, 1.099, 1.103, 1.106, - & 1.110, 1.113, 1.117, 1.120, 1.124, 1.127, 1.130, 1.134, 1.137, - & 1.141, 1.144, 1.147, 1.151, 1.154, 1.158, 1.161, 1.164, 1.168, - & 1.171, 1.174, 1.178, 1.181, 1.184, 1.188, 1.191, 1.194, 1.198, - & 1.201, 1.204, 1.207, 1.211, 1.214, 1.217, 1.220, 1.224, 1.227, - & 1.230, 1.233, 1.237, 1.240, 1.243, 1.246, 1.250, 1.253, 1.256, - & 1.259, 1.262, 1.266, 1.269, 1.272, 1.275, 1.278, 1.281, 1.285, - & 1.288, 1.291, 1.294, 1.297, 1.300, 1.303, 1.306, 1.310, 1.313, - & 1.316, 1.319, 1.322, 1.325, 1.358, 1.388, 1.418, 1.447, 1.476, - & 1.504, 1.532, 1.559, 1.586, 1.613, 1.639, 1.665, 1.691, 1.716, - & 1.741, 1.766, 1.790, 1.814, 1.838, 1.861, 1.884, 1.907, 1.929, - & 1.951, 1.973, 1.995, 2.016, 2.037, 2.058, 2.079, 2.099, 2.120, - & 2.140, 2.159, 2.179, 2.198, 2.217, 2.236, 2.255, 2.274, 2.292, - & 2.310, 2.328, 2.346, 2.363, 2.381, 2.398, 2.415, 2.432, 2.449, - & 2.465, 2.482, 2.498, 2.514, 2.530, 2.546, 2.562, 2.577, 2.592, - & 2.608, 2.623, 2.638, 2.653, 2.667, 2.682, 2.697, 2.711, 2.725, - & 2.739, 2.753, 2.767, 2.781, 2.795, 2.808, 2.822, 2.835, 2.848, - & 2.861, 2.874, 2.887, 2.900, 2.913, 2.925, 2.938, 2.950, 2.963, - & 2.975, 2.987, 2.999, 3.011, 3.023, 3.035, 3.046, 3.058, 3.069, - & 3.081, 3.092, 3.104, 3.115, 3.126, 3.137, 3.148, 3.159, 3.170, - & 3.180, 3.191, 3.202, 3.212, 3.223, 3.233, 3.244, 3.254, 3.264, - & 3.274, 3.284, 3.294, 3.304, 3.314, 3.324, 3.334, 3.343, 3.353, - & 3.363, 3.372, 3.382, 3.391, 3.400, 3.410, 3.419, 3.428, 3.437, - & 3.446, 3.455, 3.464, 3.473, 3.482, 3.491, 3.499, 3.508, 3.517, - & 3.525, 3.534, 3.542, 3.551, 3.559, 3.568, 3.576, 3.584, 3.592, - & 3.601, 3.609, 3.617, 3.625, 3.633, 3.641, 3.649, 3.657, 3.664, - & 3.672, 3.680, 3.688 - & / -C -C *** (NH4)3H(SO4)2 -C - DATA BNC13M/ - &-0.076,-0.165,-0.209,-0.240,-0.264,-0.284,-0.301,-0.316,-0.329, - &-0.341,-0.352,-0.362,-0.371,-0.379,-0.387,-0.394,-0.401,-0.408, - &-0.414,-0.420,-0.425,-0.430,-0.435,-0.440,-0.444,-0.449,-0.453, - &-0.457,-0.460,-0.464,-0.467,-0.471,-0.474,-0.477,-0.480,-0.483, - &-0.485,-0.488,-0.490,-0.493,-0.495,-0.497,-0.499,-0.501,-0.503, - &-0.505,-0.507,-0.509,-0.510,-0.512,-0.514,-0.515,-0.516,-0.518, - &-0.519,-0.520,-0.522,-0.523,-0.524,-0.525,-0.526,-0.527,-0.528, - &-0.529,-0.530,-0.531,-0.532,-0.532,-0.533,-0.534,-0.534,-0.535, - &-0.536,-0.536,-0.537,-0.537,-0.538,-0.538,-0.539,-0.539,-0.540, - &-0.540,-0.540,-0.541,-0.541,-0.541,-0.542,-0.542,-0.542,-0.542, - &-0.542,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543, - &-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543, - &-0.543,-0.542,-0.542,-0.542,-0.542,-0.542,-0.542,-0.542,-0.541, - &-0.541,-0.541,-0.541,-0.540,-0.540,-0.540,-0.540,-0.540,-0.539, - &-0.539,-0.539,-0.538,-0.538,-0.538,-0.538,-0.537,-0.537,-0.537, - &-0.536,-0.536,-0.536,-0.536,-0.535,-0.535,-0.535,-0.534,-0.534, - &-0.534,-0.533,-0.533,-0.533,-0.532,-0.532,-0.532,-0.531,-0.531, - &-0.530,-0.530,-0.530,-0.529,-0.529,-0.529,-0.528,-0.528,-0.528, - &-0.527,-0.527,-0.527,-0.526,-0.526,-0.525,-0.525,-0.525,-0.524, - &-0.524,-0.524,-0.523,-0.523,-0.522,-0.522,-0.522,-0.521,-0.521, - &-0.521,-0.520,-0.520,-0.519,-0.519,-0.519,-0.518,-0.518,-0.518, - &-0.517,-0.517,-0.516,-0.516,-0.516,-0.515,-0.515,-0.515,-0.514, - &-0.514,-0.513,-0.513,-0.513,-0.512,-0.512,-0.512,-0.511,-0.511, - &-0.510,-0.510,-0.510,-0.509,-0.509,-0.509,-0.508,-0.508,-0.507, - &-0.507,-0.507,-0.506,-0.506,-0.506,-0.505,-0.505,-0.504,-0.504, - &-0.504,-0.503,-0.503,-0.503,-0.502,-0.502,-0.501,-0.501,-0.501, - &-0.500,-0.500,-0.500,-0.499,-0.499,-0.499,-0.498,-0.498,-0.497, - &-0.497,-0.497,-0.496,-0.496,-0.496,-0.495,-0.495,-0.495,-0.494, - &-0.494,-0.493,-0.493,-0.493,-0.492,-0.492,-0.492,-0.491,-0.491, - &-0.491,-0.490,-0.490,-0.490,-0.489,-0.489,-0.489,-0.488,-0.488, - &-0.487,-0.487,-0.487,-0.486,-0.486,-0.486,-0.485,-0.485,-0.485, - &-0.484,-0.484,-0.484,-0.483,-0.483,-0.483,-0.482,-0.482,-0.482, - &-0.481,-0.481,-0.481,-0.480,-0.480,-0.480,-0.479,-0.479,-0.479, - &-0.478,-0.478,-0.478,-0.477,-0.477,-0.477,-0.476,-0.476,-0.476, - &-0.475,-0.475,-0.475,-0.474,-0.474,-0.474,-0.473,-0.473,-0.473, - &-0.472,-0.472,-0.472,-0.471,-0.471,-0.471,-0.471,-0.470,-0.470, - &-0.470,-0.469,-0.469,-0.469,-0.468,-0.468,-0.468,-0.467,-0.467, - &-0.467,-0.466,-0.466,-0.466,-0.466,-0.465,-0.465,-0.465,-0.464, - &-0.464,-0.464,-0.463,-0.463,-0.463,-0.463,-0.462,-0.462,-0.462, - &-0.461,-0.461,-0.461,-0.460,-0.460,-0.460,-0.460,-0.459,-0.459, - &-0.459,-0.458,-0.458,-0.458,-0.458,-0.457,-0.457,-0.457,-0.456, - &-0.456,-0.456,-0.456,-0.455,-0.455,-0.455,-0.454,-0.454,-0.454, - &-0.454,-0.453,-0.453,-0.453,-0.452,-0.452,-0.452,-0.452,-0.451, - &-0.451,-0.451,-0.450,-0.450,-0.450,-0.450,-0.449,-0.449,-0.449, - &-0.449,-0.448,-0.448,-0.448,-0.445,-0.442,-0.440,-0.437,-0.435, - &-0.432,-0.430,-0.428,-0.426,-0.423,-0.421,-0.419,-0.417,-0.415, - &-0.413,-0.411,-0.409,-0.407,-0.406,-0.404,-0.402,-0.401,-0.399, - &-0.397,-0.396,-0.394,-0.393,-0.391,-0.390,-0.389,-0.387,-0.386, - &-0.385,-0.383,-0.382,-0.381,-0.380,-0.379,-0.378,-0.377,-0.376, - &-0.375,-0.374,-0.373,-0.372,-0.371,-0.370,-0.369,-0.368,-0.367, - &-0.367,-0.366,-0.365,-0.364,-0.364,-0.363,-0.362,-0.362,-0.361, - &-0.361,-0.360,-0.360,-0.359,-0.359,-0.358,-0.358,-0.357,-0.357, - &-0.356,-0.356,-0.356,-0.355,-0.355,-0.355,-0.354,-0.354,-0.354, - &-0.354,-0.353,-0.353,-0.353,-0.353,-0.353,-0.352,-0.352,-0.352, - &-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352, - &-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352, - &-0.352,-0.353,-0.353,-0.353,-0.353,-0.353,-0.353,-0.354,-0.354, - &-0.354,-0.354,-0.355,-0.355,-0.355,-0.355,-0.356,-0.356,-0.356, - &-0.357,-0.357,-0.357,-0.358,-0.358,-0.358,-0.359,-0.359,-0.359, - &-0.360,-0.360,-0.361,-0.361,-0.362,-0.362,-0.362,-0.363,-0.363, - &-0.364,-0.364,-0.365,-0.365,-0.366,-0.366,-0.367,-0.367,-0.368, - &-0.369,-0.369,-0.370,-0.370,-0.371,-0.371,-0.372,-0.373,-0.373, - &-0.374,-0.374,-0.375 - & / -C -C *** CASO4 -C - DATA BNC14M/ - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000 - & / -C -C *** CANO32 -C - DATA BNC15M/ - &-0.094,-0.201,-0.251,-0.286,-0.312,-0.334,-0.351,-0.366,-0.379, - &-0.390,-0.400,-0.409,-0.417,-0.424,-0.430,-0.436,-0.442,-0.447, - &-0.451,-0.455,-0.459,-0.463,-0.466,-0.469,-0.472,-0.475,-0.477, - &-0.479,-0.481,-0.483,-0.485,-0.487,-0.489,-0.490,-0.491,-0.493, - &-0.494,-0.495,-0.496,-0.497,-0.498,-0.499,-0.500,-0.501,-0.501, - &-0.502,-0.503,-0.503,-0.504,-0.504,-0.505,-0.505,-0.505,-0.506, - &-0.506,-0.506,-0.507,-0.507,-0.507,-0.507,-0.507,-0.508,-0.508, - &-0.508,-0.508,-0.508,-0.508,-0.508,-0.508,-0.508,-0.508,-0.508, - &-0.508,-0.507,-0.507,-0.507,-0.507,-0.507,-0.506,-0.506,-0.506, - &-0.506,-0.505,-0.505,-0.505,-0.504,-0.504,-0.503,-0.503,-0.502, - &-0.502,-0.501,-0.501,-0.500,-0.500,-0.499,-0.499,-0.498,-0.497, - &-0.497,-0.496,-0.495,-0.495,-0.494,-0.493,-0.493,-0.492,-0.491, - &-0.490,-0.489,-0.489,-0.488,-0.487,-0.486,-0.485,-0.485,-0.484, - &-0.483,-0.482,-0.481,-0.480,-0.479,-0.478,-0.477,-0.477,-0.476, - &-0.475,-0.474,-0.473,-0.472,-0.471,-0.470,-0.469,-0.468,-0.467, - &-0.466,-0.465,-0.464,-0.463,-0.462,-0.461,-0.460,-0.459,-0.459, - &-0.458,-0.457,-0.456,-0.455,-0.454,-0.453,-0.452,-0.451,-0.450, - &-0.449,-0.448,-0.447,-0.446,-0.445,-0.444,-0.443,-0.442,-0.441, - &-0.440,-0.439,-0.438,-0.437,-0.436,-0.435,-0.434,-0.433,-0.432, - &-0.431,-0.430,-0.429,-0.428,-0.427,-0.426,-0.425,-0.424,-0.423, - &-0.422,-0.421,-0.420,-0.419,-0.418,-0.417,-0.416,-0.415,-0.414, - &-0.413,-0.412,-0.411,-0.410,-0.409,-0.408,-0.407,-0.406,-0.405, - &-0.404,-0.403,-0.402,-0.401,-0.400,-0.399,-0.398,-0.397,-0.396, - &-0.395,-0.394,-0.393,-0.392,-0.391,-0.390,-0.389,-0.388,-0.387, - &-0.386,-0.385,-0.384,-0.383,-0.382,-0.382,-0.381,-0.380,-0.379, - &-0.378,-0.377,-0.376,-0.375,-0.374,-0.373,-0.372,-0.371,-0.370, - &-0.369,-0.368,-0.367,-0.366,-0.365,-0.364,-0.363,-0.362,-0.361, - &-0.360,-0.359,-0.359,-0.358,-0.357,-0.356,-0.355,-0.354,-0.353, - &-0.352,-0.351,-0.350,-0.349,-0.348,-0.347,-0.346,-0.345,-0.344, - &-0.344,-0.343,-0.342,-0.341,-0.340,-0.339,-0.338,-0.337,-0.336, - &-0.335,-0.334,-0.333,-0.332,-0.332,-0.331,-0.330,-0.329,-0.328, - &-0.327,-0.326,-0.325,-0.324,-0.323,-0.323,-0.322,-0.321,-0.320, - &-0.319,-0.318,-0.317,-0.316,-0.315,-0.314,-0.314,-0.313,-0.312, - &-0.311,-0.310,-0.309,-0.308,-0.307,-0.307,-0.306,-0.305,-0.304, - &-0.303,-0.302,-0.301,-0.300,-0.300,-0.299,-0.298,-0.297,-0.296, - &-0.295,-0.294,-0.294,-0.293,-0.292,-0.291,-0.290,-0.289,-0.288, - &-0.288,-0.287,-0.286,-0.285,-0.284,-0.283,-0.282,-0.282,-0.281, - &-0.280,-0.279,-0.278,-0.277,-0.277,-0.276,-0.275,-0.274,-0.273, - &-0.273,-0.272,-0.271,-0.270,-0.269,-0.268,-0.268,-0.267,-0.266, - &-0.265,-0.264,-0.263,-0.263,-0.262,-0.261,-0.260,-0.259,-0.259, - &-0.258,-0.257,-0.256,-0.255,-0.255,-0.254,-0.253,-0.252,-0.251, - &-0.251,-0.250,-0.249,-0.248,-0.248,-0.247,-0.246,-0.245,-0.244, - &-0.244,-0.243,-0.242,-0.241,-0.240,-0.240,-0.239,-0.238,-0.237, - &-0.237,-0.236,-0.235,-0.234,-0.234,-0.233,-0.232,-0.231,-0.230, - &-0.230,-0.229,-0.228,-0.227,-0.219,-0.212,-0.205,-0.198,-0.191, - &-0.184,-0.177,-0.170,-0.163,-0.157,-0.151,-0.144,-0.138,-0.132, - &-0.126,-0.120,-0.114,-0.108,-0.103,-0.097,-0.091,-0.086,-0.081, - &-0.075,-0.070,-0.065,-0.060,-0.055,-0.050,-0.045,-0.041,-0.036, - &-0.031,-0.027,-0.022,-0.018,-0.014,-0.009,-0.005,-0.001, 0.003, - & 0.007, 0.011, 0.015, 0.019, 0.023, 0.027, 0.031, 0.034, 0.038, - & 0.041, 0.045, 0.048, 0.052, 0.055, 0.059, 0.062, 0.065, 0.068, - & 0.071, 0.075, 0.078, 0.081, 0.084, 0.087, 0.089, 0.092, 0.095, - & 0.098, 0.101, 0.103, 0.106, 0.109, 0.111, 0.114, 0.116, 0.119, - & 0.121, 0.124, 0.126, 0.128, 0.131, 0.133, 0.135, 0.138, 0.140, - & 0.142, 0.144, 0.146, 0.148, 0.150, 0.152, 0.154, 0.156, 0.158, - & 0.160, 0.162, 0.164, 0.166, 0.167, 0.169, 0.171, 0.173, 0.174, - & 0.176, 0.178, 0.179, 0.181, 0.182, 0.184, 0.186, 0.187, 0.189, - & 0.190, 0.191, 0.193, 0.194, 0.196, 0.197, 0.198, 0.200, 0.201, - & 0.202, 0.203, 0.205, 0.206, 0.207, 0.208, 0.209, 0.210, 0.212, - & 0.213, 0.214, 0.215, 0.216, 0.217, 0.218, 0.219, 0.220, 0.221, - & 0.222, 0.222, 0.223, 0.224, 0.225, 0.226, 0.227, 0.228, 0.228, - & 0.229, 0.230, 0.231, 0.231, 0.232, 0.233, 0.234, 0.234, 0.235, - & 0.235, 0.236, 0.237 - & / -C -C *** CACL2 -C - DATA BNC16M/ - &-0.093,-0.193,-0.238,-0.267,-0.288,-0.304,-0.316,-0.326,-0.334, - &-0.340,-0.345,-0.350,-0.353,-0.355,-0.357,-0.359,-0.360,-0.360, - &-0.360,-0.360,-0.359,-0.358,-0.357,-0.356,-0.355,-0.353,-0.351, - &-0.349,-0.347,-0.345,-0.342,-0.340,-0.337,-0.335,-0.332,-0.329, - &-0.326,-0.323,-0.321,-0.317,-0.314,-0.311,-0.308,-0.305,-0.302, - &-0.299,-0.295,-0.292,-0.289,-0.286,-0.282,-0.279,-0.276,-0.272, - &-0.269,-0.266,-0.262,-0.259,-0.255,-0.252,-0.249,-0.245,-0.242, - &-0.238,-0.235,-0.231,-0.228,-0.224,-0.221,-0.217,-0.213,-0.210, - &-0.206,-0.203,-0.199,-0.195,-0.192,-0.188,-0.184,-0.180,-0.177, - &-0.173,-0.169,-0.165,-0.161,-0.157,-0.153,-0.149,-0.145,-0.141, - &-0.137,-0.133,-0.129,-0.125,-0.120,-0.116,-0.112,-0.108,-0.103, - &-0.099,-0.095,-0.090,-0.086,-0.081,-0.077,-0.073,-0.068,-0.064, - &-0.059,-0.054,-0.050,-0.045,-0.041,-0.036,-0.032,-0.027,-0.022, - &-0.018,-0.013,-0.008,-0.004, 0.001, 0.005, 0.010, 0.015, 0.019, - & 0.024, 0.029, 0.033, 0.038, 0.043, 0.048, 0.052, 0.057, 0.062, - & 0.066, 0.071, 0.076, 0.080, 0.085, 0.090, 0.094, 0.099, 0.103, - & 0.108, 0.113, 0.117, 0.122, 0.127, 0.131, 0.136, 0.141, 0.145, - & 0.150, 0.154, 0.159, 0.164, 0.168, 0.173, 0.177, 0.182, 0.186, - & 0.191, 0.196, 0.200, 0.205, 0.209, 0.214, 0.218, 0.223, 0.227, - & 0.232, 0.236, 0.241, 0.245, 0.250, 0.254, 0.259, 0.263, 0.268, - & 0.272, 0.277, 0.281, 0.286, 0.290, 0.294, 0.299, 0.303, 0.308, - & 0.312, 0.317, 0.321, 0.325, 0.330, 0.334, 0.338, 0.343, 0.347, - & 0.352, 0.356, 0.360, 0.365, 0.369, 0.373, 0.378, 0.382, 0.386, - & 0.390, 0.395, 0.399, 0.403, 0.408, 0.412, 0.416, 0.420, 0.425, - & 0.429, 0.433, 0.437, 0.442, 0.446, 0.450, 0.454, 0.458, 0.463, - & 0.467, 0.471, 0.475, 0.479, 0.483, 0.488, 0.492, 0.496, 0.500, - & 0.504, 0.508, 0.512, 0.516, 0.521, 0.525, 0.529, 0.533, 0.537, - & 0.541, 0.545, 0.549, 0.553, 0.557, 0.561, 0.565, 0.569, 0.573, - & 0.577, 0.581, 0.585, 0.589, 0.593, 0.597, 0.601, 0.605, 0.609, - & 0.613, 0.617, 0.621, 0.625, 0.629, 0.633, 0.637, 0.641, 0.644, - & 0.648, 0.652, 0.656, 0.660, 0.664, 0.668, 0.672, 0.675, 0.679, - & 0.683, 0.687, 0.691, 0.695, 0.698, 0.702, 0.706, 0.710, 0.714, - & 0.717, 0.721, 0.725, 0.729, 0.733, 0.736, 0.740, 0.744, 0.748, - & 0.751, 0.755, 0.759, 0.762, 0.766, 0.770, 0.774, 0.777, 0.781, - & 0.785, 0.788, 0.792, 0.796, 0.799, 0.803, 0.807, 0.810, 0.814, - & 0.818, 0.821, 0.825, 0.828, 0.832, 0.836, 0.839, 0.843, 0.846, - & 0.850, 0.853, 0.857, 0.861, 0.864, 0.868, 0.871, 0.875, 0.878, - & 0.882, 0.885, 0.889, 0.892, 0.896, 0.899, 0.903, 0.906, 0.910, - & 0.913, 0.917, 0.920, 0.924, 0.927, 0.931, 0.934, 0.938, 0.941, - & 0.944, 0.948, 0.951, 0.955, 0.958, 0.961, 0.965, 0.968, 0.972, - & 0.975, 0.978, 0.982, 0.985, 0.988, 0.992, 0.995, 0.999, 1.002, - & 1.005, 1.009, 1.012, 1.015, 1.018, 1.022, 1.025, 1.028, 1.032, - & 1.035, 1.038, 1.042, 1.045, 1.048, 1.051, 1.055, 1.058, 1.061, - & 1.064, 1.068, 1.071, 1.074, 1.077, 1.080, 1.084, 1.087, 1.090, - & 1.093, 1.096, 1.100, 1.103, 1.137, 1.168, 1.199, 1.229, 1.259, - & 1.288, 1.317, 1.345, 1.373, 1.401, 1.428, 1.455, 1.482, 1.508, - & 1.534, 1.559, 1.584, 1.609, 1.634, 1.658, 1.682, 1.706, 1.729, - & 1.752, 1.775, 1.797, 1.819, 1.841, 1.863, 1.884, 1.905, 1.926, - & 1.947, 1.967, 1.988, 2.008, 2.027, 2.047, 2.066, 2.085, 2.104, - & 2.123, 2.141, 2.160, 2.178, 2.196, 2.214, 2.231, 2.249, 2.266, - & 2.283, 2.300, 2.316, 2.333, 2.349, 2.365, 2.381, 2.397, 2.413, - & 2.429, 2.444, 2.459, 2.475, 2.490, 2.504, 2.519, 2.534, 2.548, - & 2.563, 2.577, 2.591, 2.605, 2.619, 2.632, 2.646, 2.659, 2.673, - & 2.686, 2.699, 2.712, 2.725, 2.738, 2.751, 2.763, 2.776, 2.788, - & 2.800, 2.813, 2.825, 2.837, 2.849, 2.860, 2.872, 2.884, 2.895, - & 2.907, 2.918, 2.929, 2.940, 2.952, 2.963, 2.973, 2.984, 2.995, - & 3.006, 3.016, 3.027, 3.037, 3.048, 3.058, 3.068, 3.078, 3.088, - & 3.098, 3.108, 3.118, 3.128, 3.137, 3.147, 3.157, 3.166, 3.176, - & 3.185, 3.194, 3.203, 3.213, 3.222, 3.231, 3.240, 3.249, 3.258, - & 3.266, 3.275, 3.284, 3.292, 3.301, 3.309, 3.318, 3.326, 3.335, - & 3.343, 3.351, 3.359, 3.368, 3.376, 3.384, 3.392, 3.399, 3.407, - & 3.415, 3.423, 3.431, 3.438, 3.446, 3.454, 3.461, 3.469, 3.476, - & 3.483, 3.491, 3.498 - & / -C -C *** K2SO4 -C - DATA BNC17M/ - &-0.096,-0.208,-0.265,-0.305,-0.337,-0.363,-0.385,-0.405,-0.423, - &-0.439,-0.453,-0.467,-0.479,-0.491,-0.502,-0.512,-0.522,-0.531, - &-0.540,-0.548,-0.556,-0.564,-0.571,-0.578,-0.585,-0.592,-0.598, - &-0.605,-0.610,-0.616,-0.622,-0.627,-0.633,-0.638,-0.643,-0.648, - &-0.653,-0.657,-0.662,-0.666,-0.671,-0.675,-0.679,-0.683,-0.688, - &-0.691,-0.695,-0.699,-0.703,-0.707,-0.710,-0.714,-0.717,-0.721, - &-0.724,-0.727,-0.731,-0.734,-0.737,-0.740,-0.743,-0.746,-0.749, - &-0.752,-0.755,-0.758,-0.761,-0.763,-0.766,-0.769,-0.772,-0.774, - &-0.777,-0.780,-0.782,-0.785,-0.787,-0.790,-0.792,-0.795,-0.797, - &-0.799,-0.802,-0.804,-0.807,-0.809,-0.811,-0.814,-0.816,-0.818, - &-0.820,-0.823,-0.825,-0.827,-0.829,-0.831,-0.833,-0.836,-0.838, - &-0.840,-0.842,-0.844,-0.846,-0.848,-0.850,-0.852,-0.854,-0.856, - &-0.858,-0.860,-0.862,-0.864,-0.866,-0.868,-0.870,-0.872,-0.874, - &-0.875,-0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.888,-0.890, - &-0.892,-0.894,-0.895,-0.897,-0.899,-0.901,-0.902,-0.904,-0.906, - &-0.908,-0.909,-0.911,-0.913,-0.914,-0.916,-0.918,-0.919,-0.921, - &-0.923,-0.924,-0.926,-0.927,-0.929,-0.931,-0.932,-0.934,-0.935, - &-0.937,-0.938,-0.940,-0.942,-0.943,-0.945,-0.946,-0.948,-0.949, - &-0.951,-0.952,-0.954,-0.955,-0.957,-0.958,-0.960,-0.961,-0.962, - &-0.964,-0.965,-0.967,-0.968,-0.970,-0.971,-0.972,-0.974,-0.975, - &-0.977,-0.978,-0.979,-0.981,-0.982,-0.984,-0.985,-0.986,-0.988, - &-0.989,-0.990,-0.992,-0.993,-0.994,-0.996,-0.997,-0.998,-1.000, - &-1.001,-1.002,-1.004,-1.005,-1.006,-1.007,-1.009,-1.010,-1.011, - &-1.013,-1.014,-1.015,-1.016,-1.018,-1.019,-1.020,-1.021,-1.023, - &-1.024,-1.025,-1.026,-1.027,-1.029,-1.030,-1.031,-1.032,-1.034, - &-1.035,-1.036,-1.037,-1.038,-1.039,-1.041,-1.042,-1.043,-1.044, - &-1.045,-1.047,-1.048,-1.049,-1.050,-1.051,-1.052,-1.053,-1.055, - &-1.056,-1.057,-1.058,-1.059,-1.060,-1.061,-1.063,-1.064,-1.065, - &-1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.073,-1.074,-1.075, - &-1.076,-1.077,-1.078,-1.079,-1.080,-1.081,-1.082,-1.083,-1.084, - &-1.086,-1.087,-1.088,-1.089,-1.090,-1.091,-1.092,-1.093,-1.094, - &-1.095,-1.096,-1.097,-1.098,-1.099,-1.100,-1.101,-1.102,-1.103, - &-1.104,-1.105,-1.106,-1.107,-1.108,-1.109,-1.110,-1.111,-1.112, - &-1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.119,-1.120,-1.121, - &-1.122,-1.123,-1.124,-1.125,-1.126,-1.127,-1.128,-1.129,-1.130, - &-1.131,-1.132,-1.133,-1.134,-1.135,-1.136,-1.137,-1.138,-1.139, - &-1.140,-1.141,-1.142,-1.143,-1.144,-1.145,-1.146,-1.147,-1.147, - &-1.148,-1.149,-1.150,-1.151,-1.152,-1.153,-1.154,-1.155,-1.156, - &-1.157,-1.158,-1.159,-1.160,-1.160,-1.161,-1.162,-1.163,-1.164, - &-1.165,-1.166,-1.167,-1.168,-1.169,-1.169,-1.170,-1.171,-1.172, - &-1.173,-1.174,-1.175,-1.176,-1.177,-1.178,-1.178,-1.179,-1.180, - &-1.181,-1.182,-1.183,-1.184,-1.185,-1.185,-1.186,-1.187,-1.188, - &-1.189,-1.190,-1.191,-1.191,-1.192,-1.193,-1.194,-1.195,-1.196, - &-1.197,-1.198,-1.198,-1.199,-1.200,-1.201,-1.202,-1.203,-1.203, - &-1.204,-1.205,-1.206,-1.207,-1.216,-1.224,-1.232,-1.240,-1.248, - &-1.256,-1.263,-1.271,-1.279,-1.286,-1.293,-1.301,-1.308,-1.315, - &-1.322,-1.329,-1.336,-1.343,-1.349,-1.356,-1.363,-1.369,-1.376, - &-1.382,-1.389,-1.395,-1.402,-1.408,-1.414,-1.420,-1.427,-1.433, - &-1.439,-1.445,-1.451,-1.457,-1.463,-1.468,-1.474,-1.480,-1.486, - &-1.492,-1.497,-1.503,-1.509,-1.514,-1.520,-1.525,-1.531,-1.536, - &-1.542,-1.547,-1.553,-1.558,-1.563,-1.569,-1.574,-1.579,-1.585, - &-1.590,-1.595,-1.600,-1.605,-1.611,-1.616,-1.621,-1.626,-1.631, - &-1.636,-1.641,-1.646,-1.651,-1.656,-1.661,-1.666,-1.671,-1.676, - &-1.681,-1.685,-1.690,-1.695,-1.700,-1.705,-1.710,-1.714,-1.719, - &-1.724,-1.729,-1.733,-1.738,-1.743,-1.747,-1.752,-1.757,-1.761, - &-1.766,-1.770,-1.775,-1.780,-1.784,-1.789,-1.793,-1.798,-1.802, - &-1.807,-1.811,-1.816,-1.820,-1.825,-1.829,-1.834,-1.838,-1.842, - &-1.847,-1.851,-1.856,-1.860,-1.864,-1.869,-1.873,-1.877,-1.882, - &-1.886,-1.890,-1.895,-1.899,-1.903,-1.908,-1.912,-1.916,-1.920, - &-1.925,-1.929,-1.933,-1.937,-1.941,-1.946,-1.950,-1.954,-1.958, - &-1.962,-1.966,-1.971,-1.975,-1.979,-1.983,-1.987,-1.991,-1.995, - &-2.000,-2.004,-2.008,-2.012,-2.016,-2.020,-2.024,-2.028,-2.032, - &-2.036,-2.040,-2.044 - & / -C -C *** KHSO4 -C - DATA BNC18M/ - &-0.047,-0.099,-0.124,-0.141,-0.154,-0.165,-0.173,-0.181,-0.187, - &-0.193,-0.198,-0.202,-0.206,-0.209,-0.212,-0.215,-0.217,-0.220, - &-0.221,-0.223,-0.225,-0.226,-0.227,-0.228,-0.229,-0.229,-0.230, - &-0.230,-0.230,-0.230,-0.230,-0.230,-0.230,-0.229,-0.229,-0.228, - &-0.228,-0.227,-0.226,-0.225,-0.224,-0.223,-0.222,-0.221,-0.220, - &-0.218,-0.217,-0.215,-0.214,-0.212,-0.210,-0.209,-0.207,-0.205, - &-0.203,-0.201,-0.199,-0.197,-0.195,-0.193,-0.191,-0.189,-0.187, - &-0.185,-0.182,-0.180,-0.178,-0.175,-0.173,-0.171,-0.168,-0.166, - &-0.163,-0.160,-0.158,-0.155,-0.153,-0.150,-0.147,-0.144,-0.142, - &-0.139,-0.136,-0.133,-0.130,-0.127,-0.124,-0.121,-0.118,-0.115, - &-0.112,-0.109,-0.106,-0.103,-0.100,-0.097,-0.094,-0.091,-0.087, - &-0.084,-0.081,-0.078,-0.074,-0.071,-0.068,-0.064,-0.061,-0.058, - &-0.054,-0.051,-0.047,-0.044,-0.041,-0.037,-0.034,-0.030,-0.027, - &-0.023,-0.020,-0.017,-0.013,-0.010,-0.006,-0.003, 0.001, 0.004, - & 0.008, 0.011, 0.015, 0.018, 0.021, 0.025, 0.028, 0.032, 0.035, - & 0.039, 0.042, 0.046, 0.049, 0.052, 0.056, 0.059, 0.063, 0.066, - & 0.069, 0.073, 0.076, 0.079, 0.083, 0.086, 0.090, 0.093, 0.096, - & 0.100, 0.103, 0.106, 0.110, 0.113, 0.116, 0.119, 0.123, 0.126, - & 0.129, 0.133, 0.136, 0.139, 0.142, 0.146, 0.149, 0.152, 0.155, - & 0.158, 0.162, 0.165, 0.168, 0.171, 0.174, 0.177, 0.181, 0.184, - & 0.187, 0.190, 0.193, 0.196, 0.199, 0.203, 0.206, 0.209, 0.212, - & 0.215, 0.218, 0.221, 0.224, 0.227, 0.230, 0.233, 0.236, 0.239, - & 0.242, 0.245, 0.248, 0.251, 0.254, 0.257, 0.260, 0.263, 0.266, - & 0.269, 0.272, 0.275, 0.278, 0.281, 0.284, 0.287, 0.290, 0.292, - & 0.295, 0.298, 0.301, 0.304, 0.307, 0.310, 0.313, 0.315, 0.318, - & 0.321, 0.324, 0.327, 0.330, 0.332, 0.335, 0.338, 0.341, 0.343, - & 0.346, 0.349, 0.352, 0.355, 0.357, 0.360, 0.363, 0.366, 0.368, - & 0.371, 0.374, 0.376, 0.379, 0.382, 0.384, 0.387, 0.390, 0.393, - & 0.395, 0.398, 0.400, 0.403, 0.406, 0.408, 0.411, 0.414, 0.416, - & 0.419, 0.422, 0.424, 0.427, 0.429, 0.432, 0.434, 0.437, 0.440, - & 0.442, 0.445, 0.447, 0.450, 0.452, 0.455, 0.457, 0.460, 0.463, - & 0.465, 0.468, 0.470, 0.473, 0.475, 0.478, 0.480, 0.483, 0.485, - & 0.487, 0.490, 0.492, 0.495, 0.497, 0.500, 0.502, 0.505, 0.507, - & 0.509, 0.512, 0.514, 0.517, 0.519, 0.522, 0.524, 0.526, 0.529, - & 0.531, 0.533, 0.536, 0.538, 0.541, 0.543, 0.545, 0.548, 0.550, - & 0.552, 0.555, 0.557, 0.559, 0.562, 0.564, 0.566, 0.569, 0.571, - & 0.573, 0.575, 0.578, 0.580, 0.582, 0.585, 0.587, 0.589, 0.591, - & 0.594, 0.596, 0.598, 0.600, 0.603, 0.605, 0.607, 0.609, 0.612, - & 0.614, 0.616, 0.618, 0.621, 0.623, 0.625, 0.627, 0.629, 0.632, - & 0.634, 0.636, 0.638, 0.640, 0.642, 0.645, 0.647, 0.649, 0.651, - & 0.653, 0.655, 0.658, 0.660, 0.662, 0.664, 0.666, 0.668, 0.670, - & 0.672, 0.675, 0.677, 0.679, 0.681, 0.683, 0.685, 0.687, 0.689, - & 0.691, 0.693, 0.695, 0.698, 0.700, 0.702, 0.704, 0.706, 0.708, - & 0.710, 0.712, 0.714, 0.716, 0.718, 0.720, 0.722, 0.724, 0.726, - & 0.728, 0.730, 0.732, 0.734, 0.756, 0.775, 0.795, 0.814, 0.832, - & 0.851, 0.869, 0.886, 0.904, 0.921, 0.938, 0.955, 0.972, 0.988, - & 1.004, 1.020, 1.036, 1.051, 1.066, 1.081, 1.096, 1.111, 1.125, - & 1.140, 1.154, 1.168, 1.181, 1.195, 1.208, 1.222, 1.235, 1.248, - & 1.261, 1.273, 1.286, 1.298, 1.311, 1.323, 1.335, 1.347, 1.358, - & 1.370, 1.381, 1.393, 1.404, 1.415, 1.426, 1.437, 1.448, 1.459, - & 1.469, 1.480, 1.490, 1.500, 1.510, 1.521, 1.531, 1.540, 1.550, - & 1.560, 1.570, 1.579, 1.589, 1.598, 1.607, 1.616, 1.625, 1.635, - & 1.643, 1.652, 1.661, 1.670, 1.679, 1.687, 1.696, 1.704, 1.712, - & 1.721, 1.729, 1.737, 1.745, 1.753, 1.761, 1.769, 1.777, 1.785, - & 1.792, 1.800, 1.808, 1.815, 1.823, 1.830, 1.838, 1.845, 1.852, - & 1.859, 1.866, 1.874, 1.881, 1.888, 1.895, 1.901, 1.908, 1.915, - & 1.922, 1.929, 1.935, 1.942, 1.948, 1.955, 1.961, 1.968, 1.974, - & 1.980, 1.987, 1.993, 1.999, 2.005, 2.011, 2.018, 2.024, 2.030, - & 2.036, 2.041, 2.047, 2.053, 2.059, 2.065, 2.070, 2.076, 2.082, - & 2.087, 2.093, 2.099, 2.104, 2.110, 2.115, 2.120, 2.126, 2.131, - & 2.136, 2.142, 2.147, 2.152, 2.157, 2.163, 2.168, 2.173, 2.178, - & 2.183, 2.188, 2.193, 2.198, 2.203, 2.208, 2.212, 2.217, 2.222, - & 2.227, 2.232, 2.236 - & / -C -C *** KNO3 -C - DATA BNC19M/ - &-0.049,-0.112,-0.147,-0.173,-0.194,-0.213,-0.230,-0.245,-0.259, - &-0.272,-0.285,-0.297,-0.308,-0.319,-0.329,-0.339,-0.348,-0.358, - &-0.367,-0.376,-0.384,-0.392,-0.401,-0.408,-0.416,-0.424,-0.431, - &-0.439,-0.446,-0.453,-0.460,-0.466,-0.473,-0.479,-0.486,-0.492, - &-0.498,-0.504,-0.510,-0.516,-0.522,-0.528,-0.533,-0.539,-0.544, - &-0.550,-0.555,-0.560,-0.565,-0.571,-0.576,-0.580,-0.585,-0.590, - &-0.595,-0.600,-0.604,-0.609,-0.613,-0.618,-0.622,-0.627,-0.631, - &-0.635,-0.640,-0.644,-0.648,-0.652,-0.656,-0.660,-0.664,-0.668, - &-0.672,-0.676,-0.680,-0.684,-0.688,-0.692,-0.696,-0.700,-0.704, - &-0.707,-0.711,-0.715,-0.719,-0.722,-0.726,-0.730,-0.734,-0.737, - &-0.741,-0.745,-0.748,-0.752,-0.755,-0.759,-0.763,-0.766,-0.770, - &-0.773,-0.777,-0.780,-0.784,-0.788,-0.791,-0.795,-0.798,-0.801, - &-0.805,-0.808,-0.812,-0.815,-0.819,-0.822,-0.825,-0.829,-0.832, - &-0.835,-0.839,-0.842,-0.845,-0.849,-0.852,-0.855,-0.858,-0.862, - &-0.865,-0.868,-0.871,-0.874,-0.878,-0.881,-0.884,-0.887,-0.890, - &-0.893,-0.896,-0.899,-0.902,-0.905,-0.908,-0.911,-0.914,-0.917, - &-0.920,-0.923,-0.926,-0.929,-0.932,-0.935,-0.937,-0.940,-0.943, - &-0.946,-0.949,-0.951,-0.954,-0.957,-0.960,-0.963,-0.965,-0.968, - &-0.971,-0.973,-0.976,-0.979,-0.981,-0.984,-0.987,-0.989,-0.992, - &-0.994,-0.997,-0.999,-1.002,-1.005,-1.007,-1.010,-1.012,-1.015, - &-1.017,-1.020,-1.022,-1.024,-1.027,-1.029,-1.032,-1.034,-1.036, - &-1.039,-1.041,-1.044,-1.046,-1.048,-1.051,-1.053,-1.055,-1.057, - &-1.060,-1.062,-1.064,-1.067,-1.069,-1.071,-1.073,-1.075,-1.078, - &-1.080,-1.082,-1.084,-1.086,-1.089,-1.091,-1.093,-1.095,-1.097, - &-1.099,-1.101,-1.103,-1.106,-1.108,-1.110,-1.112,-1.114,-1.116, - &-1.118,-1.120,-1.122,-1.124,-1.126,-1.128,-1.130,-1.132,-1.134, - &-1.136,-1.138,-1.140,-1.142,-1.144,-1.145,-1.147,-1.149,-1.151, - &-1.153,-1.155,-1.157,-1.159,-1.160,-1.162,-1.164,-1.166,-1.168, - &-1.170,-1.171,-1.173,-1.175,-1.177,-1.179,-1.180,-1.182,-1.184, - &-1.186,-1.187,-1.189,-1.191,-1.193,-1.194,-1.196,-1.198,-1.199, - &-1.201,-1.203,-1.205,-1.206,-1.208,-1.210,-1.211,-1.213,-1.214, - &-1.216,-1.218,-1.219,-1.221,-1.223,-1.224,-1.226,-1.227,-1.229, - &-1.231,-1.232,-1.234,-1.235,-1.237,-1.238,-1.240,-1.241,-1.243, - &-1.244,-1.246,-1.248,-1.249,-1.251,-1.252,-1.254,-1.255,-1.256, - &-1.258,-1.259,-1.261,-1.262,-1.264,-1.265,-1.267,-1.268,-1.270, - &-1.271,-1.272,-1.274,-1.275,-1.277,-1.278,-1.279,-1.281,-1.282, - &-1.284,-1.285,-1.286,-1.288,-1.289,-1.290,-1.292,-1.293,-1.294, - &-1.296,-1.297,-1.298,-1.300,-1.301,-1.302,-1.304,-1.305,-1.306, - &-1.308,-1.309,-1.310,-1.311,-1.313,-1.314,-1.315,-1.316,-1.318, - &-1.319,-1.320,-1.321,-1.323,-1.324,-1.325,-1.326,-1.328,-1.329, - &-1.330,-1.331,-1.332,-1.334,-1.335,-1.336,-1.337,-1.338,-1.340, - &-1.341,-1.342,-1.343,-1.344,-1.345,-1.347,-1.348,-1.349,-1.350, - &-1.351,-1.352,-1.353,-1.355,-1.356,-1.357,-1.358,-1.359,-1.360, - &-1.361,-1.362,-1.364,-1.365,-1.366,-1.367,-1.368,-1.369,-1.370, - &-1.371,-1.372,-1.373,-1.374,-1.386,-1.396,-1.405,-1.415,-1.424, - &-1.433,-1.442,-1.450,-1.458,-1.466,-1.474,-1.482,-1.489,-1.496, - &-1.503,-1.510,-1.516,-1.523,-1.529,-1.535,-1.541,-1.547,-1.553, - &-1.558,-1.564,-1.569,-1.574,-1.580,-1.585,-1.589,-1.594,-1.599, - &-1.604,-1.608,-1.613,-1.617,-1.621,-1.626,-1.630,-1.634,-1.638, - &-1.642,-1.646,-1.650,-1.654,-1.657,-1.661,-1.665,-1.668,-1.672, - &-1.675,-1.679,-1.682,-1.685,-1.689,-1.692,-1.695,-1.698,-1.701, - &-1.705,-1.708,-1.711,-1.714,-1.717,-1.720,-1.723,-1.725,-1.728, - &-1.731,-1.734,-1.737,-1.739,-1.742,-1.745,-1.748,-1.750,-1.753, - &-1.755,-1.758,-1.761,-1.763,-1.766,-1.768,-1.771,-1.773,-1.776, - &-1.778,-1.781,-1.783,-1.785,-1.788,-1.790,-1.792,-1.795,-1.797, - &-1.799,-1.802,-1.804,-1.806,-1.809,-1.811,-1.813,-1.815,-1.817, - &-1.820,-1.822,-1.824,-1.826,-1.828,-1.830,-1.833,-1.835,-1.837, - &-1.839,-1.841,-1.843,-1.845,-1.847,-1.849,-1.851,-1.854,-1.856, - &-1.858,-1.860,-1.862,-1.864,-1.866,-1.868,-1.870,-1.872,-1.874, - &-1.876,-1.878,-1.880,-1.881,-1.883,-1.885,-1.887,-1.889,-1.891, - &-1.893,-1.895,-1.897,-1.899,-1.901,-1.903,-1.905,-1.906,-1.908, - &-1.910,-1.912,-1.914,-1.916,-1.918,-1.919,-1.921,-1.923,-1.925, - &-1.927,-1.929,-1.930 - & / -C -C *** KCL -C - DATA BNC20M/ - &-0.047,-0.100,-0.126,-0.143,-0.156,-0.167,-0.176,-0.183,-0.190, - &-0.195,-0.200,-0.205,-0.209,-0.212,-0.215,-0.218,-0.221,-0.224, - &-0.226,-0.228,-0.230,-0.232,-0.233,-0.235,-0.236,-0.238,-0.239, - &-0.240,-0.241,-0.242,-0.243,-0.244,-0.245,-0.246,-0.246,-0.247, - &-0.248,-0.248,-0.249,-0.249,-0.250,-0.250,-0.251,-0.251,-0.251, - &-0.252,-0.252,-0.252,-0.253,-0.253,-0.253,-0.253,-0.254,-0.254, - &-0.254,-0.254,-0.254,-0.254,-0.254,-0.255,-0.255,-0.255,-0.255, - &-0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.255, - &-0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.254,-0.254,-0.254, - &-0.254,-0.254,-0.254,-0.254,-0.253,-0.253,-0.253,-0.253,-0.253, - &-0.252,-0.252,-0.252,-0.252,-0.251,-0.251,-0.251,-0.250,-0.250, - &-0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.247,-0.247, - &-0.247,-0.246,-0.246,-0.245,-0.245,-0.245,-0.244,-0.244,-0.243, - &-0.243,-0.243,-0.242,-0.242,-0.241,-0.241,-0.240,-0.240,-0.240, - &-0.239,-0.239,-0.238,-0.238,-0.237,-0.237,-0.236,-0.236,-0.235, - &-0.235,-0.234,-0.234,-0.234,-0.233,-0.233,-0.232,-0.232,-0.231, - &-0.231,-0.230,-0.230,-0.229,-0.229,-0.228,-0.228,-0.227,-0.227, - &-0.226,-0.226,-0.225,-0.225,-0.224,-0.224,-0.224,-0.223,-0.223, - &-0.222,-0.222,-0.221,-0.221,-0.220,-0.220,-0.219,-0.219,-0.218, - &-0.218,-0.217,-0.217,-0.216,-0.216,-0.215,-0.215,-0.214,-0.214, - &-0.213,-0.213,-0.212,-0.212,-0.211,-0.211,-0.210,-0.210,-0.209, - &-0.209,-0.208,-0.208,-0.207,-0.207,-0.207,-0.206,-0.206,-0.205, - &-0.205,-0.204,-0.204,-0.203,-0.203,-0.202,-0.202,-0.201,-0.201, - &-0.200,-0.200,-0.199,-0.199,-0.198,-0.198,-0.197,-0.197,-0.196, - &-0.196,-0.195,-0.195,-0.194,-0.194,-0.194,-0.193,-0.193,-0.192, - &-0.192,-0.191,-0.191,-0.190,-0.190,-0.189,-0.189,-0.188,-0.188, - &-0.187,-0.187,-0.186,-0.186,-0.186,-0.185,-0.185,-0.184,-0.184, - &-0.183,-0.183,-0.182,-0.182,-0.181,-0.181,-0.180,-0.180,-0.180, - &-0.179,-0.179,-0.178,-0.178,-0.177,-0.177,-0.176,-0.176,-0.175, - &-0.175,-0.174,-0.174,-0.174,-0.173,-0.173,-0.172,-0.172,-0.171, - &-0.171,-0.170,-0.170,-0.170,-0.169,-0.169,-0.168,-0.168,-0.167, - &-0.167,-0.166,-0.166,-0.166,-0.165,-0.165,-0.164,-0.164,-0.163, - &-0.163,-0.162,-0.162,-0.162,-0.161,-0.161,-0.160,-0.160,-0.159, - &-0.159,-0.159,-0.158,-0.158,-0.157,-0.157,-0.156,-0.156,-0.156, - &-0.155,-0.155,-0.154,-0.154,-0.153,-0.153,-0.153,-0.152,-0.152, - &-0.151,-0.151,-0.150,-0.150,-0.150,-0.149,-0.149,-0.148,-0.148, - &-0.148,-0.147,-0.147,-0.146,-0.146,-0.145,-0.145,-0.145,-0.144, - &-0.144,-0.143,-0.143,-0.143,-0.142,-0.142,-0.141,-0.141,-0.141, - &-0.140,-0.140,-0.139,-0.139,-0.139,-0.138,-0.138,-0.137,-0.137, - &-0.137,-0.136,-0.136,-0.135,-0.135,-0.135,-0.134,-0.134,-0.133, - &-0.133,-0.133,-0.132,-0.132,-0.131,-0.131,-0.131,-0.130,-0.130, - &-0.129,-0.129,-0.129,-0.128,-0.128,-0.128,-0.127,-0.127,-0.126, - &-0.126,-0.126,-0.125,-0.125,-0.124,-0.124,-0.124,-0.123,-0.123, - &-0.123,-0.122,-0.122,-0.121,-0.121,-0.121,-0.120,-0.120,-0.120, - &-0.119,-0.119,-0.118,-0.118,-0.114,-0.111,-0.107,-0.103,-0.100, - &-0.097,-0.093,-0.090,-0.087,-0.084,-0.080,-0.077,-0.074,-0.071, - &-0.068,-0.065,-0.063,-0.060,-0.057,-0.054,-0.052,-0.049,-0.046, - &-0.044,-0.041,-0.039,-0.036,-0.034,-0.031,-0.029,-0.027,-0.024, - &-0.022,-0.020,-0.018,-0.016,-0.013,-0.011,-0.009,-0.007,-0.005, - &-0.003,-0.001, 0.001, 0.003, 0.004, 0.006, 0.008, 0.010, 0.012, - & 0.013, 0.015, 0.017, 0.018, 0.020, 0.022, 0.023, 0.025, 0.026, - & 0.028, 0.030, 0.031, 0.032, 0.034, 0.035, 0.037, 0.038, 0.040, - & 0.041, 0.042, 0.044, 0.045, 0.046, 0.047, 0.049, 0.050, 0.051, - & 0.052, 0.053, 0.055, 0.056, 0.057, 0.058, 0.059, 0.060, 0.061, - & 0.062, 0.063, 0.064, 0.065, 0.066, 0.067, 0.068, 0.069, 0.070, - & 0.071, 0.072, 0.073, 0.074, 0.075, 0.075, 0.076, 0.077, 0.078, - & 0.079, 0.079, 0.080, 0.081, 0.082, 0.083, 0.083, 0.084, 0.085, - & 0.085, 0.086, 0.087, 0.087, 0.088, 0.089, 0.089, 0.090, 0.091, - & 0.091, 0.092, 0.092, 0.093, 0.094, 0.094, 0.095, 0.095, 0.096, - & 0.096, 0.097, 0.097, 0.098, 0.098, 0.099, 0.099, 0.100, 0.100, - & 0.100, 0.101, 0.101, 0.102, 0.102, 0.103, 0.103, 0.103, 0.104, - & 0.104, 0.104, 0.105, 0.105, 0.105, 0.106, 0.106, 0.106, 0.107, - & 0.107, 0.107, 0.108 - & / -C -C *** MGSO4 -C - DATA BNC21M/ - &-0.190,-0.411,-0.520,-0.597,-0.656,-0.705,-0.746,-0.782,-0.814, - &-0.843,-0.868,-0.892,-0.914,-0.934,-0.953,-0.970,-0.986,-1.002, - &-1.016,-1.030,-1.043,-1.056,-1.068,-1.079,-1.090,-1.100,-1.110, - &-1.120,-1.129,-1.138,-1.147,-1.155,-1.163,-1.171,-1.178,-1.186, - &-1.193,-1.200,-1.206,-1.213,-1.219,-1.225,-1.231,-1.237,-1.243, - &-1.249,-1.254,-1.260,-1.265,-1.270,-1.275,-1.280,-1.285,-1.289, - &-1.294,-1.299,-1.303,-1.307,-1.312,-1.316,-1.320,-1.324,-1.328, - &-1.332,-1.336,-1.340,-1.344,-1.347,-1.351,-1.354,-1.358,-1.361, - &-1.365,-1.368,-1.372,-1.375,-1.378,-1.381,-1.384,-1.387,-1.390, - &-1.393,-1.396,-1.399,-1.402,-1.405,-1.408,-1.411,-1.413,-1.416, - &-1.419,-1.421,-1.424,-1.426,-1.429,-1.431,-1.434,-1.436,-1.439, - &-1.441,-1.443,-1.446,-1.448,-1.450,-1.452,-1.455,-1.457,-1.459, - &-1.461,-1.463,-1.465,-1.467,-1.469,-1.471,-1.473,-1.475,-1.477, - &-1.479,-1.481,-1.483,-1.485,-1.487,-1.489,-1.491,-1.493,-1.494, - &-1.496,-1.498,-1.500,-1.501,-1.503,-1.505,-1.507,-1.508,-1.510, - &-1.512,-1.513,-1.515,-1.517,-1.518,-1.520,-1.521,-1.523,-1.525, - &-1.526,-1.528,-1.529,-1.531,-1.532,-1.534,-1.535,-1.537,-1.538, - &-1.540,-1.541,-1.543,-1.544,-1.546,-1.547,-1.548,-1.550,-1.551, - &-1.553,-1.554,-1.555,-1.557,-1.558,-1.559,-1.561,-1.562,-1.563, - &-1.565,-1.566,-1.567,-1.569,-1.570,-1.571,-1.573,-1.574,-1.575, - &-1.576,-1.578,-1.579,-1.580,-1.581,-1.583,-1.584,-1.585,-1.586, - &-1.587,-1.589,-1.590,-1.591,-1.592,-1.593,-1.594,-1.596,-1.597, - &-1.598,-1.599,-1.600,-1.601,-1.603,-1.604,-1.605,-1.606,-1.607, - &-1.608,-1.609,-1.610,-1.611,-1.613,-1.614,-1.615,-1.616,-1.617, - &-1.618,-1.619,-1.620,-1.621,-1.622,-1.623,-1.624,-1.625,-1.626, - &-1.627,-1.628,-1.630,-1.631,-1.632,-1.633,-1.634,-1.635,-1.636, - &-1.637,-1.638,-1.639,-1.640,-1.641,-1.642,-1.643,-1.644,-1.645, - &-1.646,-1.647,-1.647,-1.648,-1.649,-1.650,-1.651,-1.652,-1.653, - &-1.654,-1.655,-1.656,-1.657,-1.658,-1.659,-1.660,-1.661,-1.662, - &-1.663,-1.664,-1.664,-1.665,-1.666,-1.667,-1.668,-1.669,-1.670, - &-1.671,-1.672,-1.673,-1.674,-1.674,-1.675,-1.676,-1.677,-1.678, - &-1.679,-1.680,-1.681,-1.682,-1.682,-1.683,-1.684,-1.685,-1.686, - &-1.687,-1.688,-1.688,-1.689,-1.690,-1.691,-1.692,-1.693,-1.694, - &-1.694,-1.695,-1.696,-1.697,-1.698,-1.699,-1.700,-1.700,-1.701, - &-1.702,-1.703,-1.704,-1.705,-1.705,-1.706,-1.707,-1.708,-1.709, - &-1.709,-1.710,-1.711,-1.712,-1.713,-1.713,-1.714,-1.715,-1.716, - &-1.717,-1.718,-1.718,-1.719,-1.720,-1.721,-1.722,-1.722,-1.723, - &-1.724,-1.725,-1.725,-1.726,-1.727,-1.728,-1.729,-1.729,-1.730, - &-1.731,-1.732,-1.733,-1.733,-1.734,-1.735,-1.736,-1.736,-1.737, - &-1.738,-1.739,-1.739,-1.740,-1.741,-1.742,-1.743,-1.743,-1.744, - &-1.745,-1.746,-1.746,-1.747,-1.748,-1.749,-1.749,-1.750,-1.751, - &-1.752,-1.752,-1.753,-1.754,-1.755,-1.755,-1.756,-1.757,-1.758, - &-1.758,-1.759,-1.760,-1.760,-1.761,-1.762,-1.763,-1.763,-1.764, - &-1.765,-1.766,-1.766,-1.767,-1.768,-1.769,-1.769,-1.770,-1.771, - &-1.771,-1.772,-1.773,-1.774,-1.781,-1.788,-1.795,-1.802,-1.809, - &-1.816,-1.823,-1.830,-1.836,-1.843,-1.849,-1.856,-1.862,-1.869, - &-1.875,-1.882,-1.888,-1.894,-1.901,-1.907,-1.913,-1.919,-1.926, - &-1.932,-1.938,-1.944,-1.950,-1.956,-1.962,-1.968,-1.974,-1.981, - &-1.987,-1.993,-1.999,-2.004,-2.010,-2.016,-2.022,-2.028,-2.034, - &-2.040,-2.046,-2.052,-2.058,-2.064,-2.069,-2.075,-2.081,-2.087, - &-2.093,-2.099,-2.104,-2.110,-2.116,-2.122,-2.128,-2.133,-2.139, - &-2.145,-2.151,-2.157,-2.162,-2.168,-2.174,-2.180,-2.185,-2.191, - &-2.197,-2.202,-2.208,-2.214,-2.220,-2.225,-2.231,-2.237,-2.242, - &-2.248,-2.254,-2.260,-2.265,-2.271,-2.277,-2.282,-2.288,-2.294, - &-2.299,-2.305,-2.311,-2.316,-2.322,-2.328,-2.333,-2.339,-2.345, - &-2.350,-2.356,-2.361,-2.367,-2.373,-2.378,-2.384,-2.390,-2.395, - &-2.401,-2.407,-2.412,-2.418,-2.423,-2.429,-2.435,-2.440,-2.446, - &-2.452,-2.457,-2.463,-2.468,-2.474,-2.480,-2.485,-2.491,-2.496, - &-2.502,-2.508,-2.513,-2.519,-2.524,-2.530,-2.536,-2.541,-2.547, - &-2.552,-2.558,-2.564,-2.569,-2.575,-2.580,-2.586,-2.592,-2.597, - &-2.603,-2.608,-2.614,-2.620,-2.625,-2.631,-2.636,-2.642,-2.647, - &-2.653,-2.659,-2.664,-2.670,-2.675,-2.681,-2.686,-2.692,-2.698, - &-2.703,-2.709,-2.714 - & / -C -C *** MGNO32 -C - DATA BNC22M/ - &-0.093,-0.193,-0.238,-0.268,-0.289,-0.305,-0.318,-0.328,-0.336, - &-0.343,-0.348,-0.352,-0.356,-0.359,-0.361,-0.362,-0.364,-0.364, - &-0.364,-0.364,-0.364,-0.364,-0.363,-0.362,-0.360,-0.359,-0.357, - &-0.355,-0.354,-0.352,-0.349,-0.347,-0.345,-0.342,-0.340,-0.337, - &-0.335,-0.332,-0.329,-0.326,-0.324,-0.321,-0.318,-0.315,-0.312, - &-0.309,-0.306,-0.303,-0.300,-0.297,-0.294,-0.290,-0.287,-0.284, - &-0.281,-0.278,-0.275,-0.271,-0.268,-0.265,-0.262,-0.258,-0.255, - &-0.252,-0.249,-0.245,-0.242,-0.239,-0.235,-0.232,-0.229,-0.225, - &-0.222,-0.218,-0.215,-0.211,-0.208,-0.204,-0.201,-0.197,-0.194, - &-0.190,-0.186,-0.183,-0.179,-0.175,-0.172,-0.168,-0.164,-0.160, - &-0.156,-0.152,-0.148,-0.144,-0.140,-0.136,-0.132,-0.128,-0.124, - &-0.120,-0.116,-0.112,-0.107,-0.103,-0.099,-0.095,-0.090,-0.086, - &-0.082,-0.078,-0.073,-0.069,-0.065,-0.060,-0.056,-0.051,-0.047, - &-0.043,-0.038,-0.034,-0.029,-0.025,-0.020,-0.016,-0.011,-0.007, - &-0.003, 0.002, 0.006, 0.011, 0.015, 0.020, 0.024, 0.029, 0.033, - & 0.038, 0.042, 0.046, 0.051, 0.055, 0.060, 0.064, 0.069, 0.073, - & 0.078, 0.082, 0.086, 0.091, 0.095, 0.100, 0.104, 0.109, 0.113, - & 0.117, 0.122, 0.126, 0.130, 0.135, 0.139, 0.144, 0.148, 0.152, - & 0.157, 0.161, 0.165, 0.170, 0.174, 0.178, 0.183, 0.187, 0.191, - & 0.196, 0.200, 0.204, 0.209, 0.213, 0.217, 0.221, 0.226, 0.230, - & 0.234, 0.239, 0.243, 0.247, 0.251, 0.256, 0.260, 0.264, 0.268, - & 0.272, 0.277, 0.281, 0.285, 0.289, 0.293, 0.298, 0.302, 0.306, - & 0.310, 0.314, 0.318, 0.323, 0.327, 0.331, 0.335, 0.339, 0.343, - & 0.347, 0.351, 0.355, 0.360, 0.364, 0.368, 0.372, 0.376, 0.380, - & 0.384, 0.388, 0.392, 0.396, 0.400, 0.404, 0.408, 0.412, 0.416, - & 0.420, 0.424, 0.428, 0.432, 0.436, 0.440, 0.444, 0.448, 0.452, - & 0.456, 0.460, 0.464, 0.468, 0.472, 0.475, 0.479, 0.483, 0.487, - & 0.491, 0.495, 0.499, 0.503, 0.507, 0.510, 0.514, 0.518, 0.522, - & 0.526, 0.530, 0.533, 0.537, 0.541, 0.545, 0.549, 0.552, 0.556, - & 0.560, 0.564, 0.568, 0.571, 0.575, 0.579, 0.583, 0.586, 0.590, - & 0.594, 0.598, 0.601, 0.605, 0.609, 0.612, 0.616, 0.620, 0.623, - & 0.627, 0.631, 0.634, 0.638, 0.642, 0.645, 0.649, 0.653, 0.656, - & 0.660, 0.664, 0.667, 0.671, 0.674, 0.678, 0.682, 0.685, 0.689, - & 0.692, 0.696, 0.699, 0.703, 0.707, 0.710, 0.714, 0.717, 0.721, - & 0.724, 0.728, 0.731, 0.735, 0.738, 0.742, 0.745, 0.749, 0.752, - & 0.756, 0.759, 0.763, 0.766, 0.769, 0.773, 0.776, 0.780, 0.783, - & 0.787, 0.790, 0.793, 0.797, 0.800, 0.804, 0.807, 0.810, 0.814, - & 0.817, 0.821, 0.824, 0.827, 0.831, 0.834, 0.837, 0.841, 0.844, - & 0.847, 0.851, 0.854, 0.857, 0.861, 0.864, 0.867, 0.870, 0.874, - & 0.877, 0.880, 0.884, 0.887, 0.890, 0.893, 0.897, 0.900, 0.903, - & 0.906, 0.910, 0.913, 0.916, 0.919, 0.922, 0.926, 0.929, 0.932, - & 0.935, 0.938, 0.942, 0.945, 0.948, 0.951, 0.954, 0.957, 0.961, - & 0.964, 0.967, 0.970, 0.973, 0.976, 0.979, 0.983, 0.986, 0.989, - & 0.992, 0.995, 0.998, 1.001, 1.004, 1.007, 1.010, 1.013, 1.016, - & 1.020, 1.023, 1.026, 1.029, 1.061, 1.091, 1.120, 1.149, 1.178, - & 1.206, 1.233, 1.261, 1.288, 1.314, 1.340, 1.366, 1.391, 1.417, - & 1.441, 1.466, 1.490, 1.514, 1.537, 1.560, 1.583, 1.606, 1.628, - & 1.650, 1.672, 1.694, 1.715, 1.736, 1.757, 1.777, 1.797, 1.817, - & 1.837, 1.857, 1.876, 1.895, 1.914, 1.933, 1.951, 1.970, 1.988, - & 2.006, 2.023, 2.041, 2.058, 2.075, 2.092, 2.109, 2.126, 2.142, - & 2.159, 2.175, 2.191, 2.207, 2.222, 2.238, 2.253, 2.268, 2.283, - & 2.298, 2.313, 2.328, 2.342, 2.357, 2.371, 2.385, 2.399, 2.413, - & 2.426, 2.440, 2.453, 2.467, 2.480, 2.493, 2.506, 2.519, 2.532, - & 2.545, 2.557, 2.570, 2.582, 2.594, 2.606, 2.618, 2.630, 2.642, - & 2.654, 2.666, 2.677, 2.689, 2.700, 2.711, 2.722, 2.733, 2.744, - & 2.755, 2.766, 2.777, 2.788, 2.798, 2.809, 2.819, 2.829, 2.840, - & 2.850, 2.860, 2.870, 2.880, 2.890, 2.900, 2.909, 2.919, 2.929, - & 2.938, 2.948, 2.957, 2.966, 2.976, 2.985, 2.994, 3.003, 3.012, - & 3.021, 3.030, 3.039, 3.047, 3.056, 3.065, 3.073, 3.082, 3.090, - & 3.099, 3.107, 3.115, 3.123, 3.132, 3.140, 3.148, 3.156, 3.164, - & 3.172, 3.179, 3.187, 3.195, 3.203, 3.210, 3.218, 3.225, 3.233, - & 3.240, 3.248, 3.255, 3.262, 3.270, 3.277, 3.284, 3.291, 3.298, - & 3.305, 3.312, 3.319 - & / -C -C *** MGCL2 -C - DATA BNC23M/ - &-0.092,-0.190,-0.233,-0.261,-0.280,-0.295,-0.306,-0.314,-0.321, - &-0.326,-0.330,-0.333,-0.335,-0.336,-0.336,-0.336,-0.336,-0.335, - &-0.334,-0.332,-0.330,-0.328,-0.326,-0.323,-0.320,-0.317,-0.314, - &-0.311,-0.308,-0.304,-0.300,-0.297,-0.293,-0.289,-0.285,-0.281, - &-0.277,-0.272,-0.268,-0.264,-0.259,-0.255,-0.251,-0.246,-0.242, - &-0.237,-0.233,-0.228,-0.224,-0.219,-0.215,-0.210,-0.205,-0.201, - &-0.196,-0.192,-0.187,-0.182,-0.178,-0.173,-0.168,-0.164,-0.159, - &-0.154,-0.150,-0.145,-0.140,-0.135,-0.131,-0.126,-0.121,-0.116, - &-0.111,-0.106,-0.102,-0.097,-0.092,-0.087,-0.082,-0.077,-0.072, - &-0.067,-0.062,-0.056,-0.051,-0.046,-0.041,-0.036,-0.030,-0.025, - &-0.019,-0.014,-0.009,-0.003, 0.002, 0.008, 0.013, 0.019, 0.025, - & 0.030, 0.036, 0.042, 0.047, 0.053, 0.059, 0.065, 0.071, 0.077, - & 0.082, 0.088, 0.094, 0.100, 0.106, 0.112, 0.118, 0.124, 0.130, - & 0.136, 0.142, 0.148, 0.154, 0.160, 0.166, 0.172, 0.178, 0.184, - & 0.190, 0.196, 0.202, 0.208, 0.214, 0.220, 0.226, 0.232, 0.238, - & 0.244, 0.250, 0.256, 0.262, 0.268, 0.274, 0.280, 0.286, 0.292, - & 0.298, 0.304, 0.310, 0.316, 0.322, 0.328, 0.334, 0.340, 0.346, - & 0.352, 0.358, 0.364, 0.370, 0.376, 0.382, 0.387, 0.393, 0.399, - & 0.405, 0.411, 0.417, 0.423, 0.429, 0.434, 0.440, 0.446, 0.452, - & 0.458, 0.463, 0.469, 0.475, 0.481, 0.487, 0.492, 0.498, 0.504, - & 0.509, 0.515, 0.521, 0.527, 0.532, 0.538, 0.544, 0.549, 0.555, - & 0.561, 0.566, 0.572, 0.578, 0.583, 0.589, 0.594, 0.600, 0.606, - & 0.611, 0.617, 0.622, 0.628, 0.633, 0.639, 0.645, 0.650, 0.656, - & 0.661, 0.667, 0.672, 0.678, 0.683, 0.688, 0.694, 0.699, 0.705, - & 0.710, 0.716, 0.721, 0.726, 0.732, 0.737, 0.743, 0.748, 0.753, - & 0.759, 0.764, 0.769, 0.775, 0.780, 0.785, 0.791, 0.796, 0.801, - & 0.807, 0.812, 0.817, 0.822, 0.828, 0.833, 0.838, 0.843, 0.848, - & 0.854, 0.859, 0.864, 0.869, 0.874, 0.879, 0.885, 0.890, 0.895, - & 0.900, 0.905, 0.910, 0.915, 0.920, 0.925, 0.931, 0.936, 0.941, - & 0.946, 0.951, 0.956, 0.961, 0.966, 0.971, 0.976, 0.981, 0.986, - & 0.991, 0.996, 1.001, 1.006, 1.011, 1.015, 1.020, 1.025, 1.030, - & 1.035, 1.040, 1.045, 1.050, 1.055, 1.059, 1.064, 1.069, 1.074, - & 1.079, 1.084, 1.088, 1.093, 1.098, 1.103, 1.108, 1.112, 1.117, - & 1.122, 1.127, 1.131, 1.136, 1.141, 1.146, 1.150, 1.155, 1.160, - & 1.164, 1.169, 1.174, 1.178, 1.183, 1.188, 1.192, 1.197, 1.201, - & 1.206, 1.211, 1.215, 1.220, 1.224, 1.229, 1.234, 1.238, 1.243, - & 1.247, 1.252, 1.256, 1.261, 1.265, 1.270, 1.274, 1.279, 1.283, - & 1.288, 1.292, 1.297, 1.301, 1.306, 1.310, 1.315, 1.319, 1.323, - & 1.328, 1.332, 1.337, 1.341, 1.345, 1.350, 1.354, 1.359, 1.363, - & 1.367, 1.372, 1.376, 1.380, 1.385, 1.389, 1.393, 1.398, 1.402, - & 1.406, 1.410, 1.415, 1.419, 1.423, 1.428, 1.432, 1.436, 1.440, - & 1.444, 1.449, 1.453, 1.457, 1.461, 1.466, 1.470, 1.474, 1.478, - & 1.482, 1.486, 1.491, 1.495, 1.499, 1.503, 1.507, 1.511, 1.515, - & 1.519, 1.524, 1.528, 1.532, 1.536, 1.540, 1.544, 1.548, 1.552, - & 1.556, 1.560, 1.564, 1.568, 1.611, 1.651, 1.690, 1.728, 1.765, - & 1.802, 1.839, 1.875, 1.911, 1.945, 1.980, 2.014, 2.048, 2.081, - & 2.113, 2.146, 2.177, 2.209, 2.240, 2.270, 2.300, 2.330, 2.360, - & 2.389, 2.417, 2.446, 2.474, 2.502, 2.529, 2.556, 2.583, 2.609, - & 2.635, 2.661, 2.686, 2.712, 2.737, 2.761, 2.786, 2.810, 2.834, - & 2.857, 2.881, 2.904, 2.927, 2.950, 2.972, 2.994, 3.016, 3.038, - & 3.060, 3.081, 3.102, 3.123, 3.144, 3.164, 3.184, 3.205, 3.225, - & 3.244, 3.264, 3.283, 3.302, 3.322, 3.340, 3.359, 3.378, 3.396, - & 3.414, 3.432, 3.450, 3.468, 3.485, 3.503, 3.520, 3.537, 3.554, - & 3.571, 3.588, 3.604, 3.621, 3.637, 3.653, 3.669, 3.685, 3.701, - & 3.717, 3.732, 3.748, 3.763, 3.778, 3.793, 3.808, 3.823, 3.838, - & 3.852, 3.867, 3.881, 3.896, 3.910, 3.924, 3.938, 3.952, 3.966, - & 3.979, 3.993, 4.006, 4.020, 4.033, 4.046, 4.059, 4.072, 4.085, - & 4.098, 4.111, 4.123, 4.136, 4.148, 4.161, 4.173, 4.185, 4.197, - & 4.210, 4.222, 4.233, 4.245, 4.257, 4.269, 4.280, 4.292, 4.303, - & 4.315, 4.326, 4.337, 4.348, 4.359, 4.370, 4.381, 4.392, 4.403, - & 4.414, 4.424, 4.435, 4.446, 4.456, 4.466, 4.477, 4.487, 4.497, - & 4.507, 4.518, 4.528, 4.538, 4.548, 4.557, 4.567, 4.577, 4.587, - & 4.596, 4.606, 4.615 - & / - END -C -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE KM298 (IONIC, BINARR) -C -C *** Common block definition -C - COMMON /KMC298/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL Binarr (23), Ionic -C -C *** Find position in arrays for bincoef -C - IF (Ionic.LE. 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) -C -C *** Assign values to return array -C - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) -C -C *** Return point ; End of subroutine -C - RETURN - END - - - BLOCK DATA KMCF298 -C -C *** Common block definition -C - COMMON /KMC298/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - -C -C *** NaCl -C - DATA BNC01M/ - &-0.045,-0.095,-0.117,-0.132,-0.142,-0.150,-0.157,-0.162,-0.166, - &-0.170,-0.173,-0.175,-0.177,-0.179,-0.180,-0.181,-0.182,-0.182, - &-0.183,-0.183,-0.183,-0.183,-0.182,-0.182,-0.182,-0.181,-0.181, - &-0.180,-0.179,-0.178,-0.178,-0.177,-0.176,-0.175,-0.174,-0.173, - &-0.172,-0.170,-0.169,-0.168,-0.167,-0.166,-0.164,-0.163,-0.162, - &-0.161,-0.159,-0.158,-0.157,-0.155,-0.154,-0.153,-0.151,-0.150, - &-0.148,-0.147,-0.146,-0.144,-0.143,-0.141,-0.140,-0.138,-0.137, - &-0.136,-0.134,-0.133,-0.131,-0.130,-0.128,-0.127,-0.125,-0.124, - &-0.122,-0.121,-0.119,-0.117,-0.116,-0.114,-0.113,-0.111,-0.110, - &-0.108,-0.106,-0.105,-0.103,-0.101,-0.100,-0.098,-0.096,-0.094, - &-0.093,-0.091,-0.089,-0.087,-0.086,-0.084,-0.082,-0.080,-0.078, - &-0.076,-0.075,-0.073,-0.071,-0.069,-0.067,-0.065,-0.063,-0.061, - &-0.059,-0.057,-0.055,-0.053,-0.051,-0.049,-0.047,-0.046,-0.044, - &-0.042,-0.040,-0.038,-0.036,-0.034,-0.032,-0.030,-0.028,-0.026, - &-0.024,-0.022,-0.019,-0.017,-0.015,-0.013,-0.011,-0.009,-0.007, - &-0.005,-0.003,-0.001, 0.001, 0.003, 0.005, 0.007, 0.009, 0.011, - & 0.013, 0.015, 0.017, 0.019, 0.021, 0.023, 0.025, 0.027, 0.029, - & 0.031, 0.033, 0.035, 0.037, 0.039, 0.041, 0.043, 0.045, 0.047, - & 0.049, 0.050, 0.052, 0.054, 0.056, 0.058, 0.060, 0.062, 0.064, - & 0.066, 0.068, 0.070, 0.072, 0.074, 0.076, 0.078, 0.080, 0.082, - & 0.084, 0.086, 0.088, 0.090, 0.091, 0.093, 0.095, 0.097, 0.099, - & 0.101, 0.103, 0.105, 0.107, 0.109, 0.111, 0.113, 0.114, 0.116, - & 0.118, 0.120, 0.122, 0.124, 0.126, 0.128, 0.130, 0.131, 0.133, - & 0.135, 0.137, 0.139, 0.141, 0.143, 0.145, 0.146, 0.148, 0.150, - & 0.152, 0.154, 0.156, 0.158, 0.159, 0.161, 0.163, 0.165, 0.167, - & 0.169, 0.170, 0.172, 0.174, 0.176, 0.178, 0.180, 0.181, 0.183, - & 0.185, 0.187, 0.189, 0.190, 0.192, 0.194, 0.196, 0.198, 0.199, - & 0.201, 0.203, 0.205, 0.206, 0.208, 0.210, 0.212, 0.214, 0.215, - & 0.217, 0.219, 0.221, 0.222, 0.224, 0.226, 0.228, 0.229, 0.231, - & 0.233, 0.235, 0.236, 0.238, 0.240, 0.242, 0.243, 0.245, 0.247, - & 0.248, 0.250, 0.252, 0.254, 0.255, 0.257, 0.259, 0.260, 0.262, - & 0.264, 0.265, 0.267, 0.269, 0.271, 0.272, 0.274, 0.276, 0.277, - & 0.279, 0.281, 0.282, 0.284, 0.286, 0.287, 0.289, 0.291, 0.292, - & 0.294, 0.296, 0.297, 0.299, 0.301, 0.302, 0.304, 0.305, 0.307, - & 0.309, 0.310, 0.312, 0.314, 0.315, 0.317, 0.318, 0.320, 0.322, - & 0.323, 0.325, 0.327, 0.328, 0.330, 0.331, 0.333, 0.335, 0.336, - & 0.338, 0.339, 0.341, 0.343, 0.344, 0.346, 0.347, 0.349, 0.350, - & 0.352, 0.354, 0.355, 0.357, 0.358, 0.360, 0.361, 0.363, 0.364, - & 0.366, 0.368, 0.369, 0.371, 0.372, 0.374, 0.375, 0.377, 0.378, - & 0.380, 0.381, 0.383, 0.384, 0.386, 0.388, 0.389, 0.391, 0.392, - & 0.394, 0.395, 0.397, 0.398, 0.400, 0.401, 0.403, 0.404, 0.406, - & 0.407, 0.409, 0.410, 0.412, 0.413, 0.415, 0.416, 0.418, 0.419, - & 0.421, 0.422, 0.423, 0.425, 0.426, 0.428, 0.429, 0.431, 0.432, - & 0.434, 0.435, 0.437, 0.438, 0.440, 0.441, 0.442, 0.444, 0.445, - & 0.447, 0.448, 0.450, 0.451, 0.466, 0.480, 0.494, 0.508, 0.522, - & 0.535, 0.548, 0.561, 0.574, 0.586, 0.599, 0.611, 0.624, 0.636, - & 0.648, 0.659, 0.671, 0.683, 0.694, 0.705, 0.716, 0.727, 0.738, - & 0.749, 0.760, 0.770, 0.781, 0.791, 0.801, 0.811, 0.821, 0.831, - & 0.841, 0.851, 0.861, 0.870, 0.879, 0.889, 0.898, 0.907, 0.916, - & 0.925, 0.934, 0.943, 0.952, 0.961, 0.969, 0.978, 0.986, 0.995, - & 1.003, 1.011, 1.019, 1.028, 1.036, 1.044, 1.051, 1.059, 1.067, - & 1.075, 1.082, 1.090, 1.098, 1.105, 1.113, 1.120, 1.127, 1.135, - & 1.142, 1.149, 1.156, 1.163, 1.170, 1.177, 1.184, 1.191, 1.198, - & 1.204, 1.211, 1.218, 1.224, 1.231, 1.237, 1.244, 1.250, 1.257, - & 1.263, 1.269, 1.276, 1.282, 1.288, 1.294, 1.300, 1.307, 1.313, - & 1.319, 1.325, 1.330, 1.336, 1.342, 1.348, 1.354, 1.360, 1.365, - & 1.371, 1.377, 1.382, 1.388, 1.393, 1.399, 1.404, 1.410, 1.415, - & 1.421, 1.426, 1.431, 1.437, 1.442, 1.447, 1.453, 1.458, 1.463, - & 1.468, 1.473, 1.478, 1.483, 1.488, 1.493, 1.498, 1.503, 1.508, - & 1.513, 1.518, 1.523, 1.528, 1.532, 1.537, 1.542, 1.547, 1.551, - & 1.556, 1.561, 1.565, 1.570, 1.575, 1.579, 1.584, 1.588, 1.593, - & 1.597, 1.602, 1.606, 1.611, 1.615, 1.620, 1.624, 1.628, 1.633, - & 1.637, 1.641, 1.645 - & / -C -C *** Na2SO4 -C - DATA BNC02M/ - &-0.093,-0.202,-0.256,-0.295,-0.325,-0.349,-0.371,-0.389,-0.405, - &-0.420,-0.434,-0.446,-0.457,-0.468,-0.478,-0.487,-0.496,-0.504, - &-0.512,-0.520,-0.527,-0.533,-0.540,-0.546,-0.552,-0.558,-0.563, - &-0.569,-0.574,-0.579,-0.584,-0.588,-0.593,-0.597,-0.602,-0.606, - &-0.610,-0.614,-0.618,-0.621,-0.625,-0.628,-0.632,-0.635,-0.639, - &-0.642,-0.645,-0.648,-0.651,-0.654,-0.657,-0.660,-0.663,-0.665, - &-0.668,-0.671,-0.673,-0.676,-0.678,-0.681,-0.683,-0.686,-0.688, - &-0.690,-0.692,-0.695,-0.697,-0.699,-0.701,-0.703,-0.705,-0.707, - &-0.709,-0.711,-0.713,-0.715,-0.717,-0.719,-0.721,-0.723,-0.724, - &-0.726,-0.728,-0.730,-0.731,-0.733,-0.735,-0.737,-0.738,-0.740, - &-0.741,-0.743,-0.745,-0.746,-0.748,-0.749,-0.751,-0.752,-0.754, - &-0.755,-0.757,-0.758,-0.760,-0.761,-0.763,-0.764,-0.766,-0.767, - &-0.768,-0.770,-0.771,-0.772,-0.774,-0.775,-0.776,-0.778,-0.779, - &-0.780,-0.782,-0.783,-0.784,-0.785,-0.787,-0.788,-0.789,-0.790, - &-0.791,-0.793,-0.794,-0.795,-0.796,-0.797,-0.798,-0.800,-0.801, - &-0.802,-0.803,-0.804,-0.805,-0.806,-0.807,-0.808,-0.810,-0.811, - &-0.812,-0.813,-0.814,-0.815,-0.816,-0.817,-0.818,-0.819,-0.820, - &-0.821,-0.822,-0.823,-0.824,-0.825,-0.826,-0.827,-0.828,-0.829, - &-0.830,-0.831,-0.832,-0.832,-0.833,-0.834,-0.835,-0.836,-0.837, - &-0.838,-0.839,-0.840,-0.841,-0.841,-0.842,-0.843,-0.844,-0.845, - &-0.846,-0.847,-0.847,-0.848,-0.849,-0.850,-0.851,-0.852,-0.852, - &-0.853,-0.854,-0.855,-0.856,-0.856,-0.857,-0.858,-0.859,-0.860, - &-0.860,-0.861,-0.862,-0.863,-0.864,-0.864,-0.865,-0.866,-0.867, - &-0.867,-0.868,-0.869,-0.869,-0.870,-0.871,-0.872,-0.872,-0.873, - &-0.874,-0.875,-0.875,-0.876,-0.877,-0.877,-0.878,-0.879,-0.879, - &-0.880,-0.881,-0.882,-0.882,-0.883,-0.884,-0.884,-0.885,-0.886, - &-0.886,-0.887,-0.888,-0.888,-0.889,-0.889,-0.890,-0.891,-0.891, - &-0.892,-0.893,-0.893,-0.894,-0.895,-0.895,-0.896,-0.896,-0.897, - &-0.898,-0.898,-0.899,-0.899,-0.900,-0.901,-0.901,-0.902,-0.903, - &-0.903,-0.904,-0.904,-0.905,-0.905,-0.906,-0.907,-0.907,-0.908, - &-0.908,-0.909,-0.910,-0.910,-0.911,-0.911,-0.912,-0.912,-0.913, - &-0.913,-0.914,-0.915,-0.915,-0.916,-0.916,-0.917,-0.917,-0.918, - &-0.918,-0.919,-0.919,-0.920,-0.921,-0.921,-0.922,-0.922,-0.923, - &-0.923,-0.924,-0.924,-0.925,-0.925,-0.926,-0.926,-0.927,-0.927, - &-0.928,-0.928,-0.929,-0.929,-0.930,-0.930,-0.931,-0.931,-0.932, - &-0.932,-0.933,-0.933,-0.934,-0.934,-0.935,-0.935,-0.936,-0.936, - &-0.937,-0.937,-0.938,-0.938,-0.939,-0.939,-0.940,-0.940,-0.940, - &-0.941,-0.941,-0.942,-0.942,-0.943,-0.943,-0.944,-0.944,-0.945, - &-0.945,-0.946,-0.946,-0.946,-0.947,-0.947,-0.948,-0.948,-0.949, - &-0.949,-0.950,-0.950,-0.950,-0.951,-0.951,-0.952,-0.952,-0.953, - &-0.953,-0.954,-0.954,-0.954,-0.955,-0.955,-0.956,-0.956,-0.957, - &-0.957,-0.957,-0.958,-0.958,-0.959,-0.959,-0.959,-0.960,-0.960, - &-0.961,-0.961,-0.962,-0.962,-0.962,-0.963,-0.963,-0.964,-0.964, - &-0.964,-0.965,-0.965,-0.966,-0.966,-0.966,-0.967,-0.967,-0.968, - &-0.968,-0.968,-0.969,-0.969,-0.973,-0.977,-0.981,-0.984,-0.988, - &-0.991,-0.995,-0.998,-1.001,-1.004,-1.007,-1.010,-1.013,-1.016, - &-1.019,-1.022,-1.024,-1.027,-1.030,-1.032,-1.035,-1.037,-1.040, - &-1.042,-1.045,-1.047,-1.049,-1.052,-1.054,-1.056,-1.058,-1.061, - &-1.063,-1.065,-1.067,-1.069,-1.071,-1.073,-1.075,-1.077,-1.079, - &-1.080,-1.082,-1.084,-1.086,-1.088,-1.089,-1.091,-1.093,-1.095, - &-1.096,-1.098,-1.100,-1.101,-1.103,-1.104,-1.106,-1.108,-1.109, - &-1.111,-1.112,-1.114,-1.115,-1.117,-1.118,-1.119,-1.121,-1.122, - &-1.124,-1.125,-1.126,-1.128,-1.129,-1.130,-1.132,-1.133,-1.134, - &-1.135,-1.137,-1.138,-1.139,-1.140,-1.142,-1.143,-1.144,-1.145, - &-1.146,-1.148,-1.149,-1.150,-1.151,-1.152,-1.153,-1.154,-1.155, - &-1.157,-1.158,-1.159,-1.160,-1.161,-1.162,-1.163,-1.164,-1.165, - &-1.166,-1.167,-1.168,-1.169,-1.170,-1.171,-1.172,-1.173,-1.174, - &-1.175,-1.176,-1.177,-1.178,-1.179,-1.180,-1.180,-1.181,-1.182, - &-1.183,-1.184,-1.185,-1.186,-1.187,-1.188,-1.188,-1.189,-1.190, - &-1.191,-1.192,-1.193,-1.193,-1.194,-1.195,-1.196,-1.197,-1.198, - &-1.198,-1.199,-1.200,-1.201,-1.201,-1.202,-1.203,-1.204,-1.205, - &-1.205,-1.206,-1.207,-1.208,-1.208,-1.209,-1.210,-1.210,-1.211, - &-1.212,-1.213,-1.213 - & / -C -C *** NaNO3 -C - DATA BNC03M/ - &-0.047,-0.102,-0.129,-0.149,-0.164,-0.177,-0.188,-0.198,-0.206, - &-0.214,-0.221,-0.228,-0.234,-0.239,-0.245,-0.250,-0.255,-0.259, - &-0.263,-0.267,-0.271,-0.275,-0.279,-0.282,-0.285,-0.289,-0.292, - &-0.295,-0.298,-0.300,-0.303,-0.306,-0.308,-0.311,-0.313,-0.316, - &-0.318,-0.320,-0.322,-0.324,-0.326,-0.329,-0.331,-0.332,-0.334, - &-0.336,-0.338,-0.340,-0.342,-0.343,-0.345,-0.347,-0.348,-0.350, - &-0.352,-0.353,-0.355,-0.356,-0.358,-0.359,-0.360,-0.362,-0.363, - &-0.365,-0.366,-0.367,-0.369,-0.370,-0.371,-0.372,-0.374,-0.375, - &-0.376,-0.377,-0.378,-0.380,-0.381,-0.382,-0.383,-0.384,-0.385, - &-0.386,-0.388,-0.389,-0.390,-0.391,-0.392,-0.393,-0.394,-0.395, - &-0.396,-0.397,-0.398,-0.399,-0.400,-0.401,-0.402,-0.403,-0.404, - &-0.405,-0.406,-0.407,-0.408,-0.408,-0.409,-0.410,-0.411,-0.412, - &-0.413,-0.414,-0.415,-0.416,-0.416,-0.417,-0.418,-0.419,-0.420, - &-0.421,-0.422,-0.422,-0.423,-0.424,-0.425,-0.426,-0.427,-0.427, - &-0.428,-0.429,-0.430,-0.430,-0.431,-0.432,-0.433,-0.434,-0.434, - &-0.435,-0.436,-0.437,-0.437,-0.438,-0.439,-0.439,-0.440,-0.441, - &-0.442,-0.442,-0.443,-0.444,-0.444,-0.445,-0.446,-0.447,-0.447, - &-0.448,-0.449,-0.449,-0.450,-0.451,-0.451,-0.452,-0.453,-0.453, - &-0.454,-0.454,-0.455,-0.456,-0.456,-0.457,-0.458,-0.458,-0.459, - &-0.460,-0.460,-0.461,-0.461,-0.462,-0.463,-0.463,-0.464,-0.464, - &-0.465,-0.466,-0.466,-0.467,-0.467,-0.468,-0.468,-0.469,-0.470, - &-0.470,-0.471,-0.471,-0.472,-0.472,-0.473,-0.474,-0.474,-0.475, - &-0.475,-0.476,-0.476,-0.477,-0.477,-0.478,-0.478,-0.479,-0.479, - &-0.480,-0.480,-0.481,-0.482,-0.482,-0.483,-0.483,-0.484,-0.484, - &-0.485,-0.485,-0.486,-0.486,-0.487,-0.487,-0.488,-0.488,-0.489, - &-0.489,-0.490,-0.490,-0.491,-0.491,-0.491,-0.492,-0.492,-0.493, - &-0.493,-0.494,-0.494,-0.495,-0.495,-0.496,-0.496,-0.497,-0.497, - &-0.498,-0.498,-0.498,-0.499,-0.499,-0.500,-0.500,-0.501,-0.501, - &-0.502,-0.502,-0.502,-0.503,-0.503,-0.504,-0.504,-0.505,-0.505, - &-0.505,-0.506,-0.506,-0.507,-0.507,-0.508,-0.508,-0.508,-0.509, - &-0.509,-0.510,-0.510,-0.511,-0.511,-0.511,-0.512,-0.512,-0.513, - &-0.513,-0.513,-0.514,-0.514,-0.515,-0.515,-0.515,-0.516,-0.516, - &-0.517,-0.517,-0.517,-0.518,-0.518,-0.518,-0.519,-0.519,-0.520, - &-0.520,-0.520,-0.521,-0.521,-0.522,-0.522,-0.522,-0.523,-0.523, - &-0.523,-0.524,-0.524,-0.525,-0.525,-0.525,-0.526,-0.526,-0.526, - &-0.527,-0.527,-0.527,-0.528,-0.528,-0.529,-0.529,-0.529,-0.530, - &-0.530,-0.530,-0.531,-0.531,-0.531,-0.532,-0.532,-0.532,-0.533, - &-0.533,-0.533,-0.534,-0.534,-0.534,-0.535,-0.535,-0.535,-0.536, - &-0.536,-0.536,-0.537,-0.537,-0.537,-0.538,-0.538,-0.538,-0.539, - &-0.539,-0.539,-0.540,-0.540,-0.540,-0.541,-0.541,-0.541,-0.542, - &-0.542,-0.542,-0.543,-0.543,-0.543,-0.544,-0.544,-0.544,-0.545, - &-0.545,-0.545,-0.546,-0.546,-0.546,-0.546,-0.547,-0.547,-0.547, - &-0.548,-0.548,-0.548,-0.549,-0.549,-0.549,-0.549,-0.550,-0.550, - &-0.550,-0.551,-0.551,-0.551,-0.552,-0.552,-0.552,-0.552,-0.553, - &-0.553,-0.553,-0.554,-0.554,-0.557,-0.560,-0.563,-0.565,-0.568, - &-0.570,-0.573,-0.575,-0.578,-0.580,-0.583,-0.585,-0.587,-0.589, - &-0.592,-0.594,-0.596,-0.598,-0.600,-0.602,-0.604,-0.606,-0.608, - &-0.609,-0.611,-0.613,-0.615,-0.617,-0.618,-0.620,-0.622,-0.623, - &-0.625,-0.627,-0.628,-0.630,-0.631,-0.633,-0.634,-0.636,-0.637, - &-0.639,-0.640,-0.642,-0.643,-0.644,-0.646,-0.647,-0.648,-0.650, - &-0.651,-0.652,-0.653,-0.655,-0.656,-0.657,-0.658,-0.660,-0.661, - &-0.662,-0.663,-0.664,-0.665,-0.667,-0.668,-0.669,-0.670,-0.671, - &-0.672,-0.673,-0.674,-0.675,-0.676,-0.677,-0.678,-0.679,-0.680, - &-0.681,-0.682,-0.683,-0.684,-0.685,-0.686,-0.687,-0.688,-0.689, - &-0.690,-0.691,-0.692,-0.692,-0.693,-0.694,-0.695,-0.696,-0.697, - &-0.698,-0.698,-0.699,-0.700,-0.701,-0.702,-0.703,-0.703,-0.704, - &-0.705,-0.706,-0.706,-0.707,-0.708,-0.709,-0.709,-0.710,-0.711, - &-0.712,-0.712,-0.713,-0.714,-0.715,-0.715,-0.716,-0.717,-0.717, - &-0.718,-0.719,-0.719,-0.720,-0.721,-0.721,-0.722,-0.723,-0.723, - &-0.724,-0.725,-0.725,-0.726,-0.727,-0.727,-0.728,-0.729,-0.729, - &-0.730,-0.730,-0.731,-0.732,-0.732,-0.733,-0.733,-0.734,-0.735, - &-0.735,-0.736,-0.736,-0.737,-0.737,-0.738,-0.739,-0.739,-0.740, - &-0.740,-0.741,-0.741 - & / -C -C *** (NH4)2SO4 -C - DATA BNC04M/ - &-0.093,-0.203,-0.257,-0.296,-0.326,-0.351,-0.372,-0.391,-0.408, - &-0.423,-0.436,-0.449,-0.460,-0.471,-0.481,-0.491,-0.500,-0.508, - &-0.516,-0.524,-0.531,-0.538,-0.545,-0.552,-0.558,-0.564,-0.569, - &-0.575,-0.580,-0.585,-0.590,-0.595,-0.600,-0.605,-0.609,-0.613, - &-0.618,-0.622,-0.626,-0.629,-0.633,-0.637,-0.641,-0.644,-0.648, - &-0.651,-0.654,-0.658,-0.661,-0.664,-0.667,-0.670,-0.673,-0.676, - &-0.678,-0.681,-0.684,-0.687,-0.689,-0.692,-0.694,-0.697,-0.699, - &-0.702,-0.704,-0.707,-0.709,-0.711,-0.713,-0.716,-0.718,-0.720, - &-0.722,-0.724,-0.726,-0.728,-0.730,-0.732,-0.734,-0.736,-0.738, - &-0.740,-0.742,-0.744,-0.746,-0.748,-0.749,-0.751,-0.753,-0.755, - &-0.756,-0.758,-0.760,-0.762,-0.763,-0.765,-0.767,-0.768,-0.770, - &-0.772,-0.773,-0.775,-0.776,-0.778,-0.779,-0.781,-0.782,-0.784, - &-0.786,-0.787,-0.788,-0.790,-0.791,-0.793,-0.794,-0.796,-0.797, - &-0.799,-0.800,-0.801,-0.803,-0.804,-0.805,-0.807,-0.808,-0.809, - &-0.811,-0.812,-0.813,-0.815,-0.816,-0.817,-0.819,-0.820,-0.821, - &-0.822,-0.824,-0.825,-0.826,-0.827,-0.828,-0.830,-0.831,-0.832, - &-0.833,-0.834,-0.835,-0.837,-0.838,-0.839,-0.840,-0.841,-0.842, - &-0.843,-0.844,-0.846,-0.847,-0.848,-0.849,-0.850,-0.851,-0.852, - &-0.853,-0.854,-0.855,-0.856,-0.857,-0.858,-0.859,-0.860,-0.861, - &-0.862,-0.863,-0.864,-0.865,-0.866,-0.867,-0.868,-0.869,-0.870, - &-0.871,-0.872,-0.873,-0.874,-0.875,-0.876,-0.877,-0.878,-0.878, - &-0.879,-0.880,-0.881,-0.882,-0.883,-0.884,-0.885,-0.886,-0.886, - &-0.887,-0.888,-0.889,-0.890,-0.891,-0.892,-0.893,-0.893,-0.894, - &-0.895,-0.896,-0.897,-0.898,-0.898,-0.899,-0.900,-0.901,-0.902, - &-0.902,-0.903,-0.904,-0.905,-0.906,-0.906,-0.907,-0.908,-0.909, - &-0.910,-0.910,-0.911,-0.912,-0.913,-0.913,-0.914,-0.915,-0.916, - &-0.916,-0.917,-0.918,-0.919,-0.919,-0.920,-0.921,-0.922,-0.922, - &-0.923,-0.924,-0.924,-0.925,-0.926,-0.927,-0.927,-0.928,-0.929, - &-0.929,-0.930,-0.931,-0.931,-0.932,-0.933,-0.933,-0.934,-0.935, - &-0.936,-0.936,-0.937,-0.938,-0.938,-0.939,-0.940,-0.940,-0.941, - &-0.941,-0.942,-0.943,-0.943,-0.944,-0.945,-0.945,-0.946,-0.947, - &-0.947,-0.948,-0.949,-0.949,-0.950,-0.950,-0.951,-0.952,-0.952, - &-0.953,-0.954,-0.954,-0.955,-0.955,-0.956,-0.957,-0.957,-0.958, - &-0.958,-0.959,-0.960,-0.960,-0.961,-0.961,-0.962,-0.962,-0.963, - &-0.964,-0.964,-0.965,-0.965,-0.966,-0.967,-0.967,-0.968,-0.968, - &-0.969,-0.969,-0.970,-0.970,-0.971,-0.972,-0.972,-0.973,-0.973, - &-0.974,-0.974,-0.975,-0.975,-0.976,-0.977,-0.977,-0.978,-0.978, - &-0.979,-0.979,-0.980,-0.980,-0.981,-0.981,-0.982,-0.982,-0.983, - &-0.983,-0.984,-0.984,-0.985,-0.986,-0.986,-0.987,-0.987,-0.988, - &-0.988,-0.989,-0.989,-0.990,-0.990,-0.991,-0.991,-0.992,-0.992, - &-0.993,-0.993,-0.994,-0.994,-0.995,-0.995,-0.996,-0.996,-0.997, - &-0.997,-0.998,-0.998,-0.998,-0.999,-0.999,-1.000,-1.000,-1.001, - &-1.001,-1.002,-1.002,-1.003,-1.003,-1.004,-1.004,-1.005,-1.005, - &-1.006,-1.006,-1.006,-1.007,-1.007,-1.008,-1.008,-1.009,-1.009, - &-1.010,-1.010,-1.011,-1.011,-1.016,-1.020,-1.024,-1.029,-1.033, - &-1.037,-1.040,-1.044,-1.048,-1.052,-1.055,-1.059,-1.062,-1.065, - &-1.069,-1.072,-1.075,-1.078,-1.081,-1.084,-1.087,-1.090,-1.093, - &-1.096,-1.099,-1.102,-1.104,-1.107,-1.110,-1.112,-1.115,-1.117, - &-1.120,-1.122,-1.125,-1.127,-1.129,-1.132,-1.134,-1.136,-1.139, - &-1.141,-1.143,-1.145,-1.147,-1.149,-1.151,-1.153,-1.155,-1.157, - &-1.159,-1.161,-1.163,-1.165,-1.167,-1.169,-1.171,-1.173,-1.174, - &-1.176,-1.178,-1.180,-1.181,-1.183,-1.185,-1.187,-1.188,-1.190, - &-1.191,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201,-1.202,-1.204, - &-1.205,-1.207,-1.208,-1.210,-1.211,-1.213,-1.214,-1.216,-1.217, - &-1.218,-1.220,-1.221,-1.223,-1.224,-1.225,-1.226,-1.228,-1.229, - &-1.230,-1.232,-1.233,-1.234,-1.235,-1.237,-1.238,-1.239,-1.240, - &-1.242,-1.243,-1.244,-1.245,-1.246,-1.247,-1.249,-1.250,-1.251, - &-1.252,-1.253,-1.254,-1.255,-1.256,-1.258,-1.259,-1.260,-1.261, - &-1.262,-1.263,-1.264,-1.265,-1.266,-1.267,-1.268,-1.269,-1.270, - &-1.271,-1.272,-1.273,-1.274,-1.275,-1.276,-1.277,-1.278,-1.279, - &-1.280,-1.281,-1.282,-1.283,-1.283,-1.284,-1.285,-1.286,-1.287, - &-1.288,-1.289,-1.290,-1.291,-1.292,-1.292,-1.293,-1.294,-1.295, - &-1.296,-1.297,-1.298 - & / -C -C *** NH4NO3 -C - DATA BNC05M/ - &-0.047,-0.104,-0.134,-0.155,-0.172,-0.187,-0.199,-0.211,-0.221, - &-0.230,-0.239,-0.247,-0.255,-0.262,-0.268,-0.275,-0.281,-0.287, - &-0.293,-0.298,-0.303,-0.308,-0.313,-0.318,-0.323,-0.327,-0.332, - &-0.336,-0.340,-0.344,-0.348,-0.352,-0.356,-0.359,-0.363,-0.366, - &-0.370,-0.373,-0.377,-0.380,-0.383,-0.386,-0.389,-0.392,-0.395, - &-0.398,-0.401,-0.404,-0.406,-0.409,-0.412,-0.414,-0.417,-0.420, - &-0.422,-0.425,-0.427,-0.429,-0.432,-0.434,-0.436,-0.439,-0.441, - &-0.443,-0.445,-0.447,-0.450,-0.452,-0.454,-0.456,-0.458,-0.460, - &-0.462,-0.464,-0.466,-0.468,-0.470,-0.472,-0.474,-0.476,-0.478, - &-0.480,-0.481,-0.483,-0.485,-0.487,-0.489,-0.491,-0.492,-0.494, - &-0.496,-0.498,-0.500,-0.501,-0.503,-0.505,-0.507,-0.508,-0.510, - &-0.512,-0.514,-0.515,-0.517,-0.519,-0.520,-0.522,-0.524,-0.525, - &-0.527,-0.529,-0.530,-0.532,-0.534,-0.535,-0.537,-0.538,-0.540, - &-0.542,-0.543,-0.545,-0.546,-0.548,-0.550,-0.551,-0.553,-0.554, - &-0.556,-0.557,-0.559,-0.560,-0.562,-0.563,-0.565,-0.566,-0.568, - &-0.569,-0.571,-0.572,-0.573,-0.575,-0.576,-0.578,-0.579,-0.580, - &-0.582,-0.583,-0.585,-0.586,-0.587,-0.589,-0.590,-0.591,-0.593, - &-0.594,-0.595,-0.597,-0.598,-0.599,-0.601,-0.602,-0.603,-0.604, - &-0.606,-0.607,-0.608,-0.610,-0.611,-0.612,-0.613,-0.615,-0.616, - &-0.617,-0.618,-0.619,-0.621,-0.622,-0.623,-0.624,-0.625,-0.627, - &-0.628,-0.629,-0.630,-0.631,-0.632,-0.634,-0.635,-0.636,-0.637, - &-0.638,-0.639,-0.640,-0.642,-0.643,-0.644,-0.645,-0.646,-0.647, - &-0.648,-0.649,-0.650,-0.651,-0.652,-0.654,-0.655,-0.656,-0.657, - &-0.658,-0.659,-0.660,-0.661,-0.662,-0.663,-0.664,-0.665,-0.666, - &-0.667,-0.668,-0.669,-0.670,-0.671,-0.672,-0.673,-0.674,-0.675, - &-0.676,-0.677,-0.678,-0.679,-0.680,-0.681,-0.682,-0.683,-0.684, - &-0.685,-0.686,-0.687,-0.688,-0.688,-0.689,-0.690,-0.691,-0.692, - &-0.693,-0.694,-0.695,-0.696,-0.697,-0.698,-0.699,-0.699,-0.700, - &-0.701,-0.702,-0.703,-0.704,-0.705,-0.706,-0.707,-0.707,-0.708, - &-0.709,-0.710,-0.711,-0.712,-0.713,-0.713,-0.714,-0.715,-0.716, - &-0.717,-0.718,-0.718,-0.719,-0.720,-0.721,-0.722,-0.723,-0.723, - &-0.724,-0.725,-0.726,-0.727,-0.727,-0.728,-0.729,-0.730,-0.731, - &-0.731,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736,-0.737,-0.738, - &-0.738,-0.739,-0.740,-0.741,-0.741,-0.742,-0.743,-0.744,-0.744, - &-0.745,-0.746,-0.747,-0.747,-0.748,-0.749,-0.750,-0.750,-0.751, - &-0.752,-0.753,-0.753,-0.754,-0.755,-0.755,-0.756,-0.757,-0.758, - &-0.758,-0.759,-0.760,-0.760,-0.761,-0.762,-0.762,-0.763,-0.764, - &-0.764,-0.765,-0.766,-0.767,-0.767,-0.768,-0.769,-0.769,-0.770, - &-0.771,-0.771,-0.772,-0.773,-0.773,-0.774,-0.775,-0.775,-0.776, - &-0.777,-0.777,-0.778,-0.778,-0.779,-0.780,-0.780,-0.781,-0.782, - &-0.782,-0.783,-0.784,-0.784,-0.785,-0.785,-0.786,-0.787,-0.787, - &-0.788,-0.789,-0.789,-0.790,-0.790,-0.791,-0.792,-0.792,-0.793, - &-0.793,-0.794,-0.795,-0.795,-0.796,-0.796,-0.797,-0.798,-0.798, - &-0.799,-0.799,-0.800,-0.801,-0.801,-0.802,-0.802,-0.803,-0.804, - &-0.804,-0.805,-0.805,-0.806,-0.812,-0.817,-0.823,-0.828,-0.833, - &-0.838,-0.843,-0.848,-0.852,-0.857,-0.861,-0.866,-0.870,-0.874, - &-0.878,-0.882,-0.886,-0.890,-0.893,-0.897,-0.900,-0.904,-0.907, - &-0.911,-0.914,-0.917,-0.920,-0.924,-0.927,-0.930,-0.933,-0.936, - &-0.938,-0.941,-0.944,-0.947,-0.949,-0.952,-0.954,-0.957,-0.959, - &-0.962,-0.964,-0.967,-0.969,-0.971,-0.973,-0.976,-0.978,-0.980, - &-0.982,-0.984,-0.986,-0.988,-0.990,-0.992,-0.994,-0.996,-0.998, - &-1.000,-1.002,-1.003,-1.005,-1.007,-1.009,-1.010,-1.012,-1.014, - &-1.015,-1.017,-1.019,-1.020,-1.022,-1.023,-1.025,-1.026,-1.028, - &-1.029,-1.031,-1.032,-1.033,-1.035,-1.036,-1.037,-1.039,-1.040, - &-1.041,-1.043,-1.044,-1.045,-1.046,-1.048,-1.049,-1.050,-1.051, - &-1.052,-1.054,-1.055,-1.056,-1.057,-1.058,-1.059,-1.060,-1.061, - &-1.062,-1.063,-1.064,-1.066,-1.067,-1.068,-1.069,-1.070,-1.070, - &-1.071,-1.072,-1.073,-1.074,-1.075,-1.076,-1.077,-1.078,-1.079, - &-1.080,-1.081,-1.081,-1.082,-1.083,-1.084,-1.085,-1.086,-1.086, - &-1.087,-1.088,-1.089,-1.090,-1.090,-1.091,-1.092,-1.093,-1.093, - &-1.094,-1.095,-1.096,-1.096,-1.097,-1.098,-1.099,-1.099,-1.100, - &-1.101,-1.101,-1.102,-1.103,-1.103,-1.104,-1.105,-1.105,-1.106, - &-1.107,-1.107,-1.108 - & / -C -C *** NH4Cl -C - DATA BNC06M/ - &-0.046,-0.098,-0.123,-0.140,-0.153,-0.163,-0.172,-0.180,-0.186, - &-0.191,-0.196,-0.201,-0.205,-0.208,-0.212,-0.215,-0.217,-0.220, - &-0.222,-0.224,-0.226,-0.228,-0.230,-0.231,-0.233,-0.234,-0.235, - &-0.237,-0.238,-0.239,-0.240,-0.241,-0.241,-0.242,-0.243,-0.244, - &-0.244,-0.245,-0.246,-0.246,-0.247,-0.247,-0.247,-0.248,-0.248, - &-0.249,-0.249,-0.249,-0.250,-0.250,-0.250,-0.250,-0.251,-0.251, - &-0.251,-0.251,-0.251,-0.251,-0.252,-0.252,-0.252,-0.252,-0.252, - &-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252, - &-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.251,-0.251, - &-0.251,-0.251,-0.251,-0.251,-0.250,-0.250,-0.250,-0.250,-0.250, - &-0.249,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.248,-0.247, - &-0.247,-0.247,-0.246,-0.246,-0.246,-0.245,-0.245,-0.245,-0.244, - &-0.244,-0.244,-0.243,-0.243,-0.243,-0.242,-0.242,-0.241,-0.241, - &-0.241,-0.240,-0.240,-0.239,-0.239,-0.239,-0.238,-0.238,-0.237, - &-0.237,-0.236,-0.236,-0.236,-0.235,-0.235,-0.234,-0.234,-0.233, - &-0.233,-0.233,-0.232,-0.232,-0.231,-0.231,-0.230,-0.230,-0.229, - &-0.229,-0.228,-0.228,-0.228,-0.227,-0.227,-0.226,-0.226,-0.225, - &-0.225,-0.224,-0.224,-0.223,-0.223,-0.222,-0.222,-0.221,-0.221, - &-0.220,-0.220,-0.220,-0.219,-0.219,-0.218,-0.218,-0.217,-0.217, - &-0.216,-0.216,-0.215,-0.215,-0.214,-0.214,-0.213,-0.213,-0.212, - &-0.212,-0.211,-0.211,-0.210,-0.210,-0.210,-0.209,-0.209,-0.208, - &-0.208,-0.207,-0.207,-0.206,-0.206,-0.205,-0.205,-0.204,-0.204, - &-0.203,-0.203,-0.202,-0.202,-0.201,-0.201,-0.200,-0.200,-0.199, - &-0.199,-0.198,-0.198,-0.197,-0.197,-0.197,-0.196,-0.196,-0.195, - &-0.195,-0.194,-0.194,-0.193,-0.193,-0.192,-0.192,-0.191,-0.191, - &-0.190,-0.190,-0.189,-0.189,-0.188,-0.188,-0.187,-0.187,-0.186, - &-0.186,-0.186,-0.185,-0.185,-0.184,-0.184,-0.183,-0.183,-0.182, - &-0.182,-0.181,-0.181,-0.180,-0.180,-0.179,-0.179,-0.178,-0.178, - &-0.177,-0.177,-0.177,-0.176,-0.176,-0.175,-0.175,-0.174,-0.174, - &-0.173,-0.173,-0.172,-0.172,-0.171,-0.171,-0.170,-0.170,-0.170, - &-0.169,-0.169,-0.168,-0.168,-0.167,-0.167,-0.166,-0.166,-0.165, - &-0.165,-0.164,-0.164,-0.164,-0.163,-0.163,-0.162,-0.162,-0.161, - &-0.161,-0.160,-0.160,-0.159,-0.159,-0.159,-0.158,-0.158,-0.157, - &-0.157,-0.156,-0.156,-0.155,-0.155,-0.154,-0.154,-0.154,-0.153, - &-0.153,-0.152,-0.152,-0.151,-0.151,-0.150,-0.150,-0.149,-0.149, - &-0.149,-0.148,-0.148,-0.147,-0.147,-0.146,-0.146,-0.145,-0.145, - &-0.145,-0.144,-0.144,-0.143,-0.143,-0.142,-0.142,-0.142,-0.141, - &-0.141,-0.140,-0.140,-0.139,-0.139,-0.138,-0.138,-0.138,-0.137, - &-0.137,-0.136,-0.136,-0.135,-0.135,-0.135,-0.134,-0.134,-0.133, - &-0.133,-0.132,-0.132,-0.132,-0.131,-0.131,-0.130,-0.130,-0.129, - &-0.129,-0.129,-0.128,-0.128,-0.127,-0.127,-0.126,-0.126,-0.126, - &-0.125,-0.125,-0.124,-0.124,-0.123,-0.123,-0.123,-0.122,-0.122, - &-0.121,-0.121,-0.121,-0.120,-0.120,-0.119,-0.119,-0.118,-0.118, - &-0.118,-0.117,-0.117,-0.116,-0.116,-0.116,-0.115,-0.115,-0.114, - &-0.114,-0.114,-0.113,-0.113,-0.108,-0.104,-0.100,-0.096,-0.092, - &-0.089,-0.085,-0.081,-0.077,-0.074,-0.070,-0.066,-0.063,-0.059, - &-0.055,-0.052,-0.049,-0.045,-0.042,-0.038,-0.035,-0.032,-0.028, - &-0.025,-0.022,-0.019,-0.016,-0.012,-0.009,-0.006,-0.003, 0.000, - & 0.003, 0.006, 0.009, 0.012, 0.014, 0.017, 0.020, 0.023, 0.026, - & 0.029, 0.031, 0.034, 0.037, 0.040, 0.042, 0.045, 0.047, 0.050, - & 0.053, 0.055, 0.058, 0.060, 0.063, 0.065, 0.068, 0.070, 0.073, - & 0.075, 0.078, 0.080, 0.082, 0.085, 0.087, 0.089, 0.092, 0.094, - & 0.096, 0.099, 0.101, 0.103, 0.105, 0.107, 0.110, 0.112, 0.114, - & 0.116, 0.118, 0.120, 0.123, 0.125, 0.127, 0.129, 0.131, 0.133, - & 0.135, 0.137, 0.139, 0.141, 0.143, 0.145, 0.147, 0.149, 0.151, - & 0.153, 0.155, 0.157, 0.159, 0.160, 0.162, 0.164, 0.166, 0.168, - & 0.170, 0.172, 0.173, 0.175, 0.177, 0.179, 0.181, 0.182, 0.184, - & 0.186, 0.188, 0.189, 0.191, 0.193, 0.195, 0.196, 0.198, 0.200, - & 0.201, 0.203, 0.205, 0.206, 0.208, 0.210, 0.211, 0.213, 0.215, - & 0.216, 0.218, 0.219, 0.221, 0.223, 0.224, 0.226, 0.227, 0.229, - & 0.230, 0.232, 0.233, 0.235, 0.236, 0.238, 0.239, 0.241, 0.242, - & 0.244, 0.245, 0.247, 0.248, 0.250, 0.251, 0.253, 0.254, 0.256, - & 0.257, 0.258, 0.260 - & / -C -C *** (2H,SO4) -C - DATA BNC07M/ - &-0.093,-0.202,-0.255,-0.293,-0.323,-0.347,-0.368,-0.386,-0.402, - &-0.417,-0.430,-0.442,-0.453,-0.463,-0.473,-0.482,-0.490,-0.498, - &-0.506,-0.513,-0.520,-0.526,-0.532,-0.538,-0.544,-0.549,-0.555, - &-0.560,-0.565,-0.569,-0.574,-0.578,-0.583,-0.587,-0.591,-0.595, - &-0.598,-0.602,-0.606,-0.609,-0.613,-0.616,-0.619,-0.622,-0.625, - &-0.628,-0.631,-0.634,-0.637,-0.640,-0.642,-0.645,-0.648,-0.650, - &-0.653,-0.655,-0.657,-0.660,-0.662,-0.664,-0.666,-0.669,-0.671, - &-0.673,-0.675,-0.677,-0.679,-0.681,-0.683,-0.685,-0.687,-0.688, - &-0.690,-0.692,-0.694,-0.695,-0.697,-0.699,-0.701,-0.702,-0.704, - &-0.705,-0.707,-0.709,-0.710,-0.712,-0.713,-0.715,-0.716,-0.718, - &-0.719,-0.721,-0.722,-0.723,-0.725,-0.726,-0.727,-0.729,-0.730, - &-0.731,-0.733,-0.734,-0.735,-0.737,-0.738,-0.739,-0.740,-0.741, - &-0.743,-0.744,-0.745,-0.746,-0.747,-0.748,-0.750,-0.751,-0.752, - &-0.753,-0.754,-0.755,-0.756,-0.757,-0.758,-0.759,-0.760,-0.762, - &-0.763,-0.764,-0.765,-0.766,-0.767,-0.768,-0.769,-0.769,-0.770, - &-0.771,-0.772,-0.773,-0.774,-0.775,-0.776,-0.777,-0.778,-0.779, - &-0.780,-0.781,-0.781,-0.782,-0.783,-0.784,-0.785,-0.786,-0.787, - &-0.787,-0.788,-0.789,-0.790,-0.791,-0.792,-0.792,-0.793,-0.794, - &-0.795,-0.795,-0.796,-0.797,-0.798,-0.799,-0.799,-0.800,-0.801, - &-0.802,-0.802,-0.803,-0.804,-0.804,-0.805,-0.806,-0.807,-0.807, - &-0.808,-0.809,-0.809,-0.810,-0.811,-0.811,-0.812,-0.813,-0.814, - &-0.814,-0.815,-0.816,-0.816,-0.817,-0.817,-0.818,-0.819,-0.819, - &-0.820,-0.821,-0.821,-0.822,-0.823,-0.823,-0.824,-0.824,-0.825, - &-0.826,-0.826,-0.827,-0.827,-0.828,-0.829,-0.829,-0.830,-0.830, - &-0.831,-0.831,-0.832,-0.833,-0.833,-0.834,-0.834,-0.835,-0.835, - &-0.836,-0.837,-0.837,-0.838,-0.838,-0.839,-0.839,-0.840,-0.840, - &-0.841,-0.841,-0.842,-0.842,-0.843,-0.843,-0.844,-0.845,-0.845, - &-0.846,-0.846,-0.847,-0.847,-0.848,-0.848,-0.849,-0.849,-0.850, - &-0.850,-0.851,-0.851,-0.851,-0.852,-0.852,-0.853,-0.853,-0.854, - &-0.854,-0.855,-0.855,-0.856,-0.856,-0.857,-0.857,-0.858,-0.858, - &-0.859,-0.859,-0.859,-0.860,-0.860,-0.861,-0.861,-0.862,-0.862, - &-0.863,-0.863,-0.863,-0.864,-0.864,-0.865,-0.865,-0.866,-0.866, - &-0.866,-0.867,-0.867,-0.868,-0.868,-0.869,-0.869,-0.869,-0.870, - &-0.870,-0.871,-0.871,-0.871,-0.872,-0.872,-0.873,-0.873,-0.873, - &-0.874,-0.874,-0.875,-0.875,-0.875,-0.876,-0.876,-0.877,-0.877, - &-0.877,-0.878,-0.878,-0.878,-0.879,-0.879,-0.880,-0.880,-0.880, - &-0.881,-0.881,-0.881,-0.882,-0.882,-0.883,-0.883,-0.883,-0.884, - &-0.884,-0.884,-0.885,-0.885,-0.885,-0.886,-0.886,-0.887,-0.887, - &-0.887,-0.888,-0.888,-0.888,-0.889,-0.889,-0.889,-0.890,-0.890, - &-0.890,-0.891,-0.891,-0.891,-0.892,-0.892,-0.892,-0.893,-0.893, - &-0.893,-0.894,-0.894,-0.894,-0.895,-0.895,-0.895,-0.896,-0.896, - &-0.896,-0.897,-0.897,-0.897,-0.898,-0.898,-0.898,-0.899,-0.899, - &-0.899,-0.900,-0.900,-0.900,-0.901,-0.901,-0.901,-0.901,-0.902, - &-0.902,-0.902,-0.903,-0.903,-0.903,-0.904,-0.904,-0.904,-0.905, - &-0.905,-0.905,-0.905,-0.906,-0.909,-0.912,-0.915,-0.917,-0.920, - &-0.922,-0.925,-0.927,-0.930,-0.932,-0.935,-0.937,-0.939,-0.941, - &-0.943,-0.945,-0.947,-0.949,-0.951,-0.953,-0.955,-0.957,-0.959, - &-0.961,-0.962,-0.964,-0.966,-0.967,-0.969,-0.971,-0.972,-0.974, - &-0.975,-0.977,-0.978,-0.980,-0.981,-0.983,-0.984,-0.986,-0.987, - &-0.988,-0.990,-0.991,-0.992,-0.994,-0.995,-0.996,-0.997,-0.999, - &-1.000,-1.001,-1.002,-1.003,-1.004,-1.006,-1.007,-1.008,-1.009, - &-1.010,-1.011,-1.012,-1.013,-1.014,-1.015,-1.016,-1.017,-1.018, - &-1.019,-1.020,-1.021,-1.022,-1.023,-1.024,-1.025,-1.026,-1.027, - &-1.028,-1.028,-1.029,-1.030,-1.031,-1.032,-1.033,-1.034,-1.034, - &-1.035,-1.036,-1.037,-1.038,-1.039,-1.039,-1.040,-1.041,-1.042, - &-1.042,-1.043,-1.044,-1.045,-1.045,-1.046,-1.047,-1.048,-1.048, - &-1.049,-1.050,-1.050,-1.051,-1.052,-1.052,-1.053,-1.054,-1.055, - &-1.055,-1.056,-1.056,-1.057,-1.058,-1.058,-1.059,-1.060,-1.060, - &-1.061,-1.062,-1.062,-1.063,-1.063,-1.064,-1.065,-1.065,-1.066, - &-1.066,-1.067,-1.068,-1.068,-1.069,-1.069,-1.070,-1.070,-1.071, - &-1.071,-1.072,-1.073,-1.073,-1.074,-1.074,-1.075,-1.075,-1.076, - &-1.076,-1.077,-1.077,-1.078,-1.078,-1.079,-1.079,-1.080,-1.080, - &-1.081,-1.081,-1.082 - & / -C -C *** (H,HSO4) -C - DATA BNC08M/ - &-0.044,-0.088,-0.106,-0.116,-0.123,-0.128,-0.131,-0.133,-0.134, - &-0.134,-0.134,-0.133,-0.131,-0.129,-0.127,-0.125,-0.122,-0.119, - &-0.115,-0.112,-0.108,-0.104,-0.100,-0.095,-0.091,-0.086,-0.081, - &-0.076,-0.071,-0.066,-0.060,-0.055,-0.049,-0.043,-0.037,-0.031, - &-0.025,-0.019,-0.013,-0.006, 0.000, 0.007, 0.013, 0.020, 0.027, - & 0.034, 0.041, 0.048, 0.055, 0.062, 0.069, 0.076, 0.083, 0.090, - & 0.098, 0.105, 0.113, 0.120, 0.127, 0.135, 0.143, 0.150, 0.158, - & 0.166, 0.173, 0.181, 0.189, 0.197, 0.205, 0.212, 0.220, 0.228, - & 0.236, 0.245, 0.253, 0.261, 0.269, 0.277, 0.286, 0.294, 0.302, - & 0.311, 0.319, 0.328, 0.336, 0.345, 0.353, 0.362, 0.371, 0.380, - & 0.388, 0.397, 0.406, 0.415, 0.424, 0.433, 0.442, 0.451, 0.460, - & 0.469, 0.479, 0.488, 0.497, 0.506, 0.516, 0.525, 0.535, 0.544, - & 0.553, 0.563, 0.572, 0.582, 0.591, 0.601, 0.610, 0.620, 0.629, - & 0.639, 0.648, 0.658, 0.667, 0.677, 0.686, 0.696, 0.705, 0.715, - & 0.725, 0.734, 0.744, 0.753, 0.763, 0.772, 0.782, 0.791, 0.800, - & 0.810, 0.819, 0.829, 0.838, 0.848, 0.857, 0.866, 0.876, 0.885, - & 0.894, 0.904, 0.913, 0.922, 0.932, 0.941, 0.950, 0.959, 0.968, - & 0.978, 0.987, 0.996, 1.005, 1.014, 1.023, 1.032, 1.041, 1.050, - & 1.059, 1.069, 1.077, 1.086, 1.095, 1.104, 1.113, 1.122, 1.131, - & 1.140, 1.149, 1.158, 1.166, 1.175, 1.184, 1.193, 1.202, 1.210, - & 1.219, 1.228, 1.236, 1.245, 1.254, 1.262, 1.271, 1.279, 1.288, - & 1.296, 1.305, 1.314, 1.322, 1.330, 1.339, 1.347, 1.356, 1.364, - & 1.373, 1.381, 1.389, 1.398, 1.406, 1.414, 1.422, 1.431, 1.439, - & 1.447, 1.455, 1.464, 1.472, 1.480, 1.488, 1.496, 1.504, 1.512, - & 1.520, 1.528, 1.537, 1.545, 1.553, 1.561, 1.568, 1.576, 1.584, - & 1.592, 1.600, 1.608, 1.616, 1.624, 1.632, 1.639, 1.647, 1.655, - & 1.663, 1.670, 1.678, 1.686, 1.694, 1.701, 1.709, 1.717, 1.724, - & 1.732, 1.740, 1.747, 1.755, 1.762, 1.770, 1.777, 1.785, 1.792, - & 1.800, 1.807, 1.815, 1.822, 1.830, 1.837, 1.844, 1.852, 1.859, - & 1.866, 1.874, 1.881, 1.888, 1.896, 1.903, 1.910, 1.917, 1.925, - & 1.932, 1.939, 1.946, 1.953, 1.961, 1.968, 1.975, 1.982, 1.989, - & 1.996, 2.003, 2.010, 2.017, 2.024, 2.031, 2.038, 2.045, 2.052, - & 2.059, 2.066, 2.073, 2.080, 2.087, 2.094, 2.101, 2.108, 2.114, - & 2.121, 2.128, 2.135, 2.142, 2.148, 2.155, 2.162, 2.169, 2.175, - & 2.182, 2.189, 2.196, 2.202, 2.209, 2.216, 2.222, 2.229, 2.236, - & 2.242, 2.249, 2.255, 2.262, 2.268, 2.275, 2.281, 2.288, 2.295, - & 2.301, 2.308, 2.314, 2.320, 2.327, 2.333, 2.340, 2.346, 2.353, - & 2.359, 2.365, 2.372, 2.378, 2.384, 2.391, 2.397, 2.403, 2.410, - & 2.416, 2.422, 2.429, 2.435, 2.441, 2.447, 2.453, 2.460, 2.466, - & 2.472, 2.478, 2.484, 2.491, 2.497, 2.503, 2.509, 2.515, 2.521, - & 2.527, 2.533, 2.539, 2.546, 2.552, 2.558, 2.564, 2.570, 2.576, - & 2.582, 2.588, 2.594, 2.600, 2.606, 2.612, 2.617, 2.623, 2.629, - & 2.635, 2.641, 2.647, 2.653, 2.659, 2.665, 2.670, 2.676, 2.682, - & 2.688, 2.694, 2.700, 2.705, 2.711, 2.717, 2.723, 2.728, 2.734, - & 2.740, 2.746, 2.751, 2.757, 2.818, 2.874, 2.928, 2.982, 3.035, - & 3.087, 3.139, 3.190, 3.239, 3.289, 3.337, 3.385, 3.432, 3.479, - & 3.525, 3.571, 3.615, 3.660, 3.703, 3.746, 3.789, 3.831, 3.873, - & 3.914, 3.954, 3.995, 4.034, 4.073, 4.112, 4.151, 4.189, 4.226, - & 4.263, 4.300, 4.336, 4.372, 4.408, 4.443, 4.478, 4.513, 4.547, - & 4.581, 4.614, 4.647, 4.680, 4.713, 4.745, 4.777, 4.809, 4.840, - & 4.871, 4.902, 4.933, 4.963, 4.993, 5.023, 5.052, 5.082, 5.111, - & 5.140, 5.168, 5.196, 5.224, 5.252, 5.280, 5.307, 5.335, 5.362, - & 5.388, 5.415, 5.441, 5.468, 5.494, 5.519, 5.545, 5.570, 5.596, - & 5.621, 5.646, 5.670, 5.695, 5.719, 5.743, 5.767, 5.791, 5.815, - & 5.838, 5.862, 5.885, 5.908, 5.931, 5.954, 5.976, 5.999, 6.021, - & 6.043, 6.065, 6.087, 6.109, 6.130, 6.152, 6.173, 6.194, 6.215, - & 6.236, 6.257, 6.278, 6.298, 6.319, 6.339, 6.359, 6.380, 6.400, - & 6.419, 6.439, 6.459, 6.478, 6.498, 6.517, 6.536, 6.555, 6.574, - & 6.593, 6.612, 6.631, 6.649, 6.668, 6.686, 6.705, 6.723, 6.741, - & 6.759, 6.777, 6.795, 6.812, 6.830, 6.848, 6.865, 6.882, 6.900, - & 6.917, 6.934, 6.951, 6.968, 6.985, 7.002, 7.018, 7.035, 7.052, - & 7.068, 7.084, 7.101, 7.117, 7.133, 7.149, 7.165, 7.181, 7.197, - & 7.213, 7.229, 7.244 - & / -C -C *** NH4HSO4 -C - DATA BNC09M/ - &-0.046,-0.097,-0.122,-0.138,-0.151,-0.162,-0.170,-0.177,-0.184, - &-0.189,-0.194,-0.198,-0.202,-0.206,-0.209,-0.212,-0.214,-0.216, - &-0.218,-0.220,-0.222,-0.223,-0.224,-0.225,-0.226,-0.227,-0.227, - &-0.228,-0.228,-0.228,-0.228,-0.228,-0.228,-0.228,-0.228,-0.227, - &-0.227,-0.226,-0.225,-0.225,-0.224,-0.223,-0.222,-0.221,-0.220, - &-0.219,-0.218,-0.216,-0.215,-0.214,-0.212,-0.211,-0.209,-0.208, - &-0.206,-0.204,-0.203,-0.201,-0.199,-0.197,-0.195,-0.193,-0.192, - &-0.190,-0.188,-0.185,-0.183,-0.181,-0.179,-0.177,-0.175,-0.173, - &-0.170,-0.168,-0.166,-0.163,-0.161,-0.159,-0.156,-0.154,-0.151, - &-0.149,-0.146,-0.144,-0.141,-0.139,-0.136,-0.133,-0.131,-0.128, - &-0.125,-0.122,-0.120,-0.117,-0.114,-0.111,-0.108,-0.106,-0.103, - &-0.100,-0.097,-0.094,-0.091,-0.088,-0.085,-0.082,-0.079,-0.076, - &-0.073,-0.070,-0.067,-0.064,-0.061,-0.058,-0.055,-0.052,-0.049, - &-0.045,-0.042,-0.039,-0.036,-0.033,-0.030,-0.027,-0.024,-0.021, - &-0.018,-0.014,-0.011,-0.008,-0.005,-0.002, 0.001, 0.004, 0.007, - & 0.010, 0.013, 0.016, 0.020, 0.023, 0.026, 0.029, 0.032, 0.035, - & 0.038, 0.041, 0.044, 0.047, 0.050, 0.053, 0.056, 0.059, 0.062, - & 0.065, 0.068, 0.071, 0.074, 0.077, 0.080, 0.083, 0.086, 0.089, - & 0.092, 0.095, 0.098, 0.101, 0.104, 0.106, 0.109, 0.112, 0.115, - & 0.118, 0.121, 0.124, 0.127, 0.130, 0.132, 0.135, 0.138, 0.141, - & 0.144, 0.147, 0.150, 0.152, 0.155, 0.158, 0.161, 0.164, 0.166, - & 0.169, 0.172, 0.175, 0.177, 0.180, 0.183, 0.186, 0.188, 0.191, - & 0.194, 0.197, 0.199, 0.202, 0.205, 0.208, 0.210, 0.213, 0.216, - & 0.218, 0.221, 0.224, 0.226, 0.229, 0.232, 0.234, 0.237, 0.239, - & 0.242, 0.245, 0.247, 0.250, 0.253, 0.255, 0.258, 0.260, 0.263, - & 0.265, 0.268, 0.271, 0.273, 0.276, 0.278, 0.281, 0.283, 0.286, - & 0.288, 0.291, 0.293, 0.296, 0.298, 0.301, 0.303, 0.306, 0.308, - & 0.311, 0.313, 0.316, 0.318, 0.321, 0.323, 0.326, 0.328, 0.330, - & 0.333, 0.335, 0.338, 0.340, 0.343, 0.345, 0.347, 0.350, 0.352, - & 0.355, 0.357, 0.359, 0.362, 0.364, 0.366, 0.369, 0.371, 0.374, - & 0.376, 0.378, 0.381, 0.383, 0.385, 0.388, 0.390, 0.392, 0.394, - & 0.397, 0.399, 0.401, 0.404, 0.406, 0.408, 0.410, 0.413, 0.415, - & 0.417, 0.420, 0.422, 0.424, 0.426, 0.429, 0.431, 0.433, 0.435, - & 0.437, 0.440, 0.442, 0.444, 0.446, 0.449, 0.451, 0.453, 0.455, - & 0.457, 0.460, 0.462, 0.464, 0.466, 0.468, 0.470, 0.473, 0.475, - & 0.477, 0.479, 0.481, 0.483, 0.485, 0.488, 0.490, 0.492, 0.494, - & 0.496, 0.498, 0.500, 0.502, 0.504, 0.507, 0.509, 0.511, 0.513, - & 0.515, 0.517, 0.519, 0.521, 0.523, 0.525, 0.527, 0.529, 0.531, - & 0.534, 0.536, 0.538, 0.540, 0.542, 0.544, 0.546, 0.548, 0.550, - & 0.552, 0.554, 0.556, 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, - & 0.570, 0.572, 0.574, 0.576, 0.578, 0.580, 0.582, 0.584, 0.586, - & 0.588, 0.590, 0.592, 0.593, 0.595, 0.597, 0.599, 0.601, 0.603, - & 0.605, 0.607, 0.609, 0.611, 0.613, 0.615, 0.617, 0.619, 0.620, - & 0.622, 0.624, 0.626, 0.628, 0.630, 0.632, 0.634, 0.636, 0.637, - & 0.639, 0.641, 0.643, 0.645, 0.665, 0.683, 0.701, 0.719, 0.736, - & 0.753, 0.770, 0.787, 0.803, 0.820, 0.836, 0.852, 0.867, 0.883, - & 0.898, 0.913, 0.928, 0.942, 0.957, 0.971, 0.985, 0.999, 1.013, - & 1.027, 1.040, 1.053, 1.067, 1.080, 1.093, 1.105, 1.118, 1.131, - & 1.143, 1.155, 1.167, 1.179, 1.191, 1.203, 1.215, 1.226, 1.238, - & 1.249, 1.260, 1.271, 1.283, 1.293, 1.304, 1.315, 1.326, 1.336, - & 1.347, 1.357, 1.367, 1.377, 1.388, 1.398, 1.408, 1.417, 1.427, - & 1.437, 1.446, 1.456, 1.466, 1.475, 1.484, 1.493, 1.503, 1.512, - & 1.521, 1.530, 1.539, 1.548, 1.556, 1.565, 1.574, 1.582, 1.591, - & 1.599, 1.608, 1.616, 1.624, 1.633, 1.641, 1.649, 1.657, 1.665, - & 1.673, 1.681, 1.689, 1.697, 1.704, 1.712, 1.720, 1.727, 1.735, - & 1.742, 1.750, 1.757, 1.765, 1.772, 1.779, 1.787, 1.794, 1.801, - & 1.808, 1.815, 1.822, 1.829, 1.836, 1.843, 1.850, 1.857, 1.864, - & 1.870, 1.877, 1.884, 1.890, 1.897, 1.904, 1.910, 1.917, 1.923, - & 1.930, 1.936, 1.942, 1.949, 1.955, 1.961, 1.968, 1.974, 1.980, - & 1.986, 1.992, 1.998, 2.004, 2.010, 2.016, 2.022, 2.028, 2.034, - & 2.040, 2.046, 2.052, 2.058, 2.063, 2.069, 2.075, 2.080, 2.086, - & 2.092, 2.097, 2.103, 2.108, 2.114, 2.119, 2.125, 2.130, 2.136, - & 2.141, 2.147, 2.152 - & / -C -C *** (H,NO3) -C - DATA BNC10M/ - &-0.045,-0.094,-0.116,-0.130,-0.140,-0.147,-0.153,-0.158,-0.162, - &-0.165,-0.167,-0.169,-0.171,-0.172,-0.173,-0.173,-0.174,-0.174, - &-0.174,-0.173,-0.173,-0.172,-0.172,-0.171,-0.170,-0.169,-0.168, - &-0.167,-0.166,-0.165,-0.163,-0.162,-0.161,-0.159,-0.158,-0.156, - &-0.155,-0.153,-0.152,-0.150,-0.148,-0.147,-0.145,-0.143,-0.142, - &-0.140,-0.138,-0.136,-0.135,-0.133,-0.131,-0.129,-0.127,-0.126, - &-0.124,-0.122,-0.120,-0.118,-0.117,-0.115,-0.113,-0.111,-0.109, - &-0.107,-0.106,-0.104,-0.102,-0.100,-0.098,-0.096,-0.094,-0.092, - &-0.090,-0.088,-0.086,-0.084,-0.083,-0.081,-0.079,-0.077,-0.074, - &-0.072,-0.070,-0.068,-0.066,-0.064,-0.062,-0.060,-0.058,-0.056, - &-0.053,-0.051,-0.049,-0.047,-0.045,-0.042,-0.040,-0.038,-0.036, - &-0.033,-0.031,-0.029,-0.026,-0.024,-0.022,-0.019,-0.017,-0.015, - &-0.012,-0.010,-0.008,-0.005,-0.003, 0.000, 0.002, 0.004, 0.007, - & 0.009, 0.012, 0.014, 0.017, 0.019, 0.022, 0.024, 0.026, 0.029, - & 0.031, 0.034, 0.036, 0.039, 0.041, 0.044, 0.046, 0.049, 0.051, - & 0.053, 0.056, 0.058, 0.061, 0.063, 0.066, 0.068, 0.071, 0.073, - & 0.075, 0.078, 0.080, 0.083, 0.085, 0.088, 0.090, 0.092, 0.095, - & 0.097, 0.100, 0.102, 0.105, 0.107, 0.109, 0.112, 0.114, 0.117, - & 0.119, 0.121, 0.124, 0.126, 0.129, 0.131, 0.133, 0.136, 0.138, - & 0.140, 0.143, 0.145, 0.148, 0.150, 0.152, 0.155, 0.157, 0.159, - & 0.162, 0.164, 0.166, 0.169, 0.171, 0.173, 0.176, 0.178, 0.180, - & 0.183, 0.185, 0.187, 0.190, 0.192, 0.194, 0.197, 0.199, 0.201, - & 0.204, 0.206, 0.208, 0.210, 0.213, 0.215, 0.217, 0.220, 0.222, - & 0.224, 0.226, 0.229, 0.231, 0.233, 0.235, 0.238, 0.240, 0.242, - & 0.244, 0.247, 0.249, 0.251, 0.253, 0.256, 0.258, 0.260, 0.262, - & 0.264, 0.267, 0.269, 0.271, 0.273, 0.275, 0.278, 0.280, 0.282, - & 0.284, 0.286, 0.288, 0.291, 0.293, 0.295, 0.297, 0.299, 0.301, - & 0.304, 0.306, 0.308, 0.310, 0.312, 0.314, 0.317, 0.319, 0.321, - & 0.323, 0.325, 0.327, 0.329, 0.331, 0.333, 0.336, 0.338, 0.340, - & 0.342, 0.344, 0.346, 0.348, 0.350, 0.352, 0.354, 0.356, 0.359, - & 0.361, 0.363, 0.365, 0.367, 0.369, 0.371, 0.373, 0.375, 0.377, - & 0.379, 0.381, 0.383, 0.385, 0.387, 0.389, 0.391, 0.393, 0.395, - & 0.397, 0.399, 0.401, 0.403, 0.405, 0.407, 0.409, 0.411, 0.413, - & 0.415, 0.417, 0.419, 0.421, 0.423, 0.425, 0.427, 0.429, 0.431, - & 0.433, 0.435, 0.437, 0.439, 0.441, 0.443, 0.445, 0.447, 0.449, - & 0.451, 0.453, 0.455, 0.456, 0.458, 0.460, 0.462, 0.464, 0.466, - & 0.468, 0.470, 0.472, 0.474, 0.476, 0.477, 0.479, 0.481, 0.483, - & 0.485, 0.487, 0.489, 0.491, 0.493, 0.494, 0.496, 0.498, 0.500, - & 0.502, 0.504, 0.506, 0.507, 0.509, 0.511, 0.513, 0.515, 0.517, - & 0.518, 0.520, 0.522, 0.524, 0.526, 0.528, 0.529, 0.531, 0.533, - & 0.535, 0.537, 0.539, 0.540, 0.542, 0.544, 0.546, 0.547, 0.549, - & 0.551, 0.553, 0.555, 0.556, 0.558, 0.560, 0.562, 0.564, 0.565, - & 0.567, 0.569, 0.571, 0.572, 0.574, 0.576, 0.578, 0.579, 0.581, - & 0.583, 0.585, 0.586, 0.588, 0.590, 0.592, 0.593, 0.595, 0.597, - & 0.598, 0.600, 0.602, 0.604, 0.622, 0.639, 0.655, 0.672, 0.688, - & 0.704, 0.719, 0.735, 0.750, 0.765, 0.780, 0.795, 0.809, 0.824, - & 0.838, 0.852, 0.866, 0.879, 0.893, 0.906, 0.919, 0.932, 0.945, - & 0.958, 0.971, 0.983, 0.996, 1.008, 1.020, 1.032, 1.044, 1.055, - & 1.067, 1.079, 1.090, 1.101, 1.112, 1.123, 1.134, 1.145, 1.156, - & 1.167, 1.177, 1.188, 1.198, 1.208, 1.218, 1.228, 1.238, 1.248, - & 1.258, 1.268, 1.278, 1.287, 1.297, 1.306, 1.315, 1.325, 1.334, - & 1.343, 1.352, 1.361, 1.370, 1.379, 1.387, 1.396, 1.405, 1.413, - & 1.422, 1.430, 1.438, 1.447, 1.455, 1.463, 1.471, 1.479, 1.487, - & 1.495, 1.503, 1.511, 1.519, 1.527, 1.534, 1.542, 1.550, 1.557, - & 1.565, 1.572, 1.579, 1.587, 1.594, 1.601, 1.608, 1.616, 1.623, - & 1.630, 1.637, 1.644, 1.651, 1.657, 1.664, 1.671, 1.678, 1.685, - & 1.691, 1.698, 1.704, 1.711, 1.718, 1.724, 1.730, 1.737, 1.743, - & 1.750, 1.756, 1.762, 1.768, 1.775, 1.781, 1.787, 1.793, 1.799, - & 1.805, 1.811, 1.817, 1.823, 1.829, 1.835, 1.841, 1.846, 1.852, - & 1.858, 1.864, 1.869, 1.875, 1.881, 1.886, 1.892, 1.897, 1.903, - & 1.908, 1.914, 1.919, 1.925, 1.930, 1.936, 1.941, 1.946, 1.952, - & 1.957, 1.962, 1.967, 1.972, 1.978, 1.983, 1.988, 1.993, 1.998, - & 2.003, 2.008, 2.013 - & / -C -C *** (H,Cl) -C - DATA BNC11M/ - &-0.044,-0.089,-0.107,-0.118,-0.125,-0.130,-0.133,-0.135,-0.136, - &-0.136,-0.136,-0.135,-0.134,-0.132,-0.130,-0.128,-0.125,-0.122, - &-0.119,-0.116,-0.113,-0.109,-0.105,-0.102,-0.098,-0.094,-0.089, - &-0.085,-0.081,-0.076,-0.072,-0.067,-0.062,-0.057,-0.053,-0.048, - &-0.043,-0.038,-0.033,-0.028,-0.022,-0.017,-0.012,-0.007,-0.001, - & 0.004, 0.009, 0.015, 0.020, 0.025, 0.031, 0.036, 0.042, 0.047, - & 0.053, 0.058, 0.064, 0.069, 0.075, 0.081, 0.086, 0.092, 0.097, - & 0.103, 0.109, 0.114, 0.120, 0.126, 0.132, 0.137, 0.143, 0.149, - & 0.155, 0.161, 0.167, 0.172, 0.178, 0.184, 0.190, 0.196, 0.202, - & 0.208, 0.214, 0.220, 0.227, 0.233, 0.239, 0.245, 0.251, 0.258, - & 0.264, 0.270, 0.277, 0.283, 0.290, 0.296, 0.303, 0.309, 0.316, - & 0.322, 0.329, 0.335, 0.342, 0.349, 0.355, 0.362, 0.369, 0.376, - & 0.382, 0.389, 0.396, 0.403, 0.409, 0.416, 0.423, 0.430, 0.437, - & 0.444, 0.450, 0.457, 0.464, 0.471, 0.478, 0.485, 0.491, 0.498, - & 0.505, 0.512, 0.519, 0.526, 0.533, 0.539, 0.546, 0.553, 0.560, - & 0.567, 0.573, 0.580, 0.587, 0.594, 0.601, 0.607, 0.614, 0.621, - & 0.628, 0.634, 0.641, 0.648, 0.654, 0.661, 0.668, 0.675, 0.681, - & 0.688, 0.694, 0.701, 0.708, 0.714, 0.721, 0.728, 0.734, 0.741, - & 0.747, 0.754, 0.760, 0.767, 0.773, 0.780, 0.786, 0.793, 0.799, - & 0.806, 0.812, 0.819, 0.825, 0.831, 0.838, 0.844, 0.850, 0.857, - & 0.863, 0.870, 0.876, 0.882, 0.888, 0.895, 0.901, 0.907, 0.914, - & 0.920, 0.926, 0.932, 0.938, 0.945, 0.951, 0.957, 0.963, 0.969, - & 0.975, 0.981, 0.988, 0.994, 1.000, 1.006, 1.012, 1.018, 1.024, - & 1.030, 1.036, 1.042, 1.048, 1.054, 1.060, 1.066, 1.072, 1.078, - & 1.084, 1.090, 1.096, 1.101, 1.107, 1.113, 1.119, 1.125, 1.131, - & 1.137, 1.142, 1.148, 1.154, 1.160, 1.165, 1.171, 1.177, 1.183, - & 1.188, 1.194, 1.200, 1.205, 1.211, 1.217, 1.222, 1.228, 1.234, - & 1.239, 1.245, 1.251, 1.256, 1.262, 1.267, 1.273, 1.278, 1.284, - & 1.289, 1.295, 1.300, 1.306, 1.311, 1.317, 1.322, 1.328, 1.333, - & 1.339, 1.344, 1.349, 1.355, 1.360, 1.366, 1.371, 1.376, 1.382, - & 1.387, 1.392, 1.398, 1.403, 1.408, 1.413, 1.419, 1.424, 1.429, - & 1.434, 1.440, 1.445, 1.450, 1.455, 1.460, 1.466, 1.471, 1.476, - & 1.481, 1.486, 1.491, 1.497, 1.502, 1.507, 1.512, 1.517, 1.522, - & 1.527, 1.532, 1.537, 1.542, 1.547, 1.552, 1.557, 1.562, 1.567, - & 1.572, 1.577, 1.582, 1.587, 1.592, 1.597, 1.602, 1.607, 1.612, - & 1.617, 1.622, 1.626, 1.631, 1.636, 1.641, 1.646, 1.651, 1.656, - & 1.660, 1.665, 1.670, 1.675, 1.680, 1.684, 1.689, 1.694, 1.699, - & 1.703, 1.708, 1.713, 1.718, 1.722, 1.727, 1.732, 1.736, 1.741, - & 1.746, 1.750, 1.755, 1.760, 1.764, 1.769, 1.774, 1.778, 1.783, - & 1.787, 1.792, 1.797, 1.801, 1.806, 1.810, 1.815, 1.819, 1.824, - & 1.828, 1.833, 1.838, 1.842, 1.847, 1.851, 1.855, 1.860, 1.864, - & 1.869, 1.873, 1.878, 1.882, 1.887, 1.891, 1.895, 1.900, 1.904, - & 1.909, 1.913, 1.917, 1.922, 1.926, 1.931, 1.935, 1.939, 1.944, - & 1.948, 1.952, 1.957, 1.961, 1.965, 1.969, 1.974, 1.978, 1.982, - & 1.987, 1.991, 1.995, 1.999, 2.045, 2.086, 2.127, 2.167, 2.206, - & 2.245, 2.284, 2.322, 2.359, 2.396, 2.432, 2.468, 2.503, 2.538, - & 2.572, 2.606, 2.639, 2.672, 2.705, 2.737, 2.769, 2.800, 2.831, - & 2.862, 2.892, 2.922, 2.952, 2.981, 3.010, 3.039, 3.067, 3.095, - & 3.123, 3.150, 3.178, 3.204, 3.231, 3.257, 3.283, 3.309, 3.335, - & 3.360, 3.385, 3.410, 3.435, 3.459, 3.483, 3.507, 3.531, 3.554, - & 3.577, 3.600, 3.623, 3.646, 3.668, 3.691, 3.713, 3.735, 3.756, - & 3.778, 3.799, 3.820, 3.841, 3.862, 3.883, 3.903, 3.924, 3.944, - & 3.964, 3.984, 4.003, 4.023, 4.043, 4.062, 4.081, 4.100, 4.119, - & 4.138, 4.156, 4.175, 4.193, 4.211, 4.229, 4.247, 4.265, 4.283, - & 4.300, 4.318, 4.335, 4.352, 4.369, 4.386, 4.403, 4.420, 4.437, - & 4.453, 4.470, 4.486, 4.503, 4.519, 4.535, 4.551, 4.567, 4.582, - & 4.598, 4.614, 4.629, 4.644, 4.660, 4.675, 4.690, 4.705, 4.720, - & 4.735, 4.750, 4.764, 4.779, 4.794, 4.808, 4.822, 4.837, 4.851, - & 4.865, 4.879, 4.893, 4.907, 4.921, 4.935, 4.948, 4.962, 4.975, - & 4.989, 5.002, 5.016, 5.029, 5.042, 5.055, 5.068, 5.081, 5.094, - & 5.107, 5.120, 5.133, 5.145, 5.158, 5.171, 5.183, 5.196, 5.208, - & 5.220, 5.233, 5.245, 5.257, 5.269, 5.281, 5.293, 5.305, 5.317, - & 5.329, 5.340, 5.352 - & / -C -C *** NaHSO4 -C - DATA BNC12M/ - &-0.045,-0.094,-0.116,-0.130,-0.140,-0.148,-0.155,-0.160,-0.164, - &-0.168,-0.170,-0.173,-0.174,-0.176,-0.177,-0.178,-0.178,-0.179, - &-0.179,-0.178,-0.178,-0.177,-0.177,-0.176,-0.175,-0.174,-0.172, - &-0.171,-0.170,-0.168,-0.166,-0.164,-0.162,-0.160,-0.158,-0.156, - &-0.154,-0.152,-0.149,-0.147,-0.144,-0.142,-0.139,-0.136,-0.134, - &-0.131,-0.128,-0.125,-0.122,-0.119,-0.116,-0.113,-0.110,-0.107, - &-0.103,-0.100,-0.097,-0.094,-0.090,-0.087,-0.084,-0.080,-0.077, - &-0.073,-0.070,-0.066,-0.063,-0.059,-0.055,-0.052,-0.048,-0.044, - &-0.040,-0.037,-0.033,-0.029,-0.025,-0.021,-0.017,-0.013,-0.010, - &-0.006,-0.002, 0.003, 0.007, 0.011, 0.015, 0.019, 0.023, 0.027, - & 0.032, 0.036, 0.040, 0.045, 0.049, 0.053, 0.058, 0.062, 0.066, - & 0.071, 0.075, 0.080, 0.084, 0.089, 0.094, 0.098, 0.103, 0.107, - & 0.112, 0.116, 0.121, 0.126, 0.130, 0.135, 0.140, 0.144, 0.149, - & 0.154, 0.158, 0.163, 0.168, 0.172, 0.177, 0.182, 0.186, 0.191, - & 0.196, 0.200, 0.205, 0.210, 0.215, 0.219, 0.224, 0.229, 0.233, - & 0.238, 0.242, 0.247, 0.252, 0.256, 0.261, 0.266, 0.270, 0.275, - & 0.279, 0.284, 0.289, 0.293, 0.298, 0.302, 0.307, 0.311, 0.316, - & 0.320, 0.325, 0.329, 0.334, 0.338, 0.343, 0.347, 0.352, 0.356, - & 0.361, 0.365, 0.370, 0.374, 0.379, 0.383, 0.387, 0.392, 0.396, - & 0.400, 0.405, 0.409, 0.414, 0.418, 0.422, 0.427, 0.431, 0.435, - & 0.440, 0.444, 0.448, 0.452, 0.457, 0.461, 0.465, 0.469, 0.474, - & 0.478, 0.482, 0.486, 0.490, 0.495, 0.499, 0.503, 0.507, 0.511, - & 0.515, 0.520, 0.524, 0.528, 0.532, 0.536, 0.540, 0.544, 0.548, - & 0.552, 0.556, 0.561, 0.565, 0.569, 0.573, 0.577, 0.581, 0.585, - & 0.589, 0.593, 0.597, 0.601, 0.605, 0.609, 0.613, 0.616, 0.620, - & 0.624, 0.628, 0.632, 0.636, 0.640, 0.644, 0.648, 0.652, 0.655, - & 0.659, 0.663, 0.667, 0.671, 0.675, 0.679, 0.682, 0.686, 0.690, - & 0.694, 0.697, 0.701, 0.705, 0.709, 0.713, 0.716, 0.720, 0.724, - & 0.728, 0.731, 0.735, 0.739, 0.742, 0.746, 0.750, 0.753, 0.757, - & 0.761, 0.764, 0.768, 0.772, 0.775, 0.779, 0.783, 0.786, 0.790, - & 0.793, 0.797, 0.801, 0.804, 0.808, 0.811, 0.815, 0.818, 0.822, - & 0.825, 0.829, 0.833, 0.836, 0.840, 0.843, 0.847, 0.850, 0.854, - & 0.857, 0.861, 0.864, 0.867, 0.871, 0.874, 0.878, 0.881, 0.885, - & 0.888, 0.892, 0.895, 0.898, 0.902, 0.905, 0.909, 0.912, 0.915, - & 0.919, 0.922, 0.925, 0.929, 0.932, 0.935, 0.939, 0.942, 0.945, - & 0.949, 0.952, 0.955, 0.959, 0.962, 0.965, 0.969, 0.972, 0.975, - & 0.978, 0.982, 0.985, 0.988, 0.991, 0.995, 0.998, 1.001, 1.004, - & 1.008, 1.011, 1.014, 1.017, 1.020, 1.024, 1.027, 1.030, 1.033, - & 1.036, 1.039, 1.043, 1.046, 1.049, 1.052, 1.055, 1.058, 1.061, - & 1.065, 1.068, 1.071, 1.074, 1.077, 1.080, 1.083, 1.086, 1.089, - & 1.092, 1.096, 1.099, 1.102, 1.105, 1.108, 1.111, 1.114, 1.117, - & 1.120, 1.123, 1.126, 1.129, 1.132, 1.135, 1.138, 1.141, 1.144, - & 1.147, 1.150, 1.153, 1.156, 1.159, 1.162, 1.165, 1.168, 1.171, - & 1.174, 1.177, 1.180, 1.183, 1.185, 1.188, 1.191, 1.194, 1.197, - & 1.200, 1.203, 1.206, 1.209, 1.240, 1.268, 1.296, 1.323, 1.350, - & 1.377, 1.403, 1.429, 1.454, 1.480, 1.505, 1.529, 1.553, 1.577, - & 1.601, 1.624, 1.647, 1.670, 1.692, 1.715, 1.737, 1.758, 1.780, - & 1.801, 1.822, 1.843, 1.863, 1.883, 1.903, 1.923, 1.943, 1.962, - & 1.981, 2.000, 2.019, 2.038, 2.056, 2.075, 2.093, 2.111, 2.128, - & 2.146, 2.163, 2.181, 2.198, 2.215, 2.231, 2.248, 2.264, 2.281, - & 2.297, 2.313, 2.329, 2.345, 2.360, 2.376, 2.391, 2.406, 2.422, - & 2.437, 2.451, 2.466, 2.481, 2.495, 2.510, 2.524, 2.538, 2.552, - & 2.566, 2.580, 2.594, 2.608, 2.621, 2.635, 2.648, 2.661, 2.674, - & 2.687, 2.700, 2.713, 2.726, 2.739, 2.751, 2.764, 2.776, 2.789, - & 2.801, 2.813, 2.825, 2.838, 2.850, 2.861, 2.873, 2.885, 2.897, - & 2.908, 2.920, 2.931, 2.943, 2.954, 2.965, 2.976, 2.987, 2.998, - & 3.009, 3.020, 3.031, 3.042, 3.053, 3.063, 3.074, 3.084, 3.095, - & 3.105, 3.116, 3.126, 3.136, 3.146, 3.156, 3.166, 3.176, 3.186, - & 3.196, 3.206, 3.216, 3.226, 3.235, 3.245, 3.255, 3.264, 3.274, - & 3.283, 3.292, 3.302, 3.311, 3.320, 3.330, 3.339, 3.348, 3.357, - & 3.366, 3.375, 3.384, 3.393, 3.402, 3.410, 3.419, 3.428, 3.437, - & 3.445, 3.454, 3.462, 3.471, 3.479, 3.488, 3.496, 3.505, 3.513, - & 3.521, 3.529, 3.538 - & / -C -C *** (NH4)3H(SO4)2 -C - DATA BNC13M/ - &-0.074,-0.160,-0.203,-0.233,-0.256,-0.275,-0.291,-0.306,-0.318, - &-0.329,-0.339,-0.349,-0.357,-0.365,-0.372,-0.379,-0.386,-0.392, - &-0.397,-0.402,-0.407,-0.412,-0.417,-0.421,-0.425,-0.429,-0.433, - &-0.436,-0.439,-0.443,-0.446,-0.448,-0.451,-0.454,-0.456,-0.459, - &-0.461,-0.463,-0.466,-0.468,-0.470,-0.471,-0.473,-0.475,-0.477, - &-0.478,-0.480,-0.481,-0.482,-0.484,-0.485,-0.486,-0.487,-0.488, - &-0.489,-0.490,-0.491,-0.492,-0.493,-0.494,-0.495,-0.496,-0.496, - &-0.497,-0.498,-0.498,-0.499,-0.499,-0.500,-0.500,-0.501,-0.501, - &-0.501,-0.502,-0.502,-0.502,-0.503,-0.503,-0.503,-0.503,-0.503, - &-0.504,-0.504,-0.504,-0.504,-0.504,-0.504,-0.504,-0.504,-0.504, - &-0.504,-0.504,-0.504,-0.504,-0.504,-0.503,-0.503,-0.503,-0.503, - &-0.503,-0.503,-0.502,-0.502,-0.502,-0.502,-0.501,-0.501,-0.501, - &-0.501,-0.500,-0.500,-0.500,-0.499,-0.499,-0.498,-0.498,-0.498, - &-0.497,-0.497,-0.497,-0.496,-0.496,-0.495,-0.495,-0.494,-0.494, - &-0.494,-0.493,-0.493,-0.492,-0.492,-0.491,-0.491,-0.490,-0.490, - &-0.489,-0.489,-0.488,-0.488,-0.487,-0.487,-0.486,-0.486,-0.485, - &-0.485,-0.484,-0.484,-0.483,-0.483,-0.482,-0.482,-0.481,-0.481, - &-0.480,-0.479,-0.479,-0.478,-0.478,-0.477,-0.477,-0.476,-0.476, - &-0.475,-0.475,-0.474,-0.473,-0.473,-0.472,-0.472,-0.471,-0.471, - &-0.470,-0.470,-0.469,-0.468,-0.468,-0.467,-0.467,-0.466,-0.466, - &-0.465,-0.464,-0.464,-0.463,-0.463,-0.462,-0.462,-0.461,-0.461, - &-0.460,-0.459,-0.459,-0.458,-0.458,-0.457,-0.457,-0.456,-0.455, - &-0.455,-0.454,-0.454,-0.453,-0.453,-0.452,-0.451,-0.451,-0.450, - &-0.450,-0.449,-0.449,-0.448,-0.447,-0.447,-0.446,-0.446,-0.445, - &-0.445,-0.444,-0.443,-0.443,-0.442,-0.442,-0.441,-0.441,-0.440, - &-0.440,-0.439,-0.438,-0.438,-0.437,-0.437,-0.436,-0.436,-0.435, - &-0.434,-0.434,-0.433,-0.433,-0.432,-0.432,-0.431,-0.431,-0.430, - &-0.429,-0.429,-0.428,-0.428,-0.427,-0.427,-0.426,-0.426,-0.425, - &-0.424,-0.424,-0.423,-0.423,-0.422,-0.422,-0.421,-0.421,-0.420, - &-0.419,-0.419,-0.418,-0.418,-0.417,-0.417,-0.416,-0.416,-0.415, - &-0.415,-0.414,-0.413,-0.413,-0.412,-0.412,-0.411,-0.411,-0.410, - &-0.410,-0.409,-0.409,-0.408,-0.408,-0.407,-0.406,-0.406,-0.405, - &-0.405,-0.404,-0.404,-0.403,-0.403,-0.402,-0.402,-0.401,-0.401, - &-0.400,-0.399,-0.399,-0.398,-0.398,-0.397,-0.397,-0.396,-0.396, - &-0.395,-0.395,-0.394,-0.394,-0.393,-0.393,-0.392,-0.392,-0.391, - &-0.391,-0.390,-0.390,-0.389,-0.388,-0.388,-0.387,-0.387,-0.386, - &-0.386,-0.385,-0.385,-0.384,-0.384,-0.383,-0.383,-0.382,-0.382, - &-0.381,-0.381,-0.380,-0.380,-0.379,-0.379,-0.378,-0.378,-0.377, - &-0.377,-0.376,-0.376,-0.375,-0.375,-0.374,-0.374,-0.373,-0.373, - &-0.372,-0.372,-0.371,-0.371,-0.370,-0.370,-0.369,-0.369,-0.368, - &-0.368,-0.367,-0.367,-0.366,-0.366,-0.365,-0.365,-0.364,-0.364, - &-0.363,-0.363,-0.362,-0.362,-0.361,-0.361,-0.360,-0.360,-0.359, - &-0.359,-0.358,-0.358,-0.357,-0.357,-0.356,-0.356,-0.355,-0.355, - &-0.354,-0.354,-0.353,-0.353,-0.352,-0.352,-0.352,-0.351,-0.351, - &-0.350,-0.350,-0.349,-0.349,-0.344,-0.339,-0.334,-0.330,-0.325, - &-0.321,-0.316,-0.312,-0.307,-0.303,-0.299,-0.295,-0.290,-0.286, - &-0.282,-0.278,-0.274,-0.270,-0.266,-0.262,-0.258,-0.255,-0.251, - &-0.247,-0.243,-0.240,-0.236,-0.232,-0.229,-0.225,-0.222,-0.218, - &-0.215,-0.211,-0.208,-0.204,-0.201,-0.198,-0.194,-0.191,-0.188, - &-0.185,-0.182,-0.178,-0.175,-0.172,-0.169,-0.166,-0.163,-0.160, - &-0.157,-0.154,-0.151,-0.148,-0.145,-0.142,-0.139,-0.137,-0.134, - &-0.131,-0.128,-0.125,-0.123,-0.120,-0.117,-0.115,-0.112,-0.109, - &-0.107,-0.104,-0.101,-0.099,-0.096,-0.094,-0.091,-0.089,-0.086, - &-0.084,-0.081,-0.079,-0.076,-0.074,-0.071,-0.069,-0.067,-0.064, - &-0.062,-0.060,-0.057,-0.055,-0.053,-0.050,-0.048,-0.046,-0.043, - &-0.041,-0.039,-0.037,-0.035,-0.032,-0.030,-0.028,-0.026,-0.024, - &-0.022,-0.020,-0.017,-0.015,-0.013,-0.011,-0.009,-0.007,-0.005, - &-0.003,-0.001, 0.001, 0.003, 0.005, 0.007, 0.009, 0.011, 0.013, - & 0.015, 0.017, 0.019, 0.021, 0.022, 0.024, 0.026, 0.028, 0.030, - & 0.032, 0.034, 0.036, 0.037, 0.039, 0.041, 0.043, 0.045, 0.046, - & 0.048, 0.050, 0.052, 0.053, 0.055, 0.057, 0.059, 0.060, 0.062, - & 0.064, 0.066, 0.067, 0.069, 0.071, 0.072, 0.074, 0.076, 0.077, - & 0.079, 0.081, 0.082 - & / -C -C *** CASO4 -C - DATA BNC14M/ - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000 - & / -C -C *** CANO32 -C - DATA BNC15M/ - &-0.092,-0.196,-0.245,-0.279,-0.304,-0.325,-0.342,-0.356,-0.368, - &-0.379,-0.389,-0.397,-0.405,-0.412,-0.418,-0.424,-0.429,-0.433, - &-0.438,-0.442,-0.445,-0.448,-0.452,-0.454,-0.457,-0.459,-0.462, - &-0.464,-0.466,-0.467,-0.469,-0.470,-0.472,-0.473,-0.474,-0.475, - &-0.476,-0.477,-0.478,-0.479,-0.480,-0.480,-0.481,-0.482,-0.482, - &-0.483,-0.483,-0.483,-0.484,-0.484,-0.484,-0.484,-0.485,-0.485, - &-0.485,-0.485,-0.485,-0.485,-0.485,-0.485,-0.485,-0.485,-0.485, - &-0.485,-0.485,-0.484,-0.484,-0.484,-0.484,-0.484,-0.483,-0.483, - &-0.483,-0.482,-0.482,-0.482,-0.481,-0.481,-0.480,-0.480,-0.479, - &-0.479,-0.478,-0.478,-0.477,-0.477,-0.476,-0.475,-0.475,-0.474, - &-0.474,-0.473,-0.472,-0.471,-0.471,-0.470,-0.469,-0.468,-0.467, - &-0.467,-0.466,-0.465,-0.464,-0.463,-0.462,-0.461,-0.460,-0.459, - &-0.459,-0.458,-0.457,-0.456,-0.455,-0.454,-0.453,-0.452,-0.451, - &-0.450,-0.448,-0.447,-0.446,-0.445,-0.444,-0.443,-0.442,-0.441, - &-0.440,-0.439,-0.438,-0.437,-0.436,-0.434,-0.433,-0.432,-0.431, - &-0.430,-0.429,-0.428,-0.427,-0.425,-0.424,-0.423,-0.422,-0.421, - &-0.420,-0.419,-0.417,-0.416,-0.415,-0.414,-0.413,-0.412,-0.411, - &-0.409,-0.408,-0.407,-0.406,-0.405,-0.404,-0.402,-0.401,-0.400, - &-0.399,-0.398,-0.397,-0.395,-0.394,-0.393,-0.392,-0.391,-0.390, - &-0.388,-0.387,-0.386,-0.385,-0.384,-0.383,-0.381,-0.380,-0.379, - &-0.378,-0.377,-0.376,-0.374,-0.373,-0.372,-0.371,-0.370,-0.369, - &-0.367,-0.366,-0.365,-0.364,-0.363,-0.361,-0.360,-0.359,-0.358, - &-0.357,-0.356,-0.354,-0.353,-0.352,-0.351,-0.350,-0.349,-0.347, - &-0.346,-0.345,-0.344,-0.343,-0.342,-0.341,-0.339,-0.338,-0.337, - &-0.336,-0.335,-0.334,-0.332,-0.331,-0.330,-0.329,-0.328,-0.327, - &-0.325,-0.324,-0.323,-0.322,-0.321,-0.320,-0.319,-0.317,-0.316, - &-0.315,-0.314,-0.313,-0.312,-0.311,-0.309,-0.308,-0.307,-0.306, - &-0.305,-0.304,-0.303,-0.301,-0.300,-0.299,-0.298,-0.297,-0.296, - &-0.295,-0.294,-0.292,-0.291,-0.290,-0.289,-0.288,-0.287,-0.286, - &-0.285,-0.283,-0.282,-0.281,-0.280,-0.279,-0.278,-0.277,-0.276, - &-0.275,-0.273,-0.272,-0.271,-0.270,-0.269,-0.268,-0.267,-0.266, - &-0.265,-0.263,-0.262,-0.261,-0.260,-0.259,-0.258,-0.257,-0.256, - &-0.255,-0.254,-0.253,-0.251,-0.250,-0.249,-0.248,-0.247,-0.246, - &-0.245,-0.244,-0.243,-0.242,-0.241,-0.240,-0.238,-0.237,-0.236, - &-0.235,-0.234,-0.233,-0.232,-0.231,-0.230,-0.229,-0.228,-0.227, - &-0.226,-0.225,-0.224,-0.222,-0.221,-0.220,-0.219,-0.218,-0.217, - &-0.216,-0.215,-0.214,-0.213,-0.212,-0.211,-0.210,-0.209,-0.208, - &-0.207,-0.206,-0.205,-0.204,-0.203,-0.202,-0.201,-0.200,-0.198, - &-0.197,-0.196,-0.195,-0.194,-0.193,-0.192,-0.191,-0.190,-0.189, - &-0.188,-0.187,-0.186,-0.185,-0.184,-0.183,-0.182,-0.181,-0.180, - &-0.179,-0.178,-0.177,-0.176,-0.175,-0.174,-0.173,-0.172,-0.171, - &-0.170,-0.169,-0.168,-0.167,-0.166,-0.165,-0.164,-0.163,-0.162, - &-0.161,-0.160,-0.159,-0.158,-0.157,-0.156,-0.155,-0.154,-0.153, - &-0.152,-0.151,-0.150,-0.149,-0.148,-0.147,-0.146,-0.145,-0.144, - &-0.143,-0.142,-0.141,-0.140,-0.130,-0.121,-0.111,-0.102,-0.093, - &-0.083,-0.074,-0.066,-0.057,-0.048,-0.039,-0.031,-0.022,-0.014, - &-0.006, 0.003, 0.011, 0.019, 0.027, 0.035, 0.043, 0.050, 0.058, - & 0.066, 0.073, 0.081, 0.088, 0.095, 0.103, 0.110, 0.117, 0.124, - & 0.131, 0.138, 0.145, 0.152, 0.159, 0.165, 0.172, 0.179, 0.185, - & 0.192, 0.198, 0.205, 0.211, 0.217, 0.223, 0.230, 0.236, 0.242, - & 0.248, 0.254, 0.260, 0.266, 0.272, 0.278, 0.283, 0.289, 0.295, - & 0.301, 0.306, 0.312, 0.317, 0.323, 0.328, 0.334, 0.339, 0.345, - & 0.350, 0.355, 0.360, 0.366, 0.371, 0.376, 0.381, 0.386, 0.391, - & 0.396, 0.401, 0.406, 0.411, 0.416, 0.421, 0.426, 0.431, 0.435, - & 0.440, 0.445, 0.449, 0.454, 0.459, 0.463, 0.468, 0.472, 0.477, - & 0.482, 0.486, 0.490, 0.495, 0.499, 0.504, 0.508, 0.512, 0.517, - & 0.521, 0.525, 0.529, 0.534, 0.538, 0.542, 0.546, 0.550, 0.554, - & 0.559, 0.563, 0.567, 0.571, 0.575, 0.579, 0.583, 0.587, 0.590, - & 0.594, 0.598, 0.602, 0.606, 0.610, 0.614, 0.617, 0.621, 0.625, - & 0.629, 0.632, 0.636, 0.640, 0.643, 0.647, 0.651, 0.654, 0.658, - & 0.661, 0.665, 0.669, 0.672, 0.676, 0.679, 0.683, 0.686, 0.690, - & 0.693, 0.696, 0.700, 0.703, 0.707, 0.710, 0.713, 0.717, 0.720, - & 0.723, 0.727, 0.730 - & / -C -C *** CACL2 -C - DATA BNC16M/ - &-0.091,-0.188,-0.233,-0.261,-0.282,-0.298,-0.310,-0.320,-0.328, - &-0.335,-0.340,-0.345,-0.348,-0.351,-0.353,-0.355,-0.356,-0.356, - &-0.357,-0.357,-0.356,-0.356,-0.355,-0.354,-0.353,-0.351,-0.350, - &-0.348,-0.346,-0.344,-0.342,-0.340,-0.337,-0.335,-0.333,-0.330, - &-0.327,-0.325,-0.322,-0.319,-0.316,-0.314,-0.311,-0.308,-0.305, - &-0.302,-0.299,-0.296,-0.293,-0.290,-0.287,-0.283,-0.280,-0.277, - &-0.274,-0.271,-0.268,-0.264,-0.261,-0.258,-0.255,-0.252,-0.248, - &-0.245,-0.242,-0.238,-0.235,-0.232,-0.228,-0.225,-0.222,-0.218, - &-0.215,-0.211,-0.208,-0.204,-0.201,-0.197,-0.194,-0.190,-0.187, - &-0.183,-0.179,-0.176,-0.172,-0.168,-0.164,-0.161,-0.157,-0.153, - &-0.149,-0.145,-0.141,-0.137,-0.133,-0.129,-0.125,-0.121,-0.117, - &-0.113,-0.109,-0.105,-0.101,-0.096,-0.092,-0.088,-0.084,-0.080, - &-0.075,-0.071,-0.067,-0.062,-0.058,-0.054,-0.049,-0.045,-0.041, - &-0.036,-0.032,-0.027,-0.023,-0.019,-0.014,-0.010,-0.005,-0.001, - & 0.003, 0.008, 0.012, 0.017, 0.021, 0.026, 0.030, 0.034, 0.039, - & 0.043, 0.048, 0.052, 0.057, 0.061, 0.065, 0.070, 0.074, 0.079, - & 0.083, 0.087, 0.092, 0.096, 0.101, 0.105, 0.109, 0.114, 0.118, - & 0.123, 0.127, 0.131, 0.136, 0.140, 0.144, 0.149, 0.153, 0.157, - & 0.162, 0.166, 0.170, 0.175, 0.179, 0.183, 0.188, 0.192, 0.196, - & 0.201, 0.205, 0.209, 0.214, 0.218, 0.222, 0.226, 0.231, 0.235, - & 0.239, 0.243, 0.248, 0.252, 0.256, 0.260, 0.265, 0.269, 0.273, - & 0.277, 0.281, 0.286, 0.290, 0.294, 0.298, 0.302, 0.306, 0.311, - & 0.315, 0.319, 0.323, 0.327, 0.331, 0.336, 0.340, 0.344, 0.348, - & 0.352, 0.356, 0.360, 0.364, 0.368, 0.372, 0.377, 0.381, 0.385, - & 0.389, 0.393, 0.397, 0.401, 0.405, 0.409, 0.413, 0.417, 0.421, - & 0.425, 0.429, 0.433, 0.437, 0.441, 0.445, 0.449, 0.453, 0.457, - & 0.461, 0.465, 0.469, 0.473, 0.477, 0.481, 0.485, 0.488, 0.492, - & 0.496, 0.500, 0.504, 0.508, 0.512, 0.516, 0.520, 0.524, 0.527, - & 0.531, 0.535, 0.539, 0.543, 0.547, 0.550, 0.554, 0.558, 0.562, - & 0.566, 0.570, 0.573, 0.577, 0.581, 0.585, 0.588, 0.592, 0.596, - & 0.600, 0.604, 0.607, 0.611, 0.615, 0.618, 0.622, 0.626, 0.630, - & 0.633, 0.637, 0.641, 0.644, 0.648, 0.652, 0.656, 0.659, 0.663, - & 0.667, 0.670, 0.674, 0.677, 0.681, 0.685, 0.688, 0.692, 0.696, - & 0.699, 0.703, 0.706, 0.710, 0.714, 0.717, 0.721, 0.724, 0.728, - & 0.732, 0.735, 0.739, 0.742, 0.746, 0.749, 0.753, 0.756, 0.760, - & 0.763, 0.767, 0.770, 0.774, 0.777, 0.781, 0.784, 0.788, 0.791, - & 0.795, 0.798, 0.802, 0.805, 0.809, 0.812, 0.816, 0.819, 0.823, - & 0.826, 0.829, 0.833, 0.836, 0.840, 0.843, 0.846, 0.850, 0.853, - & 0.857, 0.860, 0.863, 0.867, 0.870, 0.873, 0.877, 0.880, 0.884, - & 0.887, 0.890, 0.894, 0.897, 0.900, 0.904, 0.907, 0.910, 0.913, - & 0.917, 0.920, 0.923, 0.927, 0.930, 0.933, 0.936, 0.940, 0.943, - & 0.946, 0.950, 0.953, 0.956, 0.959, 0.963, 0.966, 0.969, 0.972, - & 0.975, 0.979, 0.982, 0.985, 0.988, 0.991, 0.995, 0.998, 1.001, - & 1.004, 1.007, 1.011, 1.014, 1.017, 1.020, 1.023, 1.026, 1.029, - & 1.033, 1.036, 1.039, 1.042, 1.076, 1.106, 1.136, 1.166, 1.195, - & 1.224, 1.253, 1.281, 1.309, 1.337, 1.364, 1.391, 1.417, 1.444, - & 1.470, 1.495, 1.521, 1.546, 1.570, 1.595, 1.619, 1.643, 1.667, - & 1.690, 1.713, 1.736, 1.759, 1.781, 1.803, 1.825, 1.847, 1.868, - & 1.890, 1.911, 1.932, 1.952, 1.973, 1.993, 2.013, 2.033, 2.053, - & 2.072, 2.092, 2.111, 2.130, 2.149, 2.167, 2.186, 2.204, 2.222, - & 2.240, 2.258, 2.276, 2.293, 2.311, 2.328, 2.345, 2.362, 2.379, - & 2.396, 2.412, 2.429, 2.445, 2.461, 2.478, 2.493, 2.509, 2.525, - & 2.541, 2.556, 2.572, 2.587, 2.602, 2.617, 2.632, 2.647, 2.661, - & 2.676, 2.691, 2.705, 2.719, 2.734, 2.748, 2.762, 2.776, 2.789, - & 2.803, 2.817, 2.830, 2.844, 2.857, 2.871, 2.884, 2.897, 2.910, - & 2.923, 2.936, 2.949, 2.961, 2.974, 2.987, 2.999, 3.012, 3.024, - & 3.036, 3.048, 3.061, 3.073, 3.085, 3.097, 3.108, 3.120, 3.132, - & 3.144, 3.155, 3.167, 3.178, 3.190, 3.201, 3.212, 3.224, 3.235, - & 3.246, 3.257, 3.268, 3.279, 3.290, 3.300, 3.311, 3.322, 3.333, - & 3.343, 3.354, 3.364, 3.375, 3.385, 3.395, 3.406, 3.416, 3.426, - & 3.436, 3.446, 3.456, 3.466, 3.476, 3.486, 3.496, 3.506, 3.515, - & 3.525, 3.535, 3.544, 3.554, 3.563, 3.573, 3.582, 3.592, 3.601, - & 3.610, 3.620, 3.629 - & / -C -C *** K2SO4 -C - DATA BNC17M/ - &-0.093,-0.203,-0.257,-0.296,-0.326,-0.351,-0.372,-0.391,-0.408, - &-0.423,-0.436,-0.449,-0.460,-0.471,-0.481,-0.491,-0.500,-0.508, - &-0.516,-0.524,-0.531,-0.538,-0.545,-0.552,-0.558,-0.564,-0.569, - &-0.575,-0.580,-0.585,-0.590,-0.595,-0.600,-0.605,-0.609,-0.613, - &-0.618,-0.622,-0.626,-0.629,-0.633,-0.637,-0.641,-0.644,-0.648, - &-0.651,-0.654,-0.658,-0.661,-0.664,-0.667,-0.670,-0.673,-0.676, - &-0.678,-0.681,-0.684,-0.687,-0.689,-0.692,-0.694,-0.697,-0.699, - &-0.702,-0.704,-0.707,-0.709,-0.711,-0.713,-0.716,-0.718,-0.720, - &-0.722,-0.724,-0.726,-0.728,-0.730,-0.732,-0.734,-0.736,-0.738, - &-0.740,-0.742,-0.744,-0.746,-0.748,-0.749,-0.751,-0.753,-0.755, - &-0.756,-0.758,-0.760,-0.762,-0.763,-0.765,-0.767,-0.768,-0.770, - &-0.772,-0.773,-0.775,-0.776,-0.778,-0.779,-0.781,-0.782,-0.784, - &-0.786,-0.787,-0.788,-0.790,-0.791,-0.793,-0.794,-0.796,-0.797, - &-0.799,-0.800,-0.801,-0.803,-0.804,-0.805,-0.807,-0.808,-0.809, - &-0.811,-0.812,-0.813,-0.815,-0.816,-0.817,-0.819,-0.820,-0.821, - &-0.822,-0.824,-0.825,-0.826,-0.827,-0.828,-0.830,-0.831,-0.832, - &-0.833,-0.834,-0.835,-0.837,-0.838,-0.839,-0.840,-0.841,-0.842, - &-0.843,-0.844,-0.846,-0.847,-0.848,-0.849,-0.850,-0.851,-0.852, - &-0.853,-0.854,-0.855,-0.856,-0.857,-0.858,-0.859,-0.860,-0.861, - &-0.862,-0.863,-0.864,-0.865,-0.866,-0.867,-0.868,-0.869,-0.870, - &-0.871,-0.872,-0.873,-0.874,-0.875,-0.876,-0.877,-0.878,-0.878, - &-0.879,-0.880,-0.881,-0.882,-0.883,-0.884,-0.885,-0.886,-0.886, - &-0.887,-0.888,-0.889,-0.890,-0.891,-0.892,-0.893,-0.893,-0.894, - &-0.895,-0.896,-0.897,-0.898,-0.898,-0.899,-0.900,-0.901,-0.902, - &-0.902,-0.903,-0.904,-0.905,-0.906,-0.906,-0.907,-0.908,-0.909, - &-0.910,-0.910,-0.911,-0.912,-0.913,-0.913,-0.914,-0.915,-0.916, - &-0.916,-0.917,-0.918,-0.919,-0.919,-0.920,-0.921,-0.922,-0.922, - &-0.923,-0.924,-0.924,-0.925,-0.926,-0.927,-0.927,-0.928,-0.929, - &-0.929,-0.930,-0.931,-0.931,-0.932,-0.933,-0.933,-0.934,-0.935, - &-0.936,-0.936,-0.937,-0.938,-0.938,-0.939,-0.940,-0.940,-0.941, - &-0.941,-0.942,-0.943,-0.943,-0.944,-0.945,-0.945,-0.946,-0.947, - &-0.947,-0.948,-0.949,-0.949,-0.950,-0.950,-0.951,-0.952,-0.952, - &-0.953,-0.954,-0.954,-0.955,-0.955,-0.956,-0.957,-0.957,-0.958, - &-0.958,-0.959,-0.960,-0.960,-0.961,-0.961,-0.962,-0.962,-0.963, - &-0.964,-0.964,-0.965,-0.965,-0.966,-0.967,-0.967,-0.968,-0.968, - &-0.969,-0.969,-0.970,-0.970,-0.971,-0.972,-0.972,-0.973,-0.973, - &-0.974,-0.974,-0.975,-0.975,-0.976,-0.977,-0.977,-0.978,-0.978, - &-0.979,-0.979,-0.980,-0.980,-0.981,-0.981,-0.982,-0.982,-0.983, - &-0.983,-0.984,-0.984,-0.985,-0.986,-0.986,-0.987,-0.987,-0.988, - &-0.988,-0.989,-0.989,-0.990,-0.990,-0.991,-0.991,-0.992,-0.992, - &-0.993,-0.993,-0.994,-0.994,-0.995,-0.995,-0.996,-0.996,-0.997, - &-0.997,-0.998,-0.998,-0.998,-0.999,-0.999,-1.000,-1.000,-1.001, - &-1.001,-1.002,-1.002,-1.003,-1.003,-1.004,-1.004,-1.005,-1.005, - &-1.006,-1.006,-1.006,-1.007,-1.007,-1.008,-1.008,-1.009,-1.009, - &-1.010,-1.010,-1.011,-1.011,-1.016,-1.020,-1.024,-1.029,-1.033, - &-1.037,-1.040,-1.044,-1.048,-1.052,-1.055,-1.059,-1.062,-1.065, - &-1.069,-1.072,-1.075,-1.078,-1.081,-1.084,-1.087,-1.090,-1.093, - &-1.096,-1.099,-1.102,-1.104,-1.107,-1.110,-1.112,-1.115,-1.117, - &-1.120,-1.122,-1.125,-1.127,-1.129,-1.132,-1.134,-1.136,-1.139, - &-1.141,-1.143,-1.145,-1.147,-1.149,-1.151,-1.153,-1.155,-1.157, - &-1.159,-1.161,-1.163,-1.165,-1.167,-1.169,-1.171,-1.173,-1.174, - &-1.176,-1.178,-1.180,-1.181,-1.183,-1.185,-1.187,-1.188,-1.190, - &-1.191,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201,-1.202,-1.204, - &-1.205,-1.207,-1.208,-1.210,-1.211,-1.213,-1.214,-1.216,-1.217, - &-1.218,-1.220,-1.221,-1.223,-1.224,-1.225,-1.226,-1.228,-1.229, - &-1.230,-1.232,-1.233,-1.234,-1.235,-1.237,-1.238,-1.239,-1.240, - &-1.242,-1.243,-1.244,-1.245,-1.246,-1.247,-1.249,-1.250,-1.251, - &-1.252,-1.253,-1.254,-1.255,-1.256,-1.258,-1.259,-1.260,-1.261, - &-1.262,-1.263,-1.264,-1.265,-1.266,-1.267,-1.268,-1.269,-1.270, - &-1.271,-1.272,-1.273,-1.274,-1.275,-1.276,-1.277,-1.278,-1.279, - &-1.280,-1.281,-1.282,-1.283,-1.283,-1.284,-1.285,-1.286,-1.287, - &-1.288,-1.289,-1.290,-1.291,-1.292,-1.292,-1.293,-1.294,-1.295, - &-1.296,-1.297,-1.298 - & / -C -C *** KHSO4 -C - DATA BNC18M/ - &-0.046,-0.097,-0.121,-0.138,-0.150,-0.161,-0.169,-0.176,-0.182, - &-0.188,-0.192,-0.196,-0.200,-0.203,-0.206,-0.209,-0.211,-0.213, - &-0.215,-0.217,-0.218,-0.219,-0.220,-0.221,-0.222,-0.223,-0.223, - &-0.223,-0.223,-0.224,-0.223,-0.223,-0.223,-0.223,-0.222,-0.222, - &-0.221,-0.220,-0.220,-0.219,-0.218,-0.217,-0.216,-0.215,-0.213, - &-0.212,-0.211,-0.209,-0.208,-0.206,-0.205,-0.203,-0.202,-0.200, - &-0.198,-0.196,-0.195,-0.193,-0.191,-0.189,-0.187,-0.185,-0.183, - &-0.181,-0.179,-0.177,-0.174,-0.172,-0.170,-0.168,-0.165,-0.163, - &-0.161,-0.158,-0.156,-0.153,-0.151,-0.148,-0.146,-0.143,-0.141, - &-0.138,-0.136,-0.133,-0.130,-0.127,-0.125,-0.122,-0.119,-0.116, - &-0.114,-0.111,-0.108,-0.105,-0.102,-0.099,-0.096,-0.093,-0.090, - &-0.087,-0.084,-0.081,-0.078,-0.075,-0.072,-0.069,-0.066,-0.063, - &-0.060,-0.056,-0.053,-0.050,-0.047,-0.044,-0.041,-0.037,-0.034, - &-0.031,-0.028,-0.025,-0.021,-0.018,-0.015,-0.012,-0.009,-0.005, - &-0.002, 0.001, 0.004, 0.007, 0.011, 0.014, 0.017, 0.020, 0.023, - & 0.027, 0.030, 0.033, 0.036, 0.039, 0.043, 0.046, 0.049, 0.052, - & 0.055, 0.058, 0.061, 0.065, 0.068, 0.071, 0.074, 0.077, 0.080, - & 0.083, 0.086, 0.089, 0.093, 0.096, 0.099, 0.102, 0.105, 0.108, - & 0.111, 0.114, 0.117, 0.120, 0.123, 0.126, 0.129, 0.132, 0.135, - & 0.138, 0.141, 0.144, 0.147, 0.150, 0.153, 0.156, 0.159, 0.162, - & 0.165, 0.168, 0.171, 0.174, 0.176, 0.179, 0.182, 0.185, 0.188, - & 0.191, 0.194, 0.197, 0.199, 0.202, 0.205, 0.208, 0.211, 0.214, - & 0.217, 0.219, 0.222, 0.225, 0.228, 0.231, 0.233, 0.236, 0.239, - & 0.242, 0.244, 0.247, 0.250, 0.253, 0.255, 0.258, 0.261, 0.264, - & 0.266, 0.269, 0.272, 0.274, 0.277, 0.280, 0.282, 0.285, 0.288, - & 0.290, 0.293, 0.296, 0.298, 0.301, 0.304, 0.306, 0.309, 0.312, - & 0.314, 0.317, 0.319, 0.322, 0.325, 0.327, 0.330, 0.332, 0.335, - & 0.337, 0.340, 0.343, 0.345, 0.348, 0.350, 0.353, 0.355, 0.358, - & 0.360, 0.363, 0.365, 0.368, 0.370, 0.373, 0.375, 0.378, 0.380, - & 0.383, 0.385, 0.388, 0.390, 0.393, 0.395, 0.397, 0.400, 0.402, - & 0.405, 0.407, 0.410, 0.412, 0.414, 0.417, 0.419, 0.422, 0.424, - & 0.426, 0.429, 0.431, 0.434, 0.436, 0.438, 0.441, 0.443, 0.445, - & 0.448, 0.450, 0.452, 0.455, 0.457, 0.459, 0.462, 0.464, 0.466, - & 0.469, 0.471, 0.473, 0.475, 0.478, 0.480, 0.482, 0.485, 0.487, - & 0.489, 0.491, 0.494, 0.496, 0.498, 0.500, 0.503, 0.505, 0.507, - & 0.509, 0.512, 0.514, 0.516, 0.518, 0.520, 0.523, 0.525, 0.527, - & 0.529, 0.531, 0.534, 0.536, 0.538, 0.540, 0.542, 0.544, 0.547, - & 0.549, 0.551, 0.553, 0.555, 0.557, 0.560, 0.562, 0.564, 0.566, - & 0.568, 0.570, 0.572, 0.574, 0.577, 0.579, 0.581, 0.583, 0.585, - & 0.587, 0.589, 0.591, 0.593, 0.595, 0.597, 0.600, 0.602, 0.604, - & 0.606, 0.608, 0.610, 0.612, 0.614, 0.616, 0.618, 0.620, 0.622, - & 0.624, 0.626, 0.628, 0.630, 0.632, 0.634, 0.636, 0.638, 0.640, - & 0.642, 0.644, 0.646, 0.648, 0.650, 0.652, 0.654, 0.656, 0.658, - & 0.660, 0.662, 0.664, 0.666, 0.668, 0.670, 0.672, 0.674, 0.676, - & 0.678, 0.680, 0.682, 0.684, 0.704, 0.723, 0.742, 0.760, 0.778, - & 0.796, 0.813, 0.831, 0.848, 0.865, 0.881, 0.898, 0.914, 0.930, - & 0.946, 0.961, 0.977, 0.992, 1.007, 1.022, 1.036, 1.051, 1.065, - & 1.079, 1.093, 1.107, 1.121, 1.134, 1.148, 1.161, 1.174, 1.187, - & 1.200, 1.213, 1.225, 1.238, 1.250, 1.262, 1.275, 1.287, 1.298, - & 1.310, 1.322, 1.333, 1.345, 1.356, 1.367, 1.379, 1.390, 1.401, - & 1.411, 1.422, 1.433, 1.443, 1.454, 1.464, 1.475, 1.485, 1.495, - & 1.505, 1.515, 1.525, 1.535, 1.545, 1.554, 1.564, 1.573, 1.583, - & 1.592, 1.602, 1.611, 1.620, 1.629, 1.638, 1.647, 1.656, 1.665, - & 1.674, 1.682, 1.691, 1.700, 1.708, 1.717, 1.725, 1.734, 1.742, - & 1.750, 1.758, 1.767, 1.775, 1.783, 1.791, 1.799, 1.807, 1.815, - & 1.822, 1.830, 1.838, 1.845, 1.853, 1.861, 1.868, 1.876, 1.883, - & 1.891, 1.898, 1.905, 1.912, 1.920, 1.927, 1.934, 1.941, 1.948, - & 1.955, 1.962, 1.969, 1.976, 1.983, 1.990, 1.997, 2.003, 2.010, - & 2.017, 2.023, 2.030, 2.037, 2.043, 2.050, 2.056, 2.063, 2.069, - & 2.075, 2.082, 2.088, 2.094, 2.101, 2.107, 2.113, 2.119, 2.125, - & 2.131, 2.137, 2.143, 2.149, 2.155, 2.161, 2.167, 2.173, 2.179, - & 2.185, 2.191, 2.197, 2.202, 2.208, 2.214, 2.219, 2.225, 2.231, - & 2.236, 2.242, 2.248 - & / -C -C *** KNO3 -C - DATA BNC19M/ - &-0.048,-0.109,-0.141,-0.166,-0.186,-0.204,-0.219,-0.233,-0.246, - &-0.258,-0.270,-0.281,-0.291,-0.301,-0.310,-0.319,-0.328,-0.336, - &-0.344,-0.352,-0.360,-0.367,-0.375,-0.382,-0.389,-0.395,-0.402, - &-0.409,-0.415,-0.421,-0.427,-0.433,-0.439,-0.445,-0.451,-0.456, - &-0.462,-0.467,-0.472,-0.477,-0.483,-0.488,-0.492,-0.497,-0.502, - &-0.507,-0.511,-0.516,-0.521,-0.525,-0.529,-0.534,-0.538,-0.542, - &-0.546,-0.550,-0.554,-0.558,-0.562,-0.566,-0.570,-0.574,-0.578, - &-0.581,-0.585,-0.589,-0.592,-0.596,-0.600,-0.603,-0.607,-0.610, - &-0.613,-0.617,-0.620,-0.624,-0.627,-0.630,-0.634,-0.637,-0.640, - &-0.643,-0.647,-0.650,-0.653,-0.656,-0.660,-0.663,-0.666,-0.669, - &-0.672,-0.675,-0.678,-0.682,-0.685,-0.688,-0.691,-0.694,-0.697, - &-0.700,-0.703,-0.706,-0.709,-0.712,-0.715,-0.718,-0.721,-0.724, - &-0.727,-0.730,-0.733,-0.736,-0.739,-0.741,-0.744,-0.747,-0.750, - &-0.753,-0.756,-0.758,-0.761,-0.764,-0.767,-0.770,-0.772,-0.775, - &-0.778,-0.780,-0.783,-0.786,-0.789,-0.791,-0.794,-0.796,-0.799, - &-0.802,-0.804,-0.807,-0.809,-0.812,-0.814,-0.817,-0.819,-0.822, - &-0.824,-0.827,-0.829,-0.832,-0.834,-0.837,-0.839,-0.841,-0.844, - &-0.846,-0.848,-0.851,-0.853,-0.855,-0.858,-0.860,-0.862,-0.865, - &-0.867,-0.869,-0.871,-0.873,-0.876,-0.878,-0.880,-0.882,-0.884, - &-0.887,-0.889,-0.891,-0.893,-0.895,-0.897,-0.899,-0.901,-0.903, - &-0.905,-0.908,-0.910,-0.912,-0.914,-0.916,-0.918,-0.920,-0.922, - &-0.924,-0.925,-0.927,-0.929,-0.931,-0.933,-0.935,-0.937,-0.939, - &-0.941,-0.943,-0.945,-0.946,-0.948,-0.950,-0.952,-0.954,-0.956, - &-0.957,-0.959,-0.961,-0.963,-0.965,-0.966,-0.968,-0.970,-0.972, - &-0.973,-0.975,-0.977,-0.978,-0.980,-0.982,-0.984,-0.985,-0.987, - &-0.989,-0.990,-0.992,-0.993,-0.995,-0.997,-0.998,-1.000,-1.002, - &-1.003,-1.005,-1.006,-1.008,-1.009,-1.011,-1.013,-1.014,-1.016, - &-1.017,-1.019,-1.020,-1.022,-1.023,-1.025,-1.026,-1.028,-1.029, - &-1.031,-1.032,-1.034,-1.035,-1.036,-1.038,-1.039,-1.041,-1.042, - &-1.044,-1.045,-1.046,-1.048,-1.049,-1.051,-1.052,-1.053,-1.055, - &-1.056,-1.057,-1.059,-1.060,-1.061,-1.063,-1.064,-1.065,-1.067, - &-1.068,-1.069,-1.071,-1.072,-1.073,-1.074,-1.076,-1.077,-1.078, - &-1.079,-1.081,-1.082,-1.083,-1.084,-1.086,-1.087,-1.088,-1.089, - &-1.090,-1.092,-1.093,-1.094,-1.095,-1.096,-1.098,-1.099,-1.100, - &-1.101,-1.102,-1.103,-1.105,-1.106,-1.107,-1.108,-1.109,-1.110, - &-1.111,-1.112,-1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.120, - &-1.121,-1.122,-1.123,-1.124,-1.125,-1.127,-1.128,-1.129,-1.130, - &-1.131,-1.132,-1.133,-1.134,-1.135,-1.136,-1.137,-1.138,-1.139, - &-1.140,-1.141,-1.142,-1.143,-1.144,-1.145,-1.146,-1.147,-1.148, - &-1.149,-1.150,-1.151,-1.152,-1.153,-1.153,-1.154,-1.155,-1.156, - &-1.157,-1.158,-1.159,-1.160,-1.161,-1.162,-1.163,-1.164,-1.165, - &-1.165,-1.166,-1.167,-1.168,-1.169,-1.170,-1.171,-1.172,-1.172, - &-1.173,-1.174,-1.175,-1.176,-1.177,-1.178,-1.178,-1.179,-1.180, - &-1.181,-1.182,-1.183,-1.183,-1.184,-1.185,-1.186,-1.187,-1.188, - &-1.188,-1.189,-1.190,-1.191,-1.199,-1.207,-1.214,-1.221,-1.228, - &-1.234,-1.240,-1.246,-1.252,-1.258,-1.263,-1.268,-1.273,-1.278, - &-1.283,-1.287,-1.292,-1.296,-1.300,-1.304,-1.308,-1.312,-1.315, - &-1.319,-1.322,-1.325,-1.329,-1.332,-1.335,-1.338,-1.341,-1.343, - &-1.346,-1.349,-1.351,-1.354,-1.356,-1.358,-1.361,-1.363,-1.365, - &-1.367,-1.369,-1.371,-1.373,-1.375,-1.377,-1.378,-1.380,-1.382, - &-1.383,-1.385,-1.387,-1.388,-1.390,-1.391,-1.393,-1.394,-1.395, - &-1.397,-1.398,-1.399,-1.400,-1.402,-1.403,-1.404,-1.405,-1.406, - &-1.407,-1.408,-1.409,-1.410,-1.411,-1.412,-1.413,-1.414,-1.415, - &-1.416,-1.417,-1.418,-1.419,-1.420,-1.420,-1.421,-1.422,-1.423, - &-1.424,-1.424,-1.425,-1.426,-1.427,-1.427,-1.428,-1.429,-1.429, - &-1.430,-1.430,-1.431,-1.432,-1.432,-1.433,-1.434,-1.434,-1.435, - &-1.435,-1.436,-1.436,-1.437,-1.437,-1.438,-1.438,-1.439,-1.439, - &-1.440,-1.440,-1.441,-1.441,-1.442,-1.442,-1.443,-1.443,-1.443, - &-1.444,-1.444,-1.445,-1.445,-1.445,-1.446,-1.446,-1.447,-1.447, - &-1.447,-1.448,-1.448,-1.448,-1.449,-1.449,-1.449,-1.450,-1.450, - &-1.450,-1.451,-1.451,-1.451,-1.452,-1.452,-1.452,-1.453,-1.453, - &-1.453,-1.454,-1.454,-1.454,-1.454,-1.455,-1.455,-1.455,-1.455, - &-1.456,-1.456,-1.456 - & / -C -C *** KCL -C - DATA BNC20M/ - &-0.046,-0.098,-0.123,-0.139,-0.152,-0.162,-0.171,-0.178,-0.184, - &-0.190,-0.195,-0.199,-0.203,-0.206,-0.209,-0.212,-0.215,-0.217, - &-0.219,-0.221,-0.223,-0.225,-0.226,-0.228,-0.229,-0.230,-0.231, - &-0.232,-0.233,-0.234,-0.235,-0.236,-0.236,-0.237,-0.238,-0.238, - &-0.239,-0.239,-0.240,-0.240,-0.240,-0.241,-0.241,-0.241,-0.242, - &-0.242,-0.242,-0.242,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243, - &-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243, - &-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.242, - &-0.242,-0.242,-0.242,-0.242,-0.242,-0.241,-0.241,-0.241,-0.241, - &-0.241,-0.240,-0.240,-0.240,-0.239,-0.239,-0.239,-0.239,-0.238, - &-0.238,-0.238,-0.237,-0.237,-0.237,-0.236,-0.236,-0.235,-0.235, - &-0.235,-0.234,-0.234,-0.233,-0.233,-0.232,-0.232,-0.232,-0.231, - &-0.231,-0.230,-0.230,-0.229,-0.229,-0.228,-0.228,-0.227,-0.227, - &-0.226,-0.226,-0.225,-0.225,-0.224,-0.224,-0.223,-0.223,-0.222, - &-0.222,-0.221,-0.220,-0.220,-0.219,-0.219,-0.218,-0.218,-0.217, - &-0.217,-0.216,-0.216,-0.215,-0.214,-0.214,-0.213,-0.213,-0.212, - &-0.212,-0.211,-0.210,-0.210,-0.209,-0.209,-0.208,-0.208,-0.207, - &-0.207,-0.206,-0.205,-0.205,-0.204,-0.204,-0.203,-0.203,-0.202, - &-0.201,-0.201,-0.200,-0.200,-0.199,-0.199,-0.198,-0.197,-0.197, - &-0.196,-0.196,-0.195,-0.194,-0.194,-0.193,-0.193,-0.192,-0.192, - &-0.191,-0.190,-0.190,-0.189,-0.189,-0.188,-0.188,-0.187,-0.186, - &-0.186,-0.185,-0.185,-0.184,-0.184,-0.183,-0.182,-0.182,-0.181, - &-0.181,-0.180,-0.180,-0.179,-0.178,-0.178,-0.177,-0.177,-0.176, - &-0.176,-0.175,-0.174,-0.174,-0.173,-0.173,-0.172,-0.172,-0.171, - &-0.170,-0.170,-0.169,-0.169,-0.168,-0.168,-0.167,-0.166,-0.166, - &-0.165,-0.165,-0.164,-0.164,-0.163,-0.162,-0.162,-0.161,-0.161, - &-0.160,-0.160,-0.159,-0.158,-0.158,-0.157,-0.157,-0.156,-0.156, - &-0.155,-0.155,-0.154,-0.153,-0.153,-0.152,-0.152,-0.151,-0.151, - &-0.150,-0.150,-0.149,-0.148,-0.148,-0.147,-0.147,-0.146,-0.146, - &-0.145,-0.145,-0.144,-0.143,-0.143,-0.142,-0.142,-0.141,-0.141, - &-0.140,-0.140,-0.139,-0.139,-0.138,-0.137,-0.137,-0.136,-0.136, - &-0.135,-0.135,-0.134,-0.134,-0.133,-0.133,-0.132,-0.131,-0.131, - &-0.130,-0.130,-0.129,-0.129,-0.128,-0.128,-0.127,-0.127,-0.126, - &-0.126,-0.125,-0.125,-0.124,-0.123,-0.123,-0.122,-0.122,-0.121, - &-0.121,-0.120,-0.120,-0.119,-0.119,-0.118,-0.118,-0.117,-0.117, - &-0.116,-0.116,-0.115,-0.115,-0.114,-0.113,-0.113,-0.112,-0.112, - &-0.111,-0.111,-0.110,-0.110,-0.109,-0.109,-0.108,-0.108,-0.107, - &-0.107,-0.106,-0.106,-0.105,-0.105,-0.104,-0.104,-0.103,-0.103, - &-0.102,-0.102,-0.101,-0.101,-0.100,-0.100,-0.099,-0.099,-0.098, - &-0.098,-0.097,-0.097,-0.096,-0.096,-0.095,-0.095,-0.094,-0.094, - &-0.093,-0.093,-0.092,-0.092,-0.091,-0.091,-0.090,-0.090,-0.089, - &-0.089,-0.088,-0.088,-0.087,-0.087,-0.086,-0.086,-0.085,-0.085, - &-0.084,-0.084,-0.083,-0.083,-0.082,-0.082,-0.081,-0.081,-0.080, - &-0.080,-0.079,-0.079,-0.078,-0.078,-0.077,-0.077,-0.077,-0.076, - &-0.076,-0.075,-0.075,-0.074,-0.069,-0.064,-0.060,-0.055,-0.051, - &-0.046,-0.042,-0.037,-0.033,-0.028,-0.024,-0.020,-0.016,-0.012, - &-0.008,-0.004, 0.000, 0.004, 0.008, 0.012, 0.016, 0.020, 0.024, - & 0.028, 0.031, 0.035, 0.039, 0.042, 0.046, 0.049, 0.053, 0.056, - & 0.060, 0.063, 0.067, 0.070, 0.073, 0.077, 0.080, 0.083, 0.087, - & 0.090, 0.093, 0.096, 0.099, 0.102, 0.105, 0.108, 0.111, 0.114, - & 0.117, 0.120, 0.123, 0.126, 0.129, 0.132, 0.135, 0.138, 0.141, - & 0.143, 0.146, 0.149, 0.152, 0.154, 0.157, 0.160, 0.162, 0.165, - & 0.168, 0.170, 0.173, 0.176, 0.178, 0.181, 0.183, 0.186, 0.188, - & 0.191, 0.193, 0.196, 0.198, 0.200, 0.203, 0.205, 0.208, 0.210, - & 0.212, 0.215, 0.217, 0.219, 0.221, 0.224, 0.226, 0.228, 0.231, - & 0.233, 0.235, 0.237, 0.239, 0.242, 0.244, 0.246, 0.248, 0.250, - & 0.252, 0.254, 0.256, 0.258, 0.261, 0.263, 0.265, 0.267, 0.269, - & 0.271, 0.273, 0.275, 0.277, 0.279, 0.281, 0.283, 0.285, 0.286, - & 0.288, 0.290, 0.292, 0.294, 0.296, 0.298, 0.300, 0.302, 0.304, - & 0.305, 0.307, 0.309, 0.311, 0.313, 0.314, 0.316, 0.318, 0.320, - & 0.322, 0.323, 0.325, 0.327, 0.329, 0.330, 0.332, 0.334, 0.335, - & 0.337, 0.339, 0.341, 0.342, 0.344, 0.346, 0.347, 0.349, 0.350, - & 0.352, 0.354, 0.355 - & / -C -C *** MGSO4 -C - DATA BNC21M/ - &-0.185,-0.400,-0.506,-0.579,-0.636,-0.683,-0.723,-0.757,-0.787, - &-0.814,-0.839,-0.861,-0.881,-0.900,-0.917,-0.934,-0.949,-0.963, - &-0.977,-0.989,-1.001,-1.013,-1.023,-1.034,-1.044,-1.053,-1.062, - &-1.071,-1.079,-1.087,-1.094,-1.102,-1.109,-1.116,-1.122,-1.129, - &-1.135,-1.141,-1.147,-1.152,-1.158,-1.163,-1.168,-1.173,-1.178, - &-1.183,-1.187,-1.192,-1.196,-1.200,-1.205,-1.209,-1.213,-1.216, - &-1.220,-1.224,-1.228,-1.231,-1.235,-1.238,-1.241,-1.244,-1.248, - &-1.251,-1.254,-1.257,-1.260,-1.263,-1.265,-1.268,-1.271,-1.274, - &-1.276,-1.279,-1.281,-1.284,-1.286,-1.288,-1.291,-1.293,-1.295, - &-1.297,-1.300,-1.302,-1.304,-1.306,-1.308,-1.310,-1.312,-1.314, - &-1.316,-1.317,-1.319,-1.321,-1.323,-1.324,-1.326,-1.328,-1.329, - &-1.331,-1.333,-1.334,-1.336,-1.337,-1.339,-1.340,-1.341,-1.343, - &-1.344,-1.346,-1.347,-1.348,-1.350,-1.351,-1.352,-1.353,-1.355, - &-1.356,-1.357,-1.358,-1.359,-1.360,-1.362,-1.363,-1.364,-1.365, - &-1.366,-1.367,-1.368,-1.369,-1.370,-1.371,-1.372,-1.373,-1.374, - &-1.375,-1.376,-1.377,-1.377,-1.378,-1.379,-1.380,-1.381,-1.382, - &-1.383,-1.383,-1.384,-1.385,-1.386,-1.387,-1.387,-1.388,-1.389, - &-1.390,-1.390,-1.391,-1.392,-1.393,-1.393,-1.394,-1.395,-1.395, - &-1.396,-1.397,-1.397,-1.398,-1.399,-1.399,-1.400,-1.401,-1.401, - &-1.402,-1.402,-1.403,-1.404,-1.404,-1.405,-1.405,-1.406,-1.406, - &-1.407,-1.407,-1.408,-1.408,-1.409,-1.410,-1.410,-1.411,-1.411, - &-1.412,-1.412,-1.412,-1.413,-1.413,-1.414,-1.414,-1.415,-1.415, - &-1.416,-1.416,-1.417,-1.417,-1.417,-1.418,-1.418,-1.419,-1.419, - &-1.420,-1.420,-1.420,-1.421,-1.421,-1.422,-1.422,-1.422,-1.423, - &-1.423,-1.423,-1.424,-1.424,-1.424,-1.425,-1.425,-1.426,-1.426, - &-1.426,-1.427,-1.427,-1.427,-1.428,-1.428,-1.428,-1.428,-1.429, - &-1.429,-1.429,-1.430,-1.430,-1.430,-1.431,-1.431,-1.431,-1.431, - &-1.432,-1.432,-1.432,-1.433,-1.433,-1.433,-1.433,-1.434,-1.434, - &-1.434,-1.434,-1.435,-1.435,-1.435,-1.435,-1.436,-1.436,-1.436, - &-1.436,-1.437,-1.437,-1.437,-1.437,-1.437,-1.438,-1.438,-1.438, - &-1.438,-1.439,-1.439,-1.439,-1.439,-1.439,-1.440,-1.440,-1.440, - &-1.440,-1.440,-1.441,-1.441,-1.441,-1.441,-1.441,-1.441,-1.442, - &-1.442,-1.442,-1.442,-1.442,-1.442,-1.443,-1.443,-1.443,-1.443, - &-1.443,-1.443,-1.444,-1.444,-1.444,-1.444,-1.444,-1.444,-1.445, - &-1.445,-1.445,-1.445,-1.445,-1.445,-1.445,-1.446,-1.446,-1.446, - &-1.446,-1.446,-1.446,-1.446,-1.446,-1.447,-1.447,-1.447,-1.447, - &-1.447,-1.447,-1.447,-1.447,-1.448,-1.448,-1.448,-1.448,-1.448, - &-1.448,-1.448,-1.448,-1.448,-1.449,-1.449,-1.449,-1.449,-1.449, - &-1.449,-1.449,-1.449,-1.449,-1.449,-1.450,-1.450,-1.450,-1.450, - &-1.450,-1.450,-1.450,-1.450,-1.450,-1.450,-1.450,-1.451,-1.451, - &-1.451,-1.451,-1.451,-1.451,-1.451,-1.451,-1.451,-1.451,-1.451, - &-1.451,-1.451,-1.451,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452, - &-1.452,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452, - &-1.453,-1.453,-1.453,-1.453,-1.453,-1.453,-1.453,-1.453,-1.453, - &-1.453,-1.453,-1.453,-1.453,-1.454,-1.454,-1.454,-1.455,-1.455, - &-1.455,-1.455,-1.455,-1.455,-1.455,-1.455,-1.455,-1.455,-1.455, - &-1.454,-1.454,-1.454,-1.454,-1.453,-1.453,-1.453,-1.452,-1.452, - &-1.452,-1.451,-1.451,-1.450,-1.450,-1.450,-1.449,-1.449,-1.448, - &-1.448,-1.447,-1.447,-1.446,-1.446,-1.445,-1.445,-1.444,-1.444, - &-1.443,-1.442,-1.442,-1.441,-1.441,-1.440,-1.440,-1.439,-1.438, - &-1.438,-1.437,-1.437,-1.436,-1.436,-1.435,-1.434,-1.434,-1.433, - &-1.433,-1.432,-1.431,-1.431,-1.430,-1.430,-1.429,-1.428,-1.428, - &-1.427,-1.426,-1.426,-1.425,-1.425,-1.424,-1.423,-1.423,-1.422, - &-1.422,-1.421,-1.420,-1.420,-1.419,-1.418,-1.418,-1.417,-1.417, - &-1.416,-1.415,-1.415,-1.414,-1.414,-1.413,-1.412,-1.412,-1.411, - &-1.411,-1.410,-1.409,-1.409,-1.408,-1.408,-1.407,-1.406,-1.406, - &-1.405,-1.405,-1.404,-1.403,-1.403,-1.402,-1.402,-1.401,-1.400, - &-1.400,-1.399,-1.399,-1.398,-1.398,-1.397,-1.396,-1.396,-1.395, - &-1.395,-1.394,-1.394,-1.393,-1.392,-1.392,-1.391,-1.391,-1.390, - &-1.390,-1.389,-1.388,-1.388,-1.387,-1.387,-1.386,-1.386,-1.385, - &-1.385,-1.384,-1.383,-1.383,-1.382,-1.382,-1.381,-1.381,-1.380, - &-1.380,-1.379,-1.378,-1.378,-1.377,-1.377,-1.376,-1.376,-1.375, - &-1.375,-1.374,-1.374 - & / -C -C *** MGNO32 -C - DATA BNC22M/ - &-0.091,-0.189,-0.233,-0.262,-0.283,-0.299,-0.312,-0.322,-0.330, - &-0.337,-0.343,-0.347,-0.351,-0.354,-0.356,-0.358,-0.359,-0.360, - &-0.361,-0.361,-0.361,-0.360,-0.360,-0.359,-0.358,-0.356,-0.355, - &-0.354,-0.352,-0.350,-0.348,-0.346,-0.344,-0.342,-0.340,-0.337, - &-0.335,-0.332,-0.330,-0.327,-0.325,-0.322,-0.319,-0.316,-0.314, - &-0.311,-0.308,-0.305,-0.302,-0.299,-0.297,-0.294,-0.291,-0.288, - &-0.285,-0.282,-0.279,-0.276,-0.273,-0.270,-0.267,-0.263,-0.260, - &-0.257,-0.254,-0.251,-0.248,-0.245,-0.242,-0.238,-0.235,-0.232, - &-0.229,-0.225,-0.222,-0.219,-0.215,-0.212,-0.209,-0.205,-0.202, - &-0.198,-0.195,-0.191,-0.188,-0.184,-0.181,-0.177,-0.173,-0.170, - &-0.166,-0.162,-0.159,-0.155,-0.151,-0.147,-0.143,-0.140,-0.136, - &-0.132,-0.128,-0.124,-0.120,-0.116,-0.112,-0.108,-0.104,-0.100, - &-0.096,-0.091,-0.087,-0.083,-0.079,-0.075,-0.071,-0.067,-0.062, - &-0.058,-0.054,-0.050,-0.046,-0.041,-0.037,-0.033,-0.029,-0.024, - &-0.020,-0.016,-0.012,-0.008,-0.003, 0.001, 0.005, 0.009, 0.014, - & 0.018, 0.022, 0.026, 0.031, 0.035, 0.039, 0.043, 0.047, 0.052, - & 0.056, 0.060, 0.064, 0.069, 0.073, 0.077, 0.081, 0.085, 0.090, - & 0.094, 0.098, 0.102, 0.106, 0.110, 0.115, 0.119, 0.123, 0.127, - & 0.131, 0.135, 0.140, 0.144, 0.148, 0.152, 0.156, 0.160, 0.164, - & 0.169, 0.173, 0.177, 0.181, 0.185, 0.189, 0.193, 0.197, 0.201, - & 0.205, 0.209, 0.214, 0.218, 0.222, 0.226, 0.230, 0.234, 0.238, - & 0.242, 0.246, 0.250, 0.254, 0.258, 0.262, 0.266, 0.270, 0.274, - & 0.278, 0.282, 0.286, 0.290, 0.294, 0.298, 0.302, 0.306, 0.310, - & 0.314, 0.318, 0.321, 0.325, 0.329, 0.333, 0.337, 0.341, 0.345, - & 0.349, 0.353, 0.357, 0.361, 0.364, 0.368, 0.372, 0.376, 0.380, - & 0.384, 0.388, 0.391, 0.395, 0.399, 0.403, 0.407, 0.410, 0.414, - & 0.418, 0.422, 0.426, 0.429, 0.433, 0.437, 0.441, 0.445, 0.448, - & 0.452, 0.456, 0.459, 0.463, 0.467, 0.471, 0.474, 0.478, 0.482, - & 0.486, 0.489, 0.493, 0.497, 0.500, 0.504, 0.508, 0.511, 0.515, - & 0.519, 0.522, 0.526, 0.530, 0.533, 0.537, 0.540, 0.544, 0.548, - & 0.551, 0.555, 0.559, 0.562, 0.566, 0.569, 0.573, 0.576, 0.580, - & 0.584, 0.587, 0.591, 0.594, 0.598, 0.601, 0.605, 0.608, 0.612, - & 0.615, 0.619, 0.622, 0.626, 0.629, 0.633, 0.636, 0.640, 0.643, - & 0.647, 0.650, 0.654, 0.657, 0.661, 0.664, 0.668, 0.671, 0.674, - & 0.678, 0.681, 0.685, 0.688, 0.691, 0.695, 0.698, 0.702, 0.705, - & 0.708, 0.712, 0.715, 0.719, 0.722, 0.725, 0.729, 0.732, 0.735, - & 0.739, 0.742, 0.745, 0.749, 0.752, 0.755, 0.759, 0.762, 0.765, - & 0.768, 0.772, 0.775, 0.778, 0.782, 0.785, 0.788, 0.791, 0.795, - & 0.798, 0.801, 0.804, 0.808, 0.811, 0.814, 0.817, 0.821, 0.824, - & 0.827, 0.830, 0.833, 0.837, 0.840, 0.843, 0.846, 0.849, 0.853, - & 0.856, 0.859, 0.862, 0.865, 0.868, 0.872, 0.875, 0.878, 0.881, - & 0.884, 0.887, 0.890, 0.893, 0.897, 0.900, 0.903, 0.906, 0.909, - & 0.912, 0.915, 0.918, 0.921, 0.924, 0.928, 0.931, 0.934, 0.937, - & 0.940, 0.943, 0.946, 0.949, 0.952, 0.955, 0.958, 0.961, 0.964, - & 0.967, 0.970, 0.973, 0.976, 1.008, 1.038, 1.067, 1.095, 1.124, - & 1.152, 1.179, 1.206, 1.233, 1.260, 1.286, 1.312, 1.337, 1.363, - & 1.387, 1.412, 1.437, 1.461, 1.484, 1.508, 1.531, 1.554, 1.577, - & 1.600, 1.622, 1.644, 1.666, 1.687, 1.709, 1.730, 1.751, 1.772, - & 1.792, 1.812, 1.832, 1.852, 1.872, 1.892, 1.911, 1.930, 1.949, - & 1.968, 1.987, 2.005, 2.023, 2.042, 2.060, 2.077, 2.095, 2.113, - & 2.130, 2.147, 2.164, 2.181, 2.198, 2.215, 2.231, 2.248, 2.264, - & 2.280, 2.296, 2.312, 2.328, 2.343, 2.359, 2.374, 2.389, 2.405, - & 2.420, 2.435, 2.449, 2.464, 2.479, 2.493, 2.508, 2.522, 2.536, - & 2.550, 2.564, 2.578, 2.592, 2.606, 2.619, 2.633, 2.646, 2.660, - & 2.673, 2.686, 2.699, 2.712, 2.725, 2.738, 2.751, 2.763, 2.776, - & 2.788, 2.801, 2.813, 2.826, 2.838, 2.850, 2.862, 2.874, 2.886, - & 2.898, 2.910, 2.921, 2.933, 2.945, 2.956, 2.967, 2.979, 2.990, - & 3.001, 3.013, 3.024, 3.035, 3.046, 3.057, 3.068, 3.079, 3.089, - & 3.100, 3.111, 3.121, 3.132, 3.142, 3.153, 3.163, 3.173, 3.184, - & 3.194, 3.204, 3.214, 3.224, 3.234, 3.244, 3.254, 3.264, 3.274, - & 3.284, 3.293, 3.303, 3.313, 3.322, 3.332, 3.341, 3.351, 3.360, - & 3.370, 3.379, 3.388, 3.397, 3.407, 3.416, 3.425, 3.434, 3.443, - & 3.452, 3.461, 3.470 - & / -C -C *** MGCL2 -C - DATA BNC23M/ - &-0.090,-0.186,-0.229,-0.256,-0.276,-0.290,-0.302,-0.310,-0.317, - &-0.322,-0.327,-0.330,-0.332,-0.333,-0.334,-0.335,-0.335,-0.334, - &-0.333,-0.332,-0.331,-0.329,-0.327,-0.325,-0.322,-0.320,-0.317, - &-0.314,-0.311,-0.308,-0.305,-0.301,-0.298,-0.294,-0.291,-0.287, - &-0.283,-0.279,-0.275,-0.272,-0.268,-0.264,-0.260,-0.255,-0.251, - &-0.247,-0.243,-0.239,-0.235,-0.231,-0.226,-0.222,-0.218,-0.214, - &-0.209,-0.205,-0.201,-0.196,-0.192,-0.188,-0.184,-0.179,-0.175, - &-0.170,-0.166,-0.162,-0.157,-0.153,-0.148,-0.144,-0.139,-0.135, - &-0.130,-0.126,-0.121,-0.117,-0.112,-0.107,-0.103,-0.098,-0.093, - &-0.089,-0.084,-0.079,-0.074,-0.069,-0.065,-0.060,-0.055,-0.050, - &-0.045,-0.040,-0.034,-0.029,-0.024,-0.019,-0.014,-0.009,-0.003, - & 0.002, 0.007, 0.013, 0.018, 0.023, 0.029, 0.034, 0.040, 0.045, - & 0.050, 0.056, 0.061, 0.067, 0.073, 0.078, 0.084, 0.089, 0.095, - & 0.100, 0.106, 0.112, 0.117, 0.123, 0.128, 0.134, 0.140, 0.145, - & 0.151, 0.157, 0.162, 0.168, 0.174, 0.179, 0.185, 0.190, 0.196, - & 0.202, 0.207, 0.213, 0.219, 0.224, 0.230, 0.235, 0.241, 0.247, - & 0.252, 0.258, 0.263, 0.269, 0.275, 0.280, 0.286, 0.291, 0.297, - & 0.302, 0.308, 0.313, 0.319, 0.325, 0.330, 0.336, 0.341, 0.347, - & 0.352, 0.358, 0.363, 0.369, 0.374, 0.380, 0.385, 0.390, 0.396, - & 0.401, 0.407, 0.412, 0.418, 0.423, 0.428, 0.434, 0.439, 0.445, - & 0.450, 0.455, 0.461, 0.466, 0.471, 0.477, 0.482, 0.487, 0.493, - & 0.498, 0.503, 0.509, 0.514, 0.519, 0.525, 0.530, 0.535, 0.540, - & 0.546, 0.551, 0.556, 0.561, 0.567, 0.572, 0.577, 0.582, 0.587, - & 0.593, 0.598, 0.603, 0.608, 0.613, 0.618, 0.624, 0.629, 0.634, - & 0.639, 0.644, 0.649, 0.654, 0.659, 0.664, 0.669, 0.675, 0.680, - & 0.685, 0.690, 0.695, 0.700, 0.705, 0.710, 0.715, 0.720, 0.725, - & 0.730, 0.735, 0.740, 0.745, 0.750, 0.755, 0.759, 0.764, 0.769, - & 0.774, 0.779, 0.784, 0.789, 0.794, 0.799, 0.804, 0.808, 0.813, - & 0.818, 0.823, 0.828, 0.833, 0.837, 0.842, 0.847, 0.852, 0.857, - & 0.861, 0.866, 0.871, 0.876, 0.880, 0.885, 0.890, 0.895, 0.899, - & 0.904, 0.909, 0.914, 0.918, 0.923, 0.928, 0.932, 0.937, 0.942, - & 0.946, 0.951, 0.955, 0.960, 0.965, 0.969, 0.974, 0.979, 0.983, - & 0.988, 0.992, 0.997, 1.001, 1.006, 1.011, 1.015, 1.020, 1.024, - & 1.029, 1.033, 1.038, 1.042, 1.047, 1.051, 1.056, 1.060, 1.065, - & 1.069, 1.073, 1.078, 1.082, 1.087, 1.091, 1.096, 1.100, 1.104, - & 1.109, 1.113, 1.118, 1.122, 1.126, 1.131, 1.135, 1.139, 1.144, - & 1.148, 1.152, 1.157, 1.161, 1.165, 1.170, 1.174, 1.178, 1.183, - & 1.187, 1.191, 1.195, 1.200, 1.204, 1.208, 1.212, 1.217, 1.221, - & 1.225, 1.229, 1.234, 1.238, 1.242, 1.246, 1.250, 1.255, 1.259, - & 1.263, 1.267, 1.271, 1.275, 1.279, 1.284, 1.288, 1.292, 1.296, - & 1.300, 1.304, 1.308, 1.312, 1.316, 1.321, 1.325, 1.329, 1.333, - & 1.337, 1.341, 1.345, 1.349, 1.353, 1.357, 1.361, 1.365, 1.369, - & 1.373, 1.377, 1.381, 1.385, 1.389, 1.393, 1.397, 1.401, 1.405, - & 1.409, 1.413, 1.417, 1.421, 1.425, 1.428, 1.432, 1.436, 1.440, - & 1.444, 1.448, 1.452, 1.456, 1.497, 1.535, 1.573, 1.610, 1.646, - & 1.682, 1.717, 1.752, 1.787, 1.821, 1.854, 1.888, 1.920, 1.953, - & 1.985, 2.016, 2.048, 2.078, 2.109, 2.139, 2.169, 2.198, 2.227, - & 2.256, 2.285, 2.313, 2.341, 2.368, 2.395, 2.422, 2.449, 2.475, - & 2.501, 2.527, 2.553, 2.578, 2.603, 2.628, 2.653, 2.677, 2.701, - & 2.725, 2.749, 2.772, 2.796, 2.819, 2.841, 2.864, 2.887, 2.909, - & 2.931, 2.953, 2.974, 2.996, 3.017, 3.038, 3.059, 3.080, 3.100, - & 3.121, 3.141, 3.161, 3.181, 3.201, 3.221, 3.240, 3.259, 3.279, - & 3.298, 3.317, 3.335, 3.354, 3.372, 3.391, 3.409, 3.427, 3.445, - & 3.463, 3.480, 3.498, 3.516, 3.533, 3.550, 3.567, 3.584, 3.601, - & 3.618, 3.634, 3.651, 3.667, 3.684, 3.700, 3.716, 3.732, 3.748, - & 3.764, 3.779, 3.795, 3.810, 3.826, 3.841, 3.856, 3.872, 3.887, - & 3.902, 3.916, 3.931, 3.946, 3.961, 3.975, 3.989, 4.004, 4.018, - & 4.032, 4.046, 4.060, 4.074, 4.088, 4.102, 4.116, 4.129, 4.143, - & 4.157, 4.170, 4.183, 4.197, 4.210, 4.223, 4.236, 4.249, 4.262, - & 4.275, 4.288, 4.300, 4.313, 4.326, 4.338, 4.351, 4.363, 4.376, - & 4.388, 4.400, 4.412, 4.424, 4.436, 4.449, 4.460, 4.472, 4.484, - & 4.496, 4.508, 4.519, 4.531, 4.543, 4.554, 4.566, 4.577, 4.588, - & 4.600, 4.611, 4.622 - & / - END -C -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -C -C======================================================================= -C - SUBROUTINE KM323 (IONIC, BINARR) -C -C *** Common block definition -C - COMMON /KMC323/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL Binarr (23), Ionic -C -C *** Find position in arrays for bincoef -C - IF (Ionic.LE. 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) -C -C *** Assign values to return array -C - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) -C -C *** Return point ; End of subroutine -C - RETURN - END - - - BLOCK DATA KMCF323 -C -C *** Common block definition -C - COMMON /KMC323/ - &BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), - &BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), - &BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), - &BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), - &BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), - &BNC21M( 561),BNC22M( 561),BNC23M( 561) - -C -C *** NaCl -C - DATA BNC01M/ - &-0.044,-0.092,-0.114,-0.129,-0.139,-0.147,-0.154,-0.159,-0.163, - &-0.167,-0.170,-0.172,-0.174,-0.176,-0.177,-0.178,-0.179,-0.180, - &-0.180,-0.181,-0.181,-0.181,-0.181,-0.180,-0.180,-0.180,-0.179, - &-0.179,-0.178,-0.177,-0.177,-0.176,-0.175,-0.174,-0.173,-0.172, - &-0.171,-0.170,-0.169,-0.168,-0.167,-0.166,-0.165,-0.163,-0.162, - &-0.161,-0.160,-0.159,-0.157,-0.156,-0.155,-0.153,-0.152,-0.151, - &-0.150,-0.148,-0.147,-0.146,-0.144,-0.143,-0.142,-0.140,-0.139, - &-0.137,-0.136,-0.135,-0.133,-0.132,-0.130,-0.129,-0.127,-0.126, - &-0.125,-0.123,-0.122,-0.120,-0.119,-0.117,-0.116,-0.114,-0.113, - &-0.111,-0.109,-0.108,-0.106,-0.105,-0.103,-0.101,-0.100,-0.098, - &-0.096,-0.095,-0.093,-0.091,-0.090,-0.088,-0.086,-0.084,-0.083, - &-0.081,-0.079,-0.077,-0.076,-0.074,-0.072,-0.070,-0.068,-0.066, - &-0.065,-0.063,-0.061,-0.059,-0.057,-0.055,-0.053,-0.052,-0.050, - &-0.048,-0.046,-0.044,-0.042,-0.040,-0.038,-0.036,-0.035,-0.033, - &-0.031,-0.029,-0.027,-0.025,-0.023,-0.021,-0.019,-0.017,-0.015, - &-0.013,-0.012,-0.010,-0.008,-0.006,-0.004,-0.002, 0.000, 0.002, - & 0.004, 0.006, 0.008, 0.009, 0.011, 0.013, 0.015, 0.017, 0.019, - & 0.021, 0.023, 0.025, 0.027, 0.028, 0.030, 0.032, 0.034, 0.036, - & 0.038, 0.040, 0.042, 0.044, 0.045, 0.047, 0.049, 0.051, 0.053, - & 0.055, 0.057, 0.059, 0.060, 0.062, 0.064, 0.066, 0.068, 0.070, - & 0.072, 0.074, 0.075, 0.077, 0.079, 0.081, 0.083, 0.085, 0.086, - & 0.088, 0.090, 0.092, 0.094, 0.096, 0.097, 0.099, 0.101, 0.103, - & 0.105, 0.107, 0.108, 0.110, 0.112, 0.114, 0.116, 0.117, 0.119, - & 0.121, 0.123, 0.125, 0.127, 0.128, 0.130, 0.132, 0.134, 0.135, - & 0.137, 0.139, 0.141, 0.143, 0.144, 0.146, 0.148, 0.150, 0.151, - & 0.153, 0.155, 0.157, 0.159, 0.160, 0.162, 0.164, 0.166, 0.167, - & 0.169, 0.171, 0.173, 0.174, 0.176, 0.178, 0.180, 0.181, 0.183, - & 0.185, 0.186, 0.188, 0.190, 0.192, 0.193, 0.195, 0.197, 0.198, - & 0.200, 0.202, 0.204, 0.205, 0.207, 0.209, 0.210, 0.212, 0.214, - & 0.215, 0.217, 0.219, 0.221, 0.222, 0.224, 0.226, 0.227, 0.229, - & 0.231, 0.232, 0.234, 0.236, 0.237, 0.239, 0.241, 0.242, 0.244, - & 0.246, 0.247, 0.249, 0.250, 0.252, 0.254, 0.255, 0.257, 0.259, - & 0.260, 0.262, 0.264, 0.265, 0.267, 0.268, 0.270, 0.272, 0.273, - & 0.275, 0.276, 0.278, 0.280, 0.281, 0.283, 0.285, 0.286, 0.288, - & 0.289, 0.291, 0.293, 0.294, 0.296, 0.297, 0.299, 0.300, 0.302, - & 0.304, 0.305, 0.307, 0.308, 0.310, 0.311, 0.313, 0.315, 0.316, - & 0.318, 0.319, 0.321, 0.322, 0.324, 0.325, 0.327, 0.329, 0.330, - & 0.332, 0.333, 0.335, 0.336, 0.338, 0.339, 0.341, 0.342, 0.344, - & 0.345, 0.347, 0.349, 0.350, 0.352, 0.353, 0.355, 0.356, 0.358, - & 0.359, 0.361, 0.362, 0.364, 0.365, 0.367, 0.368, 0.370, 0.371, - & 0.373, 0.374, 0.376, 0.377, 0.379, 0.380, 0.382, 0.383, 0.384, - & 0.386, 0.387, 0.389, 0.390, 0.392, 0.393, 0.395, 0.396, 0.398, - & 0.399, 0.401, 0.402, 0.404, 0.405, 0.406, 0.408, 0.409, 0.411, - & 0.412, 0.414, 0.415, 0.417, 0.418, 0.419, 0.421, 0.422, 0.424, - & 0.425, 0.427, 0.428, 0.429, 0.445, 0.459, 0.472, 0.486, 0.499, - & 0.513, 0.526, 0.539, 0.552, 0.565, 0.577, 0.590, 0.602, 0.614, - & 0.626, 0.638, 0.650, 0.662, 0.674, 0.685, 0.697, 0.708, 0.719, - & 0.730, 0.741, 0.752, 0.763, 0.773, 0.784, 0.795, 0.805, 0.815, - & 0.825, 0.836, 0.846, 0.856, 0.866, 0.875, 0.885, 0.895, 0.904, - & 0.914, 0.923, 0.933, 0.942, 0.951, 0.960, 0.969, 0.979, 0.987, - & 0.996, 1.005, 1.014, 1.023, 1.031, 1.040, 1.049, 1.057, 1.065, - & 1.074, 1.082, 1.090, 1.099, 1.107, 1.115, 1.123, 1.131, 1.139, - & 1.147, 1.155, 1.163, 1.170, 1.178, 1.186, 1.193, 1.201, 1.209, - & 1.216, 1.224, 1.231, 1.238, 1.246, 1.253, 1.260, 1.267, 1.275, - & 1.282, 1.289, 1.296, 1.303, 1.310, 1.317, 1.324, 1.331, 1.338, - & 1.345, 1.351, 1.358, 1.365, 1.372, 1.378, 1.385, 1.392, 1.398, - & 1.405, 1.411, 1.418, 1.424, 1.431, 1.437, 1.443, 1.450, 1.456, - & 1.462, 1.469, 1.475, 1.481, 1.487, 1.493, 1.500, 1.506, 1.512, - & 1.518, 1.524, 1.530, 1.536, 1.542, 1.548, 1.554, 1.560, 1.565, - & 1.571, 1.577, 1.583, 1.589, 1.594, 1.600, 1.606, 1.612, 1.617, - & 1.623, 1.629, 1.634, 1.640, 1.645, 1.651, 1.656, 1.662, 1.667, - & 1.673, 1.678, 1.684, 1.689, 1.695, 1.700, 1.705, 1.711, 1.716, - & 1.721, 1.727, 1.732 - & / -C -C *** Na2SO4 -C - DATA BNC02M/ - &-0.091,-0.196,-0.249,-0.285,-0.314,-0.337,-0.358,-0.375,-0.390, - &-0.404,-0.417,-0.428,-0.439,-0.449,-0.458,-0.466,-0.475,-0.482, - &-0.489,-0.496,-0.502,-0.508,-0.514,-0.520,-0.525,-0.530,-0.535, - &-0.540,-0.544,-0.549,-0.553,-0.557,-0.561,-0.565,-0.569,-0.572, - &-0.576,-0.579,-0.582,-0.585,-0.588,-0.591,-0.594,-0.597,-0.600, - &-0.603,-0.605,-0.608,-0.610,-0.613,-0.615,-0.617,-0.620,-0.622, - &-0.624,-0.626,-0.628,-0.630,-0.632,-0.634,-0.636,-0.638,-0.640, - &-0.641,-0.643,-0.645,-0.647,-0.648,-0.650,-0.651,-0.653,-0.654, - &-0.656,-0.657,-0.659,-0.660,-0.662,-0.663,-0.665,-0.666,-0.667, - &-0.669,-0.670,-0.671,-0.672,-0.674,-0.675,-0.676,-0.677,-0.678, - &-0.679,-0.681,-0.682,-0.683,-0.684,-0.685,-0.686,-0.687,-0.688, - &-0.689,-0.690,-0.691,-0.692,-0.693,-0.694,-0.695,-0.696,-0.697, - &-0.698,-0.699,-0.700,-0.701,-0.701,-0.702,-0.703,-0.704,-0.705, - &-0.706,-0.706,-0.707,-0.708,-0.709,-0.710,-0.710,-0.711,-0.712, - &-0.713,-0.713,-0.714,-0.715,-0.716,-0.716,-0.717,-0.718,-0.718, - &-0.719,-0.720,-0.720,-0.721,-0.722,-0.722,-0.723,-0.724,-0.724, - &-0.725,-0.725,-0.726,-0.727,-0.727,-0.728,-0.728,-0.729,-0.730, - &-0.730,-0.731,-0.731,-0.732,-0.732,-0.733,-0.733,-0.734,-0.734, - &-0.735,-0.735,-0.736,-0.736,-0.737,-0.737,-0.738,-0.738,-0.739, - &-0.739,-0.740,-0.740,-0.741,-0.741,-0.742,-0.742,-0.742,-0.743, - &-0.743,-0.744,-0.744,-0.745,-0.745,-0.745,-0.746,-0.746,-0.747, - &-0.747,-0.747,-0.748,-0.748,-0.748,-0.749,-0.749,-0.750,-0.750, - &-0.750,-0.751,-0.751,-0.751,-0.752,-0.752,-0.752,-0.753,-0.753, - &-0.753,-0.754,-0.754,-0.754,-0.755,-0.755,-0.755,-0.755,-0.756, - &-0.756,-0.756,-0.757,-0.757,-0.757,-0.758,-0.758,-0.758,-0.758, - &-0.759,-0.759,-0.759,-0.759,-0.760,-0.760,-0.760,-0.760,-0.761, - &-0.761,-0.761,-0.761,-0.762,-0.762,-0.762,-0.762,-0.763,-0.763, - &-0.763,-0.763,-0.764,-0.764,-0.764,-0.764,-0.764,-0.765,-0.765, - &-0.765,-0.765,-0.765,-0.766,-0.766,-0.766,-0.766,-0.766,-0.767, - &-0.767,-0.767,-0.767,-0.767,-0.768,-0.768,-0.768,-0.768,-0.768, - &-0.768,-0.769,-0.769,-0.769,-0.769,-0.769,-0.769,-0.770,-0.770, - &-0.770,-0.770,-0.770,-0.770,-0.771,-0.771,-0.771,-0.771,-0.771, - &-0.771,-0.771,-0.771,-0.772,-0.772,-0.772,-0.772,-0.772,-0.772, - &-0.772,-0.773,-0.773,-0.773,-0.773,-0.773,-0.773,-0.773,-0.773, - &-0.773,-0.774,-0.774,-0.774,-0.774,-0.774,-0.774,-0.774,-0.774, - &-0.774,-0.775,-0.775,-0.775,-0.775,-0.775,-0.775,-0.775,-0.775, - &-0.775,-0.775,-0.775,-0.775,-0.776,-0.776,-0.776,-0.776,-0.776, - &-0.776,-0.776,-0.776,-0.776,-0.776,-0.776,-0.776,-0.776,-0.777, - &-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777, - &-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.778, - &-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778, - &-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778, - &-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778, - &-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.779,-0.779, - &-0.779,-0.779,-0.779,-0.779,-0.779,-0.779,-0.778,-0.778,-0.778, - &-0.778,-0.777,-0.777,-0.776,-0.776,-0.775,-0.774,-0.774,-0.773, - &-0.772,-0.771,-0.770,-0.769,-0.768,-0.767,-0.766,-0.765,-0.764, - &-0.763,-0.762,-0.760,-0.759,-0.758,-0.756,-0.755,-0.754,-0.752, - &-0.751,-0.749,-0.748,-0.746,-0.745,-0.743,-0.742,-0.740,-0.739, - &-0.737,-0.735,-0.734,-0.732,-0.730,-0.729,-0.727,-0.725,-0.723, - &-0.722,-0.720,-0.718,-0.716,-0.714,-0.713,-0.711,-0.709,-0.707, - &-0.705,-0.703,-0.701,-0.699,-0.697,-0.695,-0.693,-0.691,-0.690, - &-0.688,-0.686,-0.683,-0.681,-0.679,-0.677,-0.675,-0.673,-0.671, - &-0.669,-0.667,-0.665,-0.663,-0.661,-0.659,-0.656,-0.654,-0.652, - &-0.650,-0.648,-0.646,-0.644,-0.641,-0.639,-0.637,-0.635,-0.633, - &-0.630,-0.628,-0.626,-0.624,-0.621,-0.619,-0.617,-0.615,-0.612, - &-0.610,-0.608,-0.606,-0.603,-0.601,-0.599,-0.597,-0.594,-0.592, - &-0.590,-0.587,-0.585,-0.583,-0.580,-0.578,-0.576,-0.573,-0.571, - &-0.569,-0.566,-0.564,-0.562,-0.559,-0.557,-0.555,-0.552,-0.550, - &-0.547,-0.545,-0.543,-0.540,-0.538,-0.536,-0.533,-0.531,-0.528, - &-0.526,-0.524,-0.521,-0.519,-0.516,-0.514,-0.511,-0.509,-0.507, - &-0.504,-0.502,-0.499,-0.497,-0.494,-0.492,-0.490,-0.487,-0.485, - &-0.482,-0.480,-0.477 - & / -C -C *** NaNO3 -C - DATA BNC03M/ - &-0.045,-0.099,-0.125,-0.144,-0.159,-0.171,-0.181,-0.190,-0.198, - &-0.206,-0.212,-0.218,-0.224,-0.229,-0.234,-0.239,-0.243,-0.247, - &-0.251,-0.255,-0.258,-0.261,-0.265,-0.268,-0.271,-0.274,-0.276, - &-0.279,-0.281,-0.284,-0.286,-0.289,-0.291,-0.293,-0.295,-0.297, - &-0.299,-0.301,-0.303,-0.305,-0.306,-0.308,-0.310,-0.312,-0.313, - &-0.315,-0.316,-0.318,-0.319,-0.321,-0.322,-0.323,-0.325,-0.326, - &-0.327,-0.329,-0.330,-0.331,-0.332,-0.333,-0.335,-0.336,-0.337, - &-0.338,-0.339,-0.340,-0.341,-0.342,-0.343,-0.344,-0.345,-0.346, - &-0.347,-0.348,-0.349,-0.350,-0.350,-0.351,-0.352,-0.353,-0.354, - &-0.355,-0.356,-0.356,-0.357,-0.358,-0.359,-0.359,-0.360,-0.361, - &-0.362,-0.363,-0.363,-0.364,-0.365,-0.365,-0.366,-0.367,-0.368, - &-0.368,-0.369,-0.370,-0.370,-0.371,-0.372,-0.372,-0.373,-0.374, - &-0.374,-0.375,-0.375,-0.376,-0.377,-0.377,-0.378,-0.378,-0.379, - &-0.380,-0.380,-0.381,-0.381,-0.382,-0.383,-0.383,-0.384,-0.384, - &-0.385,-0.385,-0.386,-0.386,-0.387,-0.387,-0.388,-0.388,-0.389, - &-0.389,-0.390,-0.390,-0.391,-0.391,-0.392,-0.392,-0.393,-0.393, - &-0.394,-0.394,-0.395,-0.395,-0.396,-0.396,-0.397,-0.397,-0.397, - &-0.398,-0.398,-0.399,-0.399,-0.400,-0.400,-0.400,-0.401,-0.401, - &-0.402,-0.402,-0.402,-0.403,-0.403,-0.404,-0.404,-0.404,-0.405, - &-0.405,-0.406,-0.406,-0.406,-0.407,-0.407,-0.407,-0.408,-0.408, - &-0.408,-0.409,-0.409,-0.409,-0.410,-0.410,-0.411,-0.411,-0.411, - &-0.412,-0.412,-0.412,-0.413,-0.413,-0.413,-0.413,-0.414,-0.414, - &-0.414,-0.415,-0.415,-0.415,-0.416,-0.416,-0.416,-0.417,-0.417, - &-0.417,-0.417,-0.418,-0.418,-0.418,-0.419,-0.419,-0.419,-0.419, - &-0.420,-0.420,-0.420,-0.421,-0.421,-0.421,-0.421,-0.422,-0.422, - &-0.422,-0.422,-0.423,-0.423,-0.423,-0.423,-0.424,-0.424,-0.424, - &-0.424,-0.425,-0.425,-0.425,-0.425,-0.426,-0.426,-0.426,-0.426, - &-0.427,-0.427,-0.427,-0.427,-0.428,-0.428,-0.428,-0.428,-0.428, - &-0.429,-0.429,-0.429,-0.429,-0.430,-0.430,-0.430,-0.430,-0.430, - &-0.431,-0.431,-0.431,-0.431,-0.431,-0.432,-0.432,-0.432,-0.432, - &-0.432,-0.433,-0.433,-0.433,-0.433,-0.433,-0.434,-0.434,-0.434, - &-0.434,-0.434,-0.435,-0.435,-0.435,-0.435,-0.435,-0.435,-0.436, - &-0.436,-0.436,-0.436,-0.436,-0.436,-0.437,-0.437,-0.437,-0.437, - &-0.437,-0.438,-0.438,-0.438,-0.438,-0.438,-0.438,-0.438,-0.439, - &-0.439,-0.439,-0.439,-0.439,-0.439,-0.440,-0.440,-0.440,-0.440, - &-0.440,-0.440,-0.440,-0.441,-0.441,-0.441,-0.441,-0.441,-0.441, - &-0.442,-0.442,-0.442,-0.442,-0.442,-0.442,-0.442,-0.442,-0.443, - &-0.443,-0.443,-0.443,-0.443,-0.443,-0.443,-0.444,-0.444,-0.444, - &-0.444,-0.444,-0.444,-0.444,-0.444,-0.445,-0.445,-0.445,-0.445, - &-0.445,-0.445,-0.445,-0.445,-0.446,-0.446,-0.446,-0.446,-0.446, - &-0.446,-0.446,-0.446,-0.446,-0.447,-0.447,-0.447,-0.447,-0.447, - &-0.447,-0.447,-0.447,-0.447,-0.447,-0.448,-0.448,-0.448,-0.448, - &-0.448,-0.448,-0.448,-0.448,-0.448,-0.449,-0.449,-0.449,-0.449, - &-0.449,-0.449,-0.449,-0.449,-0.449,-0.449,-0.449,-0.450,-0.450, - &-0.450,-0.450,-0.450,-0.450,-0.451,-0.452,-0.452,-0.453,-0.454, - &-0.454,-0.455,-0.455,-0.456,-0.456,-0.457,-0.457,-0.457,-0.458, - &-0.458,-0.458,-0.458,-0.458,-0.458,-0.458,-0.459,-0.459,-0.459, - &-0.459,-0.459,-0.458,-0.458,-0.458,-0.458,-0.458,-0.458,-0.458, - &-0.457,-0.457,-0.457,-0.457,-0.456,-0.456,-0.456,-0.455,-0.455, - &-0.455,-0.454,-0.454,-0.453,-0.453,-0.453,-0.452,-0.452,-0.451, - &-0.451,-0.450,-0.450,-0.449,-0.449,-0.448,-0.448,-0.447,-0.446, - &-0.446,-0.445,-0.445,-0.444,-0.443,-0.443,-0.442,-0.442,-0.441, - &-0.440,-0.440,-0.439,-0.438,-0.437,-0.437,-0.436,-0.435,-0.435, - &-0.434,-0.433,-0.432,-0.432,-0.431,-0.430,-0.429,-0.429,-0.428, - &-0.427,-0.426,-0.425,-0.425,-0.424,-0.423,-0.422,-0.421,-0.420, - &-0.420,-0.419,-0.418,-0.417,-0.416,-0.415,-0.414,-0.414,-0.413, - &-0.412,-0.411,-0.410,-0.409,-0.408,-0.407,-0.406,-0.405,-0.404, - &-0.404,-0.403,-0.402,-0.401,-0.400,-0.399,-0.398,-0.397,-0.396, - &-0.395,-0.394,-0.393,-0.392,-0.391,-0.390,-0.389,-0.388,-0.387, - &-0.386,-0.385,-0.384,-0.383,-0.382,-0.381,-0.380,-0.379,-0.378, - &-0.377,-0.376,-0.375,-0.374,-0.373,-0.372,-0.371,-0.370,-0.369, - &-0.368,-0.367,-0.366,-0.365,-0.364,-0.363,-0.362,-0.361,-0.360, - &-0.359,-0.358,-0.356 - & / -C -C *** (NH4)2SO4 -C - DATA BNC04M/ - &-0.091,-0.197,-0.249,-0.286,-0.315,-0.339,-0.359,-0.377,-0.392, - &-0.406,-0.419,-0.431,-0.442,-0.452,-0.461,-0.470,-0.478,-0.486, - &-0.493,-0.500,-0.507,-0.513,-0.519,-0.525,-0.530,-0.535,-0.540, - &-0.545,-0.550,-0.554,-0.559,-0.563,-0.567,-0.571,-0.575,-0.579, - &-0.582,-0.586,-0.589,-0.592,-0.596,-0.599,-0.602,-0.605,-0.608, - &-0.611,-0.613,-0.616,-0.619,-0.621,-0.624,-0.626,-0.628,-0.631, - &-0.633,-0.635,-0.637,-0.640,-0.642,-0.644,-0.646,-0.648,-0.650, - &-0.652,-0.653,-0.655,-0.657,-0.659,-0.661,-0.662,-0.664,-0.666, - &-0.667,-0.669,-0.670,-0.672,-0.673,-0.675,-0.676,-0.678,-0.679, - &-0.681,-0.682,-0.683,-0.685,-0.686,-0.687,-0.689,-0.690,-0.691, - &-0.693,-0.694,-0.695,-0.696,-0.697,-0.699,-0.700,-0.701,-0.702, - &-0.703,-0.704,-0.705,-0.707,-0.708,-0.709,-0.710,-0.711,-0.712, - &-0.713,-0.714,-0.715,-0.716,-0.717,-0.718,-0.719,-0.720,-0.721, - &-0.722,-0.723,-0.724,-0.724,-0.725,-0.726,-0.727,-0.728,-0.729, - &-0.730,-0.731,-0.731,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736, - &-0.737,-0.738,-0.738,-0.739,-0.740,-0.741,-0.741,-0.742,-0.743, - &-0.744,-0.744,-0.745,-0.746,-0.746,-0.747,-0.748,-0.748,-0.749, - &-0.750,-0.750,-0.751,-0.752,-0.752,-0.753,-0.754,-0.754,-0.755, - &-0.755,-0.756,-0.757,-0.757,-0.758,-0.758,-0.759,-0.759,-0.760, - &-0.761,-0.761,-0.762,-0.762,-0.763,-0.763,-0.764,-0.764,-0.765, - &-0.765,-0.766,-0.766,-0.767,-0.767,-0.768,-0.768,-0.769,-0.769, - &-0.770,-0.770,-0.771,-0.771,-0.772,-0.772,-0.772,-0.773,-0.773, - &-0.774,-0.774,-0.775,-0.775,-0.776,-0.776,-0.776,-0.777,-0.777, - &-0.778,-0.778,-0.778,-0.779,-0.779,-0.780,-0.780,-0.780,-0.781, - &-0.781,-0.781,-0.782,-0.782,-0.783,-0.783,-0.783,-0.784,-0.784, - &-0.784,-0.785,-0.785,-0.785,-0.786,-0.786,-0.786,-0.787,-0.787, - &-0.787,-0.788,-0.788,-0.788,-0.789,-0.789,-0.789,-0.790,-0.790, - &-0.790,-0.790,-0.791,-0.791,-0.791,-0.792,-0.792,-0.792,-0.793, - &-0.793,-0.793,-0.793,-0.794,-0.794,-0.794,-0.794,-0.795,-0.795, - &-0.795,-0.795,-0.796,-0.796,-0.796,-0.796,-0.797,-0.797,-0.797, - &-0.797,-0.798,-0.798,-0.798,-0.798,-0.799,-0.799,-0.799,-0.799, - &-0.800,-0.800,-0.800,-0.800,-0.800,-0.801,-0.801,-0.801,-0.801, - &-0.801,-0.802,-0.802,-0.802,-0.802,-0.802,-0.803,-0.803,-0.803, - &-0.803,-0.803,-0.804,-0.804,-0.804,-0.804,-0.804,-0.804,-0.805, - &-0.805,-0.805,-0.805,-0.805,-0.806,-0.806,-0.806,-0.806,-0.806, - &-0.806,-0.806,-0.807,-0.807,-0.807,-0.807,-0.807,-0.807,-0.808, - &-0.808,-0.808,-0.808,-0.808,-0.808,-0.808,-0.809,-0.809,-0.809, - &-0.809,-0.809,-0.809,-0.809,-0.810,-0.810,-0.810,-0.810,-0.810, - &-0.810,-0.810,-0.810,-0.810,-0.811,-0.811,-0.811,-0.811,-0.811, - &-0.811,-0.811,-0.811,-0.812,-0.812,-0.812,-0.812,-0.812,-0.812, - &-0.812,-0.812,-0.812,-0.812,-0.813,-0.813,-0.813,-0.813,-0.813, - &-0.813,-0.813,-0.813,-0.813,-0.813,-0.813,-0.814,-0.814,-0.814, - &-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814, - &-0.814,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815, - &-0.815,-0.815,-0.815,-0.815,-0.816,-0.816,-0.817,-0.817,-0.817, - &-0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.816,-0.816, - &-0.816,-0.815,-0.815,-0.814,-0.813,-0.813,-0.812,-0.811,-0.811, - &-0.810,-0.809,-0.808,-0.807,-0.806,-0.805,-0.804,-0.803,-0.802, - &-0.801,-0.800,-0.799,-0.797,-0.796,-0.795,-0.794,-0.792,-0.791, - &-0.790,-0.788,-0.787,-0.786,-0.784,-0.783,-0.781,-0.780,-0.778, - &-0.777,-0.775,-0.774,-0.772,-0.771,-0.769,-0.767,-0.766,-0.764, - &-0.762,-0.761,-0.759,-0.757,-0.756,-0.754,-0.752,-0.750,-0.749, - &-0.747,-0.745,-0.743,-0.741,-0.740,-0.738,-0.736,-0.734,-0.732, - &-0.730,-0.728,-0.727,-0.725,-0.723,-0.721,-0.719,-0.717,-0.715, - &-0.713,-0.711,-0.709,-0.707,-0.705,-0.703,-0.701,-0.699,-0.697, - &-0.695,-0.693,-0.691,-0.689,-0.687,-0.685,-0.683,-0.681,-0.678, - &-0.676,-0.674,-0.672,-0.670,-0.668,-0.666,-0.664,-0.661,-0.659, - &-0.657,-0.655,-0.653,-0.651,-0.648,-0.646,-0.644,-0.642,-0.640, - &-0.638,-0.635,-0.633,-0.631,-0.629,-0.626,-0.624,-0.622,-0.620, - &-0.618,-0.615,-0.613,-0.611,-0.609,-0.606,-0.604,-0.602,-0.599, - &-0.597,-0.595,-0.593,-0.590,-0.588,-0.586,-0.583,-0.581,-0.579, - &-0.577,-0.574,-0.572,-0.570,-0.567,-0.565,-0.563,-0.560,-0.558, - &-0.556,-0.553,-0.551 - & / -C -C *** NH4NO3 -C - DATA BNC05M/ - &-0.046,-0.101,-0.129,-0.149,-0.166,-0.179,-0.191,-0.202,-0.211, - &-0.220,-0.228,-0.235,-0.242,-0.249,-0.255,-0.261,-0.266,-0.272, - &-0.277,-0.282,-0.286,-0.291,-0.295,-0.299,-0.303,-0.307,-0.311, - &-0.315,-0.319,-0.322,-0.326,-0.329,-0.332,-0.335,-0.339,-0.342, - &-0.345,-0.348,-0.350,-0.353,-0.356,-0.359,-0.361,-0.364,-0.366, - &-0.369,-0.371,-0.374,-0.376,-0.378,-0.380,-0.383,-0.385,-0.387, - &-0.389,-0.391,-0.393,-0.395,-0.397,-0.399,-0.401,-0.403,-0.405, - &-0.406,-0.408,-0.410,-0.412,-0.414,-0.415,-0.417,-0.419,-0.420, - &-0.422,-0.424,-0.425,-0.427,-0.428,-0.430,-0.432,-0.433,-0.435, - &-0.436,-0.438,-0.439,-0.441,-0.442,-0.444,-0.445,-0.447,-0.448, - &-0.449,-0.451,-0.452,-0.454,-0.455,-0.456,-0.458,-0.459,-0.461, - &-0.462,-0.463,-0.465,-0.466,-0.467,-0.469,-0.470,-0.471,-0.473, - &-0.474,-0.475,-0.477,-0.478,-0.479,-0.480,-0.482,-0.483,-0.484, - &-0.485,-0.487,-0.488,-0.489,-0.490,-0.492,-0.493,-0.494,-0.495, - &-0.496,-0.498,-0.499,-0.500,-0.501,-0.502,-0.503,-0.504,-0.506, - &-0.507,-0.508,-0.509,-0.510,-0.511,-0.512,-0.513,-0.514,-0.515, - &-0.516,-0.517,-0.519,-0.520,-0.521,-0.522,-0.523,-0.524,-0.525, - &-0.526,-0.527,-0.528,-0.529,-0.530,-0.531,-0.532,-0.533,-0.534, - &-0.535,-0.535,-0.536,-0.537,-0.538,-0.539,-0.540,-0.541,-0.542, - &-0.543,-0.544,-0.545,-0.546,-0.547,-0.547,-0.548,-0.549,-0.550, - &-0.551,-0.552,-0.553,-0.553,-0.554,-0.555,-0.556,-0.557,-0.558, - &-0.559,-0.559,-0.560,-0.561,-0.562,-0.563,-0.563,-0.564,-0.565, - &-0.566,-0.567,-0.567,-0.568,-0.569,-0.570,-0.570,-0.571,-0.572, - &-0.573,-0.574,-0.574,-0.575,-0.576,-0.576,-0.577,-0.578,-0.579, - &-0.579,-0.580,-0.581,-0.582,-0.582,-0.583,-0.584,-0.584,-0.585, - &-0.586,-0.586,-0.587,-0.588,-0.589,-0.589,-0.590,-0.591,-0.591, - &-0.592,-0.593,-0.593,-0.594,-0.595,-0.595,-0.596,-0.596,-0.597, - &-0.598,-0.598,-0.599,-0.600,-0.600,-0.601,-0.602,-0.602,-0.603, - &-0.603,-0.604,-0.605,-0.605,-0.606,-0.606,-0.607,-0.608,-0.608, - &-0.609,-0.609,-0.610,-0.611,-0.611,-0.612,-0.612,-0.613,-0.613, - &-0.614,-0.615,-0.615,-0.616,-0.616,-0.617,-0.617,-0.618,-0.618, - &-0.619,-0.620,-0.620,-0.621,-0.621,-0.622,-0.622,-0.623,-0.623, - &-0.624,-0.624,-0.625,-0.625,-0.626,-0.626,-0.627,-0.627,-0.628, - &-0.628,-0.629,-0.629,-0.630,-0.630,-0.631,-0.631,-0.632,-0.632, - &-0.633,-0.633,-0.634,-0.634,-0.635,-0.635,-0.636,-0.636,-0.637, - &-0.637,-0.638,-0.638,-0.639,-0.639,-0.639,-0.640,-0.640,-0.641, - &-0.641,-0.642,-0.642,-0.643,-0.643,-0.643,-0.644,-0.644,-0.645, - &-0.645,-0.646,-0.646,-0.647,-0.647,-0.647,-0.648,-0.648,-0.649, - &-0.649,-0.649,-0.650,-0.650,-0.651,-0.651,-0.652,-0.652,-0.652, - &-0.653,-0.653,-0.654,-0.654,-0.654,-0.655,-0.655,-0.656,-0.656, - &-0.656,-0.657,-0.657,-0.658,-0.658,-0.658,-0.659,-0.659,-0.659, - &-0.660,-0.660,-0.661,-0.661,-0.661,-0.662,-0.662,-0.662,-0.663, - &-0.663,-0.663,-0.664,-0.664,-0.665,-0.665,-0.665,-0.666,-0.666, - &-0.666,-0.667,-0.667,-0.667,-0.668,-0.668,-0.668,-0.669,-0.669, - &-0.669,-0.670,-0.670,-0.670,-0.674,-0.677,-0.680,-0.683,-0.686, - &-0.688,-0.691,-0.693,-0.696,-0.698,-0.700,-0.702,-0.705,-0.706, - &-0.708,-0.710,-0.712,-0.714,-0.715,-0.717,-0.718,-0.720,-0.721, - &-0.722,-0.723,-0.725,-0.726,-0.727,-0.728,-0.729,-0.730,-0.731, - &-0.732,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736,-0.736,-0.737, - &-0.737,-0.738,-0.738,-0.739,-0.739,-0.739,-0.740,-0.740,-0.740, - &-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741, - &-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741, - &-0.741,-0.740,-0.740,-0.740,-0.740,-0.739,-0.739,-0.739,-0.739, - &-0.738,-0.738,-0.738,-0.737,-0.737,-0.736,-0.736,-0.736,-0.735, - &-0.735,-0.734,-0.734,-0.733,-0.733,-0.732,-0.732,-0.731,-0.731, - &-0.730,-0.729,-0.729,-0.728,-0.728,-0.727,-0.726,-0.726,-0.725, - &-0.725,-0.724,-0.723,-0.723,-0.722,-0.721,-0.721,-0.720,-0.719, - &-0.718,-0.718,-0.717,-0.716,-0.715,-0.715,-0.714,-0.713,-0.712, - &-0.711,-0.711,-0.710,-0.709,-0.708,-0.707,-0.707,-0.706,-0.705, - &-0.704,-0.703,-0.702,-0.701,-0.701,-0.700,-0.699,-0.698,-0.697, - &-0.696,-0.695,-0.694,-0.693,-0.692,-0.692,-0.691,-0.690,-0.689, - &-0.688,-0.687,-0.686,-0.685,-0.684,-0.683,-0.682,-0.681,-0.680, - &-0.679,-0.678,-0.677 - & / -C -C *** NH4Cl -C - DATA BNC06M/ - &-0.045,-0.096,-0.120,-0.136,-0.149,-0.159,-0.167,-0.174,-0.181, - &-0.186,-0.191,-0.195,-0.199,-0.202,-0.205,-0.208,-0.210,-0.213, - &-0.215,-0.217,-0.219,-0.220,-0.222,-0.223,-0.225,-0.226,-0.227, - &-0.228,-0.229,-0.230,-0.231,-0.232,-0.232,-0.233,-0.234,-0.234, - &-0.235,-0.235,-0.236,-0.236,-0.237,-0.237,-0.237,-0.238,-0.238, - &-0.238,-0.238,-0.238,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239, - &-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239, - &-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.238,-0.238, - &-0.238,-0.238,-0.238,-0.238,-0.237,-0.237,-0.237,-0.237,-0.237, - &-0.236,-0.236,-0.236,-0.235,-0.235,-0.235,-0.235,-0.234,-0.234, - &-0.234,-0.233,-0.233,-0.233,-0.232,-0.232,-0.231,-0.231,-0.231, - &-0.230,-0.230,-0.229,-0.229,-0.229,-0.228,-0.228,-0.227,-0.227, - &-0.226,-0.226,-0.225,-0.225,-0.224,-0.224,-0.224,-0.223,-0.223, - &-0.222,-0.222,-0.221,-0.221,-0.220,-0.219,-0.219,-0.218,-0.218, - &-0.217,-0.217,-0.216,-0.216,-0.215,-0.215,-0.214,-0.214,-0.213, - &-0.213,-0.212,-0.211,-0.211,-0.210,-0.210,-0.209,-0.209,-0.208, - &-0.208,-0.207,-0.206,-0.206,-0.205,-0.205,-0.204,-0.204,-0.203, - &-0.203,-0.202,-0.201,-0.201,-0.200,-0.200,-0.199,-0.199,-0.198, - &-0.197,-0.197,-0.196,-0.196,-0.195,-0.195,-0.194,-0.193,-0.193, - &-0.192,-0.192,-0.191,-0.191,-0.190,-0.189,-0.189,-0.188,-0.188, - &-0.187,-0.186,-0.186,-0.185,-0.185,-0.184,-0.184,-0.183,-0.182, - &-0.182,-0.181,-0.181,-0.180,-0.179,-0.179,-0.178,-0.178,-0.177, - &-0.177,-0.176,-0.175,-0.175,-0.174,-0.174,-0.173,-0.172,-0.172, - &-0.171,-0.171,-0.170,-0.170,-0.169,-0.168,-0.168,-0.167,-0.167, - &-0.166,-0.165,-0.165,-0.164,-0.164,-0.163,-0.163,-0.162,-0.161, - &-0.161,-0.160,-0.160,-0.159,-0.158,-0.158,-0.157,-0.157,-0.156, - &-0.156,-0.155,-0.154,-0.154,-0.153,-0.153,-0.152,-0.151,-0.151, - &-0.150,-0.150,-0.149,-0.149,-0.148,-0.147,-0.147,-0.146,-0.146, - &-0.145,-0.145,-0.144,-0.143,-0.143,-0.142,-0.142,-0.141,-0.140, - &-0.140,-0.139,-0.139,-0.138,-0.138,-0.137,-0.136,-0.136,-0.135, - &-0.135,-0.134,-0.134,-0.133,-0.132,-0.132,-0.131,-0.131,-0.130, - &-0.130,-0.129,-0.128,-0.128,-0.127,-0.127,-0.126,-0.126,-0.125, - &-0.125,-0.124,-0.123,-0.123,-0.122,-0.122,-0.121,-0.121,-0.120, - &-0.119,-0.119,-0.118,-0.118,-0.117,-0.117,-0.116,-0.115,-0.115, - &-0.114,-0.114,-0.113,-0.113,-0.112,-0.112,-0.111,-0.110,-0.110, - &-0.109,-0.109,-0.108,-0.108,-0.107,-0.107,-0.106,-0.105,-0.105, - &-0.104,-0.104,-0.103,-0.103,-0.102,-0.102,-0.101,-0.100,-0.100, - &-0.099,-0.099,-0.098,-0.098,-0.097,-0.097,-0.096,-0.096,-0.095, - &-0.094,-0.094,-0.093,-0.093,-0.092,-0.092,-0.091,-0.091,-0.090, - &-0.090,-0.089,-0.088,-0.088,-0.087,-0.087,-0.086,-0.086,-0.085, - &-0.085,-0.084,-0.084,-0.083,-0.083,-0.082,-0.081,-0.081,-0.080, - &-0.080,-0.079,-0.079,-0.078,-0.078,-0.077,-0.077,-0.076,-0.076, - &-0.075,-0.074,-0.074,-0.073,-0.073,-0.072,-0.072,-0.071,-0.071, - &-0.070,-0.070,-0.069,-0.069,-0.068,-0.068,-0.067,-0.067,-0.066, - &-0.065,-0.065,-0.064,-0.064,-0.058,-0.053,-0.048,-0.043,-0.038, - &-0.033,-0.028,-0.023,-0.018,-0.013,-0.008,-0.003, 0.002, 0.006, - & 0.011, 0.016, 0.021, 0.025, 0.030, 0.035, 0.039, 0.044, 0.048, - & 0.053, 0.057, 0.062, 0.066, 0.070, 0.075, 0.079, 0.083, 0.088, - & 0.092, 0.096, 0.100, 0.105, 0.109, 0.113, 0.117, 0.121, 0.125, - & 0.129, 0.133, 0.137, 0.141, 0.145, 0.149, 0.153, 0.157, 0.161, - & 0.165, 0.169, 0.173, 0.176, 0.180, 0.184, 0.188, 0.192, 0.195, - & 0.199, 0.203, 0.207, 0.210, 0.214, 0.218, 0.221, 0.225, 0.228, - & 0.232, 0.236, 0.239, 0.243, 0.246, 0.250, 0.253, 0.257, 0.260, - & 0.264, 0.267, 0.271, 0.274, 0.278, 0.281, 0.285, 0.288, 0.291, - & 0.295, 0.298, 0.301, 0.305, 0.308, 0.311, 0.315, 0.318, 0.321, - & 0.325, 0.328, 0.331, 0.334, 0.338, 0.341, 0.344, 0.347, 0.350, - & 0.354, 0.357, 0.360, 0.363, 0.366, 0.369, 0.373, 0.376, 0.379, - & 0.382, 0.385, 0.388, 0.391, 0.394, 0.397, 0.400, 0.403, 0.406, - & 0.409, 0.412, 0.416, 0.419, 0.422, 0.425, 0.428, 0.430, 0.433, - & 0.436, 0.439, 0.442, 0.445, 0.448, 0.451, 0.454, 0.457, 0.460, - & 0.463, 0.466, 0.469, 0.471, 0.474, 0.477, 0.480, 0.483, 0.486, - & 0.489, 0.491, 0.494, 0.497, 0.500, 0.503, 0.506, 0.508, 0.511, - & 0.514, 0.517, 0.520 - & / -C -C *** (2H,SO4) -C - DATA BNC07M/ - &-0.091,-0.196,-0.248,-0.284,-0.312,-0.336,-0.355,-0.372,-0.388, - &-0.401,-0.414,-0.425,-0.435,-0.445,-0.453,-0.462,-0.469,-0.477, - &-0.484,-0.490,-0.496,-0.502,-0.508,-0.513,-0.518,-0.523,-0.528, - &-0.532,-0.536,-0.540,-0.544,-0.548,-0.552,-0.556,-0.559,-0.562, - &-0.566,-0.569,-0.572,-0.575,-0.578,-0.580,-0.583,-0.586,-0.588, - &-0.591,-0.593,-0.595,-0.598,-0.600,-0.602,-0.604,-0.606,-0.608, - &-0.610,-0.612,-0.614,-0.616,-0.618,-0.620,-0.621,-0.623,-0.625, - &-0.626,-0.628,-0.629,-0.631,-0.632,-0.634,-0.635,-0.637,-0.638, - &-0.639,-0.641,-0.642,-0.643,-0.644,-0.646,-0.647,-0.648,-0.649, - &-0.650,-0.652,-0.653,-0.654,-0.655,-0.656,-0.657,-0.658,-0.659, - &-0.660,-0.661,-0.662,-0.663,-0.664,-0.665,-0.666,-0.666,-0.667, - &-0.668,-0.669,-0.670,-0.671,-0.671,-0.672,-0.673,-0.674,-0.675, - &-0.675,-0.676,-0.677,-0.678,-0.678,-0.679,-0.680,-0.680,-0.681, - &-0.682,-0.682,-0.683,-0.684,-0.684,-0.685,-0.686,-0.686,-0.687, - &-0.687,-0.688,-0.689,-0.689,-0.690,-0.690,-0.691,-0.691,-0.692, - &-0.692,-0.693,-0.693,-0.694,-0.694,-0.695,-0.695,-0.696,-0.696, - &-0.697,-0.697,-0.698,-0.698,-0.699,-0.699,-0.700,-0.700,-0.700, - &-0.701,-0.701,-0.702,-0.702,-0.702,-0.703,-0.703,-0.704,-0.704, - &-0.704,-0.705,-0.705,-0.705,-0.706,-0.706,-0.706,-0.707,-0.707, - &-0.707,-0.708,-0.708,-0.708,-0.709,-0.709,-0.709,-0.710,-0.710, - &-0.710,-0.711,-0.711,-0.711,-0.711,-0.712,-0.712,-0.712,-0.712, - &-0.713,-0.713,-0.713,-0.713,-0.714,-0.714,-0.714,-0.714,-0.715, - &-0.715,-0.715,-0.715,-0.716,-0.716,-0.716,-0.716,-0.716,-0.717, - &-0.717,-0.717,-0.717,-0.717,-0.718,-0.718,-0.718,-0.718,-0.718, - &-0.719,-0.719,-0.719,-0.719,-0.719,-0.719,-0.720,-0.720,-0.720, - &-0.720,-0.720,-0.720,-0.720,-0.721,-0.721,-0.721,-0.721,-0.721, - &-0.721,-0.721,-0.722,-0.722,-0.722,-0.722,-0.722,-0.722,-0.722, - &-0.722,-0.723,-0.723,-0.723,-0.723,-0.723,-0.723,-0.723,-0.723, - &-0.723,-0.723,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724, - &-0.724,-0.724,-0.724,-0.724,-0.724,-0.725,-0.725,-0.725,-0.725, - &-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725, - &-0.725,-0.725,-0.725,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, - &-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.725,-0.725,-0.725, - &-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725, - &-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725, - &-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724, - &-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.723,-0.723, - &-0.723,-0.723,-0.723,-0.723,-0.722,-0.721,-0.721,-0.720,-0.719, - &-0.717,-0.716,-0.715,-0.714,-0.713,-0.711,-0.710,-0.709,-0.707, - &-0.706,-0.704,-0.703,-0.701,-0.700,-0.698,-0.696,-0.695,-0.693, - &-0.691,-0.689,-0.688,-0.686,-0.684,-0.682,-0.680,-0.678,-0.676, - &-0.675,-0.673,-0.671,-0.669,-0.667,-0.665,-0.663,-0.661,-0.658, - &-0.656,-0.654,-0.652,-0.650,-0.648,-0.646,-0.644,-0.642,-0.639, - &-0.637,-0.635,-0.633,-0.631,-0.628,-0.626,-0.624,-0.622,-0.619, - &-0.617,-0.615,-0.612,-0.610,-0.608,-0.605,-0.603,-0.601,-0.598, - &-0.596,-0.594,-0.591,-0.589,-0.587,-0.584,-0.582,-0.579,-0.577, - &-0.575,-0.572,-0.570,-0.567,-0.565,-0.563,-0.560,-0.558,-0.555, - &-0.553,-0.550,-0.548,-0.545,-0.543,-0.540,-0.538,-0.535,-0.533, - &-0.530,-0.528,-0.525,-0.523,-0.520,-0.518,-0.515,-0.513,-0.510, - &-0.508,-0.505,-0.503,-0.500,-0.498,-0.495,-0.493,-0.490,-0.487, - &-0.485,-0.482,-0.480,-0.477,-0.475,-0.472,-0.470,-0.467,-0.464, - &-0.462,-0.459,-0.457,-0.454,-0.451,-0.449,-0.446,-0.444,-0.441, - &-0.438,-0.436,-0.433,-0.431,-0.428,-0.425,-0.423,-0.420,-0.418, - &-0.415,-0.412,-0.410,-0.407,-0.404,-0.402,-0.399,-0.397,-0.394, - &-0.391,-0.389,-0.386,-0.383,-0.381,-0.378,-0.375,-0.373,-0.370, - &-0.367,-0.365,-0.362 - & / -C -C *** (H,HSO4) -C - DATA BNC08M/ - &-0.043,-0.086,-0.105,-0.116,-0.123,-0.128,-0.131,-0.134,-0.135, - &-0.136,-0.136,-0.135,-0.134,-0.133,-0.131,-0.129,-0.127,-0.124, - &-0.122,-0.118,-0.115,-0.112,-0.108,-0.104,-0.100,-0.096,-0.092, - &-0.088,-0.083,-0.079,-0.074,-0.069,-0.064,-0.059,-0.054,-0.048, - &-0.043,-0.037,-0.032,-0.026,-0.021,-0.015,-0.009,-0.003, 0.003, - & 0.009, 0.015, 0.021, 0.027, 0.034, 0.040, 0.046, 0.053, 0.059, - & 0.066, 0.072, 0.079, 0.086, 0.092, 0.099, 0.106, 0.112, 0.119, - & 0.126, 0.133, 0.140, 0.147, 0.154, 0.161, 0.168, 0.175, 0.182, - & 0.189, 0.196, 0.204, 0.211, 0.218, 0.226, 0.233, 0.240, 0.248, - & 0.255, 0.263, 0.270, 0.278, 0.286, 0.293, 0.301, 0.309, 0.317, - & 0.324, 0.332, 0.340, 0.348, 0.356, 0.364, 0.372, 0.380, 0.389, - & 0.397, 0.405, 0.413, 0.421, 0.430, 0.438, 0.446, 0.455, 0.463, - & 0.471, 0.480, 0.488, 0.497, 0.505, 0.514, 0.522, 0.530, 0.539, - & 0.547, 0.556, 0.564, 0.573, 0.581, 0.590, 0.598, 0.607, 0.615, - & 0.624, 0.632, 0.641, 0.649, 0.658, 0.666, 0.675, 0.683, 0.692, - & 0.700, 0.708, 0.717, 0.725, 0.734, 0.742, 0.750, 0.759, 0.767, - & 0.775, 0.784, 0.792, 0.800, 0.808, 0.817, 0.825, 0.833, 0.841, - & 0.849, 0.858, 0.866, 0.874, 0.882, 0.890, 0.898, 0.906, 0.915, - & 0.923, 0.931, 0.939, 0.947, 0.955, 0.963, 0.971, 0.979, 0.986, - & 0.994, 1.002, 1.010, 1.018, 1.026, 1.034, 1.042, 1.049, 1.057, - & 1.065, 1.073, 1.080, 1.088, 1.096, 1.104, 1.111, 1.119, 1.127, - & 1.134, 1.142, 1.150, 1.157, 1.165, 1.172, 1.180, 1.187, 1.195, - & 1.202, 1.210, 1.217, 1.225, 1.232, 1.240, 1.247, 1.254, 1.262, - & 1.269, 1.276, 1.284, 1.291, 1.298, 1.306, 1.313, 1.320, 1.327, - & 1.335, 1.342, 1.349, 1.356, 1.363, 1.371, 1.378, 1.385, 1.392, - & 1.399, 1.406, 1.413, 1.420, 1.427, 1.434, 1.441, 1.448, 1.455, - & 1.462, 1.469, 1.476, 1.483, 1.490, 1.497, 1.504, 1.510, 1.517, - & 1.524, 1.531, 1.538, 1.545, 1.551, 1.558, 1.565, 1.572, 1.578, - & 1.585, 1.592, 1.598, 1.605, 1.612, 1.618, 1.625, 1.632, 1.638, - & 1.645, 1.651, 1.658, 1.664, 1.671, 1.678, 1.684, 1.691, 1.697, - & 1.704, 1.710, 1.716, 1.723, 1.729, 1.736, 1.742, 1.749, 1.755, - & 1.761, 1.768, 1.774, 1.780, 1.787, 1.793, 1.799, 1.805, 1.812, - & 1.818, 1.824, 1.830, 1.837, 1.843, 1.849, 1.855, 1.861, 1.868, - & 1.874, 1.880, 1.886, 1.892, 1.898, 1.904, 1.910, 1.916, 1.923, - & 1.929, 1.935, 1.941, 1.947, 1.953, 1.959, 1.965, 1.971, 1.977, - & 1.983, 1.988, 1.994, 2.000, 2.006, 2.012, 2.018, 2.024, 2.030, - & 2.036, 2.041, 2.047, 2.053, 2.059, 2.065, 2.070, 2.076, 2.082, - & 2.088, 2.094, 2.099, 2.105, 2.111, 2.116, 2.122, 2.128, 2.134, - & 2.139, 2.145, 2.150, 2.156, 2.162, 2.167, 2.173, 2.179, 2.184, - & 2.190, 2.195, 2.201, 2.206, 2.212, 2.218, 2.223, 2.229, 2.234, - & 2.240, 2.245, 2.251, 2.256, 2.261, 2.267, 2.272, 2.278, 2.283, - & 2.289, 2.294, 2.299, 2.305, 2.310, 2.316, 2.321, 2.326, 2.332, - & 2.337, 2.342, 2.348, 2.353, 2.358, 2.364, 2.369, 2.374, 2.379, - & 2.385, 2.390, 2.395, 2.400, 2.406, 2.411, 2.416, 2.421, 2.426, - & 2.432, 2.437, 2.442, 2.447, 2.502, 2.553, 2.602, 2.651, 2.699, - & 2.746, 2.793, 2.839, 2.884, 2.929, 2.973, 3.017, 3.060, 3.102, - & 3.144, 3.186, 3.227, 3.267, 3.307, 3.346, 3.385, 3.424, 3.462, - & 3.499, 3.536, 3.573, 3.610, 3.646, 3.681, 3.716, 3.751, 3.786, - & 3.820, 3.854, 3.887, 3.920, 3.953, 3.985, 4.018, 4.049, 4.081, - & 4.112, 4.143, 4.174, 4.204, 4.234, 4.264, 4.294, 4.323, 4.352, - & 4.381, 4.410, 4.438, 4.466, 4.494, 4.522, 4.549, 4.577, 4.604, - & 4.630, 4.657, 4.683, 4.710, 4.736, 4.761, 4.787, 4.812, 4.838, - & 4.863, 4.888, 4.912, 4.937, 4.961, 4.985, 5.009, 5.033, 5.057, - & 5.080, 5.104, 5.127, 5.150, 5.173, 5.196, 5.218, 5.241, 5.263, - & 5.285, 5.307, 5.329, 5.351, 5.372, 5.394, 5.415, 5.436, 5.457, - & 5.478, 5.499, 5.520, 5.541, 5.561, 5.581, 5.602, 5.622, 5.642, - & 5.662, 5.682, 5.701, 5.721, 5.740, 5.760, 5.779, 5.798, 5.817, - & 5.836, 5.855, 5.874, 5.892, 5.911, 5.929, 5.948, 5.966, 5.984, - & 6.002, 6.020, 6.038, 6.056, 6.074, 6.092, 6.109, 6.127, 6.144, - & 6.161, 6.179, 6.196, 6.213, 6.230, 6.247, 6.264, 6.280, 6.297, - & 6.314, 6.330, 6.347, 6.363, 6.379, 6.396, 6.412, 6.428, 6.444, - & 6.460, 6.476, 6.492, 6.507, 6.523, 6.539, 6.554, 6.570, 6.585, - & 6.600, 6.616, 6.631 - & / -C -C *** NH4HSO4 -C - DATA BNC09M/ - &-0.045,-0.095,-0.119,-0.135,-0.147,-0.157,-0.166,-0.173,-0.179, - &-0.184,-0.189,-0.193,-0.196,-0.200,-0.203,-0.205,-0.208,-0.210, - &-0.212,-0.213,-0.215,-0.216,-0.217,-0.218,-0.219,-0.219,-0.220, - &-0.220,-0.221,-0.221,-0.221,-0.221,-0.221,-0.221,-0.220,-0.220, - &-0.219,-0.219,-0.218,-0.217,-0.217,-0.216,-0.215,-0.214,-0.213, - &-0.212,-0.211,-0.210,-0.208,-0.207,-0.206,-0.204,-0.203,-0.201, - &-0.200,-0.198,-0.197,-0.195,-0.193,-0.192,-0.190,-0.188,-0.186, - &-0.185,-0.183,-0.181,-0.179,-0.177,-0.175,-0.173,-0.171,-0.169, - &-0.167,-0.165,-0.162,-0.160,-0.158,-0.156,-0.154,-0.151,-0.149, - &-0.147,-0.144,-0.142,-0.140,-0.137,-0.135,-0.132,-0.130,-0.127, - &-0.125,-0.122,-0.120,-0.117,-0.115,-0.112,-0.109,-0.107,-0.104, - &-0.101,-0.099,-0.096,-0.093,-0.091,-0.088,-0.085,-0.082,-0.079, - &-0.077,-0.074,-0.071,-0.068,-0.065,-0.063,-0.060,-0.057,-0.054, - &-0.051,-0.048,-0.046,-0.043,-0.040,-0.037,-0.034,-0.031,-0.028, - &-0.025,-0.023,-0.020,-0.017,-0.014,-0.011,-0.008,-0.005,-0.003, - & 0.000, 0.003, 0.006, 0.009, 0.012, 0.014, 0.017, 0.020, 0.023, - & 0.026, 0.029, 0.031, 0.034, 0.037, 0.040, 0.043, 0.045, 0.048, - & 0.051, 0.054, 0.057, 0.059, 0.062, 0.065, 0.068, 0.070, 0.073, - & 0.076, 0.079, 0.081, 0.084, 0.087, 0.089, 0.092, 0.095, 0.098, - & 0.100, 0.103, 0.106, 0.108, 0.111, 0.114, 0.116, 0.119, 0.122, - & 0.124, 0.127, 0.130, 0.132, 0.135, 0.137, 0.140, 0.143, 0.145, - & 0.148, 0.150, 0.153, 0.156, 0.158, 0.161, 0.163, 0.166, 0.168, - & 0.171, 0.174, 0.176, 0.179, 0.181, 0.184, 0.186, 0.189, 0.191, - & 0.194, 0.196, 0.199, 0.201, 0.204, 0.206, 0.209, 0.211, 0.214, - & 0.216, 0.219, 0.221, 0.223, 0.226, 0.228, 0.231, 0.233, 0.236, - & 0.238, 0.240, 0.243, 0.245, 0.248, 0.250, 0.252, 0.255, 0.257, - & 0.260, 0.262, 0.264, 0.267, 0.269, 0.271, 0.274, 0.276, 0.278, - & 0.281, 0.283, 0.285, 0.288, 0.290, 0.292, 0.295, 0.297, 0.299, - & 0.302, 0.304, 0.306, 0.308, 0.311, 0.313, 0.315, 0.317, 0.320, - & 0.322, 0.324, 0.326, 0.329, 0.331, 0.333, 0.335, 0.338, 0.340, - & 0.342, 0.344, 0.346, 0.349, 0.351, 0.353, 0.355, 0.357, 0.360, - & 0.362, 0.364, 0.366, 0.368, 0.371, 0.373, 0.375, 0.377, 0.379, - & 0.381, 0.383, 0.386, 0.388, 0.390, 0.392, 0.394, 0.396, 0.398, - & 0.400, 0.403, 0.405, 0.407, 0.409, 0.411, 0.413, 0.415, 0.417, - & 0.419, 0.421, 0.423, 0.426, 0.428, 0.430, 0.432, 0.434, 0.436, - & 0.438, 0.440, 0.442, 0.444, 0.446, 0.448, 0.450, 0.452, 0.454, - & 0.456, 0.458, 0.460, 0.462, 0.464, 0.466, 0.468, 0.470, 0.472, - & 0.474, 0.476, 0.478, 0.480, 0.482, 0.484, 0.486, 0.488, 0.490, - & 0.492, 0.494, 0.496, 0.498, 0.500, 0.502, 0.504, 0.506, 0.508, - & 0.510, 0.511, 0.513, 0.515, 0.517, 0.519, 0.521, 0.523, 0.525, - & 0.527, 0.529, 0.531, 0.533, 0.534, 0.536, 0.538, 0.540, 0.542, - & 0.544, 0.546, 0.548, 0.549, 0.551, 0.553, 0.555, 0.557, 0.559, - & 0.561, 0.563, 0.564, 0.566, 0.568, 0.570, 0.572, 0.574, 0.575, - & 0.577, 0.579, 0.581, 0.583, 0.585, 0.586, 0.588, 0.590, 0.592, - & 0.594, 0.595, 0.597, 0.599, 0.618, 0.636, 0.653, 0.670, 0.687, - & 0.704, 0.721, 0.737, 0.753, 0.769, 0.784, 0.800, 0.815, 0.830, - & 0.845, 0.860, 0.875, 0.889, 0.904, 0.918, 0.932, 0.946, 0.959, - & 0.973, 0.986, 1.000, 1.013, 1.026, 1.039, 1.052, 1.065, 1.077, - & 1.090, 1.102, 1.114, 1.126, 1.138, 1.150, 1.162, 1.174, 1.186, - & 1.197, 1.209, 1.220, 1.231, 1.242, 1.254, 1.265, 1.276, 1.286, - & 1.297, 1.308, 1.318, 1.329, 1.339, 1.350, 1.360, 1.370, 1.381, - & 1.391, 1.401, 1.411, 1.421, 1.430, 1.440, 1.450, 1.459, 1.469, - & 1.479, 1.488, 1.497, 1.507, 1.516, 1.525, 1.534, 1.544, 1.553, - & 1.562, 1.571, 1.579, 1.588, 1.597, 1.606, 1.615, 1.623, 1.632, - & 1.640, 1.649, 1.657, 1.666, 1.674, 1.683, 1.691, 1.699, 1.707, - & 1.715, 1.724, 1.732, 1.740, 1.748, 1.756, 1.764, 1.771, 1.779, - & 1.787, 1.795, 1.803, 1.810, 1.818, 1.826, 1.833, 1.841, 1.848, - & 1.856, 1.863, 1.871, 1.878, 1.885, 1.893, 1.900, 1.907, 1.915, - & 1.922, 1.929, 1.936, 1.943, 1.950, 1.957, 1.964, 1.971, 1.978, - & 1.985, 1.992, 1.999, 2.006, 2.013, 2.019, 2.026, 2.033, 2.040, - & 2.046, 2.053, 2.060, 2.066, 2.073, 2.079, 2.086, 2.093, 2.099, - & 2.105, 2.112, 2.118, 2.125, 2.131, 2.138, 2.144, 2.150, 2.156, - & 2.163, 2.169, 2.175 - & / -C -C *** (H,NO3) -C - DATA BNC10M/ - &-0.044,-0.092,-0.113,-0.127,-0.137,-0.145,-0.151,-0.156,-0.160, - &-0.163,-0.165,-0.167,-0.169,-0.170,-0.171,-0.172,-0.172,-0.172, - &-0.172,-0.172,-0.172,-0.172,-0.171,-0.171,-0.170,-0.169,-0.168, - &-0.167,-0.166,-0.165,-0.164,-0.163,-0.162,-0.160,-0.159,-0.158, - &-0.156,-0.155,-0.153,-0.152,-0.151,-0.149,-0.147,-0.146,-0.144, - &-0.143,-0.141,-0.140,-0.138,-0.136,-0.135,-0.133,-0.131,-0.130, - &-0.128,-0.126,-0.125,-0.123,-0.121,-0.120,-0.118,-0.116,-0.114, - &-0.113,-0.111,-0.109,-0.107,-0.106,-0.104,-0.102,-0.100,-0.099, - &-0.097,-0.095,-0.093,-0.091,-0.089,-0.088,-0.086,-0.084,-0.082, - &-0.080,-0.078,-0.076,-0.074,-0.072,-0.070,-0.068,-0.066,-0.064, - &-0.062,-0.060,-0.058,-0.056,-0.054,-0.052,-0.050,-0.048,-0.045, - &-0.043,-0.041,-0.039,-0.037,-0.035,-0.032,-0.030,-0.028,-0.026, - &-0.024,-0.021,-0.019,-0.017,-0.015,-0.012,-0.010,-0.008,-0.006, - &-0.003,-0.001, 0.001, 0.004, 0.006, 0.008, 0.010, 0.013, 0.015, - & 0.017, 0.020, 0.022, 0.024, 0.027, 0.029, 0.031, 0.033, 0.036, - & 0.038, 0.040, 0.043, 0.045, 0.047, 0.049, 0.052, 0.054, 0.056, - & 0.059, 0.061, 0.063, 0.066, 0.068, 0.070, 0.072, 0.075, 0.077, - & 0.079, 0.081, 0.084, 0.086, 0.088, 0.091, 0.093, 0.095, 0.097, - & 0.100, 0.102, 0.104, 0.106, 0.109, 0.111, 0.113, 0.115, 0.118, - & 0.120, 0.122, 0.124, 0.127, 0.129, 0.131, 0.133, 0.135, 0.138, - & 0.140, 0.142, 0.144, 0.147, 0.149, 0.151, 0.153, 0.155, 0.158, - & 0.160, 0.162, 0.164, 0.166, 0.169, 0.171, 0.173, 0.175, 0.177, - & 0.179, 0.182, 0.184, 0.186, 0.188, 0.190, 0.192, 0.195, 0.197, - & 0.199, 0.201, 0.203, 0.205, 0.207, 0.210, 0.212, 0.214, 0.216, - & 0.218, 0.220, 0.222, 0.224, 0.227, 0.229, 0.231, 0.233, 0.235, - & 0.237, 0.239, 0.241, 0.243, 0.245, 0.248, 0.250, 0.252, 0.254, - & 0.256, 0.258, 0.260, 0.262, 0.264, 0.266, 0.268, 0.270, 0.272, - & 0.274, 0.276, 0.278, 0.281, 0.283, 0.285, 0.287, 0.289, 0.291, - & 0.293, 0.295, 0.297, 0.299, 0.301, 0.303, 0.305, 0.307, 0.309, - & 0.311, 0.313, 0.315, 0.317, 0.319, 0.321, 0.323, 0.325, 0.327, - & 0.329, 0.331, 0.333, 0.335, 0.337, 0.339, 0.341, 0.343, 0.344, - & 0.346, 0.348, 0.350, 0.352, 0.354, 0.356, 0.358, 0.360, 0.362, - & 0.364, 0.366, 0.368, 0.370, 0.372, 0.373, 0.375, 0.377, 0.379, - & 0.381, 0.383, 0.385, 0.387, 0.389, 0.391, 0.393, 0.394, 0.396, - & 0.398, 0.400, 0.402, 0.404, 0.406, 0.408, 0.409, 0.411, 0.413, - & 0.415, 0.417, 0.419, 0.421, 0.422, 0.424, 0.426, 0.428, 0.430, - & 0.432, 0.433, 0.435, 0.437, 0.439, 0.441, 0.443, 0.444, 0.446, - & 0.448, 0.450, 0.452, 0.454, 0.455, 0.457, 0.459, 0.461, 0.463, - & 0.464, 0.466, 0.468, 0.470, 0.471, 0.473, 0.475, 0.477, 0.479, - & 0.480, 0.482, 0.484, 0.486, 0.487, 0.489, 0.491, 0.493, 0.494, - & 0.496, 0.498, 0.500, 0.501, 0.503, 0.505, 0.507, 0.508, 0.510, - & 0.512, 0.514, 0.515, 0.517, 0.519, 0.521, 0.522, 0.524, 0.526, - & 0.527, 0.529, 0.531, 0.533, 0.534, 0.536, 0.538, 0.539, 0.541, - & 0.543, 0.544, 0.546, 0.548, 0.549, 0.551, 0.553, 0.554, 0.556, - & 0.558, 0.560, 0.561, 0.563, 0.581, 0.597, 0.613, 0.629, 0.645, - & 0.660, 0.676, 0.691, 0.706, 0.721, 0.736, 0.750, 0.765, 0.779, - & 0.793, 0.807, 0.820, 0.834, 0.848, 0.861, 0.874, 0.887, 0.900, - & 0.913, 0.926, 0.938, 0.951, 0.963, 0.975, 0.987, 0.999, 1.011, - & 1.023, 1.035, 1.046, 1.058, 1.069, 1.081, 1.092, 1.103, 1.114, - & 1.125, 1.136, 1.147, 1.157, 1.168, 1.178, 1.189, 1.199, 1.210, - & 1.220, 1.230, 1.240, 1.250, 1.260, 1.270, 1.279, 1.289, 1.299, - & 1.308, 1.318, 1.327, 1.337, 1.346, 1.355, 1.365, 1.374, 1.383, - & 1.392, 1.401, 1.410, 1.419, 1.427, 1.436, 1.445, 1.454, 1.462, - & 1.471, 1.479, 1.488, 1.496, 1.504, 1.513, 1.521, 1.529, 1.537, - & 1.546, 1.554, 1.562, 1.570, 1.578, 1.586, 1.593, 1.601, 1.609, - & 1.617, 1.624, 1.632, 1.640, 1.647, 1.655, 1.662, 1.670, 1.677, - & 1.685, 1.692, 1.700, 1.707, 1.714, 1.721, 1.729, 1.736, 1.743, - & 1.750, 1.757, 1.764, 1.771, 1.778, 1.785, 1.792, 1.799, 1.806, - & 1.813, 1.820, 1.826, 1.833, 1.840, 1.847, 1.853, 1.860, 1.866, - & 1.873, 1.880, 1.886, 1.893, 1.899, 1.906, 1.912, 1.918, 1.925, - & 1.931, 1.938, 1.944, 1.950, 1.956, 1.963, 1.969, 1.975, 1.981, - & 1.987, 1.994, 2.000, 2.006, 2.012, 2.018, 2.024, 2.030, 2.036, - & 2.042, 2.048, 2.054 - & / -C -C *** (H,Cl) -C - DATA BNC11M/ - &-0.043,-0.087,-0.106,-0.117,-0.124,-0.130,-0.133,-0.135,-0.137, - &-0.138,-0.138,-0.137,-0.136,-0.135,-0.134,-0.132,-0.130,-0.127, - &-0.125,-0.122,-0.119,-0.116,-0.113,-0.110,-0.107,-0.103,-0.099, - &-0.096,-0.092,-0.088,-0.084,-0.080,-0.076,-0.071,-0.067,-0.063, - &-0.058,-0.054,-0.049,-0.045,-0.040,-0.036,-0.031,-0.027,-0.022, - &-0.017,-0.012,-0.008,-0.003, 0.002, 0.007, 0.012, 0.017, 0.022, - & 0.027, 0.031, 0.036, 0.041, 0.046, 0.051, 0.056, 0.061, 0.066, - & 0.071, 0.077, 0.082, 0.087, 0.092, 0.097, 0.102, 0.107, 0.113, - & 0.118, 0.123, 0.128, 0.134, 0.139, 0.144, 0.149, 0.155, 0.160, - & 0.166, 0.171, 0.177, 0.182, 0.188, 0.193, 0.199, 0.204, 0.210, - & 0.216, 0.221, 0.227, 0.233, 0.239, 0.244, 0.250, 0.256, 0.262, - & 0.268, 0.274, 0.280, 0.286, 0.292, 0.298, 0.304, 0.310, 0.316, - & 0.322, 0.328, 0.334, 0.340, 0.346, 0.352, 0.358, 0.364, 0.370, - & 0.377, 0.383, 0.389, 0.395, 0.401, 0.407, 0.413, 0.420, 0.426, - & 0.432, 0.438, 0.444, 0.450, 0.457, 0.463, 0.469, 0.475, 0.481, - & 0.487, 0.493, 0.499, 0.505, 0.512, 0.518, 0.524, 0.530, 0.536, - & 0.542, 0.548, 0.554, 0.560, 0.566, 0.572, 0.578, 0.584, 0.590, - & 0.596, 0.602, 0.608, 0.614, 0.620, 0.626, 0.632, 0.638, 0.643, - & 0.649, 0.655, 0.661, 0.667, 0.673, 0.679, 0.684, 0.690, 0.696, - & 0.702, 0.708, 0.713, 0.719, 0.725, 0.731, 0.737, 0.742, 0.748, - & 0.754, 0.759, 0.765, 0.771, 0.776, 0.782, 0.788, 0.793, 0.799, - & 0.805, 0.810, 0.816, 0.821, 0.827, 0.833, 0.838, 0.844, 0.849, - & 0.855, 0.860, 0.866, 0.871, 0.877, 0.882, 0.888, 0.893, 0.899, - & 0.904, 0.909, 0.915, 0.920, 0.926, 0.931, 0.936, 0.942, 0.947, - & 0.953, 0.958, 0.963, 0.969, 0.974, 0.979, 0.984, 0.990, 0.995, - & 1.000, 1.005, 1.011, 1.016, 1.021, 1.026, 1.032, 1.037, 1.042, - & 1.047, 1.052, 1.057, 1.062, 1.068, 1.073, 1.078, 1.083, 1.088, - & 1.093, 1.098, 1.103, 1.108, 1.113, 1.118, 1.123, 1.128, 1.133, - & 1.138, 1.143, 1.148, 1.153, 1.158, 1.163, 1.168, 1.173, 1.178, - & 1.183, 1.188, 1.193, 1.198, 1.202, 1.207, 1.212, 1.217, 1.222, - & 1.227, 1.232, 1.236, 1.241, 1.246, 1.251, 1.256, 1.260, 1.265, - & 1.270, 1.275, 1.279, 1.284, 1.289, 1.293, 1.298, 1.303, 1.307, - & 1.312, 1.317, 1.321, 1.326, 1.331, 1.335, 1.340, 1.345, 1.349, - & 1.354, 1.358, 1.363, 1.368, 1.372, 1.377, 1.381, 1.386, 1.390, - & 1.395, 1.399, 1.404, 1.408, 1.413, 1.417, 1.422, 1.426, 1.431, - & 1.435, 1.440, 1.444, 1.449, 1.453, 1.457, 1.462, 1.466, 1.471, - & 1.475, 1.479, 1.484, 1.488, 1.492, 1.497, 1.501, 1.506, 1.510, - & 1.514, 1.518, 1.523, 1.527, 1.531, 1.536, 1.540, 1.544, 1.548, - & 1.553, 1.557, 1.561, 1.565, 1.570, 1.574, 1.578, 1.582, 1.587, - & 1.591, 1.595, 1.599, 1.603, 1.607, 1.612, 1.616, 1.620, 1.624, - & 1.628, 1.632, 1.636, 1.640, 1.645, 1.649, 1.653, 1.657, 1.661, - & 1.665, 1.669, 1.673, 1.677, 1.681, 1.685, 1.689, 1.693, 1.697, - & 1.701, 1.705, 1.709, 1.713, 1.717, 1.721, 1.725, 1.729, 1.733, - & 1.737, 1.741, 1.745, 1.749, 1.753, 1.757, 1.761, 1.765, 1.769, - & 1.772, 1.776, 1.780, 1.784, 1.826, 1.864, 1.901, 1.938, 1.974, - & 2.010, 2.045, 2.080, 2.114, 2.148, 2.181, 2.214, 2.246, 2.278, - & 2.310, 2.341, 2.372, 2.403, 2.433, 2.463, 2.492, 2.522, 2.550, - & 2.579, 2.607, 2.635, 2.663, 2.690, 2.717, 2.744, 2.770, 2.796, - & 2.822, 2.848, 2.873, 2.898, 2.923, 2.948, 2.972, 2.996, 3.020, - & 3.044, 3.068, 3.091, 3.114, 3.137, 3.160, 3.182, 3.205, 3.227, - & 3.249, 3.271, 3.292, 3.314, 3.335, 3.356, 3.377, 3.398, 3.418, - & 3.439, 3.459, 3.479, 3.499, 3.519, 3.539, 3.558, 3.578, 3.597, - & 3.616, 3.635, 3.654, 3.673, 3.691, 3.710, 3.728, 3.746, 3.765, - & 3.783, 3.800, 3.818, 3.836, 3.853, 3.871, 3.888, 3.905, 3.922, - & 3.939, 3.956, 3.973, 3.990, 4.006, 4.023, 4.039, 4.055, 4.071, - & 4.088, 4.104, 4.119, 4.135, 4.151, 4.167, 4.182, 4.198, 4.213, - & 4.228, 4.243, 4.259, 4.274, 4.289, 4.304, 4.318, 4.333, 4.348, - & 4.362, 4.377, 4.391, 4.406, 4.420, 4.434, 4.448, 4.462, 4.476, - & 4.490, 4.504, 4.518, 4.532, 4.545, 4.559, 4.572, 4.586, 4.599, - & 4.613, 4.626, 4.639, 4.652, 4.665, 4.678, 4.691, 4.704, 4.717, - & 4.730, 4.743, 4.756, 4.768, 4.781, 4.793, 4.806, 4.818, 4.831, - & 4.843, 4.855, 4.867, 4.880, 4.892, 4.904, 4.916, 4.928, 4.940, - & 4.952, 4.964, 4.975 - & / -C -C *** NaHSO4 -C - DATA BNC12M/ - &-0.044,-0.092,-0.113,-0.127,-0.138,-0.146,-0.152,-0.157,-0.162, - &-0.165,-0.168,-0.170,-0.172,-0.174,-0.175,-0.176,-0.176,-0.177, - &-0.177,-0.177,-0.176,-0.176,-0.176,-0.175,-0.174,-0.173,-0.172, - &-0.171,-0.169,-0.168,-0.167,-0.165,-0.163,-0.161,-0.160,-0.158, - &-0.156,-0.154,-0.151,-0.149,-0.147,-0.145,-0.142,-0.140,-0.137, - &-0.135,-0.132,-0.130,-0.127,-0.124,-0.122,-0.119,-0.116,-0.113, - &-0.110,-0.107,-0.104,-0.101,-0.098,-0.095,-0.092,-0.089,-0.086, - &-0.083,-0.080,-0.076,-0.073,-0.070,-0.067,-0.063,-0.060,-0.057, - &-0.053,-0.050,-0.046,-0.043,-0.039,-0.036,-0.032,-0.029,-0.025, - &-0.021,-0.018,-0.014,-0.010,-0.007,-0.003, 0.001, 0.005, 0.009, - & 0.012, 0.016, 0.020, 0.024, 0.028, 0.032, 0.036, 0.040, 0.044, - & 0.048, 0.052, 0.056, 0.060, 0.064, 0.068, 0.073, 0.077, 0.081, - & 0.085, 0.089, 0.093, 0.098, 0.102, 0.106, 0.110, 0.115, 0.119, - & 0.123, 0.127, 0.131, 0.136, 0.140, 0.144, 0.148, 0.153, 0.157, - & 0.161, 0.165, 0.170, 0.174, 0.178, 0.182, 0.187, 0.191, 0.195, - & 0.199, 0.204, 0.208, 0.212, 0.216, 0.220, 0.225, 0.229, 0.233, - & 0.237, 0.241, 0.245, 0.250, 0.254, 0.258, 0.262, 0.266, 0.270, - & 0.274, 0.279, 0.283, 0.287, 0.291, 0.295, 0.299, 0.303, 0.307, - & 0.311, 0.315, 0.319, 0.323, 0.327, 0.331, 0.335, 0.339, 0.343, - & 0.347, 0.351, 0.355, 0.359, 0.363, 0.367, 0.371, 0.375, 0.379, - & 0.383, 0.387, 0.391, 0.395, 0.399, 0.402, 0.406, 0.410, 0.414, - & 0.418, 0.422, 0.426, 0.429, 0.433, 0.437, 0.441, 0.445, 0.449, - & 0.452, 0.456, 0.460, 0.464, 0.467, 0.471, 0.475, 0.479, 0.482, - & 0.486, 0.490, 0.494, 0.497, 0.501, 0.505, 0.508, 0.512, 0.516, - & 0.519, 0.523, 0.527, 0.530, 0.534, 0.538, 0.541, 0.545, 0.548, - & 0.552, 0.556, 0.559, 0.563, 0.566, 0.570, 0.573, 0.577, 0.581, - & 0.584, 0.588, 0.591, 0.595, 0.598, 0.602, 0.605, 0.609, 0.612, - & 0.616, 0.619, 0.623, 0.626, 0.630, 0.633, 0.636, 0.640, 0.643, - & 0.647, 0.650, 0.654, 0.657, 0.660, 0.664, 0.667, 0.671, 0.674, - & 0.677, 0.681, 0.684, 0.687, 0.691, 0.694, 0.697, 0.701, 0.704, - & 0.707, 0.711, 0.714, 0.717, 0.721, 0.724, 0.727, 0.730, 0.734, - & 0.737, 0.740, 0.743, 0.747, 0.750, 0.753, 0.756, 0.760, 0.763, - & 0.766, 0.769, 0.773, 0.776, 0.779, 0.782, 0.785, 0.788, 0.792, - & 0.795, 0.798, 0.801, 0.804, 0.807, 0.811, 0.814, 0.817, 0.820, - & 0.823, 0.826, 0.829, 0.832, 0.835, 0.839, 0.842, 0.845, 0.848, - & 0.851, 0.854, 0.857, 0.860, 0.863, 0.866, 0.869, 0.872, 0.875, - & 0.878, 0.881, 0.884, 0.887, 0.890, 0.893, 0.896, 0.899, 0.902, - & 0.905, 0.908, 0.911, 0.914, 0.917, 0.920, 0.923, 0.926, 0.929, - & 0.932, 0.935, 0.938, 0.941, 0.944, 0.947, 0.949, 0.952, 0.955, - & 0.958, 0.961, 0.964, 0.967, 0.970, 0.973, 0.975, 0.978, 0.981, - & 0.984, 0.987, 0.990, 0.993, 0.995, 0.998, 1.001, 1.004, 1.007, - & 1.010, 1.012, 1.015, 1.018, 1.021, 1.024, 1.026, 1.029, 1.032, - & 1.035, 1.038, 1.040, 1.043, 1.046, 1.049, 1.051, 1.054, 1.057, - & 1.060, 1.062, 1.065, 1.068, 1.071, 1.073, 1.076, 1.079, 1.082, - & 1.084, 1.087, 1.090, 1.092, 1.121, 1.148, 1.174, 1.199, 1.225, - & 1.250, 1.274, 1.299, 1.323, 1.346, 1.370, 1.393, 1.416, 1.438, - & 1.461, 1.483, 1.504, 1.526, 1.547, 1.568, 1.589, 1.610, 1.630, - & 1.650, 1.670, 1.690, 1.710, 1.729, 1.748, 1.767, 1.786, 1.805, - & 1.823, 1.841, 1.860, 1.878, 1.895, 1.913, 1.930, 1.948, 1.965, - & 1.982, 1.999, 2.015, 2.032, 2.048, 2.065, 2.081, 2.097, 2.113, - & 2.129, 2.144, 2.160, 2.175, 2.191, 2.206, 2.221, 2.236, 2.251, - & 2.265, 2.280, 2.294, 2.309, 2.323, 2.337, 2.352, 2.366, 2.379, - & 2.393, 2.407, 2.421, 2.434, 2.448, 2.461, 2.474, 2.488, 2.501, - & 2.514, 2.527, 2.540, 2.552, 2.565, 2.578, 2.590, 2.603, 2.615, - & 2.628, 2.640, 2.652, 2.664, 2.676, 2.688, 2.700, 2.712, 2.724, - & 2.735, 2.747, 2.759, 2.770, 2.782, 2.793, 2.805, 2.816, 2.827, - & 2.838, 2.849, 2.860, 2.871, 2.882, 2.893, 2.904, 2.915, 2.926, - & 2.936, 2.947, 2.957, 2.968, 2.978, 2.989, 2.999, 3.010, 3.020, - & 3.030, 3.040, 3.050, 3.060, 3.070, 3.080, 3.090, 3.100, 3.110, - & 3.120, 3.130, 3.139, 3.149, 3.159, 3.168, 3.178, 3.188, 3.197, - & 3.206, 3.216, 3.225, 3.235, 3.244, 3.253, 3.262, 3.272, 3.281, - & 3.290, 3.299, 3.308, 3.317, 3.326, 3.335, 3.344, 3.353, 3.361, - & 3.370, 3.379, 3.388 - & / -C -C *** (NH4)3H(SO4)2 -C - DATA BNC13M/ - &-0.072,-0.156,-0.197,-0.226,-0.248,-0.266,-0.282,-0.295,-0.307, - &-0.317,-0.327,-0.336,-0.344,-0.351,-0.358,-0.364,-0.370,-0.375, - &-0.380,-0.385,-0.390,-0.394,-0.398,-0.402,-0.406,-0.409,-0.412, - &-0.415,-0.418,-0.421,-0.424,-0.426,-0.429,-0.431,-0.433,-0.435, - &-0.437,-0.439,-0.441,-0.442,-0.444,-0.446,-0.447,-0.449,-0.450, - &-0.451,-0.452,-0.453,-0.454,-0.456,-0.456,-0.457,-0.458,-0.459, - &-0.460,-0.461,-0.461,-0.462,-0.462,-0.463,-0.463,-0.464,-0.464, - &-0.465,-0.465,-0.465,-0.466,-0.466,-0.466,-0.467,-0.467,-0.467, - &-0.467,-0.467,-0.467,-0.467,-0.467,-0.467,-0.467,-0.467,-0.467, - &-0.467,-0.467,-0.467,-0.467,-0.467,-0.466,-0.466,-0.466,-0.466, - &-0.466,-0.465,-0.465,-0.465,-0.464,-0.464,-0.464,-0.463,-0.463, - &-0.463,-0.462,-0.462,-0.461,-0.461,-0.460,-0.460,-0.459,-0.459, - &-0.458,-0.458,-0.457,-0.457,-0.456,-0.456,-0.455,-0.455,-0.454, - &-0.454,-0.453,-0.452,-0.452,-0.451,-0.451,-0.450,-0.449,-0.449, - &-0.448,-0.447,-0.447,-0.446,-0.445,-0.445,-0.444,-0.443,-0.443, - &-0.442,-0.441,-0.441,-0.440,-0.439,-0.439,-0.438,-0.437,-0.437, - &-0.436,-0.435,-0.434,-0.434,-0.433,-0.432,-0.432,-0.431,-0.430, - &-0.429,-0.429,-0.428,-0.427,-0.427,-0.426,-0.425,-0.424,-0.424, - &-0.423,-0.422,-0.421,-0.421,-0.420,-0.419,-0.418,-0.418,-0.417, - &-0.416,-0.415,-0.415,-0.414,-0.413,-0.412,-0.412,-0.411,-0.410, - &-0.409,-0.409,-0.408,-0.407,-0.406,-0.406,-0.405,-0.404,-0.403, - &-0.403,-0.402,-0.401,-0.400,-0.400,-0.399,-0.398,-0.397,-0.397, - &-0.396,-0.395,-0.394,-0.394,-0.393,-0.392,-0.391,-0.391,-0.390, - &-0.389,-0.388,-0.388,-0.387,-0.386,-0.385,-0.385,-0.384,-0.383, - &-0.382,-0.381,-0.381,-0.380,-0.379,-0.378,-0.378,-0.377,-0.376, - &-0.375,-0.375,-0.374,-0.373,-0.372,-0.372,-0.371,-0.370,-0.369, - &-0.369,-0.368,-0.367,-0.366,-0.366,-0.365,-0.364,-0.363,-0.363, - &-0.362,-0.361,-0.360,-0.360,-0.359,-0.358,-0.357,-0.357,-0.356, - &-0.355,-0.354,-0.354,-0.353,-0.352,-0.351,-0.351,-0.350,-0.349, - &-0.348,-0.348,-0.347,-0.346,-0.345,-0.345,-0.344,-0.343,-0.342, - &-0.342,-0.341,-0.340,-0.339,-0.339,-0.338,-0.337,-0.336,-0.336, - &-0.335,-0.334,-0.333,-0.333,-0.332,-0.331,-0.331,-0.330,-0.329, - &-0.328,-0.328,-0.327,-0.326,-0.325,-0.325,-0.324,-0.323,-0.322, - &-0.322,-0.321,-0.320,-0.320,-0.319,-0.318,-0.317,-0.317,-0.316, - &-0.315,-0.314,-0.314,-0.313,-0.312,-0.312,-0.311,-0.310,-0.309, - &-0.309,-0.308,-0.307,-0.306,-0.306,-0.305,-0.304,-0.304,-0.303, - &-0.302,-0.301,-0.301,-0.300,-0.299,-0.299,-0.298,-0.297,-0.296, - &-0.296,-0.295,-0.294,-0.294,-0.293,-0.292,-0.291,-0.291,-0.290, - &-0.289,-0.289,-0.288,-0.287,-0.286,-0.286,-0.285,-0.284,-0.284, - &-0.283,-0.282,-0.281,-0.281,-0.280,-0.279,-0.279,-0.278,-0.277, - &-0.277,-0.276,-0.275,-0.274,-0.274,-0.273,-0.272,-0.272,-0.271, - &-0.270,-0.270,-0.269,-0.268,-0.267,-0.267,-0.266,-0.265,-0.265, - &-0.264,-0.263,-0.263,-0.262,-0.261,-0.261,-0.260,-0.259,-0.258, - &-0.258,-0.257,-0.256,-0.256,-0.255,-0.254,-0.254,-0.253,-0.252, - &-0.252,-0.251,-0.250,-0.250,-0.242,-0.235,-0.229,-0.222,-0.215, - &-0.209,-0.202,-0.196,-0.189,-0.183,-0.176,-0.170,-0.164,-0.157, - &-0.151,-0.145,-0.139,-0.133,-0.127,-0.121,-0.115,-0.109,-0.103, - &-0.097,-0.091,-0.085,-0.079,-0.073,-0.067,-0.062,-0.056,-0.050, - &-0.045,-0.039,-0.033,-0.028,-0.022,-0.017,-0.011,-0.006, 0.000, - & 0.005, 0.010, 0.016, 0.021, 0.026, 0.032, 0.037, 0.042, 0.048, - & 0.053, 0.058, 0.063, 0.068, 0.073, 0.079, 0.084, 0.089, 0.094, - & 0.099, 0.104, 0.109, 0.114, 0.119, 0.124, 0.129, 0.134, 0.138, - & 0.143, 0.148, 0.153, 0.158, 0.163, 0.167, 0.172, 0.177, 0.182, - & 0.186, 0.191, 0.196, 0.201, 0.205, 0.210, 0.215, 0.219, 0.224, - & 0.228, 0.233, 0.238, 0.242, 0.247, 0.251, 0.256, 0.260, 0.265, - & 0.269, 0.274, 0.278, 0.283, 0.287, 0.291, 0.296, 0.300, 0.305, - & 0.309, 0.313, 0.318, 0.322, 0.326, 0.331, 0.335, 0.339, 0.344, - & 0.348, 0.352, 0.357, 0.361, 0.365, 0.369, 0.374, 0.378, 0.382, - & 0.386, 0.390, 0.395, 0.399, 0.403, 0.407, 0.411, 0.415, 0.419, - & 0.424, 0.428, 0.432, 0.436, 0.440, 0.444, 0.448, 0.452, 0.456, - & 0.460, 0.464, 0.468, 0.472, 0.476, 0.480, 0.484, 0.488, 0.492, - & 0.496, 0.500, 0.504, 0.508, 0.512, 0.516, 0.520, 0.524, 0.528, - & 0.532, 0.536, 0.540 - & / -C -C *** CASO4 -C - DATA BNC14M/ - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000 - & / -C -C *** CANO32 -C - DATA BNC15M/ - &-0.090,-0.191,-0.239,-0.271,-0.296,-0.316,-0.332,-0.346,-0.358, - &-0.368,-0.378,-0.386,-0.393,-0.400,-0.405,-0.411,-0.416,-0.420, - &-0.424,-0.428,-0.431,-0.434,-0.437,-0.440,-0.442,-0.444,-0.446, - &-0.448,-0.450,-0.451,-0.453,-0.454,-0.455,-0.456,-0.457,-0.458, - &-0.459,-0.460,-0.460,-0.461,-0.461,-0.462,-0.462,-0.463,-0.463, - &-0.463,-0.463,-0.463,-0.464,-0.464,-0.464,-0.464,-0.464,-0.464, - &-0.464,-0.463,-0.463,-0.463,-0.463,-0.463,-0.462,-0.462,-0.462, - &-0.462,-0.461,-0.461,-0.460,-0.460,-0.460,-0.459,-0.459,-0.458, - &-0.458,-0.457,-0.457,-0.456,-0.455,-0.455,-0.454,-0.454,-0.453, - &-0.452,-0.451,-0.451,-0.450,-0.449,-0.448,-0.448,-0.447,-0.446, - &-0.445,-0.444,-0.443,-0.442,-0.441,-0.440,-0.439,-0.439,-0.438, - &-0.437,-0.435,-0.434,-0.433,-0.432,-0.431,-0.430,-0.429,-0.428, - &-0.427,-0.426,-0.425,-0.423,-0.422,-0.421,-0.420,-0.419,-0.417, - &-0.416,-0.415,-0.414,-0.413,-0.411,-0.410,-0.409,-0.408,-0.406, - &-0.405,-0.404,-0.403,-0.401,-0.400,-0.399,-0.398,-0.396,-0.395, - &-0.394,-0.392,-0.391,-0.390,-0.388,-0.387,-0.386,-0.385,-0.383, - &-0.382,-0.381,-0.379,-0.378,-0.377,-0.375,-0.374,-0.373,-0.371, - &-0.370,-0.369,-0.367,-0.366,-0.365,-0.363,-0.362,-0.361,-0.359, - &-0.358,-0.357,-0.355,-0.354,-0.353,-0.351,-0.350,-0.349,-0.347, - &-0.346,-0.345,-0.343,-0.342,-0.341,-0.339,-0.338,-0.337,-0.335, - &-0.334,-0.333,-0.331,-0.330,-0.328,-0.327,-0.326,-0.324,-0.323, - &-0.322,-0.320,-0.319,-0.318,-0.316,-0.315,-0.314,-0.312,-0.311, - &-0.310,-0.308,-0.307,-0.306,-0.304,-0.303,-0.301,-0.300,-0.299, - &-0.297,-0.296,-0.295,-0.293,-0.292,-0.291,-0.289,-0.288,-0.287, - &-0.285,-0.284,-0.283,-0.281,-0.280,-0.279,-0.277,-0.276,-0.275, - &-0.273,-0.272,-0.271,-0.269,-0.268,-0.267,-0.265,-0.264,-0.263, - &-0.261,-0.260,-0.259,-0.257,-0.256,-0.255,-0.253,-0.252,-0.251, - &-0.249,-0.248,-0.247,-0.245,-0.244,-0.243,-0.241,-0.240,-0.239, - &-0.237,-0.236,-0.235,-0.233,-0.232,-0.231,-0.230,-0.228,-0.227, - &-0.226,-0.224,-0.223,-0.222,-0.220,-0.219,-0.218,-0.216,-0.215, - &-0.214,-0.213,-0.211,-0.210,-0.209,-0.207,-0.206,-0.205,-0.203, - &-0.202,-0.201,-0.200,-0.198,-0.197,-0.196,-0.194,-0.193,-0.192, - &-0.191,-0.189,-0.188,-0.187,-0.185,-0.184,-0.183,-0.182,-0.180, - &-0.179,-0.178,-0.176,-0.175,-0.174,-0.173,-0.171,-0.170,-0.169, - &-0.167,-0.166,-0.165,-0.164,-0.162,-0.161,-0.160,-0.159,-0.157, - &-0.156,-0.155,-0.154,-0.152,-0.151,-0.150,-0.149,-0.147,-0.146, - &-0.145,-0.144,-0.142,-0.141,-0.140,-0.139,-0.137,-0.136,-0.135, - &-0.134,-0.132,-0.131,-0.130,-0.129,-0.127,-0.126,-0.125,-0.124, - &-0.122,-0.121,-0.120,-0.119,-0.117,-0.116,-0.115,-0.114,-0.113, - &-0.111,-0.110,-0.109,-0.108,-0.106,-0.105,-0.104,-0.103,-0.102, - &-0.100,-0.099,-0.098,-0.097,-0.095,-0.094,-0.093,-0.092,-0.091, - &-0.089,-0.088,-0.087,-0.086,-0.085,-0.083,-0.082,-0.081,-0.080, - &-0.079,-0.077,-0.076,-0.075,-0.074,-0.073,-0.071,-0.070,-0.069, - &-0.068,-0.067,-0.065,-0.064,-0.063,-0.062,-0.061,-0.059,-0.058, - &-0.057,-0.056,-0.055,-0.054,-0.041,-0.029,-0.018,-0.006, 0.005, - & 0.017, 0.028, 0.039, 0.050, 0.061, 0.072, 0.083, 0.094, 0.104, - & 0.115, 0.125, 0.136, 0.146, 0.156, 0.167, 0.177, 0.187, 0.197, - & 0.207, 0.217, 0.227, 0.236, 0.246, 0.256, 0.265, 0.275, 0.284, - & 0.294, 0.303, 0.312, 0.322, 0.331, 0.340, 0.349, 0.358, 0.367, - & 0.376, 0.385, 0.394, 0.403, 0.411, 0.420, 0.429, 0.437, 0.446, - & 0.455, 0.463, 0.472, 0.480, 0.488, 0.497, 0.505, 0.513, 0.521, - & 0.530, 0.538, 0.546, 0.554, 0.562, 0.570, 0.578, 0.586, 0.594, - & 0.602, 0.610, 0.617, 0.625, 0.633, 0.641, 0.648, 0.656, 0.664, - & 0.671, 0.679, 0.686, 0.694, 0.701, 0.709, 0.716, 0.723, 0.731, - & 0.738, 0.745, 0.753, 0.760, 0.767, 0.774, 0.782, 0.789, 0.796, - & 0.803, 0.810, 0.817, 0.824, 0.831, 0.838, 0.845, 0.852, 0.859, - & 0.866, 0.873, 0.880, 0.886, 0.893, 0.900, 0.907, 0.914, 0.920, - & 0.927, 0.934, 0.940, 0.947, 0.954, 0.960, 0.967, 0.973, 0.980, - & 0.987, 0.993, 1.000, 1.006, 1.013, 1.019, 1.025, 1.032, 1.038, - & 1.045, 1.051, 1.057, 1.064, 1.070, 1.076, 1.083, 1.089, 1.095, - & 1.101, 1.108, 1.114, 1.120, 1.126, 1.132, 1.139, 1.145, 1.151, - & 1.157, 1.163, 1.169, 1.175, 1.181, 1.187, 1.193, 1.199, 1.205, - & 1.211, 1.217, 1.223 - & / -C -C *** CACL2 -C - DATA BNC16M/ - &-0.088,-0.184,-0.228,-0.256,-0.277,-0.293,-0.305,-0.315,-0.323, - &-0.330,-0.335,-0.340,-0.343,-0.346,-0.349,-0.350,-0.352,-0.353, - &-0.353,-0.353,-0.353,-0.353,-0.352,-0.352,-0.351,-0.349,-0.348, - &-0.347,-0.345,-0.343,-0.341,-0.339,-0.337,-0.335,-0.333,-0.331, - &-0.328,-0.326,-0.324,-0.321,-0.318,-0.316,-0.313,-0.311,-0.308, - &-0.305,-0.302,-0.299,-0.297,-0.294,-0.291,-0.288,-0.285,-0.282, - &-0.279,-0.276,-0.273,-0.270,-0.267,-0.264,-0.261,-0.258,-0.255, - &-0.252,-0.249,-0.246,-0.243,-0.239,-0.236,-0.233,-0.230,-0.227, - &-0.223,-0.220,-0.217,-0.214,-0.210,-0.207,-0.203,-0.200,-0.197, - &-0.193,-0.190,-0.186,-0.183,-0.179,-0.176,-0.172,-0.168,-0.165, - &-0.161,-0.158,-0.154,-0.150,-0.146,-0.143,-0.139,-0.135,-0.131, - &-0.127,-0.123,-0.119,-0.115,-0.111,-0.107,-0.103,-0.099,-0.095, - &-0.091,-0.087,-0.083,-0.079,-0.075,-0.071,-0.067,-0.063,-0.059, - &-0.055,-0.050,-0.046,-0.042,-0.038,-0.034,-0.030,-0.026,-0.021, - &-0.017,-0.013,-0.009,-0.005, 0.000, 0.004, 0.008, 0.012, 0.016, - & 0.020, 0.025, 0.029, 0.033, 0.037, 0.041, 0.046, 0.050, 0.054, - & 0.058, 0.062, 0.066, 0.071, 0.075, 0.079, 0.083, 0.087, 0.091, - & 0.095, 0.100, 0.104, 0.108, 0.112, 0.116, 0.120, 0.124, 0.128, - & 0.133, 0.137, 0.141, 0.145, 0.149, 0.153, 0.157, 0.161, 0.165, - & 0.169, 0.174, 0.178, 0.182, 0.186, 0.190, 0.194, 0.198, 0.202, - & 0.206, 0.210, 0.214, 0.218, 0.222, 0.226, 0.230, 0.234, 0.238, - & 0.242, 0.246, 0.250, 0.254, 0.258, 0.262, 0.266, 0.270, 0.274, - & 0.278, 0.282, 0.286, 0.290, 0.294, 0.298, 0.302, 0.306, 0.310, - & 0.314, 0.318, 0.321, 0.325, 0.329, 0.333, 0.337, 0.341, 0.345, - & 0.349, 0.353, 0.356, 0.360, 0.364, 0.368, 0.372, 0.376, 0.380, - & 0.383, 0.387, 0.391, 0.395, 0.399, 0.403, 0.406, 0.410, 0.414, - & 0.418, 0.422, 0.425, 0.429, 0.433, 0.437, 0.440, 0.444, 0.448, - & 0.452, 0.455, 0.459, 0.463, 0.467, 0.470, 0.474, 0.478, 0.482, - & 0.485, 0.489, 0.493, 0.496, 0.500, 0.504, 0.507, 0.511, 0.515, - & 0.518, 0.522, 0.526, 0.529, 0.533, 0.537, 0.540, 0.544, 0.548, - & 0.551, 0.555, 0.558, 0.562, 0.566, 0.569, 0.573, 0.576, 0.580, - & 0.584, 0.587, 0.591, 0.594, 0.598, 0.601, 0.605, 0.609, 0.612, - & 0.616, 0.619, 0.623, 0.626, 0.630, 0.633, 0.637, 0.640, 0.644, - & 0.647, 0.651, 0.654, 0.658, 0.661, 0.665, 0.668, 0.672, 0.675, - & 0.678, 0.682, 0.685, 0.689, 0.692, 0.696, 0.699, 0.703, 0.706, - & 0.709, 0.713, 0.716, 0.720, 0.723, 0.726, 0.730, 0.733, 0.737, - & 0.740, 0.743, 0.747, 0.750, 0.753, 0.757, 0.760, 0.763, 0.767, - & 0.770, 0.773, 0.777, 0.780, 0.783, 0.787, 0.790, 0.793, 0.797, - & 0.800, 0.803, 0.807, 0.810, 0.813, 0.816, 0.820, 0.823, 0.826, - & 0.829, 0.833, 0.836, 0.839, 0.842, 0.846, 0.849, 0.852, 0.855, - & 0.859, 0.862, 0.865, 0.868, 0.871, 0.875, 0.878, 0.881, 0.884, - & 0.887, 0.891, 0.894, 0.897, 0.900, 0.903, 0.906, 0.910, 0.913, - & 0.916, 0.919, 0.922, 0.925, 0.928, 0.932, 0.935, 0.938, 0.941, - & 0.944, 0.947, 0.950, 0.953, 0.957, 0.960, 0.963, 0.966, 0.969, - & 0.972, 0.975, 0.978, 0.981, 1.014, 1.044, 1.074, 1.103, 1.132, - & 1.161, 1.189, 1.218, 1.245, 1.273, 1.300, 1.327, 1.353, 1.380, - & 1.406, 1.431, 1.457, 1.482, 1.507, 1.532, 1.556, 1.580, 1.604, - & 1.628, 1.652, 1.675, 1.698, 1.721, 1.744, 1.766, 1.788, 1.811, - & 1.832, 1.854, 1.876, 1.897, 1.918, 1.939, 1.960, 1.981, 2.001, - & 2.022, 2.042, 2.062, 2.082, 2.101, 2.121, 2.140, 2.160, 2.179, - & 2.198, 2.217, 2.235, 2.254, 2.273, 2.291, 2.309, 2.327, 2.345, - & 2.363, 2.381, 2.398, 2.416, 2.433, 2.451, 2.468, 2.485, 2.502, - & 2.519, 2.535, 2.552, 2.569, 2.585, 2.601, 2.618, 2.634, 2.650, - & 2.666, 2.682, 2.698, 2.713, 2.729, 2.745, 2.760, 2.775, 2.791, - & 2.806, 2.821, 2.836, 2.851, 2.866, 2.881, 2.895, 2.910, 2.925, - & 2.939, 2.954, 2.968, 2.982, 2.997, 3.011, 3.025, 3.039, 3.053, - & 3.067, 3.081, 3.094, 3.108, 3.122, 3.135, 3.149, 3.162, 3.176, - & 3.189, 3.202, 3.216, 3.229, 3.242, 3.255, 3.268, 3.281, 3.294, - & 3.307, 3.319, 3.332, 3.345, 3.357, 3.370, 3.383, 3.395, 3.407, - & 3.420, 3.432, 3.444, 3.457, 3.469, 3.481, 3.493, 3.505, 3.517, - & 3.529, 3.541, 3.553, 3.565, 3.577, 3.588, 3.600, 3.612, 3.623, - & 3.635, 3.646, 3.658, 3.669, 3.681, 3.692, 3.704, 3.715, 3.726, - & 3.737, 3.748, 3.760 - & / -C -C *** K2SO4 -C - DATA BNC17M/ - &-0.091,-0.197,-0.249,-0.286,-0.315,-0.339,-0.359,-0.377,-0.392, - &-0.406,-0.419,-0.431,-0.442,-0.452,-0.461,-0.470,-0.478,-0.486, - &-0.493,-0.500,-0.507,-0.513,-0.519,-0.525,-0.530,-0.535,-0.540, - &-0.545,-0.550,-0.554,-0.559,-0.563,-0.567,-0.571,-0.575,-0.579, - &-0.582,-0.586,-0.589,-0.592,-0.596,-0.599,-0.602,-0.605,-0.608, - &-0.611,-0.613,-0.616,-0.619,-0.621,-0.624,-0.626,-0.628,-0.631, - &-0.633,-0.635,-0.637,-0.640,-0.642,-0.644,-0.646,-0.648,-0.650, - &-0.652,-0.653,-0.655,-0.657,-0.659,-0.661,-0.662,-0.664,-0.666, - &-0.667,-0.669,-0.670,-0.672,-0.673,-0.675,-0.676,-0.678,-0.679, - &-0.681,-0.682,-0.683,-0.685,-0.686,-0.687,-0.689,-0.690,-0.691, - &-0.693,-0.694,-0.695,-0.696,-0.697,-0.699,-0.700,-0.701,-0.702, - &-0.703,-0.704,-0.705,-0.707,-0.708,-0.709,-0.710,-0.711,-0.712, - &-0.713,-0.714,-0.715,-0.716,-0.717,-0.718,-0.719,-0.720,-0.721, - &-0.722,-0.723,-0.724,-0.724,-0.725,-0.726,-0.727,-0.728,-0.729, - &-0.730,-0.731,-0.731,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736, - &-0.737,-0.738,-0.738,-0.739,-0.740,-0.741,-0.741,-0.742,-0.743, - &-0.744,-0.744,-0.745,-0.746,-0.746,-0.747,-0.748,-0.748,-0.749, - &-0.750,-0.750,-0.751,-0.752,-0.752,-0.753,-0.754,-0.754,-0.755, - &-0.755,-0.756,-0.757,-0.757,-0.758,-0.758,-0.759,-0.759,-0.760, - &-0.761,-0.761,-0.762,-0.762,-0.763,-0.763,-0.764,-0.764,-0.765, - &-0.765,-0.766,-0.766,-0.767,-0.767,-0.768,-0.768,-0.769,-0.769, - &-0.770,-0.770,-0.771,-0.771,-0.772,-0.772,-0.772,-0.773,-0.773, - &-0.774,-0.774,-0.775,-0.775,-0.776,-0.776,-0.776,-0.777,-0.777, - &-0.778,-0.778,-0.778,-0.779,-0.779,-0.780,-0.780,-0.780,-0.781, - &-0.781,-0.781,-0.782,-0.782,-0.783,-0.783,-0.783,-0.784,-0.784, - &-0.784,-0.785,-0.785,-0.785,-0.786,-0.786,-0.786,-0.787,-0.787, - &-0.787,-0.788,-0.788,-0.788,-0.789,-0.789,-0.789,-0.790,-0.790, - &-0.790,-0.790,-0.791,-0.791,-0.791,-0.792,-0.792,-0.792,-0.793, - &-0.793,-0.793,-0.793,-0.794,-0.794,-0.794,-0.794,-0.795,-0.795, - &-0.795,-0.795,-0.796,-0.796,-0.796,-0.796,-0.797,-0.797,-0.797, - &-0.797,-0.798,-0.798,-0.798,-0.798,-0.799,-0.799,-0.799,-0.799, - &-0.800,-0.800,-0.800,-0.800,-0.800,-0.801,-0.801,-0.801,-0.801, - &-0.801,-0.802,-0.802,-0.802,-0.802,-0.802,-0.803,-0.803,-0.803, - &-0.803,-0.803,-0.804,-0.804,-0.804,-0.804,-0.804,-0.804,-0.805, - &-0.805,-0.805,-0.805,-0.805,-0.806,-0.806,-0.806,-0.806,-0.806, - &-0.806,-0.806,-0.807,-0.807,-0.807,-0.807,-0.807,-0.807,-0.808, - &-0.808,-0.808,-0.808,-0.808,-0.808,-0.808,-0.809,-0.809,-0.809, - &-0.809,-0.809,-0.809,-0.809,-0.810,-0.810,-0.810,-0.810,-0.810, - &-0.810,-0.810,-0.810,-0.810,-0.811,-0.811,-0.811,-0.811,-0.811, - &-0.811,-0.811,-0.811,-0.812,-0.812,-0.812,-0.812,-0.812,-0.812, - &-0.812,-0.812,-0.812,-0.812,-0.813,-0.813,-0.813,-0.813,-0.813, - &-0.813,-0.813,-0.813,-0.813,-0.813,-0.813,-0.814,-0.814,-0.814, - &-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814, - &-0.814,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815, - &-0.815,-0.815,-0.815,-0.815,-0.816,-0.816,-0.817,-0.817,-0.817, - &-0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.816,-0.816, - &-0.816,-0.815,-0.815,-0.814,-0.813,-0.813,-0.812,-0.811,-0.811, - &-0.810,-0.809,-0.808,-0.807,-0.806,-0.805,-0.804,-0.803,-0.802, - &-0.801,-0.800,-0.799,-0.797,-0.796,-0.795,-0.794,-0.792,-0.791, - &-0.790,-0.788,-0.787,-0.786,-0.784,-0.783,-0.781,-0.780,-0.778, - &-0.777,-0.775,-0.774,-0.772,-0.771,-0.769,-0.767,-0.766,-0.764, - &-0.762,-0.761,-0.759,-0.757,-0.756,-0.754,-0.752,-0.750,-0.749, - &-0.747,-0.745,-0.743,-0.741,-0.740,-0.738,-0.736,-0.734,-0.732, - &-0.730,-0.728,-0.727,-0.725,-0.723,-0.721,-0.719,-0.717,-0.715, - &-0.713,-0.711,-0.709,-0.707,-0.705,-0.703,-0.701,-0.699,-0.697, - &-0.695,-0.693,-0.691,-0.689,-0.687,-0.685,-0.683,-0.681,-0.678, - &-0.676,-0.674,-0.672,-0.670,-0.668,-0.666,-0.664,-0.661,-0.659, - &-0.657,-0.655,-0.653,-0.651,-0.648,-0.646,-0.644,-0.642,-0.640, - &-0.638,-0.635,-0.633,-0.631,-0.629,-0.626,-0.624,-0.622,-0.620, - &-0.618,-0.615,-0.613,-0.611,-0.609,-0.606,-0.604,-0.602,-0.599, - &-0.597,-0.595,-0.593,-0.590,-0.588,-0.586,-0.583,-0.581,-0.579, - &-0.577,-0.574,-0.572,-0.570,-0.567,-0.565,-0.563,-0.560,-0.558, - &-0.556,-0.553,-0.551 - & / -C -C *** KHSO4 -C - DATA BNC18M/ - &-0.045,-0.094,-0.118,-0.134,-0.147,-0.156,-0.165,-0.171,-0.177, - &-0.182,-0.187,-0.191,-0.195,-0.198,-0.200,-0.203,-0.205,-0.207, - &-0.209,-0.210,-0.212,-0.213,-0.214,-0.215,-0.215,-0.216,-0.216, - &-0.216,-0.217,-0.217,-0.217,-0.217,-0.216,-0.216,-0.216,-0.215, - &-0.214,-0.214,-0.213,-0.212,-0.211,-0.210,-0.209,-0.208,-0.207, - &-0.206,-0.205,-0.204,-0.202,-0.201,-0.199,-0.198,-0.196,-0.195, - &-0.193,-0.191,-0.190,-0.188,-0.186,-0.184,-0.183,-0.181,-0.179, - &-0.177,-0.175,-0.173,-0.171,-0.169,-0.167,-0.165,-0.163,-0.160, - &-0.158,-0.156,-0.154,-0.152,-0.149,-0.147,-0.145,-0.142,-0.140, - &-0.137,-0.135,-0.133,-0.130,-0.128,-0.125,-0.123,-0.120,-0.117, - &-0.115,-0.112,-0.109,-0.107,-0.104,-0.101,-0.099,-0.096,-0.093, - &-0.090,-0.088,-0.085,-0.082,-0.079,-0.076,-0.074,-0.071,-0.068, - &-0.065,-0.062,-0.059,-0.056,-0.053,-0.050,-0.047,-0.044,-0.042, - &-0.039,-0.036,-0.033,-0.030,-0.027,-0.024,-0.021,-0.018,-0.015, - &-0.012,-0.009,-0.006,-0.003, 0.000, 0.003, 0.006, 0.009, 0.012, - & 0.015, 0.018, 0.020, 0.023, 0.026, 0.029, 0.032, 0.035, 0.038, - & 0.041, 0.044, 0.047, 0.050, 0.053, 0.055, 0.058, 0.061, 0.064, - & 0.067, 0.070, 0.073, 0.076, 0.078, 0.081, 0.084, 0.087, 0.090, - & 0.093, 0.095, 0.098, 0.101, 0.104, 0.107, 0.109, 0.112, 0.115, - & 0.118, 0.121, 0.123, 0.126, 0.129, 0.132, 0.134, 0.137, 0.140, - & 0.143, 0.145, 0.148, 0.151, 0.153, 0.156, 0.159, 0.162, 0.164, - & 0.167, 0.170, 0.172, 0.175, 0.178, 0.180, 0.183, 0.186, 0.188, - & 0.191, 0.193, 0.196, 0.199, 0.201, 0.204, 0.206, 0.209, 0.212, - & 0.214, 0.217, 0.219, 0.222, 0.225, 0.227, 0.230, 0.232, 0.235, - & 0.237, 0.240, 0.242, 0.245, 0.247, 0.250, 0.252, 0.255, 0.257, - & 0.260, 0.262, 0.265, 0.267, 0.270, 0.272, 0.275, 0.277, 0.280, - & 0.282, 0.285, 0.287, 0.289, 0.292, 0.294, 0.297, 0.299, 0.302, - & 0.304, 0.306, 0.309, 0.311, 0.314, 0.316, 0.318, 0.321, 0.323, - & 0.325, 0.328, 0.330, 0.333, 0.335, 0.337, 0.340, 0.342, 0.344, - & 0.347, 0.349, 0.351, 0.354, 0.356, 0.358, 0.360, 0.363, 0.365, - & 0.367, 0.370, 0.372, 0.374, 0.376, 0.379, 0.381, 0.383, 0.386, - & 0.388, 0.390, 0.392, 0.395, 0.397, 0.399, 0.401, 0.403, 0.406, - & 0.408, 0.410, 0.412, 0.415, 0.417, 0.419, 0.421, 0.423, 0.425, - & 0.428, 0.430, 0.432, 0.434, 0.436, 0.439, 0.441, 0.443, 0.445, - & 0.447, 0.449, 0.451, 0.454, 0.456, 0.458, 0.460, 0.462, 0.464, - & 0.466, 0.468, 0.471, 0.473, 0.475, 0.477, 0.479, 0.481, 0.483, - & 0.485, 0.487, 0.489, 0.491, 0.494, 0.496, 0.498, 0.500, 0.502, - & 0.504, 0.506, 0.508, 0.510, 0.512, 0.514, 0.516, 0.518, 0.520, - & 0.522, 0.524, 0.526, 0.528, 0.530, 0.532, 0.534, 0.536, 0.538, - & 0.540, 0.542, 0.544, 0.546, 0.548, 0.550, 0.552, 0.554, 0.556, - & 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, 0.570, 0.572, 0.574, - & 0.576, 0.578, 0.580, 0.582, 0.584, 0.585, 0.587, 0.589, 0.591, - & 0.593, 0.595, 0.597, 0.599, 0.601, 0.603, 0.605, 0.607, 0.608, - & 0.610, 0.612, 0.614, 0.616, 0.618, 0.620, 0.622, 0.623, 0.625, - & 0.627, 0.629, 0.631, 0.633, 0.653, 0.671, 0.689, 0.707, 0.724, - & 0.741, 0.758, 0.775, 0.792, 0.808, 0.824, 0.840, 0.856, 0.872, - & 0.887, 0.903, 0.918, 0.933, 0.947, 0.962, 0.977, 0.991, 1.005, - & 1.019, 1.033, 1.047, 1.060, 1.074, 1.087, 1.101, 1.114, 1.127, - & 1.140, 1.152, 1.165, 1.178, 1.190, 1.202, 1.215, 1.227, 1.239, - & 1.251, 1.262, 1.274, 1.286, 1.297, 1.309, 1.320, 1.332, 1.343, - & 1.354, 1.365, 1.376, 1.387, 1.397, 1.408, 1.419, 1.429, 1.440, - & 1.450, 1.461, 1.471, 1.481, 1.491, 1.501, 1.511, 1.521, 1.531, - & 1.541, 1.551, 1.561, 1.570, 1.580, 1.589, 1.599, 1.608, 1.617, - & 1.627, 1.636, 1.645, 1.654, 1.663, 1.672, 1.681, 1.690, 1.699, - & 1.708, 1.717, 1.726, 1.734, 1.743, 1.751, 1.760, 1.768, 1.777, - & 1.785, 1.794, 1.802, 1.810, 1.819, 1.827, 1.835, 1.843, 1.851, - & 1.859, 1.867, 1.875, 1.883, 1.891, 1.899, 1.907, 1.915, 1.922, - & 1.930, 1.938, 1.945, 1.953, 1.960, 1.968, 1.976, 1.983, 1.990, - & 1.998, 2.005, 2.013, 2.020, 2.027, 2.034, 2.042, 2.049, 2.056, - & 2.063, 2.070, 2.077, 2.084, 2.091, 2.098, 2.105, 2.112, 2.119, - & 2.126, 2.133, 2.140, 2.147, 2.154, 2.160, 2.167, 2.174, 2.180, - & 2.187, 2.194, 2.200, 2.207, 2.213, 2.220, 2.227, 2.233, 2.240, - & 2.246, 2.252, 2.259 - & / -C -C *** KNO3 -C - DATA BNC19M/ - &-0.046,-0.105,-0.136,-0.159,-0.178,-0.194,-0.208,-0.221,-0.233, - &-0.244,-0.255,-0.265,-0.274,-0.283,-0.291,-0.299,-0.307,-0.315, - &-0.322,-0.329,-0.336,-0.342,-0.349,-0.355,-0.361,-0.367,-0.373, - &-0.379,-0.384,-0.390,-0.395,-0.400,-0.405,-0.410,-0.415,-0.420, - &-0.425,-0.430,-0.434,-0.439,-0.443,-0.447,-0.452,-0.456,-0.460, - &-0.464,-0.468,-0.472,-0.476,-0.480,-0.483,-0.487,-0.491,-0.494, - &-0.498,-0.501,-0.505,-0.508,-0.511,-0.515,-0.518,-0.521,-0.524, - &-0.528,-0.531,-0.534,-0.537,-0.540,-0.543,-0.546,-0.549,-0.552, - &-0.555,-0.557,-0.560,-0.563,-0.566,-0.569,-0.571,-0.574,-0.577, - &-0.580,-0.582,-0.585,-0.588,-0.590,-0.593,-0.596,-0.598,-0.601, - &-0.604,-0.606,-0.609,-0.611,-0.614,-0.616,-0.619,-0.622,-0.624, - &-0.627,-0.629,-0.632,-0.634,-0.637,-0.639,-0.641,-0.644,-0.646, - &-0.649,-0.651,-0.654,-0.656,-0.658,-0.661,-0.663,-0.666,-0.668, - &-0.670,-0.673,-0.675,-0.677,-0.679,-0.682,-0.684,-0.686,-0.688, - &-0.691,-0.693,-0.695,-0.697,-0.699,-0.702,-0.704,-0.706,-0.708, - &-0.710,-0.712,-0.714,-0.716,-0.718,-0.721,-0.723,-0.725,-0.727, - &-0.729,-0.731,-0.733,-0.735,-0.737,-0.739,-0.740,-0.742,-0.744, - &-0.746,-0.748,-0.750,-0.752,-0.754,-0.756,-0.757,-0.759,-0.761, - &-0.763,-0.765,-0.767,-0.768,-0.770,-0.772,-0.774,-0.775,-0.777, - &-0.779,-0.780,-0.782,-0.784,-0.786,-0.787,-0.789,-0.791,-0.792, - &-0.794,-0.796,-0.797,-0.799,-0.800,-0.802,-0.804,-0.805,-0.807, - &-0.808,-0.810,-0.811,-0.813,-0.814,-0.816,-0.817,-0.819,-0.820, - &-0.822,-0.823,-0.825,-0.826,-0.828,-0.829,-0.831,-0.832,-0.834, - &-0.835,-0.836,-0.838,-0.839,-0.841,-0.842,-0.843,-0.845,-0.846, - &-0.847,-0.849,-0.850,-0.851,-0.853,-0.854,-0.855,-0.857,-0.858, - &-0.859,-0.861,-0.862,-0.863,-0.864,-0.866,-0.867,-0.868,-0.869, - &-0.871,-0.872,-0.873,-0.874,-0.875,-0.877,-0.878,-0.879,-0.880, - &-0.881,-0.882,-0.884,-0.885,-0.886,-0.887,-0.888,-0.889,-0.890, - &-0.892,-0.893,-0.894,-0.895,-0.896,-0.897,-0.898,-0.899,-0.900, - &-0.901,-0.902,-0.904,-0.905,-0.906,-0.907,-0.908,-0.909,-0.910, - &-0.911,-0.912,-0.913,-0.914,-0.915,-0.916,-0.917,-0.918,-0.919, - &-0.920,-0.921,-0.922,-0.923,-0.924,-0.925,-0.926,-0.926,-0.927, - &-0.928,-0.929,-0.930,-0.931,-0.932,-0.933,-0.934,-0.935,-0.936, - &-0.936,-0.937,-0.938,-0.939,-0.940,-0.941,-0.942,-0.943,-0.943, - &-0.944,-0.945,-0.946,-0.947,-0.948,-0.948,-0.949,-0.950,-0.951, - &-0.952,-0.953,-0.953,-0.954,-0.955,-0.956,-0.957,-0.957,-0.958, - &-0.959,-0.960,-0.960,-0.961,-0.962,-0.963,-0.963,-0.964,-0.965, - &-0.966,-0.966,-0.967,-0.968,-0.969,-0.969,-0.970,-0.971,-0.971, - &-0.972,-0.973,-0.974,-0.974,-0.975,-0.976,-0.976,-0.977,-0.978, - &-0.978,-0.979,-0.980,-0.980,-0.981,-0.982,-0.982,-0.983,-0.984, - &-0.984,-0.985,-0.986,-0.986,-0.987,-0.988,-0.988,-0.989,-0.989, - &-0.990,-0.991,-0.991,-0.992,-0.992,-0.993,-0.994,-0.994,-0.995, - &-0.995,-0.996,-0.997,-0.997,-0.998,-0.998,-0.999,-1.000,-1.000, - &-1.001,-1.001,-1.002,-1.002,-1.003,-1.003,-1.004,-1.005,-1.005, - &-1.006,-1.006,-1.007,-1.007,-1.013,-1.018,-1.022,-1.027,-1.031, - &-1.035,-1.039,-1.042,-1.046,-1.049,-1.052,-1.055,-1.058,-1.060, - &-1.063,-1.065,-1.067,-1.069,-1.071,-1.073,-1.075,-1.076,-1.078, - &-1.079,-1.081,-1.082,-1.083,-1.084,-1.085,-1.086,-1.087,-1.088, - &-1.088,-1.089,-1.089,-1.090,-1.090,-1.091,-1.091,-1.091,-1.092, - &-1.092,-1.092,-1.092,-1.092,-1.092,-1.092,-1.092,-1.092,-1.092, - &-1.092,-1.091,-1.091,-1.091,-1.091,-1.090,-1.090,-1.090,-1.089, - &-1.089,-1.088,-1.088,-1.087,-1.087,-1.086,-1.085,-1.085,-1.084, - &-1.084,-1.083,-1.082,-1.082,-1.081,-1.080,-1.079,-1.079,-1.078, - &-1.077,-1.076,-1.075,-1.074,-1.074,-1.073,-1.072,-1.071,-1.070, - &-1.069,-1.068,-1.067,-1.066,-1.065,-1.064,-1.063,-1.062,-1.061, - &-1.060,-1.059,-1.058,-1.057,-1.056,-1.055,-1.054,-1.053,-1.052, - &-1.051,-1.050,-1.049,-1.047,-1.046,-1.045,-1.044,-1.043,-1.042, - &-1.041,-1.040,-1.038,-1.037,-1.036,-1.035,-1.034,-1.032,-1.031, - &-1.030,-1.029,-1.028,-1.026,-1.025,-1.024,-1.023,-1.022,-1.020, - &-1.019,-1.018,-1.017,-1.015,-1.014,-1.013,-1.012,-1.010,-1.009, - &-1.008,-1.007,-1.005,-1.004,-1.003,-1.001,-1.000,-0.999,-0.998, - &-0.996,-0.995,-0.994,-0.992,-0.991,-0.990,-0.989,-0.987,-0.986, - &-0.985,-0.983,-0.982 - & / -C -C *** KCL -C - DATA BNC20M/ - &-0.045,-0.095,-0.119,-0.136,-0.148,-0.158,-0.166,-0.173,-0.179, - &-0.184,-0.189,-0.193,-0.197,-0.200,-0.203,-0.206,-0.208,-0.210, - &-0.212,-0.214,-0.216,-0.217,-0.219,-0.220,-0.221,-0.222,-0.223, - &-0.224,-0.225,-0.226,-0.227,-0.227,-0.228,-0.229,-0.229,-0.229, - &-0.230,-0.230,-0.231,-0.231,-0.231,-0.231,-0.232,-0.232,-0.232, - &-0.232,-0.232,-0.232,-0.232,-0.232,-0.233,-0.233,-0.233,-0.232, - &-0.232,-0.232,-0.232,-0.232,-0.232,-0.232,-0.232,-0.232,-0.232, - &-0.232,-0.231,-0.231,-0.231,-0.231,-0.231,-0.230,-0.230,-0.230, - &-0.230,-0.229,-0.229,-0.229,-0.229,-0.228,-0.228,-0.228,-0.227, - &-0.227,-0.227,-0.226,-0.226,-0.226,-0.225,-0.225,-0.224,-0.224, - &-0.224,-0.223,-0.223,-0.222,-0.222,-0.221,-0.221,-0.220,-0.220, - &-0.219,-0.219,-0.218,-0.218,-0.217,-0.217,-0.216,-0.216,-0.215, - &-0.215,-0.214,-0.213,-0.213,-0.212,-0.212,-0.211,-0.211,-0.210, - &-0.209,-0.209,-0.208,-0.208,-0.207,-0.206,-0.206,-0.205,-0.205, - &-0.204,-0.203,-0.203,-0.202,-0.201,-0.201,-0.200,-0.200,-0.199, - &-0.198,-0.198,-0.197,-0.196,-0.196,-0.195,-0.194,-0.194,-0.193, - &-0.192,-0.192,-0.191,-0.191,-0.190,-0.189,-0.189,-0.188,-0.187, - &-0.187,-0.186,-0.185,-0.185,-0.184,-0.183,-0.183,-0.182,-0.181, - &-0.181,-0.180,-0.179,-0.179,-0.178,-0.177,-0.177,-0.176,-0.175, - &-0.175,-0.174,-0.173,-0.173,-0.172,-0.171,-0.171,-0.170,-0.169, - &-0.169,-0.168,-0.167,-0.167,-0.166,-0.165,-0.165,-0.164,-0.163, - &-0.163,-0.162,-0.161,-0.161,-0.160,-0.159,-0.159,-0.158,-0.157, - &-0.157,-0.156,-0.155,-0.155,-0.154,-0.153,-0.153,-0.152,-0.151, - &-0.151,-0.150,-0.149,-0.149,-0.148,-0.147,-0.147,-0.146,-0.145, - &-0.145,-0.144,-0.143,-0.143,-0.142,-0.141,-0.141,-0.140,-0.140, - &-0.139,-0.138,-0.138,-0.137,-0.136,-0.136,-0.135,-0.134,-0.134, - &-0.133,-0.132,-0.132,-0.131,-0.130,-0.130,-0.129,-0.128,-0.128, - &-0.127,-0.126,-0.126,-0.125,-0.124,-0.124,-0.123,-0.122,-0.122, - &-0.121,-0.120,-0.120,-0.119,-0.119,-0.118,-0.117,-0.117,-0.116, - &-0.115,-0.115,-0.114,-0.113,-0.113,-0.112,-0.111,-0.111,-0.110, - &-0.109,-0.109,-0.108,-0.108,-0.107,-0.106,-0.106,-0.105,-0.104, - &-0.104,-0.103,-0.102,-0.102,-0.101,-0.100,-0.100,-0.099,-0.099, - &-0.098,-0.097,-0.097,-0.096,-0.095,-0.095,-0.094,-0.093,-0.093, - &-0.092,-0.092,-0.091,-0.090,-0.090,-0.089,-0.088,-0.088,-0.087, - &-0.087,-0.086,-0.085,-0.085,-0.084,-0.083,-0.083,-0.082,-0.082, - &-0.081,-0.080,-0.080,-0.079,-0.078,-0.078,-0.077,-0.077,-0.076, - &-0.075,-0.075,-0.074,-0.073,-0.073,-0.072,-0.072,-0.071,-0.070, - &-0.070,-0.069,-0.069,-0.068,-0.067,-0.067,-0.066,-0.065,-0.065, - &-0.064,-0.064,-0.063,-0.062,-0.062,-0.061,-0.061,-0.060,-0.059, - &-0.059,-0.058,-0.058,-0.057,-0.056,-0.056,-0.055,-0.055,-0.054, - &-0.053,-0.053,-0.052,-0.051,-0.051,-0.050,-0.050,-0.049,-0.048, - &-0.048,-0.047,-0.047,-0.046,-0.046,-0.045,-0.044,-0.044,-0.043, - &-0.043,-0.042,-0.041,-0.041,-0.040,-0.040,-0.039,-0.038,-0.038, - &-0.037,-0.037,-0.036,-0.035,-0.035,-0.034,-0.034,-0.033,-0.032, - &-0.032,-0.031,-0.031,-0.030,-0.024,-0.018,-0.012,-0.007,-0.001, - & 0.005, 0.010, 0.016, 0.021, 0.027, 0.032, 0.037, 0.043, 0.048, - & 0.053, 0.058, 0.064, 0.069, 0.074, 0.079, 0.084, 0.089, 0.094, - & 0.099, 0.104, 0.109, 0.113, 0.118, 0.123, 0.128, 0.132, 0.137, - & 0.142, 0.146, 0.151, 0.156, 0.160, 0.165, 0.169, 0.174, 0.178, - & 0.183, 0.187, 0.191, 0.196, 0.200, 0.205, 0.209, 0.213, 0.217, - & 0.222, 0.226, 0.230, 0.234, 0.238, 0.242, 0.247, 0.251, 0.255, - & 0.259, 0.263, 0.267, 0.271, 0.275, 0.279, 0.283, 0.287, 0.291, - & 0.295, 0.298, 0.302, 0.306, 0.310, 0.314, 0.318, 0.321, 0.325, - & 0.329, 0.333, 0.337, 0.340, 0.344, 0.348, 0.351, 0.355, 0.359, - & 0.362, 0.366, 0.370, 0.373, 0.377, 0.380, 0.384, 0.387, 0.391, - & 0.394, 0.398, 0.401, 0.405, 0.408, 0.412, 0.415, 0.419, 0.422, - & 0.426, 0.429, 0.433, 0.436, 0.439, 0.443, 0.446, 0.449, 0.453, - & 0.456, 0.459, 0.463, 0.466, 0.469, 0.473, 0.476, 0.479, 0.482, - & 0.486, 0.489, 0.492, 0.495, 0.499, 0.502, 0.505, 0.508, 0.511, - & 0.514, 0.518, 0.521, 0.524, 0.527, 0.530, 0.533, 0.536, 0.540, - & 0.543, 0.546, 0.549, 0.552, 0.555, 0.558, 0.561, 0.564, 0.567, - & 0.570, 0.573, 0.576, 0.579, 0.582, 0.585, 0.588, 0.591, 0.594, - & 0.597, 0.600, 0.603 - & / -C -C *** MGSO4 -C - DATA BNC21M/ - &-0.181,-0.389,-0.491,-0.562,-0.617,-0.661,-0.699,-0.732,-0.760, - &-0.786,-0.809,-0.829,-0.849,-0.866,-0.882,-0.897,-0.911,-0.924, - &-0.937,-0.948,-0.959,-0.969,-0.979,-0.988,-0.997,-1.006,-1.014, - &-1.021,-1.028,-1.035,-1.042,-1.048,-1.055,-1.061,-1.066,-1.072, - &-1.077,-1.082,-1.087,-1.092,-1.096,-1.100,-1.105,-1.109,-1.113, - &-1.117,-1.120,-1.124,-1.128,-1.131,-1.134,-1.137,-1.141,-1.144, - &-1.146,-1.149,-1.152,-1.155,-1.157,-1.160,-1.162,-1.165,-1.167, - &-1.169,-1.172,-1.174,-1.176,-1.178,-1.180,-1.182,-1.184,-1.186, - &-1.187,-1.189,-1.191,-1.192,-1.194,-1.196,-1.197,-1.199,-1.200, - &-1.202,-1.203,-1.204,-1.206,-1.207,-1.208,-1.209,-1.210,-1.211, - &-1.213,-1.214,-1.215,-1.216,-1.217,-1.218,-1.218,-1.219,-1.220, - &-1.221,-1.222,-1.223,-1.223,-1.224,-1.225,-1.225,-1.226,-1.227, - &-1.227,-1.228,-1.229,-1.229,-1.230,-1.230,-1.231,-1.231,-1.232, - &-1.232,-1.233,-1.233,-1.233,-1.234,-1.234,-1.235,-1.235,-1.235, - &-1.236,-1.236,-1.236,-1.236,-1.237,-1.237,-1.237,-1.237,-1.238, - &-1.238,-1.238,-1.238,-1.238,-1.239,-1.239,-1.239,-1.239,-1.239, - &-1.239,-1.239,-1.239,-1.239,-1.239,-1.240,-1.240,-1.240,-1.240, - &-1.240,-1.240,-1.240,-1.240,-1.240,-1.240,-1.240,-1.240,-1.240, - &-1.239,-1.239,-1.239,-1.239,-1.239,-1.239,-1.239,-1.239,-1.239, - &-1.239,-1.239,-1.238,-1.238,-1.238,-1.238,-1.238,-1.238,-1.238, - &-1.237,-1.237,-1.237,-1.237,-1.237,-1.237,-1.236,-1.236,-1.236, - &-1.236,-1.235,-1.235,-1.235,-1.235,-1.235,-1.234,-1.234,-1.234, - &-1.233,-1.233,-1.233,-1.233,-1.232,-1.232,-1.232,-1.232,-1.231, - &-1.231,-1.231,-1.230,-1.230,-1.230,-1.229,-1.229,-1.229,-1.228, - &-1.228,-1.228,-1.227,-1.227,-1.227,-1.226,-1.226,-1.226,-1.225, - &-1.225,-1.225,-1.224,-1.224,-1.223,-1.223,-1.223,-1.222,-1.222, - &-1.222,-1.221,-1.221,-1.220,-1.220,-1.220,-1.219,-1.219,-1.218, - &-1.218,-1.217,-1.217,-1.217,-1.216,-1.216,-1.215,-1.215,-1.214, - &-1.214,-1.214,-1.213,-1.213,-1.212,-1.212,-1.211,-1.211,-1.210, - &-1.210,-1.210,-1.209,-1.209,-1.208,-1.208,-1.207,-1.207,-1.206, - &-1.206,-1.205,-1.205,-1.204,-1.204,-1.203,-1.203,-1.202,-1.202, - &-1.201,-1.201,-1.200,-1.200,-1.199,-1.199,-1.198,-1.198,-1.197, - &-1.197,-1.196,-1.196,-1.195,-1.195,-1.194,-1.194,-1.193,-1.193, - &-1.192,-1.192,-1.191,-1.191,-1.190,-1.190,-1.189,-1.188,-1.188, - &-1.187,-1.187,-1.186,-1.186,-1.185,-1.185,-1.184,-1.184,-1.183, - &-1.182,-1.182,-1.181,-1.181,-1.180,-1.180,-1.179,-1.179,-1.178, - &-1.177,-1.177,-1.176,-1.176,-1.175,-1.175,-1.174,-1.174,-1.173, - &-1.172,-1.172,-1.171,-1.171,-1.170,-1.169,-1.169,-1.168,-1.168, - &-1.167,-1.167,-1.166,-1.165,-1.165,-1.164,-1.164,-1.163,-1.163, - &-1.162,-1.161,-1.161,-1.160,-1.160,-1.159,-1.158,-1.158,-1.157, - &-1.157,-1.156,-1.155,-1.155,-1.154,-1.154,-1.153,-1.152,-1.152, - &-1.151,-1.151,-1.150,-1.149,-1.149,-1.148,-1.148,-1.147,-1.146, - &-1.146,-1.145,-1.144,-1.144,-1.143,-1.143,-1.142,-1.141,-1.141, - &-1.140,-1.140,-1.139,-1.138,-1.138,-1.137,-1.136,-1.136,-1.135, - &-1.135,-1.134,-1.133,-1.133,-1.126,-1.120,-1.113,-1.107,-1.100, - &-1.094,-1.087,-1.080,-1.074,-1.067,-1.060,-1.054,-1.047,-1.040, - &-1.033,-1.027,-1.020,-1.013,-1.006,-0.999,-0.992,-0.985,-0.978, - &-0.971,-0.965,-0.958,-0.951,-0.944,-0.937,-0.930,-0.923,-0.916, - &-0.909,-0.902,-0.895,-0.888,-0.881,-0.874,-0.867,-0.860,-0.853, - &-0.846,-0.839,-0.832,-0.825,-0.818,-0.811,-0.804,-0.797,-0.790, - &-0.783,-0.776,-0.769,-0.762,-0.755,-0.748,-0.741,-0.734,-0.727, - &-0.720,-0.713,-0.706,-0.699,-0.692,-0.685,-0.678,-0.671,-0.664, - &-0.657,-0.650,-0.644,-0.637,-0.630,-0.623,-0.616,-0.609,-0.602, - &-0.595,-0.588,-0.581,-0.574,-0.567,-0.560,-0.554,-0.547,-0.540, - &-0.533,-0.526,-0.519,-0.512,-0.505,-0.498,-0.492,-0.485,-0.478, - &-0.471,-0.464,-0.457,-0.450,-0.444,-0.437,-0.430,-0.423,-0.416, - &-0.409,-0.403,-0.396,-0.389,-0.382,-0.375,-0.369,-0.362,-0.355, - &-0.348,-0.341,-0.335,-0.328,-0.321,-0.314,-0.308,-0.301,-0.294, - &-0.287,-0.280,-0.274,-0.267,-0.260,-0.254,-0.247,-0.240,-0.233, - &-0.227,-0.220,-0.213,-0.206,-0.200,-0.193,-0.186,-0.180,-0.173, - &-0.166,-0.160,-0.153,-0.146,-0.140,-0.133,-0.126,-0.119,-0.113, - &-0.106,-0.100,-0.093,-0.086,-0.080,-0.073,-0.066,-0.060,-0.053, - &-0.046,-0.040,-0.033 - & / -C -C *** MGNO32 -C - DATA BNC22M/ - &-0.088,-0.185,-0.228,-0.257,-0.278,-0.294,-0.306,-0.317,-0.325, - &-0.332,-0.337,-0.342,-0.346,-0.349,-0.351,-0.353,-0.355,-0.356, - &-0.357,-0.357,-0.357,-0.357,-0.356,-0.356,-0.355,-0.354,-0.353, - &-0.352,-0.350,-0.349,-0.347,-0.345,-0.343,-0.341,-0.339,-0.337, - &-0.335,-0.333,-0.330,-0.328,-0.326,-0.323,-0.321,-0.318,-0.316, - &-0.313,-0.310,-0.308,-0.305,-0.302,-0.300,-0.297,-0.294,-0.291, - &-0.288,-0.286,-0.283,-0.280,-0.277,-0.274,-0.271,-0.268,-0.266, - &-0.263,-0.260,-0.257,-0.254,-0.251,-0.248,-0.245,-0.242,-0.239, - &-0.235,-0.232,-0.229,-0.226,-0.223,-0.220,-0.216,-0.213,-0.210, - &-0.207,-0.203,-0.200,-0.197,-0.193,-0.190,-0.186,-0.183,-0.180, - &-0.176,-0.173,-0.169,-0.165,-0.162,-0.158,-0.155,-0.151,-0.147, - &-0.143,-0.140,-0.136,-0.132,-0.128,-0.125,-0.121,-0.117,-0.113, - &-0.109,-0.105,-0.101,-0.098,-0.094,-0.090,-0.086,-0.082,-0.078, - &-0.074,-0.070,-0.066,-0.062,-0.058,-0.054,-0.050,-0.046,-0.042, - &-0.038,-0.034,-0.030,-0.026,-0.022,-0.018,-0.014,-0.010,-0.006, - &-0.002, 0.002, 0.006, 0.010, 0.014, 0.018, 0.022, 0.026, 0.030, - & 0.034, 0.038, 0.042, 0.046, 0.050, 0.054, 0.058, 0.062, 0.066, - & 0.070, 0.074, 0.078, 0.082, 0.086, 0.090, 0.094, 0.098, 0.102, - & 0.106, 0.110, 0.114, 0.118, 0.122, 0.126, 0.130, 0.134, 0.137, - & 0.141, 0.145, 0.149, 0.153, 0.157, 0.161, 0.165, 0.169, 0.173, - & 0.177, 0.180, 0.184, 0.188, 0.192, 0.196, 0.200, 0.204, 0.207, - & 0.211, 0.215, 0.219, 0.223, 0.227, 0.231, 0.234, 0.238, 0.242, - & 0.246, 0.250, 0.253, 0.257, 0.261, 0.265, 0.269, 0.272, 0.276, - & 0.280, 0.284, 0.288, 0.291, 0.295, 0.299, 0.303, 0.306, 0.310, - & 0.314, 0.318, 0.321, 0.325, 0.329, 0.332, 0.336, 0.340, 0.343, - & 0.347, 0.351, 0.355, 0.358, 0.362, 0.366, 0.369, 0.373, 0.377, - & 0.380, 0.384, 0.388, 0.391, 0.395, 0.398, 0.402, 0.406, 0.409, - & 0.413, 0.417, 0.420, 0.424, 0.427, 0.431, 0.435, 0.438, 0.442, - & 0.445, 0.449, 0.452, 0.456, 0.459, 0.463, 0.467, 0.470, 0.474, - & 0.477, 0.481, 0.484, 0.488, 0.491, 0.495, 0.498, 0.502, 0.505, - & 0.509, 0.512, 0.516, 0.519, 0.523, 0.526, 0.530, 0.533, 0.537, - & 0.540, 0.543, 0.547, 0.550, 0.554, 0.557, 0.561, 0.564, 0.567, - & 0.571, 0.574, 0.578, 0.581, 0.584, 0.588, 0.591, 0.595, 0.598, - & 0.601, 0.605, 0.608, 0.611, 0.615, 0.618, 0.621, 0.625, 0.628, - & 0.631, 0.635, 0.638, 0.641, 0.645, 0.648, 0.651, 0.655, 0.658, - & 0.661, 0.665, 0.668, 0.671, 0.674, 0.678, 0.681, 0.684, 0.687, - & 0.691, 0.694, 0.697, 0.700, 0.704, 0.707, 0.710, 0.713, 0.717, - & 0.720, 0.723, 0.726, 0.729, 0.733, 0.736, 0.739, 0.742, 0.745, - & 0.749, 0.752, 0.755, 0.758, 0.761, 0.764, 0.768, 0.771, 0.774, - & 0.777, 0.780, 0.783, 0.786, 0.790, 0.793, 0.796, 0.799, 0.802, - & 0.805, 0.808, 0.811, 0.814, 0.818, 0.821, 0.824, 0.827, 0.830, - & 0.833, 0.836, 0.839, 0.842, 0.845, 0.848, 0.851, 0.854, 0.857, - & 0.860, 0.864, 0.867, 0.870, 0.873, 0.876, 0.879, 0.882, 0.885, - & 0.888, 0.891, 0.894, 0.897, 0.900, 0.903, 0.906, 0.909, 0.912, - & 0.915, 0.918, 0.921, 0.924, 0.955, 0.984, 1.013, 1.041, 1.070, - & 1.097, 1.125, 1.152, 1.179, 1.205, 1.231, 1.257, 1.283, 1.308, - & 1.334, 1.359, 1.383, 1.408, 1.432, 1.456, 1.479, 1.503, 1.526, - & 1.549, 1.572, 1.594, 1.617, 1.639, 1.661, 1.683, 1.704, 1.726, - & 1.747, 1.768, 1.789, 1.810, 1.830, 1.851, 1.871, 1.891, 1.911, - & 1.930, 1.950, 1.969, 1.989, 2.008, 2.027, 2.046, 2.064, 2.083, - & 2.101, 2.120, 2.138, 2.156, 2.174, 2.192, 2.209, 2.227, 2.244, - & 2.262, 2.279, 2.296, 2.313, 2.330, 2.347, 2.363, 2.380, 2.396, - & 2.413, 2.429, 2.445, 2.461, 2.477, 2.493, 2.509, 2.525, 2.540, - & 2.556, 2.571, 2.587, 2.602, 2.617, 2.632, 2.647, 2.662, 2.677, - & 2.692, 2.707, 2.721, 2.736, 2.750, 2.765, 2.779, 2.793, 2.807, - & 2.822, 2.836, 2.850, 2.863, 2.877, 2.891, 2.905, 2.918, 2.932, - & 2.946, 2.959, 2.972, 2.986, 2.999, 3.012, 3.025, 3.039, 3.052, - & 3.065, 3.078, 3.090, 3.103, 3.116, 3.129, 3.141, 3.154, 3.167, - & 3.179, 3.191, 3.204, 3.216, 3.229, 3.241, 3.253, 3.265, 3.277, - & 3.289, 3.301, 3.313, 3.325, 3.337, 3.349, 3.361, 3.372, 3.384, - & 3.396, 3.407, 3.419, 3.431, 3.442, 3.453, 3.465, 3.476, 3.488, - & 3.499, 3.510, 3.521, 3.532, 3.544, 3.555, 3.566, 3.577, 3.588, - & 3.599, 3.610, 3.621 - & / -C -C *** MGCL2 -C - DATA BNC23M/ - &-0.088,-0.182,-0.225,-0.252,-0.271,-0.286,-0.297,-0.306,-0.313, - &-0.319,-0.323,-0.327,-0.329,-0.331,-0.332,-0.333,-0.333,-0.333, - &-0.333,-0.332,-0.331,-0.329,-0.328,-0.326,-0.324,-0.322,-0.319, - &-0.317,-0.314,-0.312,-0.309,-0.306,-0.303,-0.300,-0.296,-0.293, - &-0.290,-0.286,-0.283,-0.279,-0.276,-0.272,-0.268,-0.265,-0.261, - &-0.257,-0.253,-0.250,-0.246,-0.242,-0.238,-0.234,-0.230,-0.226, - &-0.223,-0.219,-0.215,-0.211,-0.207,-0.203,-0.199,-0.195,-0.191, - &-0.187,-0.183,-0.179,-0.174,-0.170,-0.166,-0.162,-0.158,-0.154, - &-0.150,-0.145,-0.141,-0.137,-0.133,-0.128,-0.124,-0.120,-0.115, - &-0.111,-0.106,-0.102,-0.097,-0.093,-0.088,-0.084,-0.079,-0.074, - &-0.070,-0.065,-0.060,-0.056,-0.051,-0.046,-0.041,-0.036,-0.031, - &-0.027,-0.022,-0.017,-0.012,-0.007,-0.002, 0.003, 0.008, 0.013, - & 0.019, 0.024, 0.029, 0.034, 0.039, 0.044, 0.049, 0.055, 0.060, - & 0.065, 0.070, 0.075, 0.081, 0.086, 0.091, 0.096, 0.101, 0.107, - & 0.112, 0.117, 0.122, 0.128, 0.133, 0.138, 0.143, 0.149, 0.154, - & 0.159, 0.164, 0.170, 0.175, 0.180, 0.185, 0.190, 0.196, 0.201, - & 0.206, 0.211, 0.216, 0.222, 0.227, 0.232, 0.237, 0.242, 0.248, - & 0.253, 0.258, 0.263, 0.268, 0.273, 0.279, 0.284, 0.289, 0.294, - & 0.299, 0.304, 0.309, 0.314, 0.320, 0.325, 0.330, 0.335, 0.340, - & 0.345, 0.350, 0.355, 0.360, 0.365, 0.370, 0.375, 0.380, 0.386, - & 0.391, 0.396, 0.401, 0.406, 0.411, 0.416, 0.421, 0.426, 0.431, - & 0.436, 0.441, 0.446, 0.450, 0.455, 0.460, 0.465, 0.470, 0.475, - & 0.480, 0.485, 0.490, 0.495, 0.500, 0.505, 0.509, 0.514, 0.519, - & 0.524, 0.529, 0.534, 0.539, 0.543, 0.548, 0.553, 0.558, 0.563, - & 0.568, 0.572, 0.577, 0.582, 0.587, 0.592, 0.596, 0.601, 0.606, - & 0.611, 0.615, 0.620, 0.625, 0.629, 0.634, 0.639, 0.644, 0.648, - & 0.653, 0.658, 0.662, 0.667, 0.672, 0.676, 0.681, 0.686, 0.690, - & 0.695, 0.700, 0.704, 0.709, 0.713, 0.718, 0.723, 0.727, 0.732, - & 0.736, 0.741, 0.745, 0.750, 0.754, 0.759, 0.764, 0.768, 0.773, - & 0.777, 0.782, 0.786, 0.791, 0.795, 0.800, 0.804, 0.809, 0.813, - & 0.817, 0.822, 0.826, 0.831, 0.835, 0.840, 0.844, 0.848, 0.853, - & 0.857, 0.862, 0.866, 0.870, 0.875, 0.879, 0.884, 0.888, 0.892, - & 0.897, 0.901, 0.905, 0.910, 0.914, 0.918, 0.923, 0.927, 0.931, - & 0.935, 0.940, 0.944, 0.948, 0.953, 0.957, 0.961, 0.965, 0.970, - & 0.974, 0.978, 0.982, 0.986, 0.991, 0.995, 0.999, 1.003, 1.007, - & 1.012, 1.016, 1.020, 1.024, 1.028, 1.032, 1.037, 1.041, 1.045, - & 1.049, 1.053, 1.057, 1.061, 1.065, 1.070, 1.074, 1.078, 1.082, - & 1.086, 1.090, 1.094, 1.098, 1.102, 1.106, 1.110, 1.114, 1.118, - & 1.122, 1.126, 1.130, 1.134, 1.138, 1.142, 1.146, 1.150, 1.154, - & 1.158, 1.162, 1.166, 1.170, 1.174, 1.178, 1.182, 1.186, 1.190, - & 1.194, 1.198, 1.202, 1.206, 1.210, 1.214, 1.217, 1.221, 1.225, - & 1.229, 1.233, 1.237, 1.241, 1.245, 1.248, 1.252, 1.256, 1.260, - & 1.264, 1.268, 1.271, 1.275, 1.279, 1.283, 1.287, 1.290, 1.294, - & 1.298, 1.302, 1.306, 1.309, 1.313, 1.317, 1.321, 1.324, 1.328, - & 1.332, 1.336, 1.339, 1.343, 1.383, 1.420, 1.456, 1.491, 1.527, - & 1.561, 1.596, 1.630, 1.663, 1.696, 1.729, 1.761, 1.793, 1.825, - & 1.856, 1.887, 1.918, 1.948, 1.978, 2.008, 2.037, 2.066, 2.095, - & 2.123, 2.152, 2.180, 2.207, 2.235, 2.262, 2.289, 2.315, 2.342, - & 2.368, 2.394, 2.419, 2.445, 2.470, 2.495, 2.520, 2.544, 2.569, - & 2.593, 2.617, 2.641, 2.664, 2.688, 2.711, 2.734, 2.757, 2.780, - & 2.802, 2.824, 2.847, 2.869, 2.890, 2.912, 2.934, 2.955, 2.976, - & 2.997, 3.018, 3.039, 3.060, 3.080, 3.101, 3.121, 3.141, 3.161, - & 3.181, 3.201, 3.220, 3.240, 3.259, 3.279, 3.298, 3.317, 3.336, - & 3.354, 3.373, 3.392, 3.410, 3.428, 3.447, 3.465, 3.483, 3.501, - & 3.519, 3.536, 3.554, 3.572, 3.589, 3.606, 3.624, 3.641, 3.658, - & 3.675, 3.692, 3.709, 3.725, 3.742, 3.759, 3.775, 3.791, 3.808, - & 3.824, 3.840, 3.856, 3.872, 3.888, 3.904, 3.920, 3.935, 3.951, - & 3.967, 3.982, 3.997, 4.013, 4.028, 4.043, 4.058, 4.074, 4.089, - & 4.103, 4.118, 4.133, 4.148, 4.163, 4.177, 4.192, 4.206, 4.221, - & 4.235, 4.249, 4.264, 4.278, 4.292, 4.306, 4.320, 4.334, 4.348, - & 4.362, 4.376, 4.390, 4.403, 4.417, 4.431, 4.444, 4.458, 4.471, - & 4.484, 4.498, 4.511, 4.524, 4.538, 4.551, 4.564, 4.577, 4.590, - & 4.603, 4.616, 4.629 - & / -C -C *** END OF BLOCK DATA EXPON ****************************************** -C - 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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.1415926535897932, 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.5*(-A1+SQD) - X(3) = 0.5*(-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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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,200)/ - & 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, - & 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 PUSHERR -C *** THIS SUBROUTINE SAVES AN ERROR MESSAGE IN THE ERROR STACK -C -C *** COPYRIGHT 1996-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - ELSEIF (IERR.EQ.0051) THEN - WRITE (IO,1000) 'TOO MUCH CALCIUM GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS CALCIUM IS IGNORED.' -C - ELSEIF (IERR.EQ.0052) THEN - WRITE (IO,1000) 'TOO MUCH SODIUM (+Ca) GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS SODIUM IS IGNORED.' -C - ELSEIF (IERR.EQ.0053) THEN - WRITE (IO,1000) 'TOO MUCH MAGNESIUM (+Ca,Na) GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS MAGNESIUM IS IGNORED.' -C - ELSEIF (IERR.EQ.0054) THEN - WRITE (IO,1000) 'TOO MUCH POTASSIUM(+Ca,Na,Mg) GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS POTASSIUM 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-2012, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C *** UPDATED BY CHRISTOS FOUNTOUKIS -C *** UPDATE|ADJOINT BY SHANNON CAPPS -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 - -c---------------------------------------------------------------------- -c --- ISOFWD.FOR --- -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 *** 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 -C *** ISORROPIA CODE II -C *** SUBROUTINE ISRP4F -C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FORWARD PROBLEM OF -C AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTASSIUM-MAGNESIUM -C 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 CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE ISRP4F (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - DOUBLE PRECISION NAFRI, NO3FRI -C -C *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE *********************** -C -C WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3 -C 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 -C IF (WI(1)+WI(2)+WI(4) .LE. 1d-10) THEN -C WI(1) = 1.D-10 ! Na+ : 1e-4 umoles/m3 -C WI(2) = 1.D-10 ! SO4- : 1e-4 umoles/m3 -C ENDIF -C -C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** -C - CALL INIT4 (WI, RHI, TEMPI) -C -C *** CHECK IF TOO MUCH SODIUM+CRUSTALS ; ADJUST AND ISSUE ERROR MESSAGE -C - REST = 2.D0*W(2) + W(4) + W(5) -C - IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -C - CCASO4I = MIN (W(2),W(6)) - FRSO4I = MAX (W(2) - CCASO4I, ZERO) - CAFRI = MAX (W(6) - CCASO4I, ZERO) - CCANO32I = MIN (CAFRI, 0.5D0*W(4)) - CAFRI = MAX (CAFRI - CCANO32I, ZERO) - NO3FRI = MAX (W(4) - 2.D0*CCANO32I, ZERO) - CCACL2I = MIN (CAFRI, 0.5D0*W(5)) - CLFRI = MAX (W(5) - 2.D0*CCACL2I, ZERO) - REST1 = 2.D0*FRSO4I + NO3FRI + CLFRI -C - CNA2SO4I = MIN (FRSO4I, 0.5D0*W(1)) - FRSO4I = MAX (FRSO4I - CNA2SO4I, ZERO) - NAFRI = MAX (W(1) - 2.D0*CNA2SO4I, ZERO) - CNACLI = MIN (NAFRI, CLFRI) - NAFRI = MAX (NAFRI - CNACLI, ZERO) - CLFRI = MAX (CLFRI - CNACLI, ZERO) - CNANO3I = MIN (NAFRI, NO3FRI) - NO3FR = MAX (NO3FRI - CNANO3I, ZERO) - REST2 = 2.D0*FRSO4I + NO3FRI + CLFRI -C - CMGSO4I = MIN (FRSO4I, W(8)) - FRMGI = MAX (W(8) - CMGSO4I, ZERO) - FRSO4I = MAX (FRSO4I - CMGSO4I, ZERO) - CMGNO32I = MIN (FRMGI, 0.5D0*NO3FRI) - FRMGI = MAX (FRMGI - CMGNO32I, ZERO) - NO3FRI = MAX (NO3FRI - 2.D0*CMGNO32I, ZERO) - CMGCL2I = MIN (FRMGI, 0.5D0*CLFRI) - CLFRI = MAX (CLFRI - 2.D0*CMGCL2I, ZERO) - REST3 = 2.D0*FRSO4I + NO3FRI + CLFRI -C - IF (W(6).GT.REST) THEN ! Ca > 2*SO4+CL+NO3 ? - W(6) = (ONE-1D-6)*REST ! Adjust Ca amount - W(1)= ZERO ! Adjust Na amount - W(7)= ZERO ! Adjust K amount - W(8)= ZERO ! Adjust Mg amount - CALL PUSHERR (0051, 'ISRP4F') ! Warning error: Ca, Na, K, Mg in excess -C - ELSE IF (W(1).GT.REST1) THEN ! Na > 2*FRSO4+FRCL+FRNO3 ? - W(1) = (ONE-1D-6)*REST1 ! Adjust Na amount - W(7)= ZERO ! Adjust K amount - W(8)= ZERO ! Adjust Mg amount - CALL PUSHERR (0052, 'ISRP4F') ! Warning error: Na, K, Mg in excess -C - ELSE IF (W(8).GT.REST2) THEN ! Mg > 2*FRSO4+FRCL+FRNO3 ? - W(8) = (ONE-1D-6)*REST2 ! Adjust Mg amount - W(7)= ZERO ! Adjust K amount - CALL PUSHERR (0053, 'ISRP4F') ! Warning error: K, Mg in excess -C - ELSE IF (W(7).GT.REST3) THEN ! K > 2*FRSO4+FRCL+FRNO3 ? - W(7) = (ONE-1D-6)*REST3 ! Adjust K amount - CALL PUSHERR (0054, 'ISRP4F') ! Warning error: K in excess - ENDIF - ENDIF -C -C *** CALCULATE RATIOS ************************************************* -C - SO4RAT = (W(1)+W(3)+W(6)+W(7)+W(8))/W(2) - CRNARAT = (W(1)+W(6)+W(7)+W(8))/W(2) - CRRAT = (W(6)+W(7)+W(8))/W(2) -C -C *** FIND CALCULATION REGIME FROM (SO4RAT, CRNARAT, CRRAT, RRH) ******** -C -C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) POOR: R(Cr+Na)<2 -C - IF (2.0.LE.SO4RAT .AND. CRNARAT.LT.2.0) THEN -C - IF(METSTBL.EQ.1) THEN - SCASE = 'O7' - CALL CALCO7 ! Only liquid (metastable) - ELSE -C - IF (RH.LT.DRNH4NO3) THEN - SCASE = 'O1' - CALL CALCO1 ! CaSO4, NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN - SCASE = 'O2' - CALL CALCO2 ! CaSO4, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNH42S4) THEN - SCASE = 'O3' - CALL CALCO3 ! CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRMGSO4) THEN - SCASE = 'O4' - CALL CALCO4 ! CaSO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRNA2SO4) THEN - SCASE = 'O5' - CALL CALCO5 ! CaSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNA2SO4.LE.RH .AND. RH.LT.DRK2SO4) THEN - SCASE = 'O6' - CALL CALCO6 ! CaSO4, K2SO4 -C - ELSEIF (DRK2SO4.LE.RH) THEN - SCASE = 'O7' - CALL CALCO7 ! CaSO4 - ENDIF - ENDIF -C -C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C - ELSEIF (SO4RAT.GE.2.0 .AND. CRNARAT.GE.2.0) THEN -C - IF (CRRAT.LE.2.0) THEN -C - IF(METSTBL.EQ.1) THEN - SCASE = 'M8' - CALL CALCM8 ! Only liquid (metastable) - ELSE -C - IF (RH.LT.DRNH4NO3) THEN - SCASE = 'M1' - CALL CALCM1 ! CaSO4, NH4NO3, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 -C - ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN - SCASE = 'M2' - CALL CALCM2 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 -C - ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN - SCASE = 'M3' - CALL CALCM3 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL -C - ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4Cl) THEN - SCASE = 'M4' - CALL CALCM4 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH4Cl.LE.RH .AND. RH.LT.DRMGSO4) THEN - SCASE = 'M5' - CALL CALCM5 ! CaSO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRNA2SO4) THEN - SCASE = 'M6' - CALL CALCM6 ! CaSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNA2SO4.LE.RH .AND. RH.LT.DRK2SO4) THEN - SCASE = 'M7' - CALL CALCM7 ! CaSO4, K2SO4 -C - ELSEIF (DRK2SO4.LE.RH) THEN - SCASE = 'M8' - CALL CALCM8 ! CaSO4 - ENDIF - ENDIF -C CALL CALCHCO3 -C -C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C - ELSEIF (CRRAT.GT.2.0) THEN -C - IF(METSTBL.EQ.1) THEN - SCASE = 'P13' - CALL CALCP13 ! Only liquid (metastable) - ELSE -C - IF (RH.LT.DRCACL2) THEN - SCASE = 'P1' - CALL CALCP1 ! CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRCACL2.LE.RH .AND. RH.LT.DRMGCL2) THEN - SCASE = 'P2' - CALL CALCP2 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRMGCL2.LE.RH .AND. RH.LT.DRCANO32) THEN - SCASE = 'P3' - CALL CALCP3 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRCANO32.LE.RH .AND. RH.LT.DRMGNO32) THEN - SCASE = 'P4' - CALL CALCP4 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRMGNO32.LE.RH .AND. RH.LT.DRNH4NO3) THEN - SCASE = 'P5' - CALL CALCP5 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, -C ! NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN - SCASE = 'P6' - CALL CALCP6 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4CL -C - ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN - SCASE = 'P7' - CALL CALCP7 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NACL, NH4CL -C - ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4CL) THEN - SCASE = 'P8' - CALL CALCP8 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NH4CL -C - ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRKCL) THEN - SCASE = 'P9' - CALL CALCP9 ! CaSO4, K2SO4, KNO3, KCL, MGSO4 -C - ELSEIF (DRKCL.LE.RH .AND. RH.LT.DRMGSO4) THEN - SCASE = 'P10' - CALL CALCP10 ! CaSO4, K2SO4, KNO3, MGSO4 -C - ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRKNO3) THEN - SCASE = 'P11' - CALL CALCP11 ! CaSO4, K2SO4, KNO3 -C - ELSEIF (DRKNO3.LE.RH .AND. RH.LT.DRK2SO4) THEN - SCASE = 'P12' - CALL CALCP12 ! CaSO4, K2SO4 -C - ELSEIF (DRK2SO4.LE.RH) THEN - SCASE = 'P13' - CALL CALCP13 ! CaSO4 - ENDIF - ENDIF -C CALL CALCHCO3 - ENDIF -C -C *** SULFATE RICH (NO ACID): 1= 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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 -C ! slc.question - MOLAL (5) = MAX(PSI-LAMDA,TINY) ! SO4I - MOLAL (3) = MAX(W(3)/(ONE/A2/OMEGI + ONE), 2.*MOLAL(5)) ! NH4I - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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) = PSI2 ! Include initial amount in water calc - 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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCD3 (X2) - IF (((Y1) .LT. ZERO) .AND. ((Y2) .GT. ZERO)) GOTO 20 ! (Y1*Y2.LT.ZERO) (slc.1.2012) -C IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 - 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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) = PSI2 ! Include sulfate in initial water calculation - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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) = PSI2 ! Include initial amount in water calc - 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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCD2 (X2) - IF (((Y1) .LT. ZERO) .AND. ((Y2) .GT. ZERO)) GOTO 20 ! (Y1*Y2.LT.ZERO) slc.1.2012 -C IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) THEN -CC -CC This is done, in case if Y(PSI4LO)>0, but Y(PSI4LO+DX) < 0 (i.e.undersat) -CC -C IF (Y1 .LE. Y2) GOTO 20 ! (Y1*Y2.LT.ZERO) -C 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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) = PSI2 ! Include initial amount in water calc - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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. - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 = TINY - 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 = MIN (0.5*W(1), W(2)) - FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO) - SO4FR = MAX(W(2) - CNA2SO4, ZERO) -C CNH42S4 = W(2) - CNA2SO4 - CNH42S4 = MAX (SO4FR , ZERO) ! CNH42S4 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 = MAX (MIN (PSI5, CHI5), ZERO) -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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCI3A (ZERO) - ENDIF - GOTO 50 -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCI3A (X3) -C -50 RETURN - -C *** END OF SUBROUTINE CALCI3A ***************************************** -C - END -C -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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCI3B (PSI4LO) - ENDIF - GOTO 50 -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 = MAX (MIN (PSI5, CHI5), ZERO) -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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCI2A (ZERO) - ENDIF - GOTO 50 -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - 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 -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO7 -C *** CASE O7 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4, K2SO4 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO7 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) -C - PSI1 = CHI1 - PSI2 = CHI2 - PSI3 = ZERO - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCO7 (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 = FUNCO7 (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 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4, K2SO4 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCO7 (X) - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -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 - 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 - IF (CHI5.GE.TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - 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)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (2) = 2.0D0*PSI1 ! Na+ - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CaI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! Mg -C -C *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* -C -CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & -MOLAL(9)-2.D0*MOLAL(10) - 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 - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CCASO4 = CHI9 -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 FUNCO7 = 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 FUNCO7 ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO6 -C *** CASE O6 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO6 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) -C -C - PSI1 = CHI1 - PSI2 = CHI2 - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCO6 (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 = FUNCO6 (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 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 , K2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCO6 (X) - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -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 - 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 = XK17 *(WATER/GAMA(17))**3.0 -C -C - IF (CHI5.GE.TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - 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)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7 - CALL POLY3 (PSI1+PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV.EQ.0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF -C -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (2) = 2.0D0*PSI1 ! Na+ - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CaI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! Mg - -C -C *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - -C -CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & -MOLAL(9)-2.D0*MOLAL(10) - 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 - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, TINY) - CMGSO4 = ZERO - CCASO4 = CHI9 -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 FUNCO6 = 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 FUNCO6 ******************************************* -C - END -C -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO5 -C *** CASE O5 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO5 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) -C - PSI1 = ZERO - PSI2 = CHI2 - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCO5 (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 = FUNCO5 (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 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCO5 (X) - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -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 - 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 = XK17 *(WATER/GAMA(17))**3.0 -C -C - IF (CHI5.GE.TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - 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)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7 - CALL POLY3 ((PSI2+PSI8)/(SQRT(A1/A7)+1.D0), ZERO, - & -A7/4.D0/(SQRT(A1/A7)+1.D0), PSI7, ISLV) - IF (ISLV.EQ.0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF -C - IF (CHI1.GE.TINY) THEN ! PSI1 - PSI1 = SQRT(A1/A7)*PSI7 - PSI1 = MIN(PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF -C -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (2) = 2.0D0*PSI1 ! NaI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CaI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! Mg - -C -C *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - -C -CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & -MOLAL(9)-2.D0*MOLAL(10) - 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 - CNA2SO4 = MAX(CHI1 - PSI1, TINY) - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, TINY) - CMGSO4 = ZERO - CCASO4 = CHI9 -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 FUNCO5 = 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 FUNCO5 ******************************************* -C - END -C -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO4 -C *** CASE O4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : NA2SO4, K2SO4, MGSO4, CASO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO4 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) -C - PSI2 = CHI2 - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCO4 (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 = FUNCO4 (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 CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCO4 (X) - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -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 - 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 = XK17 *(WATER/GAMA(17))**3.0 -C A8 = XK23 *(WATER/GAMA(21))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - IF (CHI5.GE.TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - 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)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7 - CALL POLY3 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV.EQ.0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF -C -C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* -C - MOLAL (2) = ZERO ! NAI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! MGI - -C -C *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - -C -CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & -MOLAL(9)-2.D0*MOLAL(10) - 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 - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, TINY) - CMGSO4 = ZERO - CCASO4 = CHI9 -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 FUNCO4 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -CCC FUNCO4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCO4 ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO3 -C *** CASE O3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCO1A, CALCO4 -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 = 'O3 ; SUBCASE 1' - CALL CALCO3A - SCASE = 'O3 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'O1 ; SUBCASE 1' - CALL CALCO1A - SCASE = 'O1 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMO3) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCO1A - SCASE = 'O3 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'O3 ; SUBCASE 3' ! MDRH REGION (NA2SO4, NH42S4, K2SO4, MGSO4, CASO4) - CALL CALCMDRH2 (RH, DRMO3, DRNH42S4, CALCO1A, CALCO4) - SCASE = 'O3 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCO3 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO3A -C *** CASE O3 ; SUBCASE 1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, K2SO4, MGSO4, CASO4 -C 4. Completely dissolved: NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO3A - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) -C - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY -C - WATER = TINY -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCO3A (X1) - IF (CHI6.LE.TINY) GOTO 50 -CCC IF (ABS(Y1).LE.EPS .OR. CHI7.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 = FUNCO3A (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 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, K2SO4, MgSO4, CaSO4 -C 4. Completely dissolved: NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCO3A (X) - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI2 = CHI2 - PSI8 = CHI8 - PSI3 = ZERO - PSI6 = X -C - 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.0D0 - A2 = XK7 *(WATER/GAMA(4))**3.0D0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0D0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0D0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0D0 - A7 = XK17 *(WATER/GAMA(17))**3.0D0 -C A8 = XK23 *(WATER/GAMA(21))**2.0D0 - A65 = A6/A5 -C -C CALCULATE DISSOCIATION QUANTITIES -C - DENO = MAX(CHI6-PSI6-PSI3, ZERO) - PSI5 = PSI6*CHI5/(A6/A5*DENO + PSI6) - PSI5 = MIN(MAX(PSI5,ZERO),CHI5) -C -CCC IF(CHI4.GT.TINY) THEN ! PSI4 - 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 - PSI4 = MIN (MAX (PSI4,ZERO), CHI4) -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7 - CALL POLY3 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV.EQ.0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF -C - IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN - CALL POLY3 (PSI7+PSI8+PSI4, PSI4*(PSI7+PSI8)+ - & PSI4*PSI4/4.D0, (PSI4*PSI4*(PSI7+PSI8)-A2) - & /4.D0,PSI20, ISLV) - IF (ISLV.EQ.0) PSI2 = MIN (MAX(PSI20,ZERO), CHI2) - ENDIF -C PSI2 = 0.5D0*(2.0D0*SQRT(A2/A7)*PSI7 - PSI4) -C PSI2 = MIN (MAX(PSI2, ZERO), CHI2) -C ENDIF -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (2) = ZERO ! NaI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! MGI -C -CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & -MOLAL(9)-2.D0*MOLAL(10) - 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 -C CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CNH42S4 = MAX(CHI2 - PSI2, ZERO) - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI9 -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 FUNCO3A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C -C - RETURN -C -C *** END OF FUNCTION FUNCO3A ******************************************* -C - END - -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO2 -C *** CASE O2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCO1A, CALCO3A, CALCO4 -C -C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** -C - IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE - SCASE = 'O2 ; SUBCASE 1' - CALL CALCO2A - SCASE = 'O2 ; SUBCASE 1' - ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE - SCASE = 'O1 ; SUBCASE 1' - CALL CALCO1A - SCASE = 'O1 ; 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.DRMO2) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCO1A - SCASE = 'O2 ; SUBCASE 2' - ELSE - IF (W(5).GT. TINY) THEN - SCASE = 'O2 ; SUBCASE 3' ! MDRH (NH4CL, NA2SO4, NH42S4, K2SO4, MGSO4, CASO4) - CALL CALCMDRH2 (RH, DRMO2, DRNH4CL, CALCO1A, CALCO3A) - SCASE = 'O2 ; SUBCASE 3' - ENDIF - IF (WATER.LE.TINY .AND. RH.GE.DRMO3) THEN - SCASE = 'O2 ; SUBCASE 4' ! MDRH (NA2SO4, NH42S4, K2SO4, MGSO4, CASO4) - CALL CALCMDRH2 (RH, DRMO3, DRNH42S4, CALCO1A, CALCO4) - SCASE = 'O2 ; SUBCASE 4' - ELSE - WATER = TINY - DO 20 I=1,NIONS - MOLAL(I) = ZERO -20 CONTINUE - CALL CALCO1A - SCASE = 'O2 ; SUBCASE 2' - ENDIF - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCO2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO2A -C *** CASE O2 ; SUBCASE 1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4, K2SO4, MgSO4, CaSO4 -C 4. Completely dissolved: NH4NO3 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO2A - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************* -C - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) -C - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY -C - WATER = TINY -C -C *** INITIAL VALUES FOR BISECTION ************************************* -C - X1 = PSI6LO - Y1 = FUNCO2A (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 = FUNCO2A (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 ; R(Cr+Na) < 2.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4, K2SO4, MgSO4, CaSO4 -C 4. Completely dissolved: NH4NO3 -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCO2A (X) - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, - & PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, - & A5, A6, A7, A8, A9 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI2 = CHI2 - PSI3 = ZERO -C - 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.0D0 - A2 = XK7 *(WATER/GAMA(4))**3.0D0 - A3 = XK6 /(R*TEMP*R*TEMP) - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0D0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0D0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0D0 - A65 = A6/A5 - A7 = XK17 *(WATER/GAMA(17))**3.0D0 -C A8 = XK23 *(WATER/GAMA(21))**2.0D0 -C - DENO = MAX(CHI6-PSI6-PSI3, ZERO) - PSI5 = PSI6*CHI5/(A6/A5*DENO + PSI6) - PSI5 = MIN(PSI5,CHI5) -C - PSI4 = MIN(PSI5+PSI6,CHI4) -C -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7 - CALL POLY3 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV.EQ.0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF -C - IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN - CALL POLY3 (PSI7+PSI8+PSI4, PSI4*(PSI7+PSI8)+ - & PSI4*PSI4/4.D0, (PSI4*PSI4*(PSI7+PSI8)-A2) - & /4.D0,PSI20, ISLV) - IF (ISLV.EQ.0) PSI2 = MIN (MAX(PSI20,ZERO), CHI2) - ENDIF -C PSI2 = 0.5D0*(2.0D0*SQRT(A2/A7)*PSI7 - PSI4) -C PSI2 = MIN (PSI2, CHI2) -C ENDIF -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (2) = ZERO ! NaI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! MGI -C -CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & -MOLAL(9)-2.D0*MOLAL(10) - 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 -C CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CNH42S4 = MAX(CHI2 - PSI2, ZERO) - CNH4NO3 = ZERO - CK2SO4 = MAX(CHI7 - PSI7, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI9 - -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 - PSI3 = MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6) -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 - -C20 IF (CHI4.LE.TINY) THEN -C FUNCO2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C ELSE -20 FUNCO2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -C ENDIF -C - RETURN -C -C *** END OF FUNCTION FUNCO2A **************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO1 -C *** CASE O1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 -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 CALCO1A) -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCO1A, CALCO2A -C -C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** -C - IF (RH.LT.DRMO1) THEN - SCASE = 'O1 ; SUBCASE 1' - CALL CALCO1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'O1 ; SUBCASE 1' - ELSE - SCASE = 'O1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRMO1, DRNH4NO3, CALCO1A, CALCO2A) - SCASE = 'O1 ; SUBCASE 2' - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCO1 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCO1A -C *** CASE O1A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 -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 CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCO1A - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2 -C -C *** CALCULATE NON VOLATILE SOLIDS *********************************** -C - CCASO4 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2) - CCASO4, ZERO) - CAFR = MAX(W(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX(SO4FR - CK2SO4, ZERO) - CNA2SO4 = MIN (0.5D0*W(1), SO4FR) ! CNA2SO4 - FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO) - SO4FR = MAX(SO4FR - CNA2SO4, ZERO) - CMGSO4 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) -C - CNH42S4 = MAX (SO4FR , ZERO) ! CNH42S4 -C -C *** CALCULATE VOLATILE SPECIES ************************************** -C - ALF = W(3) - 2.0D0*CNH42S4 - BET = W(5) - GAM = W(4) -C - RTSQ = R*TEMP*R*TEMP - A1 = XK6/RTSQ - A2 = XK10/RTSQ - print *, A2 -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 CALCO1A ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM8 -C *** CASE M8 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4, K2SO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM8 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! 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 = FUNCM8 (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 = FUNCM8 (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) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4, K2SO4 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCM8 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = CHI9 - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C -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 -C A7 = XK8 *(WATER/GAMA(1))**2.0 -C A8 = XK9 *(WATER/GAMA(3))**2.0 -C A11 = 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 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),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 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 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 = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CCASO4 = CHI11 -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 -C20 FUNCM8 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCM8 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCM8 ******************************************* -C - END - - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM7 -C *** CASE M7 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM7 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! 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 = FUNCM7 (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 = FUNCM7 (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) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCM7 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C -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 - A9 = XK17 *(WATER/GAMA(17))**3.0 -C A7 = XK8 *(WATER/GAMA(1))**2.0 -C A8 = XK9 *(WATER/GAMA(3))**2.0 -C A11 = 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 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = 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 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 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 = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 -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 -C20 FUNCM7 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCM7 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCM7 ******************************************* -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM6 -C *** CASE M6 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM6 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! 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 = FUNCM6 (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 = FUNCM6 (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) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCM6 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = 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 - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 -C A7 = XK8 *(WATER/GAMA(1))**2.0 -C A8 = XK9 *(WATER/GAMA(3))**2.0 -C A11 = 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 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) - & /(1.D0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* - & (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) - & -A1/4.D0)/(1.D0+RIZ) -C AA = PSI7+PSI8+PSI9+PSI10 -C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. -C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 -C - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV.EQ.0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF -C -C IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN -C PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) -C PSI9 = MAX (MIN (PSI9,CHI9), ZERO) -C ELSE -C PSI9 = ZERO -C ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (PSI9,CHI9) - ELSE - PSI9 = 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 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 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 = ZERO - CNANO3 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 -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 -C20 FUNCM6 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCM6 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCM6 ******************************************* -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM5 -C *** CASE M5 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM5 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! 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 = FUNCM5 (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 = FUNCM5 (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) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCM5 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = 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 - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 -C A7 = XK8 *(WATER/GAMA(1))**2.0 -C A8 = XK9 *(WATER/GAMA(3))**2.0 -C A11 = 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 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) - & /(1.D0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* - & (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) - & -A1/4.D0)/(1.D0+RIZ) -C AA = PSI7+PSI8+PSI9+PSI10 -C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. -C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 -C - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV.EQ.0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF -C - IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF -C -C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 -C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) -C IF (ISLV.EQ.0) THEN -C PSI9 = MIN (PSI9,CHI9) -C ELSE -C PSI9 = ZERO -C ENDIF -C 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 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 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 = ZERO - CNANO3 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 -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 -C20 FUNCM5 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCM5 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCM5 ******************************************* -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM4 -C *** CASE M4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL -C 4. Completely dissolved: NH4NO3, NANO3, NACL -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM4 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** -C - IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN - SCASE = 'M4 ; SUBCASE 1' - CALL CALCM1A - SCASE = 'M4 ; SUBCASE 1' - RETURN - ENDIF -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! 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 = FUNCM4 (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 = FUNCM4 (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) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL -C 4. Completely dissolved: NH4NO3, NANO3, NACL -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCM4 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = 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 - A3 = XK6 /(R*TEMP*R*TEMP) - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 -C A7 = XK8 *(WATER/GAMA(1))**2.0 -C A8 = XK9 *(WATER/GAMA(3))**2.0 -C A11 = 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 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,TINY),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) - & /(1.D0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* - & (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) - & -A1/4.D0)/(1.D0+RIZ) -C AA = PSI7+PSI8+PSI9+PSI10 -C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. -C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 -C - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV.EQ.0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF -C - IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF -C -C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 -C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) -C IF (ISLV.EQ.0) THEN -C PSI9 = MIN (PSI9,CHI9) -C ELSE -C PSI9 = ZERO -C ENDIF -C 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 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 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 = ZERO - CNANO3 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 -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 - PSI3 = MAX (MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) -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 -C20 FUNCM4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCM4 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCM4 ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM3 -C *** CASE M3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL -C 4. Completely dissolved: NH4NO3, NANO3 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM3 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** -C - IF (W(4).LE.TINY) THEN ! NO3 NOT EXIST, WATER NOT POSSIBLE - SCASE = 'M3 ; SUBCASE 1' - CALL CALCM1A - SCASE = 'M3 ; SUBCASE 1' - RETURN - ENDIF -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! 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 = FUNCM3 (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 = FUNCM3 (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) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL -C 4. Completely dissolved: NH4NO3, NANO3 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCM3 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = 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 - A3 = XK6 /(R*TEMP*R*TEMP) - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A10 = XK23 *(WATER/GAMA(21))**2.0 -C A8 = XK9 *(WATER/GAMA(3))**2.0 -C A11 = 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 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,TINY),CHI4) - ELSE - PSI4 = TINY - ENDIF -C -C IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION -C VITA = 2.D0*PSI1+PSI8+PSI6 ! AN DE DOULEPSEI KALA VGALE PSI1 APO DW -C GKAMA= PSI6*(2.D0*PSI1+PSI8)-A7 -C DIAK = MAX(VITA**2.0 - 4.0D0*GKAMA,ZERO) -C PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) -C PSI7 = MAX(MIN(PSI7, CHI7), ZERO) -C 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 -CC -C - IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) - & /(1.D0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* - & (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) - & -A1/4.D0)/(1.D0+RIZ) -C AA = PSI7+PSI8+PSI9+PSI10 -C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. -C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 -C - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV.EQ.0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF -C - IF (CHI9.GE.TINY) THEN - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF -C -C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 -C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) -C IF (ISLV.EQ.0) THEN -C PSI9 = MIN (PSI9,CHI9) -C ELSE -C PSI9 = ZERO -C ENDIF -C 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 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 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 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 -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 - PSI3 = MAX (MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) -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 -C20 FUNCM3 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCM3 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCM3 ******************************************* -C - END - - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM2 -C *** CASE M2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -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 M1A, M2B -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 CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCM1A, CALCM3 -C -C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** -C - CALL CALCM1A -C - IF (CNH4NO3.GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE - SCASE = 'M2 ; SUBCASE 1' - CALL CALCM2A - SCASE = 'M2 ; SUBCASE 1' - ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE - SCASE = 'M2 ; SUBCASE 1' - CALL CALCM1A - SCASE = 'M2 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY .AND. RH.LT.DRMM2) THEN ! DRY AEROSOL - SCASE = 'M2 ; SUBCASE 2' -C - ELSEIF (WATER.LE.TINY .AND. RH.GE.DRMM2) THEN ! MDRH OF M2 - SCASE = 'M2 ; SUBCASE 3' - CALL CALCMDRH2 (RH, DRMM2, DRNANO3, CALCM1A, CALCM3) - SCASE = 'M2 ; SUBCASE 3' - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCM2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM2A -C *** CASE M2A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -C 4. Completely dissolved: NH4NO3 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM2A - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! 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 = FUNCM2A (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 = FUNCM2A (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) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -C 4. Completely dissolved: NH4NO3 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCM2A (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = 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 - A3 = XK6 /(R*TEMP*R*TEMP) - 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 = XK17 *(WATER/GAMA(17))**3.0 - A64 = (XK3*XK2/XKW)*(GAMA(10)/GAMA(5)/GAMA(11))**2.0 - A64 = A64*(R*TEMP*WATER)**2.0 -C A11 = 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 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,TINY),CHI4) - ELSE - PSI4 = TINY - ENDIF -C -C IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION -C VITA = 2.D0*PSI1+PSI8+PSI6 -C GKAMA= PSI6*(2.D0*PSI1+PSI8)-A7 -C DIAK = MAX(VITA**2.0 - 4.0D0*GKAMA,ZERO) -C PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) -C PSI7 = MAX(MIN(PSI7, CHI7), ZERO) -C ENDIF -CC -C IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION -C BIT = 2.D0*PSI1+PSI7+PSI5 -C GKAM = PSI5*(2.D0*PSI1+PSI8)-A8 -C DIA = BIT**2.0 - 4.0D0*GKAM -C PSI8 = 0.5D0*( -BIT + SQRT(DIA) ) -C PSI8 = MAX(MIN(PSI8, CHI8), ZERO) -C ENDIF -CC - 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 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) - & /(1.D0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* - & (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) - & -A1/4.D0)/(1.D0+RIZ) -C -C AA = PSI7+PSI8+PSI9+PSI10 -C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. -C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 -CC - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV.EQ.0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF -C - IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN -C PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF -C -C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 -C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) -C IF (ISLV.EQ.0) THEN -C PSI9 = MAX (MIN (PSI9,CHI9), ZERO) -C ELSE -C PSI9 = ZERO -C ENDIF -C 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 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 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) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 -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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) -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 -C20 FUNCM2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A64 - ONE -20 FUNCM2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCM2A ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM1 -C *** CASE M1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 -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 CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCM1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCM1A, CALCM2A -C -C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** -C - IF (RH.LT.DRMM1) THEN - SCASE = 'M1 ; SUBCASE 1' - CALL CALCM1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'M1 ; SUBCASE 1' - ELSE - SCASE = 'M1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRMM1, DRNH4NO3, CALCM1A, CALCM2A) - SCASE = 'M1 ; SUBCASE 2' - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCM1 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCM1A -C *** CASE M1A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 -C -C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= - - SUBROUTINE CALCM1A - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, - & NO3FR -C -C *** CALCULATE NON VOLATILE SOLIDS *********************************** -C - CCASO4 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2) - CCASO4, ZERO) - CAFR = MAX(W(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX(SO4FR - CK2SO4, ZERO) - CMGSO4 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) - CNA2SO4 = MAX (SO4FR,ZERO) ! CNA2SO4 - NAFR = MAX (W(1)-2.D0*CNA2SO4, ZERO) - CNANO3 = MIN (NAFR, W(4)) ! CNANO3 - NO3FR = MAX (W(4)-CNANO3, ZERO) - CNACL = MIN (MAX(NAFR-CNANO3, ZERO), W(5)) ! CNACL - 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 CALCM1A ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP13 -C *** CASE P13 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP13 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP13 (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 = FUNCP13 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP13 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI4 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = CHI9 - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = CHI13 - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C -C *** CALCULATE SPECIATION ********************************************* -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -C -C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 -C20 FUNCP13 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP13 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP13 ******************************************* -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP12 -C *** CASE P12 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP12 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP12 (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 = FUNCP12 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP12 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI4 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = CHI13 - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 -C20 FUNCP12 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP12 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP12 ******************************************* -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP11 -C *** CASE P11 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP11 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP11 (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 = FUNCP11 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP11 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 =0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 -C20 FUNCP11 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP11 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP11 ******************************************* -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP10 -C *** CASE P10 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP10 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP10 (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 = FUNCP10 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP10 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 =0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 -C20 FUNCP10 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP10 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP10 ******************************************* -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP9 -C *** CASE P9 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP9 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP9 (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 = FUNCP9 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP9 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 -C20 FUNCP9 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP9 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP9 ******************************************* -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP8 -C *** CASE P8 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP8 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP8 (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 = FUNCP8 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP8 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -C -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO -C CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) -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 -C20 FUNCP8 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP8 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP8 ******************************************* -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP7 -C *** CASE P7 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NH4NO3 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP7 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP7 (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 = FUNCP7 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NH4NO3 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP7 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO -C CNH4CL = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) -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 -C20 FUNCP7 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP7 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP7 ******************************************* -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP6 -C *** CASE P6 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NH4NO3 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP6 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP6 (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 = FUNCP6 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NH4NO3 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP6 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - - & A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF -C - IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION -C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 -C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 -C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) -C PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- - & PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -C -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C - CNH4NO3 = ZERO -C CNH4CL = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) -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 -C20 FUNCP6 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP6 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP6 ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP5 -C *** CASE P5 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4, -C NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP5 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP6 -C -C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ -C - IF (W(4).GT.TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'P5 ; SUBCASE 1' - CALL CALCP5A - SCASE = 'P5 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A - SCASE = 'P1 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP5) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCP1A - SCASE = 'P5 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'P5 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP5, DRNH4NO3, CALCP1A, CALCP6) - SCASE = 'P5 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCP5 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP5A -C *** CASE P5A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP5A - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP5 (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 = FUNCP5 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP5 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF -C - IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION -C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 -C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 -C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) -C PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- - & PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -CC -CC *** CALCULATE H+ ***************************************************** -CC -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C -C CNH4NO3 = ZERO -C CNH4CL = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) -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 *** NH4NO3(s) calculations -C - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3.GT.A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5), ZERO) -C -C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* -C - GNH3 = MAX(GNH3 - PSI2, TINY) - GHCL = MAX(GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 -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 -C20 FUNCP5 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP5 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP5 ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP4 -C *** CASE P4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP4 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP5A -C -C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ -C - IF (W(4).GT.TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'P4 ; SUBCASE 1' - CALL CALCP4A - SCASE = 'P4 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A - SCASE = 'P1 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP4) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCP1A - SCASE = 'P4 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'P4 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP4, DRMGNO32, CALCP1A, CALCP5A) - SCASE = 'P4 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCP4 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP4A -C *** CASE P4A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3, MG(NO3)2 -C 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP4A - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP4 (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 = FUNCP4 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3, MG(NO3)2 -C 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP4 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF -C - IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION -C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 -C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 -C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) -C PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- - & PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C -C CNH4CL = ZERO -C CNH4NO3 = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) -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 *** NH4NO3(s) calculations -C - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3.GT.A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5), ZERO) -C -C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* -C - GNH3 = MAX(GNH3 - PSI2, TINY) - GHCL = MAX(GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 -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 -C20 FUNCP4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP4 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP4 ******************************************* -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP3 -C *** CASE P3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP4A -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 = 'P3 ; SUBCASE 1' - CALL CALCP3A - SCASE = 'P3 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A - SCASE = 'P1 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP3) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCP1A - SCASE = 'P3 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'P3 ; SUBCASE 3' ! MDRH REGION (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP3, DRCANO32, CALCP1A, CALCP4A) - SCASE = 'P3 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCP3 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP3A -C *** CASE P3A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2 -C 4. Completely dissolved: CACL2, MGCL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP3A - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP3 (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 = FUNCP3 (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2 -C 4. Completely dissolved: CACL2, MGCL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP3 (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF -C - IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION -C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 -C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 -C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) -C PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- - & PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C -C CNH4CL = ZERO -C CNH4NO3 = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) -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 *** NH4NO3(s) calculations -C - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3.GT.A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5),ZERO) -C -C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* -C - GNH3 = MAX(GNH3 - PSI2, TINY) - GHCL = MAX(GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 -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 -C20 FUNCP3 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP3 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP3 ******************************************* -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP2 -C *** CASE P2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C THERE ARE THREE REGIMES IN THIS CASE: -C 1. CACL2(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A) -C 2. CACL2(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -C 3. CACL2(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL -C -C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES P1A, P2B -C RESPECTIVELY -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C -C - SUBROUTINE CALCP2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP3A, CALCP4A, CALCP5A, CALCP6 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCP1A -C -C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** -C - IF (CCACL2.GT.TINY) THEN - SCASE = 'P2 ; SUBCASE 1' - CALL CALCP2A - SCASE = 'P2 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP2) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCP1A - SCASE = 'P2 ; SUBCASE 2' - ELSE - IF (CMGCL2.GT. TINY) THEN - SCASE = 'P2 ; SUBCASE 3' ! MDRH (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MGCL2, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP2, DRMGCL2, CALCP1A, CALCP3A) - SCASE = 'P2 ; SUBCASE 3' - ENDIF - IF (WATER.LE.TINY .AND. RH.GE.DRMP3 .AND. RH.LT.DRMP4) THEN - SCASE = 'P2 ; SUBCASE 4' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, CANO32, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP3, DRCANO32, CALCP1A, CALCP4A) - SCASE = 'P2 ; SUBCASE 4' - ENDIF - IF (WATER.LE.TINY .AND. RH.GE.DRMP4 .AND. RH.LT.DRMP5) THEN - SCASE = 'P2 ; SUBCASE 5' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C MGNO32, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP4, DRMGNO32, CALCP1A, CALCP5A) - SCASE = 'P2 ; SUBCASE 5' - ENDIF - IF (WATER.LE.TINY .AND. RH.GE.DRMP5) THEN - SCASE = 'P2 ; SUBCASE 6' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP5, DRNH4NO3, CALCP1A, CALCP6) - SCASE = 'P2 ; SUBCASE 6' - ELSE - WATER = TINY - DO 20 I=1,NIONS - MOLAL(I) = ZERO -20 CONTINUE - CALL CALCP1A - SCASE = 'P2 ; SUBCASE 2' - ENDIF - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCP2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP2A -C *** CASE P2A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2 -C 4. Completely dissolved: CACL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP2A - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) -C - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) -C - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO -C - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI6LO - Y1 = FUNCP2A (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 = FUNCP2A (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) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2, MGCL2 -C 4. Completely dissolved: CACL2 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCP2A (X) - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - 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 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) -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 = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF -C - IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF -C - IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - - & PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF -C - IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV.EQ.0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF -C - IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF -C - IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION -C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 -C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 -C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) -C PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- - & PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI -C -C *** CALCULATE H+ ***************************************************** -C -C REST = 2.D0*W(2) + W(4) + W(5) -CC -C DELT1 = 0.0d0 -C DELT2 = 0.0d0 -C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -CC -CC *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** -CC -C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -C ALFA2 = XK27*(WATER/1.0) ! HCO3- -CC -C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) -CC -C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) -C DELT1 = 0.5*(-ALFA1 + DIAK) -C DELT1 = MIN ( MAX (DELT1, ZERO), X) -C DELT2 = ALFA2 -C DELT2 = MIN ( DELT2, DELT1) -C MOLAL(1) = DELT1 + DELT2 ! H+ -C ELSE -CC -CC *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* -CC - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - & - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI -C ENDIF -C - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) -C -C CNH4CL = ZERO -C CNH4NO3 = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = 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 - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) -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 *** NH4NO3(s) calculations -C - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3.GT.A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5),ZERO) -C -C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* -C - GNH3 = MAX (GNH3 - PSI2, TINY) - GHCL = MAX (GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 -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 -C20 FUNCP2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -20 FUNCP2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCP2A ******************************************* -C - END - - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP1 -C *** CASE P1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -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 CALCP1A) -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCP1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP2A -C -C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** -C - IF (RH.LT.DRMP1) THEN - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'P1 ; SUBCASE 1' - ELSE - SCASE = 'P1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRMP1, DRCACL2, CALCP1A, CALCP2A) - SCASE = 'P1 ; SUBCASE 2' - ENDIF -C -C - RETURN -C -C *** END OF SUBROUTINE CALCP1 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCP1A -C *** CASE P1A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= - - SUBROUTINE CALCP1A - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, - & NO3FR -C -C *** CALCULATE NON VOLATILE SOLIDS *********************************** -C - CCASO4 = MIN (W(2), W(6)) !SOLID CASO4 - CAFR = MAX (W(6) - CCASO4, ZERO) - SO4FR = MAX (W(2) - CCASO4, ZERO) - CK2SO4 = MIN (SO4FR, 0.5D0*W(7)) !SOLID K2SO4 - FRK = MAX (W(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX (SO4FR - CK2SO4, ZERO) - CMGSO4 = SO4FR !SOLID MGSO4 - FRMG = MAX (W(8) - CMGSO4, ZERO) - CNACL = MIN (W(1), W(5)) !SOLID NACL - NAFR = MAX (W(1) - CNACL, ZERO) - CLFR = MAX (W(5) - CNACL, ZERO) - CCANO32 = MIN (CAFR, 0.5D0*W(4)) !SOLID CA(NO3)2 - CAFR = MAX (CAFR - CCANO32, ZERO) - NO3FR = MAX (W(4) - 2.D0*CCANO32, ZERO) - CCACL2 = MIN (CAFR, 0.5D0*CLFR) !SOLID CACL2 - CAFR = MAX (CAFR - CCACL2, ZERO) - CLFR = MAX (CLFR - 2.D0*CCACL2, ZERO) - CMGNO32 = MIN (FRMG, 0.5D0*NO3FR) !SOLID MG(NO3)2 - FRMG = MAX (FRMG - CMGNO32, ZERO) - NO3FR = MAX (NO3FR - 2.D0*CMGNO32, ZERO) - CMGCL2 = MIN (FRMG, 0.5D0*CLFR) !SOLID MGCL2 - FRMG = MAX (FRMG - CMGCL2, ZERO) - CLFR = MAX (CLFR - 2.D0*CMGCL2, ZERO) - CNANO3 = MIN (NAFR, NO3FR) !SOLID NANO3 - NAFR = MAX (NAFR - CNANO3, ZERO) - NO3FR = MAX (NO3FR - CNANO3, ZERO) - CKCL = MIN (FRK, CLFR) !SOLID KCL - FRK = MAX (FRK - CKCL, ZERO) - CLFR = MAX (CLFR - CKCL, ZERO) - CKNO3 = MIN (FRK, NO3FR) !SOLID KNO3 - FRK = MAX (FRK - CKNO3, ZERO) - NO3FR = MAX (NO3FR - CKNO3, 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 CALCP1A ***************************************** -C - END -C -C====================================================================== -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCL9 -C *** CASE L9 -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 : CASO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4, K2SO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL9 - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = CNA2SO4 - PSI5 = CNH42S4 - PSI6 = CK2SO4 - PSI7 = CMGSO4 - PSI8 = CKHSO4 -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 - A9 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. -C -C CALCULATE DISSOCIATION QUANTITIES -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = PSI2 + PSI3 + PSI1 + PSI8 - LAMDA ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CKHSO4 = 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 -20 RETURN -C -C *** END OF SUBROUTINE CALCL9 ***************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCL8 -C *** CASE L8 -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 : K2SO4, CASO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL8 - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = CNA2SO4 - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = CMGSO4 - PSI8 = CKHSO4 -C - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI6LO = ZERO ! Low limit - PSI6HI = CHI6 ! High limit -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - IF (CHI6.LE.TINY) THEN - Y1 = FUNCL8 (ZERO) - GOTO 50 - ENDIF -C - X1 = PSI6HI - Y1 = FUNCL8 (X1) - YHI= Y1 ! Save Y-value at HI position -C -C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 ********* -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 = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCL8 (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 K2SO4 -C - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL8 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL8') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL8 (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, 'CALCL8') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL8 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCL8 ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** FUNCTION FUNCL8 -C *** CASE L8 -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 : K2SO4, CASO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4 -C -C SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL8 (P6) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI6 = P6 -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 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) -C -C CALCULATE DISSOCIATION QUANTITIES -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = BB*BB - 4.D0*CC - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = 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 A6 = XK17*(WATER/GAMA(17))**3.0 - FUNCL8 = MOLAL(9)*MOLAL(9)*MOLAL(5)/A6 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL8 **************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL7 -C *** CASE L7 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL7 - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = CMGSO4 - PSI8 = CKHSO4 -C - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - IF (CHI4.LE.TINY) THEN - Y1 = FUNCL7 (ZERO) - GOTO 50 - ENDIF -C - X1 = PSI4HI - Y1 = FUNCL7 (X1) - YHI= Y1 ! Save Y-value at HI position -C -C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 ********* -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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL7 (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 K2SO4 -C - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL7 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL7') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL7 (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, 'CALCL7') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL7 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCL7 ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** FUNCTION FUNCL7 -C *** CASE L7 -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 : K2SO4, CASO4, NA2SO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4 -C -C SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL7 (P4) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 - A6 = XK17*(WATER/GAMA(17))**3.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) -C -C CALCULATE DISSOCIATION QUANTITIES -C -C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 -C PSI6 = MIN (MAX (PSI6, ZERO), CHI6) -C - IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV.EQ.0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = BB*BB - 4.D0*CC - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = 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 - FUNCL7 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL7 **************************************** -C - END -C -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL6 -C *** CASE L6 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, NA2SO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL6 - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = ZERO - PSI8 = CKHSO4 -C - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - IF (CHI4.LE.TINY) THEN - Y1 = FUNCL6 (ZERO) - GOTO 50 - ENDIF -C - X1 = PSI4HI - Y1 = FUNCL6 (X1) - YHI= Y1 ! Save Y-value at HI position -C -C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 ********* -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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL6 (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 K2SO4 -C - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL6 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL6') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL6 (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, 'CALCL6') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL6 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCL6 ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** FUNCTION FUNCL6 -C *** CASE L6 -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 : K2SO4, CASO4, MGSO4, NA2SO4 -C -C SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL6 (P4) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 - A6 = XK17*(WATER/GAMA(17))**3.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) -C -C CALCULATE DISSOCIATION QUANTITIES -C -C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 -C PSI6 = MIN (MAX (PSI6, ZERO), CHI6) -C - IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV.EQ.0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF -C - PSI7 = CHI7 -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = BB*BB - 4.D0*CC - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = 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 - FUNCL6 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL6 **************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL5 -C *** CASE L5 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NA2SO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL5 - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = ZERO - PSI8 = ZERO -C - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit - -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - IF (CHI4.LE.TINY) THEN - Y1 = FUNCL5 (ZERO) - GOTO 50 - ENDIF -C - X1 = PSI4HI - Y1 = FUNCL5 (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 = MAX(X1-DX, PSI4LO) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL5 (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 - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL5 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL5') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL5 (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, 'CALCL5') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL5 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCL5 ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** FUNCTION FUNCL5 -C *** CASE L5 -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 : K2SO4, CASO4, MGSO4, KHSO4, NA2SO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4 -C -C SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL5 (P4) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 - A6 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) -C -C CALCULATE DISSOCIATION QUANTITIES -C -C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 -C PSI6 = MIN (MAX (PSI6, ZERO), CHI6) -C - IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV.EQ.0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF -C - PSI7 = CHI7 -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = MAX(CHI8 - PSI8, 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 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCL5 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE -C - RETURN -C -C *** END OF FUNCTION FUNCL5 **************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL4 -C *** CASE L4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL4 - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = ZERO - PSI8 = ZERO -C - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit -C - IF (CHI4.LE.TINY) THEN - Y1 = FUNCL4 (ZERO) - GOTO 50 - ENDIF -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI4HI - Y1 = FUNCL4 (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 - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL4 (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 - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL4 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL4') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL4 (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, 'CALCL4') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL4 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCL4 ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** FUNCTION FUNCL4 -C *** CASE L4 -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 : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4 -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC -C -C SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL4 (P4) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) ! psi5 - & /2.D0/SQRT(A4/A5) - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) -C - PSI7 = CHI7 -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C -C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 -C PSI6 = MIN (MAX (PSI6, ZERO), CHI6) -C - IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV.EQ.0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF -C - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = MAX(CHI5 - PSI5, ZERO) - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = MAX(CHI8 - PSI8, 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 - FUNCL4 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL4 **************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL3 -C *** CASE L3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, 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 CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCL1A, CALCL4 -C -C *** FIND DRY COMPOSITION ********************************************* -C - CALL CALCL1A -C -C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************* -C - IF (CNH4HS4.GT.TINY .OR. CNAHSO4.GT.TINY) THEN - SCASE = 'L3 ; SUBCASE 1' - CALL CALCL3A ! FULL SOLUTION - SCASE = 'L3 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRML3) THEN ! SOLID SOLUTION - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCL1A - SCASE = 'L3 ; SUBCASE 2' -C - ELSEIF (RH.GE.DRML3) THEN ! MDRH OF L3 - SCASE = 'L3 ; SUBCASE 3' - CALL CALCMDRH2 (RH, DRML3, DRLC, CALCL1A, CALCL4) - SCASE = 'L3 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCL3 ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL3A -C *** CASE L3 ; SUBCASE 1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL3A - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = ZERO - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = ZERO - PSI8 = 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 = FUNCL3A (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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL3A (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) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL3A (ZERO) - ENDIF - GOTO 50 -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL3A (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, 'CALCL3A') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL3A (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCL3A ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE FUNCL3A -C *** CASE L3 ; SUBCASE 1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL3A (P2) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 FUNCL3B FOR Y4=0 ******************************** -C - IF (CHI4.LE.TINY) THEN - FUNCL3A = FUNCL3B (ZERO) - GOTO 50 - ENDIF -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI4HI - Y1 = FUNCL3B (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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL3B (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) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL3B (PSI4LO) - ENDIF - GOTO 50 -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL3B (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, 'FUNCL3A') ! WARNING ERROR: NO CONVERGENCE -C -C *** INNER LOOP CONVERGED ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL3B (X3) -C -C *** CALCULATE FUNCTION VALUE FOR INTERNAL LOOP *************************** -C -50 A2 = XK13*(WATER/GAMA(13))**5.0 - FUNCL3A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.0/A2 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL3A ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** FUNCTION FUNCL3B -C *** CASE L3 ; 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 : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4 -C -C SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL3B (P4) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI4 = P4 -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 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) ! psi5 - & /2.D0/SQRT(A4/A5) - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) -C - PSI7 = CHI7 -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C -C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 -C PSI6 = MIN (MAX (PSI6, ZERO), CHI6) -C - IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV.EQ.0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF -C - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = MAX(CHI2 - PSI2, ZERO) - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = MAX(CHI5 - PSI5, ZERO) - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = MAX(CHI7 - PSI7, ZERO) - CKHSO4 = MAX(CHI8 - PSI8, 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 - FUNCL3B = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL3B **************************************** -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL2 -C *** CASE L2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -C -C THERE ARE THREE REGIMES IN THIS CASE: -C 1. NH4HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A) -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 L1A, L2B -C RESPECTIVELY -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCL1A, CALCL3A -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCL1A -C -C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** -C - IF (CNH4HS4.GT.TINY) THEN - SCASE = 'L2 ; SUBCASE 1' - CALL CALCL2A - SCASE = 'L2 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRML2) THEN ! SOLID SOLUTION ONLY - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCL1A - SCASE = 'L2 ; SUBCASE 2' -C - ELSEIF (RH.GE.DRML2) THEN ! MDRH OF L2 - SCASE = 'L2 ; SUBCASE 3' - CALL CALCMDRH2 (RH, DRML2, DRNAHSO4, CALCL1A, CALCL3A) - SCASE = 'L2 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCL2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL2A -C *** CASE L2 ; SUBCASE 1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -C 4. COMPLETELY DISSOLVED: NH4HSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL2A - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 -C - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = ZERO - PSI3 = ZERO - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = ZERO - PSI8 = 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 = FUNCL2A (X1) - YHI= Y1 ! Save Y-value at HI position -C -C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ********* -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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL2A (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) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL2A (ZERO) - ENDIF - GOTO 50 -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL2A (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, 'CALCL2A') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL2A (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCL2A ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE FUNCL2A -C *** CASE L2 ; SUBCASE 1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -C 4. COMPLETELY DISSOLVED: NH4HSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL2A (P2) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - - PSI2 = P2 ! Save PSI3 in COMMON BLOCK - PSI4LO = ZERO ! Low limit for PSI4 - PSI4HI = CHI4 ! High limit for PSI4 -C -C *** IF NH3 =0, CALL FUNCL3B FOR Y4=0 ******************************** -C - - IF (CHI4.LE.TINY) THEN - FUNCL2A = FUNCL2B (ZERO) - GOTO 50 - ENDIF -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - - X1 = PSI4HI - Y1 = FUNCL2B (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 LC ********* -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) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL2B (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) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCL2B (PSI4LO) - ENDIF - GOTO 50 -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL2B (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, 'FUNCL2A') ! WARNING ERROR: NO CONVERGENCE -C -C *** INNER LOOP CONVERGED ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCL2B (X3) -C -C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** -C -50 A2 = XK13*(WATER/GAMA(13))**5.0 - FUNCL2A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.0/A2 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL2A ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE FUNCL2B -C *** CASE L2 ; SUBCASE 2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -C 4. COMPLETELY DISSOLVED: NH4HSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCL2B (P4) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - PSI4 = P4 ! Save PSI4 in COMMON BLOCK -C -C *** SETUP PARAMETERS ************************************************ -C - FRST = .TRUE. - CALAIN = .TRUE. - PSI3 = CHI3 - PSI5 = CHI5 - LAMDA = ZERO - PSI6 = CHI6 - PSI8 = CHI8 -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 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) -C -C CALCULATE DISSOCIATION QUANTITIES -C - PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) ! psi5 - & /2.D0/SQRT(A4/A5) - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) -C - IF (CHI3.GT.TINY .AND. WATER.GT.TINY) THEN - AA = 2.D0*PSI4 + PSI2 + PSI1 + PSI8 - LAMDA - BB = 2.D0*PSI4*(PSI2 + PSI1 + PSI8 - LAMDA) - 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 - PSI7 = CHI7 -C - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) -C -C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 -C PSI6 = MIN (MAX (PSI6, ZERO), CHI6) -C - IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV.EQ.0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF -C - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA ! PSI8 - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) -C -C *** CALCULATE SPECIATION ******************************************** -C - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI -C - CLC = MAX(CHI2 - PSI2, ZERO) - CNAHSO4 = MAX(CHI3 - PSI3, ZERO) - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = MAX(CHI5 - PSI5, ZERO) - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = MAX(CHI7 - PSI7, ZERO) - CKHSO4 = MAX(CHI8 - PSI8, 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 - FUNCL2B = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN -C -C *** END OF FUNCTION FUNCL2B **************************************** -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL1 -C *** CASE L1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID & LIQUID AEROSOL POSSIBLE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -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 CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCL1A, CALCL2A -C -C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** -C - IF (RH.LT.DRML1) THEN - SCASE = 'L1 ; SUBCASE 1' - CALL CALCL1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'L1 ; SUBCASE 1' - ELSE - SCASE = 'L1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRML1, DRNH4HS4, CALCL1A, CALCL2A) - SCASE = 'L1 ; SUBCASE 2' - ENDIF -C -C *** AMMONIA IN GAS PHASE ********************************************** -C -C CALL CALCNH3 -C - RETURN -C -C *** END OF SUBROUTINE CALCL1 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCL1A -C *** CASE L1A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, 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 CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCL1A - INCLUDE 'isrpia.inc' -C -C *** CALCULATE NON VOLATILE SOLIDS *********************************** -C - CCASO4 = MIN (W(6), W(2)) ! CCASO4 - FRSO4 = MAX(W(2) - CCASO4, ZERO) - CAFR = MAX(W(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*W(7), FRSO4) ! CK2SO4 - FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO) - FRSO4 = MAX(FRSO4 - CK2SO4, ZERO) - CNA2SO4 = MIN (0.5D0*W(1), FRSO4) ! CNA2SO4 - FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO) - FRSO4 = MAX(FRSO4 - CNA2SO4, ZERO) - CMGSO4 = MIN (W(8), FRSO4) ! CMGSO4 - FRMG = MAX(W(8) - CMGSO4, ZERO) - FRSO4 = MAX(FRSO4 - CMGSO4, ZERO) -C - CNH4HS4 = ZERO - CNAHSO4 = ZERO - CNH42S4 = ZERO - CKHSO4 = 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) -C IF (CK2SO4.GT.TINY) THEN -C FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) -C CKHSO4 = 2.D0*FRSO4 -C CK2SO4 = MAX(CK2SO4-FRSO4, ZERO) -C ENDIF -C IF (CNA2SO4.GT.TINY) THEN -C FRSO4 = MAX(FRSO4-CKHSO4/2.D0, ZERO) -C CNAHSO4 = 2.D0*FRSO4 -C CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO) -C ENDIF -C - IF (CNA2SO4.GT.TINY) THEN - FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) - CNAHSO4 = 2.D0*FRSO4 - CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO) - ENDIF - IF (CK2SO4.GT.TINY) THEN - FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) - CKHSO4 = 2.D0*FRSO4 - CK2SO4 = MAX(CK2SO4-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 CALCL1A ***************************************** -C - END -C -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCK4 -C *** CASE K4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CASO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCK4 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, - & A1, A2, A3, A4 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU =.TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. -C - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MgSO4 -C - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED - PSI2 = CHI2 ! ALL NaHSO4 DELIQUESCED - PSI3 = CHI3 ! ALL KHSO4 DELIQUESCED - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 -C - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (1) = MAX(LAMDA + KAPA, TINY) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA + PSI1 + PSI2 + PSI3 - KAPA, ZERO) ! HSO4I - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 ! MGI -C - CNH4HS4 = ZERO - CNAHSO4 = ZERO - CKHSO4 = ZERO - CCASO4 = W(6) - CMGSO4 = 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 -20 RETURN -C -C *** END OF SUBROUTINE CALCK4 -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCK3 -C *** CASE K3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : KHSO4, CASO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCK3 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, - & A1, A2, A3, A4 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU =.TRUE. ! Outer loop activity calculation flag - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MgSO4 -C - PSI3LO = TINY ! Low limit - PSI3HI = CHI3 ! High limit -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI3HI - Y1 = FUNCK3 (X1) - YHI= Y1 ! Save Y-value at HI position -C -C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 **** -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 = (PSI3HI-PSI3LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCK3 (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 KHSO4 -C - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK3 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCK3') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK3 (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, 'CALCK3') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK3 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCK3 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE FUNCK3 -C *** CASE K3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : KHSO4, CaSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCK3 (P1) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, - & A1, A2, A3, A4 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST = .TRUE. - CALAIN = .TRUE. -C - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI3 = P1 - PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED - PSI2 = CHI2 ! ALL NaHSO4 DELIQUESCED - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED - -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A3 = XK18 *(WATER/GAMA(18))**2.0 - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 -C -C - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (4) = ZERO - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I - MOLAL (7) = ZERO - MOLAL (8) = ZERO - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 -C - CNH4HS4 = ZERO - CNAHSO4 = ZERO - CKHSO4 = CHI3-PSI3 - CCASO4 = W(6) - CMGSO4 = 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 FUNCK3 = MOLAL(9)*MOLAL(6)/A3 - ONE -C -C *** END OF FUNCTION FUNCK3 ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCK2 -C *** CASE K2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : NAHSO4, KHSO4, CaSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCK2 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, - & A1, A2, A3, A4 -C -C *** SETUP PARAMETERS ************************************************ -C - CALAOU =.TRUE. ! Outer loop activity calculation flag - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MgSO4 -C - PSI3LO = TINY ! Low limit - PSI3HI = CHI3 ! High limit -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI3HI - Y1 = FUNCK2 (X1) - YHI= Y1 ! Save Y-value at HI position -C -C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 **** -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 = (PSI3HI-PSI3LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCK2 (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 KHSO4 -C - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK2 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCK2') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK2 (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, 'CALCK2') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - Y3 = FUNCK2 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCK2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE FUNCK2 -C *** CASE K2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : NAHSO4, KHSO4, CaSO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCK2 (P1) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, - & A1, A2, A3, A4 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST = .TRUE. - CALAIN = .TRUE. -C - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI3 = P1 - PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A2 = XK11 *(WATER/GAMA(12))**2.0 - A3 = XK18 *(WATER/GAMA(18))**2.0 - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 -C - PSI2 = A2/A3*PSI3 ! PSI2 - PSI2 = MIN(MAX(PSI2, ZERO),CHI2) -C - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (4) = ZERO - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I - MOLAL (7) = ZERO - MOLAL (8) = ZERO - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 -C - CNH4HS4 = ZERO - CNAHSO4 = CHI2-PSI2 - CKHSO4 = CHI3-PSI3 - CCASO4 = W(6) - CMGSO4 = 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 FUNCK2 = MOLAL(9)*MOLAL(6)/A3 - ONE -C -C *** END OF FUNCTION FUNCK2 ******************************************* -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCK1 -C *** CASE K1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, KHSO4, CASO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCK1 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, - & A1, A2, A3, A4 -C -C *** SETUP PARAMETERS ************************************************ -C - - CALAOU =.TRUE. ! Outer loop activity calculation flag - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MGSO4 -C - PSI3LO = TINY ! Low limit - PSI3HI = CHI3 ! High limit -C -C *** INITIAL VALUES FOR BISECTION ************************************ -C - X1 = PSI3HI - Y1 = FUNCK1 (X1) - YHI= Y1 ! Save Y-value at HI position -C -C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 **** -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 = (PSI3HI-PSI3LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y2 = FUNCK1 (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 KHSO4 -C - YLO= Y1 ! Save Y-value at Hi position - IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK1 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCK1') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -C -C *** PERFORM BISECTION *********************************************** -C -20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK1 (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, 'CALCK1') ! WARNING ERROR: NO CONVERGENCE -C -C *** CONVERGED ; RETURN ********************************************** -C -40 X3 = 0.5*(X1+X2) - CALL RSTGAMP ! reinitialize activity coefficients (slc.1.2012) - Y3 = FUNCK1 (X3) -C -50 RETURN -C -C *** END OF SUBROUTINE CALCK1 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE FUNCK1 -C *** CASE K1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE super RICH, FREE ACID (SO4RAT < 1.0) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, KHSO4, CASO4 -C -C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - DOUBLE PRECISION FUNCTION FUNCK1 (P1) - INCLUDE 'isrpia.inc' - DOUBLE PRECISION LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, - & A1, A2, A3, A4 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST = .TRUE. - CALAIN = .TRUE. -C - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI3 = P1 - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A1 = XK12 *(WATER/GAMA(09))**2.0 - A2 = XK11 *(WATER/GAMA(12))**2.0 - A3 = XK18 *(WATER/GAMA(18))**2.0 - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 -C - PSI1 = A1/A3*PSI3 ! PSI1 - PSI1 = MIN(MAX(PSI1, ZERO),CHI1) -C - PSI2 = A2/A3*PSI3 ! PSI2 - PSI2 = MIN(MAX(PSI2, ZERO),CHI2) -C - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) -C -C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** -C - MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (4) = ZERO ! CLI - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I - MOLAL (7) = ZERO ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 ! MGI -C - CNH4HS4 = CHI1-PSI1 - CNAHSO4 = CHI2-PSI2 - CKHSO4 = CHI3-PSI3 - CCASO4 = W(6) - CMGSO4 = 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 FUNCK1 = MOLAL(9)*MOLAL(6)/A3 - ONE -C -C *** END OF FUNCTION FUNCK1 **************************************** -C - END - - -c---------------------------------------------------------------------- -c --- ISOREV.FOR --- -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-2008, 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 = 'S2' - CALL CALCS2 ! Only liquid (metastable) - ELSE -C - IF (RH.LT.DRNH42S4) THEN - SCASE = 'S1' - CALL CALCS1 ! NH42SO4 ; case K1 -C - ELSEIF (DRNH42S4.LE.RH) THEN - SCASE = 'S2' - CALL CALCS2 ! 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 = 'B4' - ELSE -C - IF (RH.LT.DRNH4HS4) THEN - SCASE = 'B1' - CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case B1 - SCASE = 'B1' -C - ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN - SCASE = 'B2' - CALL CALCB2 ! LC,NH42S4 ; case B2 - SCASE = 'B2' -C - ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN - SCASE = 'B3' - CALL CALCB3 ! NH42S4 ; case B3 - SCASE = 'B3' -C - ELSEIF (DRNH42S4.LE.RH) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid ; case B4 - SCASE = 'B4' - 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 = 'C2' - ELSE -C - IF (RH.LT.DRNH4HS4) THEN - SCASE = 'C1' - CALL CALCC1 ! NH4HSO4 ; case C1 - SCASE = 'C1' -C - ELSEIF (DRNH4HS4.LE.RH) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid ; case C2 - SCASE = 'C2' - 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-2008, 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 = 'B4' - ELSE -C - IF (RH.LT.DRNH4HS4) THEN - SCASE = 'B1' - CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case O1 - SCASE = 'B1' -C - ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN - SCASE = 'B2' - CALL CALCB2 ! LC,NH42S4 ; case O2 - SCASE = 'B2' -C - ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN - SCASE = 'B3' - CALL CALCB3 ! NH42S4 ; case O3 - SCASE = 'B3' -C - ELSEIF (DRNH42S4.LE.RH) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid ; case O4 - SCASE = 'B4' - 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 = 'C2' - ELSE -C - IF (RH.LT.DRNH4HS4) THEN - SCASE = 'C1' - CALL CALCC1 ! NH4HSO4 ; case P1 - SCASE = 'C1' -C - ELSEIF (DRNH4HS4.LE.RH) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid ; case P2 - SCASE = 'C2' - 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-2008, 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 = 'I6' - ELSE -C - IF (RH.LT.DRNH4HS4) THEN - SCASE = 'I1' - CALL CALCI1 ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC - SCASE = 'I1' -C - ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN - SCASE = 'I2' - CALL CALCI2 ! NA2SO4,(NH4)2SO4,NAHSO4,LC - SCASE = 'I2' -C - ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRLC) THEN - SCASE = 'I3' - CALL CALCI3 ! NA2SO4,(NH4)2SO4,LC - SCASE = 'I3' -C - ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN - SCASE = 'I4' - CALL CALCI4 ! NA2SO4,(NH4)2SO4 - SCASE = 'I4' -C - ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN - SCASE = 'I5' - CALL CALCI5 ! NA2SO4 - SCASE = 'I5' -C - ELSEIF (DRNA2SO4.LE.RH) THEN - SCASE = 'I6' - CALL CALCI6 ! NO SOLIDS - SCASE = 'I6' - 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 = 'J3' - ELSE -C - IF (RH.LT.DRNH4HS4) THEN - SCASE = 'J1' - CALL CALCJ1 ! NH4HSO4,NAHSO4 - SCASE = 'J1' -C - ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN - SCASE = 'J2' - CALL CALCJ2 ! NAHSO4 - SCASE = 'J2' -C - ELSEIF (DRNAHSO4.LE.RH) THEN - SCASE = 'J3' - CALL CALCJ3 - SCASE = 'J3' - 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 -C *** ISORROPIA CODE II -C *** SUBROUTINE ISRP4R -C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF -C AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTTASIUM-MAGNESIUM AEROSOL SYSTEM. -C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM -C RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY. -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE ISRP4R (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 - IPROB = 1 ! SOLVE REVERSE PROBLEM -C METSTBL = 1 -C -10 CALL INIT4 (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, CRUSTAL & SODIUM RATIOS *********************** -C - IF (TRYLIQ) THEN ! ** WET AEROSOL - FRSO4 = WAER(2) - WAER(1)/2.0D0 - & - WAER(6) - WAER(7)/2.0D0 - WAER(8) ! SULFATE UNBOUND BY SODIUM,CALCIUM,POTTASIUM,MAGNESIUM - FRSO4 = MAX(FRSO4, TINY) - SRI = GETASR(FRSO4, RHI) ! SULFATE RATIO FOR NH4+ - SULRATW = (WAER(1)+FRSO4*SRI+WAER(6) - & +WAER(7)+WAER(8))/WAER(2) ! LIMITING SULFATE RATIO - SULRATW = MIN (SULRATW, 2.0D0) - ELSE - SULRATW = 2.0D0 ! ** DRY AEROSOL - ENDIF - SO4RAT = (WAER(1)+WAER(3)+WAER(6)+WAER(7)+WAER(8))/WAER(2) - CRNARAT = (WAER(1)+WAER(6)+WAER(7)+WAER(8))/WAER(2) - CRRAT = (WAER(6)+WAER(7)+WAER(8))/WAER(2) -C -C *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** -C -C *** SULFATE POOR ; SODIUM+CRUSTALS POOR -C - IF (SULRATW.LE.SO4RAT .AND. CRNARAT.LT.2.0) THEN -C - IF(METSTBL.EQ.1) THEN - SCASE = 'V7' - CALL CALCV7 ! Only liquid (metastable) - ELSE -C - IF (RH.LT.DRNH4NO3) THEN - SCASE = 'V1' - CALL CALCV1 ! CaSO4, NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN - SCASE = 'V2' - CALL CALCV2 ! CaSO4, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNH42S4) THEN - SCASE = 'V3' - CALL CALCV3 ! CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRMGSO4) THEN - SCASE = 'V4' - CALL CALCV4 ! CaSO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRNA2SO4) THEN - SCASE = 'V5' - CALL CALCV5 ! CaSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNA2SO4.LE.RH .AND. RH.LT.DRK2SO4) THEN - SCASE = 'V6' - CALL CALCV6 ! CaSO4, K2SO4 -C - ELSEIF (DRK2SO4.LE.RH) THEN - SCASE = 'V7' - CALL CALCV7 ! CaSO4 - ENDIF - ENDIF -C -C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C - ELSEIF (SO4RAT.GE.SULRATW .AND. CRNARAT.GE.2.0) THEN -C - IF (CRRAT.LE.2.0) THEN -C - IF(METSTBL.EQ.1) THEN - SCASE = 'U8' - CALL CALCU8 ! Only liquid (metastable) - ELSE -C - IF (RH.LT.DRNH4NO3) THEN - SCASE = 'U1' - CALL CALCU1 ! CaSO4, NH4NO3, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 -C - ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN - SCASE = 'U2' - CALL CALCU2 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 -C - ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN - SCASE = 'U3' - CALL CALCU3 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL -C - ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4Cl) THEN - SCASE = 'U4' - CALL CALCU4 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNH4Cl.LE.RH .AND. RH.LT.DRMGSO4) THEN - SCASE = 'U5' - CALL CALCU5 ! CaSO4, MGSO4, NA2SO4, K2SO4 -C - ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRNA2SO4) THEN - SCASE = 'U6' - CALL CALCU6 ! CaSO4, NA2SO4, K2SO4 -C - ELSEIF (DRNA2SO4.LE.RH .AND. RH.LT.DRK2SO4) THEN - SCASE = 'U7' - CALL CALCU7 ! CaSO4, K2SO4 -C - ELSEIF (DRK2SO4.LE.RH) THEN - SCASE = 'U8' - CALL CALCU8 ! CaSO4 - ENDIF - ENDIF -C -C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C - ELSEIF (CRRAT.GT.2.0) THEN -C - IF(METSTBL.EQ.1) THEN - SCASE = 'W13' - CALL CALCW13 ! Only liquid (metastable) - ELSE -C - IF (RH.LT.DRCACL2) THEN - SCASE = 'W1' - CALL CALCW1 ! CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRCACL2.LE.RH .AND. RH.LT.DRMGCL2) THEN - SCASE = 'W2' - CALL CALCW2 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRMGCL2.LE.RH .AND. RH.LT.DRCANO32) THEN - SCASE = 'W3' - CALL CALCW3 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRCANO32.LE.RH .AND. RH.LT.DRMGNO32) THEN - SCASE = 'W4' - CALL CALCW4 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, -C ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRMGNO32.LE.RH .AND. RH.LT.DRNH4NO3) THEN - SCASE = 'W5' - CALL CALCW5 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, -C ! NANO3, NACL, NH4NO3, NH4CL -C - ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN - SCASE = 'W6' - CALL CALCW6 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4CL -C - ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN - SCASE = 'W7' - CALL CALCW7 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NACL, NH4CL -C - ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4CL) THEN - SCASE = 'W8' - CALL CALCW8 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NH4CL -C - ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRKCL) THEN - SCASE = 'W9' - CALL CALCW9 ! CaSO4, K2SO4, KNO3, KCL, MGSO4 -C - ELSEIF (DRKCL.LE.RH .AND. RH.LT.DRMGSO4) THEN - SCASE = 'W10' - CALL CALCW10 ! CaSO4, K2SO4, KNO3, MGSO4 -C - ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRKNO3) THEN - SCASE = 'W11' - CALL CALCW11 ! CaSO4, K2SO4, KNO3 -C - ELSEIF (DRKNO3.LE.RH .AND. RH.LT.DRK2SO4) THEN - SCASE = 'W12' - CALL CALCW12 ! CaSO4, K2SO4 -C - ELSEIF (DRK2SO4.LE.RH) THEN - SCASE = 'W13' - CALL CALCW13 ! CaSO4 - ENDIF - ENDIF -C CALL CALCNH3 - ENDIF -C -C *** SULFATE RICH (NO ACID): 1 SULFATE RICH CASE. -C - IF (SULRATW.LE.SO4RAT .AND. SO4RAT.LT.2.0 - & .AND. WATER.LE.TINY) THEN - TRYLIQ = .FALSE. - GOTO 10 - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE ISRP4R ***************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCS2 -C *** CASE S2 -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-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCS2 - 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 CALCS2 **************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCS1 -C *** CASE S1 -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-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCS1 - 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 CALCS1 ****************************************** -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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCN2 - INCLUDE 'isrpia.inc' -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, 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-2008, 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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 -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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, 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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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 <==> NH4+ - 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. A7) 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 + A7)/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-2008, 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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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. A7) 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 + A7)/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-2008, 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-2008, 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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, 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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, 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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, 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-2008, 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 -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -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-2008, 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-2008, 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 -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV7 -C *** CASE V7 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV7 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCV1A -C - CHI9 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -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 -C - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C ION CONCENTRATIONS -C - NAI = WAER(1) - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - KI = WAER(7) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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, 'CALCV7') ! 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 - CNA2SO4 = ZERO - CMGSO4 = ZERO - CK2SO4 = ZERO - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCV7 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV6 -C *** CASE V6 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV6 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSI70 =-GREAT ! GREAT = 1.D10 - ROOT7 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCV1A -C - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS -C - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7)) - CC = WAER(7)*(WAER(2)-WAER(6)) + 0.25D0*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*WAER(2) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MIN (ROOT7,WAER(7)/2.0,MAX(WAER(2)-WAER(6),ZERO),CHI7) - ROOT7 = MAX (ROOT7, ZERO) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCV6') ! 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 - CNA2SO4 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCV6 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV5 -C *** CASE V5 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV5 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSCONV1 =.TRUE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCV1A -C - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 -C - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX(WAER(2)-WAER(6) - ROOT1, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, - & MAX ((WAER(2)-WAER(6)) - ROOT7, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX ((WAER(2)-WAER(6)) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCV5') ! 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 - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCV5****************************************** -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV4 -C *** CASE V4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV4 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSCONV1 =.TRUE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCV1A -C - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 - CHI8 = CMGSO4 -C - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX((WAER(2)-WAER(6)) - ROOT1, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, - & MAX ((WAER(2)-WAER(6)) - ROOT7, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX ((WAER(2)-WAER(6)) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCV4') ! 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 - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCV4****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV3 -C *** CASE V3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV3 - INCLUDE 'isrpia.inc' - LOGICAL EXNO, EXCL - EXTERNAL CALCV1A, CALCV4 -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 = 'V3 ; SUBCASE 1' - CALL CALCV3A - SCASE = 'V3 ; SUBCASE 1' -C - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH.LT.DRMO3) THEN - SCASE = 'V3 ; SUBCASE 2' - CALL CALCV1A ! SOLID - SCASE = 'V3 ; SUBCASE 2' - ELSE - SCASE = 'V3 ; SUBCASE 3' ! MDRH (CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4) - CALL CALCMDRPII (RH, DRMO3, DRNH42S4, CALCV1A, CALCV4) - SCASE = 'V3 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCV3 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV3A -C *** CASE V3A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV3A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1, PSCONV6 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSCONV1 =.TRUE. - PSCONV6 =.TRUE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI60 =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO - ROOT6 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCV1A -C - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 - CHI8 = CMGSO4 - CHI6 = CNH42S4 -C - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A6 = XK7 *(WATER/GAMA(4))**3.0 !(NH4)2SO4 <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1 - ROOT6) - CC = WAER(7)*((WAER(2) - WAER(6)) - ROOT1 - ROOT6) + - & 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6))-ROOT1-ROOT6)-A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX (WAER(2)-WAER(6)-ROOT1-ROOT6, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7 - ROOT6) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7 - ROOT6) + - & 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6))-ROOT7-ROOT6)-A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, - & MAX (WAER(2)-WAER(6)-ROOT7-ROOT6, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C AMMONIUM SULFATE -C - IF (NH4I*NH4I*SO4I .GT. A6) THEN - BB =-((WAER(2)-WAER(6)) + WAER(3) - ROOT7 - ROOT1) - CC = WAER(3)*((WAER(2)-WAER(6)) - ROOT7 - ROOT1) + - & 0.25*WAER(3)*WAER(3) - DD =-0.25*(WAER(3)*WAER(3)*((WAER(2)-WAER(6))-ROOT7-ROOT1)-A6) - CALL POLY3(BB, CC, DD, ROOT6, ISLV) - IF (ISLV.NE.0) ROOT6 = TINY - ROOT6 = MAX (ROOT6, ZERO) - ROOT6 = MIN (ROOT6, WAER(3)/2.0, - & MAX (WAER(2)-WAER(6)-ROOT7-ROOT1, ZERO), CHI6) - PSI6 = CHI6-ROOT6 - ENDIF - PSCONV6 = ABS(PSI6-PSI60) .LE. EPS*PSI60 - PSI60 = PSI6 -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1 - ROOT6, ZERO) - NH4I = MAX (WAER(3) - 2.D0*ROOT6, ZERO) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1 .AND. PSCONV6) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCV3') ! 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 - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCV3A****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCV2 -C *** CASE V2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV2 - INCLUDE 'isrpia.inc' - LOGICAL EXNO, EXCL - EXTERNAL CALCV1A, CALCV3A, CALCV4 -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 = 'V2 ; SUBCASE 1' - CALL CALCV2A - SCASE = 'V2 ; SUBCASE 1' -C - ELSEIF (.NOT.EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS - IF (RH.LT.DRMO2) THEN - SCASE = 'V2 ; SUBCASE 2' - CALL CALCV1A ! SOLID - SCASE = 'V2 ; SUBCASE 2' - ELSE - SCASE = 'V2 ; SUBCASE 3' ! MDRH CaSO4, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - CALL CALCMDRPII (RH, DRMO2, DRNH4CL, CALCV1A, CALCV3A) - SCASE = 'V2 ; SUBCASE 3' - ENDIF -C - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH.LT.DRMO3) THEN - SCASE = 'V2 ; SUBCASE 2' - CALL CALCV1A ! SOLID - SCASE = 'V2 ; SUBCASE 2' - ELSE - SCASE = 'V2 ; SUBCASE 4' ! MDRH CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - CALL CALCMDRPII (RH, DRMO3, DRNH42S4, CALCV1A, CALCV4) - SCASE = 'V2 ; SUBCASE 4' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCV2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV2A -C *** CASE V2A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4, NH4CL -C 4. Completely dissolved: NH4NO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV2A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1, PSCONV6, PSCONV4 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSCONV1 =.TRUE. - PSCONV6 =.TRUE. - PSCONV4 =.TRUE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI60 =-GREAT - PSI40 =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO - ROOT6 = ZERO - ROOT4 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCV1A -C - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 - CHI8 = CMGSO4 - CHI6 = CNH42S4 - CHI4 = CNH4CL -C - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A6 = XK7 *(WATER/GAMA(4))**3.0 ! (NH4)2SO4 <==> NH4+ - 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) - 2.D0*ROOT6) - CC = WAER(5)*(WAER(3) - 2.D0*ROOT6) - A14 - DD = BB*BB - 4.D0*CC - IF (DD.LT.ZERO) THEN - ROOT4 = ZERO - ELSE - DD = SQRT(DD) - ROOT4A= 0.5D0*(-BB+DD) - ROOT4B= 0.5D0*(-BB-DD) - IF (ZERO.LE.ROOT4A) THEN - ROOT4 = ROOT4A - ELSE - ROOT4 = ROOT4B - ENDIF - ROOT4 = MAX(ROOT4, ZERO) - ROOT4 = MIN(ROOT4, WAER(5), - & MAX (WAER(3) - 2.D0*ROOT6, ZERO), CHI4) - PSI4 = CHI4 - ROOT4 - ENDIF - ENDIF - PSCONV4 = ABS(PSI4-PSI40) .LE. EPS*PSI40 - PSI40 = PSI4 -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2) - WAER(6)) + WAER(7) - ROOT1 - ROOT6) - CC = WAER(7)*((WAER(2) - WAER(6)) - ROOT1 - ROOT6) - & + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6))-ROOT1-ROOT6)-A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX (WAER(2)-WAER(6)-ROOT1-ROOT6, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-((WAER(2) - WAER(6)) + WAER(1) - ROOT7 - ROOT6) - CC = WAER(1)*((WAER(2) - WAER(6)) - ROOT7 - ROOT6) + - & 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6))-ROOT7-ROOT6)-A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, - & MAX (WAER(2)-WAER(6)-ROOT7-ROOT6, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C AMMONIUM SULFATE -C - IF (NH4I*NH4I*SO4I .GT. A6) THEN - BB =-((WAER(2)-WAER(6)) + WAER(3) - ROOT7 - ROOT1 - ROOT4) - CC = WAER(3)*((WAER(2)-WAER(6)) - ROOT7 - ROOT1) + 0.25* - & (WAER(3)-ROOT4)**2.0 + ROOT4*(ROOT1+ROOT7-(WAER(2)-WAER(6))) - DD =-0.25*((WAER(3)-ROOT4)**2.0 * - & ((WAER(2)-WAER(6))-ROOT7-ROOT1) - A6) - CALL POLY3(BB, CC, DD, ROOT6, ISLV) - IF (ISLV.NE.0) ROOT6 = TINY - ROOT6 = MAX (ROOT6, ZERO) - ROOT6 = MIN (ROOT6, WAER(3)/2.0, - & MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1, ZERO), CHI6) - PSI6 = CHI6-ROOT6 - ENDIF - PSCONV6 = ABS(PSI6-PSI60) .LE. EPS*PSI60 - PSI60 = PSI6 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1 - ROOT6, ZERO) - NH4I = MAX (WAER(3) - 2.D0*ROOT6, ZERO) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1 .AND. PSCONV6 .AND. PSCONV4) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCV2') ! 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 - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCV2A****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV1 -C *** CASE V1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV1 - INCLUDE 'isrpia.inc' - LOGICAL EXNO, EXCL - EXTERNAL CALCV1A, CALCV2A, CALCV3A, CALCV4 -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.DRMO1) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 2' ! MDRH (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMO1, DRNH4NO3, CALCV1A, CALCV2A) - SCASE = 'V1 ; SUBCASE 2' - ENDIF -C - ELSE IF (EXNO .AND. .NOT.EXCL) THEN ! *** ONLY NITRATE EXISTS - IF (RH.LT.DRMV1) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 3' ! MDRH (NH4)2SO4, NH4NO3, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMV1, DRNH4NO3, CALCV1A, CALCV2A) - SCASE = 'V1 ; SUBCASE 3' - ENDIF -C - ELSE IF (.NOT.EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS - IF (RH.LT.DRMO2) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 4' ! MDRH (NH4)2SO4, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMO2, DRNH4CL, CALCV1A, CALCV3A) - SCASE = 'V1 ; SUBCASE 4' - ENDIF -C - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH.LT.DRMO3) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 5' ! MDRH (NH4)2SO4, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMO3, DRNH42S4, CALCV1A, CALCV4) - SCASE = 'V1 ; SUBCASE 5' - ENDIF - ENDIF -C - RETURN -C -C IF (RH.LT.DRMO1) THEN -C SCASE = 'V1 ; SUBCASE 1' -C CALL CALCV1A ! SOLID PHASE ONLY POSSIBLE -C SCASE = 'V1 ; SUBCASE 1' -C ELSE -C SCASE = 'V1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE -C CALL CALCMDRPII (RH, DRMO1, DRNH4NO3, CALCV1A, CALCV2A) -C SCASE = 'V1 ; SUBCASE 2' -C ENDIF -C -C RETURN -C -C *** END OF SUBROUTINE CALCV1 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCV1A -C *** CASE V1A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCV1A - INCLUDE 'isrpia.inc' -C -C *** CALCULATE SOLIDS ************************************************** -C - CCASO4 = MIN (WAER(6), WAER(2)) ! CCASO4 - SO4FR = MAX (WAER(2) - CCASO4, ZERO) - CAFR = MAX (WAER(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*WAER(7), SO4FR) ! CK2SO4 - FRK = MAX (WAER(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX (SO4FR - CK2SO4, ZERO) - CNA2SO4 = MIN (0.5D0*WAER(1), SO4FR) ! CNA2SO4 - NAFR = MAX (WAER(1) - 2.D0*CNA2SO4, ZERO) - SO4FR = MAX (SO4FR - CNA2SO4, ZERO) - CMGSO4 = MIN (WAER(8), SO4FR) ! CMGSO4 - FRMG = MAX(WAER(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) - CNH42S4 = MAX (MIN (SO4FR , 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 CALCV1A ***************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCU8 -C *** CASE U8 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0); CRUSTAL+SODIUM RICH (CRNARAT >= 2.0); CRUSTAL POOR (CRRAT<2) -C 2. THERE IS ONLY A LIQUID PHASE -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU8 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - CALL CALCU1A -C - CHI9 = CCASO4 ! SALTS -C - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -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 -C - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C - NAI = WAER(1) - SO4I = MAX(WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - KI = WAER(7) - MGI = WAER(8) - -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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 - IF (HI.LE.TINY) HI = SQRT(AKW) -C OHI = AKW/HI -C -C UNDISSOCIATED SPECIES EQUILIBRIA -C - IF (HI.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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, 'CALCU8') ! 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 - CMGSO4 = ZERO - CK2SO4 = ZERO - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCU8 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU7 -C *** CASE U7 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), CRUSTAL+SODIUM RICH (CRNARAT >= 2.0); CRUSTAL POOR (CRRAT<2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MGSO4, NA2SO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU7 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSI70 =-GREAT ! GREAT = 1.D10 - ROOT7 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCU1A -C - CHI7 = CK2SO4 ! SALTS - CHI9 = CCASO4 -C - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -C - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7)) - CC = WAER(7)*(WAER(2)-WAER(6)) + 0.25D0*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*(WAER(2)-WAER(6)) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7,WAER(7)/2.0,MAX(WAER(2)-WAER(6),ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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 IF (HI.LE.TINY) HI = SQRT(AKW) -C OHI = AKW/HI -C -C UNDISSOCIATED SPECIES EQUILIBRIA -C - IF (HI.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCU7') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCU7 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU6 -C *** CASE U6 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MGSO4 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU6 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSCONV1 =.TRUE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCU1A -C - CHI1 = CNA2SO4 ! SALTS - CHI7 = CK2SO4 - CHI9 = CCASO4 -C - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -C - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX((WAER(2)-WAER(6)) - ROOT1,ZERO), CHI7) - PSI7 = CHI7-ROOT7 - - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, - & MAX((WAER(2)-WAER(6)) - ROOT7, ZERO) ,CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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 IF (HI.LE.TINY) HI = SQRT(AKW) -C OHI = AKW/HI -C -C UNDISSOCIATED SPECIES EQUILIBRIA -C - IF (HI.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCU6') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCU6****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU5 -C *** CASE U5 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4 -C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU5 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.TRUE. - PSCONV1 =.TRUE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCU1A -C - CHI1 = CNA2SO4 ! SALTS - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 -C - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -C - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX(WAER(2)-WAER(6)-ROOT1, ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, - & MAX(WAER(2)-WAER(6)-ROOT7, ZERO),CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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 IF (HI.LE.TINY) HI = SQRT(AKW) -C OHI = AKW/HI -C -C UNDISSOCIATED SPECIES EQUILIBRIA -C - IF (HI.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCU5') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCU5****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU4 -C *** CASE U4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU4 - INCLUDE 'isrpia.inc' - LOGICAL EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU5 -C -C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** -C - SCASE = 'U4 ; SUBCASE 2' - CALL CALCU1A ! SOLID - SCASE = 'U4 ; 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.DRMM1) THEN - SCASE = 'U4 ; SUBCASE 1' - CALL CALCU4A - SCASE = 'U4 ; SUBCASE 1' - ENDIF -C - ELSE IF (EXAC) THEN ! *** NH4CL EXISTS ONLY - IF (RH.GE.DRMR5) THEN - SCASE = 'U4 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMR5, DRNH4CL, CALCU1A, CALCU5) - SCASE = 'U4 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCU4 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU4A -C *** CASE U4A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL -C 4. Completely dissolved: NH4NO3, NANO3, NACL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU4A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1, PSCONV4 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.FALSE. - PSCONV1 =.FALSE. - PSCONV4 =.FALSE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI40 =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO - ROOT4 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCU1A -C - CHI1 = CNA2SO4 ! SALTS - CHI4 = CNH4CL - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 -C - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -C - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX(WAER(2)-WAER(6)-ROOT1, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, - & MAX (WAER(2)-WAER(6)-ROOT7, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C AMMONIUM CHLORIDE -C - IF (NH4I*CLI .GT. A14) THEN - BB =-(NH4I + CLI) - CC =-A14 + NH4I*CLI - DD = BB*BB - 4.D0*CC - ROOT4 = 0.5D0*(-BB-SQRT(DD)) - IF (ROOT4.GT.TINY) THEN - ROOT4 = MIN(MAX (ROOT4, ZERO), CHI4) - PSI4 = CHI4 - ROOT4 - ENDIF - ENDIF - PSCONV4 = ABS(PSI4-PSI40) .LE. EPS*PSI40 - PSI40 = PSI4 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = MAX (WAER(3) - ROOT4, ZERO) - NO3I = WAER(4) - CLI = MAX (WAER(5) - ROOT4, ZERO) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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 IF (HI.LE.TINY) HI = SQRT(AKW) -C OHI = AKW/HI -C -C UNDISSOCIATED SPECIES EQUILIBRIA -C - IF (HI.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1 .AND. PSCONV4) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCU4') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) -C - RETURN -C -C *** END OF SUBROUTINE CALCU4A **************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU3 -C *** CASE U3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NANO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU3 - INCLUDE 'isrpia.inc' - LOGICAL EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU4A, CALCU5 -C -C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** -C - SCASE = 'U3 ; SUBCASE 2' - CALL CALCU1A ! SOLID - SCASE = 'U3 ; 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.DRMM1) THEN - SCASE = 'U3 ; SUBCASE 1' - CALL CALCU3A - SCASE = 'U3 ; 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 = 'U3 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMR4, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U3 ; SUBCASE 3' - ENDIF - - ELSE IF (.NOT.EXAC .AND. EXSC) THEN - IF (RH.GE.DRMR2) THEN - SCASE = 'U3 ; SUBCASE 4' - CALL CALCMDRPII (RH, DRMR2, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U3 ; SUBCASE 4' - ENDIF - - ELSE IF ( EXAC .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR5) THEN - SCASE = 'U3 ; SUBCASE 5' - CALL CALCMDRPII (RH, DRMR5, DRNACL, CALCU1A, CALCU5) - SCASE = 'U3 ; SUBCASE 5' - ENDIF - ENDIF -C - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCU3 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU3A -C *** CASE U3A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NACL -C 4. Completely dissolved: NH4NO3, NANO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU3A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1, PSCONV4, PSCONV3 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.FALSE. - PSCONV1 =.FALSE. - PSCONV4 =.FALSE. - PSCONV3 =.FALSE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI40 =-GREAT - PSI30 =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO - ROOT4 = ZERO - ROOT3 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCU1A -C - CHI1 = CNA2SO4 ! SALTS - CHI3 = CNACL - CHI4 = CNH4CL - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 -C - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -C - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - A8 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX(WAER(2)-WAER(6)-ROOT1, ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-(((WAER(2)-WAER(6))-ROOT7)*(WAER(1) - ROOT3)) - CC = ((WAER(2) - WAER(6)) - ROOT7)*(WAER(1) - ROOT3) + - & 0.25D0*(WAER(1) - ROOT3)**2. - DD =-0.25D0*(((WAER(2) - WAER(6)) - ROOT7)* - & (WAER(1) - ROOT3)**2.D0 - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MIN (MAX(ROOT1, ZERO), MAX(WAER(1) - ROOT3, ZERO), - & CHI1, MAX(WAER(2)-WAER(6), ZERO)) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C AMMONIUM CHLORIDE -C - IF (NH4I*CLI .GT. A14) THEN - BB =-(WAER(3) + WAER(5) - ROOT4) - CC =-A14 + NH4I*(WAER(5) - ROOT4) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - ROOT4A= 0.5D0*(-BB+SQRT(DD)) - ROOT4B= 0.5D0*(-BB-SQRT(DD)) - IF (ZERO.LE.ROOT4A) THEN - ROOT4 = ROOT4A - ELSE - ROOT4 = ROOT4B - ENDIF - ROOT4 = MIN(MAX(ZERO, ROOT4), MAX(WAER(5)-ROOT3,ZERO), - & CHI4, WAER(3)) - PSI4 = CHI4 - ROOT4 - ENDIF - PSCONV4 = ABS(PSI4-PSI40) .LE. EPS*PSI40 - PSI40 = PSI4 -C -C SODIUM CHLORIDE ; To obtain new value for ROOT3 -C - IF (NAI*CLI .GT. A8) THEN - BB =-((CHI1-2.D0*ROOT1) + (WAER(5) - ROOT4)) - CC = (CHI1-2.D0*ROOT1)*(WAER(5) - ROOT4) - 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-PSI30) .LE. EPS*PSI30 - PSI30 = PSI3 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1 - ROOT3, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = MAX (WAER(3) - ROOT4, ZERO) - NO3I = WAER(4) - CLI = MAX (WAER(5) - ROOT4 - ROOT3, ZERO) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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 IF (HI.LE.TINY) HI = SQRT(AKW) -C OHI = AKW/HI -C -C UNDISSOCIATED SPECIES EQUILIBRIA -C - IF (HI.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1 .AND. PSCONV4 .AND. PSCONV3) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCU3A') ! 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 CALCU1A - 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 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCU3A***************************************** -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU2 -C *** CASE U2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NANO3, NACL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU2 - INCLUDE 'isrpia.inc' - LOGICAL EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU3A, CALCU4A, CALCU5 -C -C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** -C - SCASE = 'U2 ; SUBCASE 2' - CALL CALCU1A ! SOLID - SCASE = 'U2 ; 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.DRMM1) THEN - SCASE = 'U2 ; SUBCASE 1' - CALL CALCU2A - SCASE = 'U2 ; SUBCASE 1' - ENDIF -C - ELSE IF (.NOT.EXAN) THEN ! *** NH4NO3 = 0 - IF ( EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH.GE.DRMM2) THEN - SCASE = 'U2 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMM2, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 3' - ENDIF - - ELSE IF (.NOT.EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH.GE.DRMR1) THEN - SCASE = 'U2 ; SUBCASE 4' - CALL CALCMDRPII (RH, DRMR1, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 4' - ENDIF - - ELSE IF (.NOT.EXAC .AND. .NOT.EXSN .AND. EXSC) THEN - IF (RH.GE.DRMR2) THEN - SCASE = 'U2 ; SUBCASE 5' - CALL CALCMDRPII (RH, DRMR2, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U2 ; SUBCASE 5' - ENDIF - - ELSE IF (.NOT.EXAC .AND. EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR3) THEN - SCASE = 'U2 ; SUBCASE 6' - CALL CALCMDRPII (RH, DRMR3, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 6' - ENDIF - - ELSE IF ( EXAC .AND. .NOT.EXSN .AND. EXSC) THEN - IF (RH.GE.DRMR4) THEN - SCASE = 'U2 ; SUBCASE 7' - CALL CALCMDRPII (RH, DRMR4, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U2 ; SUBCASE 7' - ENDIF - - ELSE IF ( EXAC .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR5) THEN - SCASE = 'U2 ; SUBCASE 8' - CALL CALCMDRPII (RH, DRMR5, DRNH4CL, CALCU1A, CALCU5) - SCASE = 'U2 ; SUBCASE 8' - ENDIF - - ELSE IF ( EXAC .AND. EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR6) THEN - SCASE = 'U2 ; SUBCASE 9' - CALL CALCMDRPII (RH, DRMR6, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 9' - ENDIF - ENDIF -C - ENDIF -C - RETURN - -C IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE -C SCASE = 'U2 ; SUBCASE 1' -C CALL CALCU2A -C SCASE = 'U2 ; SUBCASE 1' -C ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE -C SCASE = 'U2 ; SUBCASE 1' -C CALL CALCU1A -C SCASE = 'U2 ; SUBCASE 1' -C ENDIF -CC -C IF (WATER.LE.TINY .AND. RH.LT.DRMM2) THEN ! DRY AEROSOL -C SCASE = 'U2 ; SUBCASE 2' -C CALL CALCU2A -C SCASE = 'U2 ; SUBCASE 1' -CC -C ELSEIF (WATER.LE.TINY .AND. RH.GE.DRMM2) THEN ! MDRH OF M2 -C SCASE = 'U2 ; SUBCASE 3' -C CALL CALCMDRPII (RH, DRMM2, DRNANO3, CALCU1A, CALCU3A) -C SCASE = 'U2 ; SUBCASE 3' -C ENDIF -CC -C RETURN -C -C *** END OF SUBROUTINE CALCU2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU2A -C *** CASE U2A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -C 4. Completely dissolved: NH4NO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU2A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV7, PSCONV1, PSCONV4, PSCONV3, PSCONV5 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV7 =.FALSE. - PSCONV1 =.FALSE. - PSCONV4 =.FALSE. - PSCONV3 =.FALSE. - PSCONV5 =.FALSE. -C - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI40 =-GREAT - PSI30 =-GREAT - PSI50 =-GREAT -C - ROOT7 = ZERO - ROOT1 = ZERO - ROOT4 = ZERO - ROOT3 = ZERO - ROOT5 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCU1A -C - CHI1 = CNA2SO4 ! SALTS - CHI2 = CNANO3 - CHI3 = CNACL - CHI4 = CNH4CL - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 -C - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -C - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A8 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A9 = XK9 *(WATER/GAMA(3))**2.0 ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV.NE.0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, - & MAX(WAER(2)-WAER(6)-ROOT1, ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) .LE. EPS*PSI70 - PSI70 = PSI7 -C -C SODIUM SULFATE -C - IF (NAI*NAI*SO4I .GT. A1) THEN - BB =-(((WAER(2)-WAER(6))-ROOT7)*(WAER(1) - ROOT3 - ROOT5)) - CC = ((WAER(2)-WAER(6)) - ROOT7)*(WAER(1) - ROOT3 - ROOT5) + - & 0.25D0*(WAER(1) - ROOT3 - ROOT5)**2.0 - DD =-0.25D0*(((WAER(2) - WAER(6)) - ROOT7)* - & (WAER(1) - ROOT3 - ROOT5)**2.D0 - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV.NE.0) ROOT1 = TINY - ROOT1 = MIN (MAX(ROOT1,ZERO), MAX(WAER(1)-ROOT3-ROOT5,ZERO), - & CHI1, MAX(WAER(2)-WAER(6),ZERO)) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O - PSI1O = PSI1 -C -C AMMONIUM CHLORIDE -C - IF (NH4I*CLI .GT. A14) THEN - BB =-(WAER(3) + WAER(5) - ROOT4) - CC =-A14 + NH4I*(WAER(5) - ROOT4) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - ROOT4A= 0.5D0*(-BB+SQRT(DD)) - ROOT4B= 0.5D0*(-BB-SQRT(DD)) - IF (ZERO.LE.ROOT4A) THEN - ROOT4 = ROOT4A - ELSE - ROOT4 = ROOT4B - ENDIF - ROOT4 = MIN(MAX(ZERO, ROOT4), MAX(WAER(5)-ROOT3,ZERO), - & CHI4, WAER(3)) - PSI4 = CHI4 - ROOT4 - ENDIF - PSCONV4 = ABS(PSI4-PSI40) .LE. EPS*PSI40 - PSI40 = PSI4 -C -C SODIUM CHLORIDE ; To obtain new value for ROOT3 -C - IF (NAI*CLI .GT. A8) THEN - BB =-((CHI1-2.D0*ROOT1-ROOT5) + (WAER(5) - ROOT4)) - CC = (CHI1-2.D0*ROOT1-ROOT5)*(WAER(5) - ROOT4) - 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-PSI30) .LE. EPS*PSI30 - PSI30 = PSI3 -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)) - ROOT5A= 0.5D0*(-BB-DD) - ROOT5B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI2) - PSI2 = CHI2-ROOT5 - ENDIF -C - PSCONV5 = ABS(PSI2-PSI20) .LE. EPS*PSI20 - PSI20 = PSI2 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.0D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.0D0*ROOT1 - ROOT3 - ROOT5, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = MAX (WAER(3) - ROOT4, ZERO) - NO3I = MAX (WAER(4) - ROOT5, ZERO) - CLI = MAX (WAER(5) - ROOT4 - ROOT3, ZERO) - CAI = ZERO - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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 IF (HI.LE.TINY) HI = SQRT(AKW) -C OHI = AKW/HI -C -C UNDISSOCIATED SPECIES EQUILIBRIA -C - IF (HI.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV7 .AND. PSCONV1 .AND. PSCONV4 .AND. PSCONV3 - & .AND. PSCONV5) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCU2A') ! 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 CALCU1A - 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 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCU2A***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCU1 -C *** CASE U1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NANO3, NACL, NH4NO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU1 - INCLUDE 'isrpia.inc' - LOGICAL EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU2A, CALCU3A, CALCU4A, CALCU5 -C -C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** -C - SCASE = 'U1 ; SUBCASE 1' - CALL CALCU1A ! SOLID - SCASE = 'U1 ; 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.OR.EXAC.OR.EXSC.OR.EXSN) THEN ! *** WATER POSSIBLE - IF (RH.GE.DRMM1) THEN - SCASE = 'U1 ; SUBCASE 2' ! MDRH - CALL CALCMDRPII (RH, DRMM1, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 2' - ENDIF -C - ELSE IF (.NOT.EXAN) THEN ! *** NH4NO3 = 0 - IF ( EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH.GE.DRMM2) THEN - SCASE = 'U1 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMM2, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; SUBCASE 3' - ENDIF - - ELSE IF (.NOT.EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH.GE.DRMR1) THEN - SCASE = 'U1 ; SUBCASE 4' - CALL CALCMDRPII (RH, DRMR1, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; SUBCASE 4' - ENDIF - - ELSE IF (.NOT.EXAC .AND. .NOT.EXSN .AND. EXSC) THEN - IF (RH.GE.DRMR2) THEN - SCASE = 'U1 ; SUBCASE 5' - CALL CALCMDRPII (RH, DRMR2, DRNACL, CALCU1A, CALCU3A) !, CALCR4A) - SCASE = 'U1 ; SUBCASE 5' - ENDIF - - ELSE IF (.NOT.EXAC .AND. EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR3) THEN - SCASE = 'U1 ; SUBCASE 6' - CALL CALCMDRPII (RH, DRMR3, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; SUBCASE 6' - ENDIF - - ELSE IF ( EXAC .AND. .NOT.EXSN .AND. EXSC) THEN - IF (RH.GE.DRMR4) THEN - SCASE = 'U1 ; SUBCASE 7' - CALL CALCMDRPII (RH, DRMR4, DRNACL, CALCU1A, CALCU3A) !, CALCR4A) - SCASE = 'U1 ; SUBCASE 7' - ENDIF - - ELSE IF ( EXAC .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR5) THEN - SCASE = 'U1 ; SUBCASE 8' - CALL CALCMDRPII (RH, DRMR5, DRNH4CL, CALCU1A, CALCU3A) !, CALCR5) - SCASE = 'U1 ; SUBCASE 8' - ENDIF - - ELSE IF ( EXAC .AND. EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR6) THEN - SCASE = 'U1 ; SUBCASE 9' - CALL CALCMDRPII (RH, DRMR6, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; 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 = 'U1 ; SUBCASE 10' - CALL CALCMDRPII (RH, DRMR7, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 10' - ENDIF - - ELSE IF ( EXAN .AND. .NOT.EXSN .AND. EXSC) THEN - IF (RH.GE.DRMR8) THEN - SCASE = 'U1 ; SUBCASE 11' - CALL CALCMDRPII (RH, DRMR8, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 11' - ENDIF - - ELSE IF ( EXAN .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR9) THEN - SCASE = 'U1 ; SUBCASE 12' - CALL CALCMDRPII (RH, DRMR9, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 12' - ENDIF - - ELSE IF ( EXAN .AND. EXSN .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR10) THEN - SCASE = 'U1 ; SUBCASE 13' - CALL CALCMDRPII (RH, DRMR10, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; 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 = 'U1 ; SUBCASE 14' - CALL CALCMDRPII (RH, DRMR11, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 14' - ENDIF - - ELSE IF ( EXAN .AND. EXAC .AND. .NOT.EXSC) THEN - IF (RH.GE.DRMR12) THEN - SCASE = 'U1 ; SUBCASE 15' - CALL CALCMDRPII (RH, DRMR12, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; 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 = 'U1 ; SUBCASE 16' - CALL CALCMDRPII (RH, DRMR13, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 16' - ENDIF - ENDIF - ENDIF -C - RETURN - - -C IF (RH.LT.DRMM1) THEN -C SCASE = 'U1 ; SUBCASE 1' -C CALL CALCU1A ! SOLID PHASE ONLY POSSIBLE -C SCASE = 'U1 ; SUBCASE 1' -C ELSE -C SCASE = 'U1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE -C CALL CALCMDRPII (RH, DRMM1, DRNH4NO3, CALCU1A, CALCU2A) -C SCASE = 'U1 ; SUBCASE 2' -C ENDIF -CC -C RETURN -CC -C *** END OF SUBROUTINE CALCU1 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE -C *** SUBROUTINE CALCU1A -C *** CASE U1A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0); CRUSTAL+SODIUM RICH (CRNARAT >= 2.0); CRUSTAL POOR (CRRAT<2) -C 2. THERE IS ONLY A SOLID PHASE -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCU1A - INCLUDE 'isrpia.inc' -C -C *** CALCULATE SOLIDS ************************************************* -C - CCASO4 = MIN (WAER(6), WAER(2)) ! CCASO4 - SO4FR = MAX(WAER(2) - CCASO4, ZERO) - CAFR = MAX(WAER(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*WAER(7), SO4FR) ! CK2SO4 - FRK = MAX(WAER(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX(SO4FR - CK2SO4, ZERO) - CMGSO4 = MIN (WAER(8), SO4FR) ! CMGSO4 - FRMG = MAX(WAER(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) - CNA2SO4 = MAX (SO4FR, ZERO) ! CNA2SO4 - FRNA = MAX (WAER(1) - 2.D0*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 CALCU1A ***************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW13 -C *** CASE W13 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW13 - INCLUDE 'isrpia.inc' -C - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -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 = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - KI = WAER(7) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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, 'CALCW13') ! 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 - CMGSO4 = ZERO - CK2SO4 = ZERO - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = ZERO - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW13 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW12 -C *** CASE W12 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW12 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSI9O =-GREAT ! GREAT = 1.D10 - ROOT9 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7)) - CC = WAER(7)*(WAER(2)-WAER(6)) + 0.25D0*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0, (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW12') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = ZERO - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW12 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW11 -C *** CASE W11 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW11 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13) - CC = (WAER(7)-ROOT13)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13)**2.0 - DD =-0.25*((WAER(7)-ROOT13)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9,WAER(7)/2.0-ROOT13,(WAER(2)-WAER(6)),CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW11') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW11 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW10 -C *** CASE W10 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4 -C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW10 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A - -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13) - CC = (WAER(7)-ROOT13)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13)**2.0 - DD =-0.25*((WAER(7)-ROOT13)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9,WAER(7)/2.0-ROOT13,(WAER(2)-WAER(6)),CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW10') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW10 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW9 -C *** CASE W9 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW9 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5) + WAER(7) - 2.D0*ROOT9 - ROOT13) - CC = WAER(5)*(WAER(7) - 2.D0*ROOT9 - ROOT13) - A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = MAX (WAER(5) - ROOT14, ZERO) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW9') ! 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 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW9 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW8 -C *** CASE W8 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW8 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14, PSCONV5 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. - PSCONV5 =.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5) - ROOT5 + WAER(7) - 2.D0*ROOT9 - ROOT13) - CC = (WAER(5)-ROOT5)*(WAER(7) - 2.D0*ROOT9 - ROOT13) - A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C AMMONIUM CLORIDE -C - IF (NH4I*CLI .GT. A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14) - CC = (WAER(5)-ROOT14)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) .LE. EPS*PSI5O - PSI5O = PSI5 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5, ZERO) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND.PSCONV5) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW8') ! 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 = CHI5 - PSI5 - CNACL = ZERO - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW8 ****************************************** -C - END -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW7 -C *** CASE W7 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NANO3, NH4NO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW7 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. - PSCONV5 =.TRUE. - PSCONV7 =.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C AMMONIUM CLORIDE -C - IF (NH4I*CLI .GT. A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) .LE. EPS*PSI5O - PSI5O = PSI5 -C -C SODIUM CLORIDE -C - IF (NAI*CLI .GT. A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*WAER(1) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) .LE. EPS*PSI7O - PSI7O = PSI7 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7, ZERO) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 - & .AND. PSCONV7) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW7') ! 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 = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW7 ****************************************** -C - END - -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW6 -C *** CASE W6 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2, NH4NO3 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW6 - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. - PSCONV5 =.TRUE. - PSCONV7 =.TRUE. - PSCONV8 =.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C AMMONIUM CLORIDE -C - IF (NH4I*CLI .GT. A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) .LE. EPS*PSI5O - PSI5O = PSI5 -C -C SODIUM CLORIDE -C - IF (NAI*CLI .GT. A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) .LE. EPS*PSI7O - PSI7O = PSI7 -C -C SODIUM NITRATE -C - IF (NAI*NO3I .GT. A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) .LE. EPS*PSI8O - PSI8O = PSI8 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 - & .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW6') ! 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 = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW6 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW5 -C *** CASE W5 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, -C MG(NO3)2, MGCL2 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW5 - INCLUDE 'isrpia.inc' -C - EXTERNAL CALCW1A, CALCW6 -C -C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ -C - IF (WAER(4).GT.TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'W5 ; SUBCASE 1' - CALL CALCW5A - SCASE = 'W5 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'W1 ; SUBCASE 1' - CALL CALCW1A - SCASE = 'W1 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP5) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCW1A - SCASE = 'W5 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'W5 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP5, DRNH4NO3, CALCW1A, CALCW6) - SCASE = 'W5 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCW5 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW5A -C *** CASE W5A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3 -C 4. Completely dissolved: CA(NO3)2, CACL2, MG(NO3)2, MGCL2 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW5A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. - PSCONV5 =.TRUE. - PSCONV7 =.TRUE. - PSCONV8 =.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C AMMONIUM CLORIDE -C - IF (NH4I*CLI .GT. A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) .LE. EPS*PSI5O - PSI5O = PSI5 -C -C SODIUM CLORIDE -C - IF (NAI*CLI .GT. A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) .LE. EPS*PSI7O - PSI7O = PSI7 -C -C SODIUM NITRATE -C - IF (NAI*NO3I .GT. A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) .LE. EPS*PSI8O - PSI8O = PSI8 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 - & .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW5') ! 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 = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW5 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW4 -C *** CASE W4 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW4 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW5A -C -C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ -C - IF (WAER(4).GT.TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'W4 ; SUBCASE 1' - CALL CALCW4A - SCASE = 'W4 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'W1 ; SUBCASE 1' - CALL CALCW1A - SCASE = 'W1 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP4) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCW1A - SCASE = 'W4 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'W4 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP4, DRMGNO32, CALCW1A, CALCW5A) - SCASE = 'W4 ; SUBCASE 3' - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCW4 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW4A -C *** CASE W4A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3, MG(NO3)2 -C 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW4A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. - PSCONV5 =.TRUE. - PSCONV7 =.TRUE. - PSCONV8 =.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI15 = CMGNO32 - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C AMMONIUM CLORIDE -C - IF (NH4I*CLI .GT. A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) .LE. EPS*PSI5O - PSI5O = PSI5 -C -C SODIUM CLORIDE -C - IF (NAI*CLI .GT. A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) .LE. EPS*PSI7O - PSI7O = PSI7 -C -C SODIUM NITRATE -C - IF (NAI*NO3I .GT. A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) .LE. EPS*PSI8O - PSI8O = PSI8 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 - & .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW4') ! 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 = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW4A ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW3 -C *** CASE W3 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW4A -C -C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ -C -C IF (WAER(4).GT.TINY .AND. WAER(5).GT.TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE -C SCASE = 'W3 ; SUBCASE 1' -C CALL CALCW3A -C SCASE = 'W3 ; SUBCASE 1' -C ELSE ! NO3, CL NON EXISTANT -C SCASE = 'W1 ; SUBCASE 1' -C CALL CALCW1A -C SCASE = 'W1 ; SUBCASE 1' -C ENDIF -C - CALL CALCW1A - - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP3) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCW1A - SCASE = 'W3 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'W3 ; SUBCASE 3' ! MDRH REGION (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP3, DRCANO32, CALCW1A, CALCW4A) - SCASE = 'W3 ; SUBCASE 3' - ENDIF - ELSE ! NO3, CL NON EXISTANT - SCASE = 'W3 ; SUBCASE 1' - CALL CALCW3A - SCASE = 'W3 ; SUBCASE 1' - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCW3 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW3A -C *** CASE W3A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3, CA(NO3)2, MG(NO3)2 -C 4. Completely dissolved: CACL2, MGCL2 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW3A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. - PSCONV5 =.TRUE. - PSCONV7 =.TRUE. - PSCONV8 =.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI15 = CMGNO32 - CHI12 = CCANO32 - CHI11 = CCASO4 -CC - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C AMMONIUM CLORIDE -C - IF (NH4I*CLI .GT. A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) .LE. EPS*PSI5O - PSI5O = PSI5 -C -C SODIUM CLORIDE -C - IF (NAI*CLI .GT. A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) .LE. EPS*PSI7O - PSI7O = PSI7 -C -C SODIUM NITRATE -C - IF (NAI*NO3I .GT. A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) .LE. EPS*PSI8O - PSI8O = PSI8 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 - & .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW3') ! 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 = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW3A ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW2 -C *** CASE W2 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C THERE ARE THREE REGIMES IN THIS CASE: -C 1. CACL2(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A) -C 2. CACL2(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -C 3. CACL2(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL -C -C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES W1A, W2B -C RESPECTIVELY -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C -C - SUBROUTINE CALCW2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW3A, CALCW4A, CALCW5A, CALCW6 -C -C *** FIND DRY COMPOSITION ********************************************** -C - CALL CALCW1A -C -C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** -C - IF (CCACL2.GT.TINY) THEN - SCASE = 'W2 ; SUBCASE 1' - CALL CALCW2A - SCASE = 'W2 ; SUBCASE 1' - ENDIF -C - IF (WATER.LE.TINY) THEN - IF (RH.LT.DRMP2) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO -10 CONTINUE - CALL CALCW1A - SCASE = 'W2 ; SUBCASE 2' - ELSE - IF (CMGCL2.GT. TINY) THEN - SCASE = 'W2 ; SUBCASE 3' ! MDRH (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MGCL2, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP2, DRMGCL2, CALCW1A, CALCW3A) - SCASE = 'W2 ; SUBCASE 3' - ENDIF - IF (WATER.LE.TINY .AND. RH.GE.DRMP3 .AND. RH.LT.DRMP4) THEN - SCASE = 'W2 ; SUBCASE 4' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, CANO32, -C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP3, DRCANO32, CALCW1A, CALCW4A) - SCASE = 'W2 ; SUBCASE 4' - ENDIF - IF (WATER.LE.TINY .AND. RH.GE.DRMP4 .AND. RH.LT.DRMP5) THEN - SCASE = 'W2 ; SUBCASE 5' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C MGNO32, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP4, DRMGNO32, CALCW1A, CALCW5A) - SCASE = 'W2 ; SUBCASE 5' - ENDIF - IF (WATER.LE.TINY .AND. RH.GE.DRMP5) THEN - SCASE = 'W2 ; SUBCASE 6' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, -C NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP5, DRNH4NO3, CALCW1A, CALCW6) - SCASE = 'W2 ; SUBCASE 6' - ELSE - WATER = TINY - DO 20 I=1,NIONS - MOLAL(I) = ZERO -20 CONTINUE - CALL CALCW1A - SCASE = 'W2 ; SUBCASE 2' - ENDIF - ENDIF - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCW2 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW2A -C *** CASE W2A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. THERE IS BOTH A LIQUID & SOLID PHASE -C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -C NANO3, NH4NO3, CA(NO3)2, MG(NO3)2, MGCL2 -C 4. Completely dissolved: CACL2 -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW2A - INCLUDE 'isrpia.inc' -C - LOGICAL PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI -C - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, - & CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, - & CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, - & PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, - & PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, - & A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 -C -C *** SETUP PARAMETERS ************************************************ -C - FRST =.TRUE. - CALAIN =.TRUE. - CALAOU =.TRUE. -C - PSCONV9 =.TRUE. - PSCONV13=.TRUE. - PSCONV14=.TRUE. - PSCONV5 =.TRUE. - PSCONV7 =.TRUE. - PSCONV8 =.TRUE. -C - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 -C - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO -C -C *** CALCULATE INITIAL SOLUTION *************************************** -C - CALL CALCW1A -C - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI15 = CMGNO32 - CHI12 = CCANO32 - CHI16 = CMGCL2 - CHI11 = CCASO4 -C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 -C - CALL CALCMR ! WATER -C - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) -C - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO -C -C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ -C - DO 10 I=1,NSWEEP -C - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ -C -C POTASSIUM SULFATE -C - IF (KI*KI*SO4I .GT. A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV.NE.0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, - & (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) .LE. EPS*PSI9O - PSI9O = PSI9 -C -C POTASSIUM NITRATE -C - IF (KI*NO3I .GT. A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) .LE. EPS*PSI13O - PSI13O = PSI13 -C -C POTASSIUM CLORIDE -C - IF (KI*CLI .GT. A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) .LE. EPS*PSI14O - PSI14O = PSI14 -C -C AMMONIUM CLORIDE -C - IF (NH4I*CLI .GT. A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) .LE. EPS*PSI5O - PSI5O = PSI5 -C -C SODIUM CLORIDE -C - IF (NAI*CLI .GT. A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) .LE. EPS*PSI7O - PSI7O = PSI7 -C -C SODIUM NITRATE -C - IF (NAI*NO3I .GT. A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO.LE.ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) .LE. EPS*PSI8O - PSI8O = PSI8 -C -C ION CONCENTRATIONS ; CORRECTIONS -C - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) -C -C SOLUTION ACIDIC OR BASIC? -C - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - & - 2.D0*CAI - KI - 2.D0*MGI - 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.GT.OHI) THEN -C CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) -C HI = AKW/OHI -C HSO4I = ZERO -C ELSE -C GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI -C & - KI - 2.D0*MGI, ZERO) -C GGCL = MAX(GG-GGNO3, ZERO) -C IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl -C IF (GGNO3.GT.TINY) THEN -C IF (GGCL.LE.TINY) HI = ZERO -C CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 -C ENDIF -C -C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. -C - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL -C IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI -C - IF (HI.LE.TINY) THEN - HI = SQRT(AKW) - 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 - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI -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 (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 - & .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF -10 CONTINUE -ccc CALL PUSHERR (0002, 'CALCW2') ! 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 = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW2A ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW1 -C *** CASE W1 -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -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 CALCP1A) -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW2A -C -C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** -C - IF (RH.LT.DRMP1) THEN - SCASE = 'W1 ; SUBCASE 1' - CALL CALCW1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'W1 ; SUBCASE 1' - ELSE - SCASE = 'W1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRPII (RH, DRMP1, DRCACL2, CALCW1A, CALCW2A) - SCASE = 'W1 ; SUBCASE 2' - ENDIF -C - RETURN -C -C *** END OF SUBROUTINE CALCW1 ****************************************** -C - END -C -C======================================================================= -C -C *** ISORROPIA CODE II -C *** SUBROUTINE CALCW1A -C *** CASE W1A -C -C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -C 2. SOLID AEROSOL ONLY -C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -C -C *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -C *** GEORGIA INSTITUTE OF TECHNOLOGY -C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES -C -C======================================================================= -C - SUBROUTINE CALCW1A - INCLUDE 'isrpia.inc' -C -C *** CALCULATE SOLIDS ************************************************** -C - CCASO4 = MIN (WAER(2), WAER(6)) !SOLID CASO4 - CAFR = MAX (WAER(6) - CCASO4, ZERO) - SO4FR = MAX (WAER(2) - CCASO4, ZERO) - CK2SO4 = MIN (SO4FR, 0.5D0*WAER(7)) !SOLID K2SO4 - FRK = MAX (WAER(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX (SO4FR - CK2SO4, ZERO) - CMGSO4 = SO4FR !SOLID MGSO4 - FRMG = MAX (WAER(8) - CMGSO4, ZERO) - CNACL = MIN (WAER(1), WAER(5)) !SOLID NACL - FRNA = MAX (WAER(1) - CNACL, ZERO) - CLFR = MAX (WAER(5) - CNACL, ZERO) - CCACL2 = MIN (CAFR, 0.5D0*CLFR) !SOLID CACL2 - CAFR = MAX (CAFR - CCACL2, ZERO) - CLFR = MAX (WAER(5) - 2.D0*CCACL2, ZERO) - CCANO32 = MIN (CAFR, 0.5D0*WAER(4)) !SOLID CA(NO3)2 - CAFR = MAX (CAFR - CCANO32, ZERO) - FRNO3 = MAX (WAER(4) - 2.D0*CCANO32, ZERO) - CMGCL2 = MIN (FRMG, 0.5D0*CLFR) !SOLID MGCL2 - FRMG = MAX (FRMG - CMGCL2, ZERO) - CLFR = MAX (CLFR - 2.D0*CMGCL2, ZERO) - CMGNO32 = MIN (FRMG, 0.5D0*FRNO3) !SOLID MG(NO3)2 - FRMG = MAX (FRMG - CMGNO32, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CMGNO32, ZERO) - CNANO3 = MIN (FRNA, FRNO3) !SOLID NANO3 - FRNA = MAX (FRNA - CNANO3, ZERO) - FRNO3 = MAX (FRNO3 - CNANO3, ZERO) - CKCL = MIN (FRK, CLFR) !SOLID KCL - FRK = MAX (FRK - CKCL, ZERO) - CLFR = MAX (CLFR - CKCL, ZERO) - CKNO3 = MIN (FRK, FRNO3) !SOLID KNO3 - FRK = MAX (FRK - CKNO3, ZERO) - FRNO3 = MAX (FRNO3 - CKNO3, ZERO) -C -C *** OTHER PHASES ****************************************************** -C - WATER = ZERO -C - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO -C - RETURN -C -C *** END OF SUBROUTINE CALCW1A ***************************************** -C - END - diff --git a/CALPUFF_SRC/CALPUFF/isrpia.inc b/CALPUFF_SRC/CALPUFF/isrpia.inc deleted file mode 100644 index 4c09ded..0000000 --- a/CALPUFF_SRC/CALPUFF/isrpia.inc +++ /dev/null @@ -1,109 +0,0 @@ -C======================================================================= -C *** ISORROPIA CODE II -C *** INCLUDE FILE 'ISRPIA.INC' -C *** THIS FILE CONTAINS THE DECLARATIONS OF THE GLOBAL CONSTANTS -C AND VARIABLES. -C -C *** COPYRIGHT 1996-2008, 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=8,NIONS=10,NGASAQ=3,NSLDS=19,NPAIR=23,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), AWCS(NZSR), AWCN(NZSR), - & AWCC(NZSR), AWPS(NZSR), AWPB(NZSR), AWPN(NZSR), - & AWPC(NZSR), AWMS(NZSR), AWMN(NZSR), AWMC(NZSR) -C -C *** DELIQUESCENCE RELATIVE HUMIDITIES ******************************** -C - INTEGER WFTYP - COMMON /DRH / DRH2SO4, DRNH42S4, DRNAHSO4, DRNACL, DRNANO3, - & DRNA2SO4, DRNH4HS4, DRLC, DRNH4NO3, DRNH4CL, - & DRCASO4, DRCANO32, DRCACL2, DRK2SO4, DRKHSO4, - & DRKNO3, DRKCL, DRMGSO4, DRMGNO32, DRMGCL2 -C - 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 - COMMON /MDRH2/ DRMO1, DRMO2, DRMO3, DRML1, DRML2, - & DRML3, DRMM1, DRMM2, DRMP1, DRMP2, - & DRMP3, DRMP4, DRMP5, DRMV1 - -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, CCASO4, - & CCANO32, CCACL2, CK2SO4, CKHSO4, CKNO3, CKCL, - & CMGSO4, CMGNO32, CMGCL2 -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, XK15, XK16, XK17, XK18, XK19, XK20, XK23, - & XK24, XK25 -C & , XK26, XK27 -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, SO4RAT, CRNARAT, CRRAT, - & 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/CALPUFF_SRC/CALPUFF/ln1.puf b/CALPUFF_SRC/CALPUFF/ln1.puf deleted file mode 100644 index 11b48fb..0000000 --- a/CALPUFF_SRC/CALPUFF/ln1.puf +++ /dev/null @@ -1,86 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /LN1/ -- Emission parameters for buoyant CALPUFF -c line sources -c---------------------------------------------------------------------- - character*16 cnamln1 - character*40 csfln1 -c - common/LN1/NLINES,XL,HBL,WBL,WML,DXL,FPRIMEL,WSEP,FPTOT,FBPT, - 1 XLBEGGRD(mxlines),YLBEGGRD(mxlines),XLENDGRD(mxlines), - 2 YLENDGRD(mxlines),HSL(mxlines),BELEVL(mxlines), - 3 XVERTL(4,mxlines),YVERTL(4,mxlines),ARLINE(mxlines), - 4 XLBAR,YLBAR,ORIENTL,MXNSEG,NSEG(mxlines),QTL(mxspec,mxlines), - 5 NEWLN1(mxlines),NLRISE,ILNU,NSLN1, - 6 IDSFLN1(mxspec,mxlines),IXREFLN1(mxspln), - 7 CNAMLN1(mxlines),CSFLN1(mxspln) -c -c --- COMMON BLOCK /LINES/ variables: -c NLINES - integer - Number of line sources -c XL - real - Average line source length (m) -c HBL - real - Average line source height (m) -c WBL - real - Average building width (m) -c WML - real - Average line source width (m) -c DXL - real - Average building separation (m) -c FPRIMEL - real - Average buoyancy parameter/line -c in units of (m**4/s**3) -c WSEP - real - Average separation between lines -c (WBL+DXL) (m) -c FPTOT - real - Total buoyancy parameter -c (FPRIMEL*NLINES) -c FBPT - real - "Point Source" buoyancy parameter -c (FPTOT/pi) -c XLBEGGRD(mxlines) - real array - Beginning X coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c YLBEGGRD(mxlines) - real array - Beginning Y coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c XLENDGRD(mxlines) - real array - Ending X coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c YLENDGRD(mxlines) - real array - Ending Y coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c HSL(mxlines) - real array - Pollutant release height (m) -c BELEVL(mxlines) - real array - Base elevation (MSL) of line -c XVERTL(4,mxlines) - real array - X-coord. (met grid) of vertices -c defining 4 corners of each line -c YVERTL(4,mxlines) - real array - Y-coord. (met grid) of vertices -c defining 4 corners of each line -c ARLINE(mxlines) - real array - Area of line source (m**2) -c XLBAR,YLBAR - real - Center of array of lines (met grid) -c ORIENTL - real - Orientation of array of lines -c (radians, CW from N) -c MXNSEG - integer - Upper limit on number of segments -c along line from which slugs are -c generated -c NSEG(mxlines) - real array - Number of segments used for line -c in current step -c QTL(mxspec,mxlines) - real array - Pollutant emission rates (g/s) -c for each line -c NEWLN1(mxlines) - integer arr- Number of puffs released by each -c source during the current step -c NLRISE - integer - Number of points used to tabulate -c plume rise from block of lines -c ILNU - integer - Units for emission rates in -c control file -c 1: g/s -c 2: kg/hr -c 3: lb/hr -c 4: ton/yr -c 5: Odour Unit * m**3/s -c 6: Odour Unit * m**3/min -c 7: metric tons/yr -c 8: Bq/s (Bq = becquerel = disintegrations/s) -c 9: GBq/yr -c NSLN1 - integer - Number of source-species pairs -c with emissions scaling factors -c IDSFLN1(mxspec,mxlines) - integer - Pointer to line-species pair -c index, 0 to NSLN1 -c (0 if no scaling) -c IXREFLN1(mxspln) - integer - Cross-reference pointer from -c line-species pairs to -c scale-factor tables -c CSFLN1(mxspln) - c*40 arr - List of scale-factor table names -c for line-species pairs -c CNAMLN1(mxlines) - c*16 arr - Source names diff --git a/CALPUFF_SRC/CALPUFF/ln2.puf b/CALPUFF_SRC/CALPUFF/ln2.puf deleted file mode 100644 index 2305735..0000000 --- a/CALPUFF_SRC/CALPUFF/ln2.puf +++ /dev/null @@ -1,180 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /LN2/ -- Emission parameters for buoyant CALPUFF -c line sources (variable) -c---------------------------------------------------------------------- -c - character*12 cslst5 - character*16 cid5 - - logical*4 lutmln2,llccln2,lpsln2,lemln2,llazaln2,lttmln2 - character*4 utmhemln2,xyunitln2 - character*8 datumln2,pmapln2 - character*12 datenln2 - - common/LN2/NLN2,NSE5,ILNGRP(mxlines), - 1 IBDATHR5,IBSEC5,IEDATHR5,IESEC5,XTZ5,T2BTZ5, - 2 XMWEM5(mxspec),IXREM5(mxspec),MXNSEG2,NLRISE2, - 3 lutmln2,llccln2,lpsln2,lemln2,llazaln2,lttmln2,iutmznln2, - 4 feastln2,fnorthln2,rnlat0ln2,relon0ln2,rnlat1ln2,rnlat2ln2, - 5 NSTEP5,NDHRQB5(mxqstep),NSECQB5(mxqstep), - 6 NDHRQE5(mxqstep),NSECQE5(mxqstep), - 7 NLINES2(mxqstep),IDLINE(mxqstep,mxlines), - 8 NL2(mxqstep,mxlngrp),XL2(mxqstep,mxlngrp), - 9 HBL2(mxqstep,mxlngrp), WBL2(mxqstep,mxlngrp), - & WML2(mxqstep,mxlngrp), DXL2(mxqstep,mxlngrp), - 1 FPRIMEL2(mxqstep,mxlngrp), WSEP2(mxqstep,mxlngrp), - 2 FPTOT2(mxqstep,mxlngrp), FBPT2(mxqstep,mxlngrp), - 3 XL2BAR(mxqstep,mxlngrp), YL2BAR(mxqstep,mxlngrp), - 4 ORIENTL2(mxqstep,mxlngrp), - 5 XL2BEGGRD(mxqstep,mxlines), YL2BEGGRD(mxqstep,mxlines), - 6 XL2ENDGRD(mxqstep,mxlines), YL2ENDGRD(mxqstep,mxlines), - 7 HSL2(mxqstep,mxlines), BELEVL2(mxqstep,mxlines), - 8 XVERTL2(4,mxqstep,mxlines), YVERTL2(4,mxqstep,mxlines), - 9 ARLINE2(mxqstep,mxlines), NSEG2(mxqstep,mxlines), - & QTL2(mxspec,mxqstep,mxlines), NEWLN2(mxlines), - 1 CSLST5(mxspec),CID5(mxlines), - 2 pmapln2,utmhemln2,datumln2,datenln2,xyunitln2 - -c -c --- COMMON BLOCK /LN2/ variables: -c -c NLN2 - integer - Total number of line sources -c NSE5 - integer - Number of emitted species in file -c ILNGRP(mxlines) - integer - Group ID for each line source ID -c IBDATHR5 - integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSEC5 - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHR5 - integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESEC5 - integer - Seconds of the last data record in the -c file (0000-3599) -c XTZ5 - real - Time zone (UTC=LST+XTZ5) -c T2BTZ5 - real - Hours to ADD to Local Time to obtain -c Base Time (xtz3-xbtz) -c XMWEM5(mxspec) - real - Species molecular weight -c IXREM5(mxspec) - integer - Cross-referencing array of "NSE5" -c values relating species ordering -c in the emissions file to the -c ordering in the main conc. array -c MXNSEG2 - integer - Upper limit on number of segments -c along line from which slugs are -c generated -c NLRISE2 - integer - Number of points used to tabulate -c plume rise from group of lines -c -c --- MAP Projection Variables --- -c -c LUTMLN2 - logical*4 - Flag for Universal Transverse Mercator -c LLCCLN2 - logical*4 - Flag for Lambert Conformal Conic -c LPSLN2 - logical*4 - Flag for Polar Stereographic -c LEMLN2 - logical*4 - Flag for Equatorial Mercator -c LLAZALN2 - logical*4 - Flag for Lambert Azimuthal Equal Area -c LTTMLN2 - logical*4 - Flag for Tangential Transverse Mercator -c -c IUTMZNLN2 - integer - UTM zone for UTM projection -c FEASTLN2 - real - False Easting (km) at projection origin -c FNORTHLN2 - real - False Northing (km) at projection origin -c RNLAT0LN2, - real - N. latitude & E. longitude of x=0 and y=0 -c RELON0LN2 (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1LN2, - real - Matching N. latitude(s) for projection -c RNLAT2LN2 (deg) (Used only if PMAP5= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c -c --- Variable data ------------------------------------------------- -c -c NSTEP5 - integer - Number of emission substeps in -c current timestep -c NDHRQB5(mxqstep) & NSECQB5(mxqstep) -c - integer - Starting time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c NDHRQE5(mxqstep) & NSECQE5(mxqstep) -c - integer - Ending time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c NLINES2(mxqstep) - integer - Number of active line sources in -c emission substep -c IDLINE(mxqstep,mxlines) -c - integer - Line source ID for each active -c line source in emission substep -c -c --- Group Properties -c -c NL2(mxqstep,mxlngrp) - int - Number of lines in each active -c group -c XL2(mxqstep,mxlngrp) - real - Average line source length (m) -c HBL2(mxqstep,mxlngrp) - real - Average line source height (m) -c WBL2(mxqstep,mxlngrp) - real - Average building width (m) -c WML2(mxqstep,mxlngrp) - real - Average line source width (m) -c DXL2(mxqstep,mxlngrp) - real - Average building separation (m) -c FPRIMEL2(mxqstep,mxlngrp) - real - Average buoyancy parameter/line -c in units of (m**4/s**3) -c WSEP2(mxqstep,mxlngrp) - real - Average separation between lines -c (WBL+DXL) (m) -c FPTOT2(mxqstep,mxlngrp) - real - Total buoyancy parameter -c (FPRIMEL*NLINES) -c FBPT2(mxqstep,mxlngrp) - real - "Point Source" buoyancy parameter -c (FPTOT/pi) -c XL2BAR(mxqstep,mxlngrp) - real - X-center of group (met grid) -c YL2BAR(mxqstep,mxlngrp) - real - Y-center of group (met grid) -c ORIENTL2(mxqstep,mxlngrp) - real - Orientation of group -c (radians, CW from N) -c --- Line Properties -c -c XL2BEGGRD(mxqstep,mxlines) - real - Beginning X coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c YL2BEGGRD(mxqstep,mxlines) - real - Beginning Y coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c XL2ENDGRD(mxqstep,mxlines) - real - Ending X coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c YL2ENDGRD(mxqstep,mxlines) - real - Ending Y coordinate of the lines -c (in met. grid units w/ origin at -c (0.0,0.0)) -c HSL2(mxqstep,mxlines) - real - Pollutant release height (m) -c BELEVL2(mxqstep,mxlines) - real - Base elevation (MSL) of line -c XVERTL2(4,mxqstep,mxlines) - real - X-coord. (met grid) of vertices -c defining 4 corners of each line -c YVERTL2(4,mxqstep,mxlines) - real - Y-coord. (met grid) of vertices -c defining 4 corners of each line -c ARLINE2(mxqstep,mxlines) - real - Area of line source (m**2) -c NSEG2(mxqstep,mxlines) - real - Number of segments used for line -c in current step -c QTL2(mxspec,mxqstep,mxlines)- real - Pollutant emission rates (g/s) -c for each line -c NEWLN2(mxlines) - int - Number of puffs released by each -c source during the current step -c -c --- Character data --- -c CSLST5(mxspec) - char*12 - Species identifiers -c CID5(mxlines) - char*16 - Line source names -c -c PMAPLN2 - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMLN2 - character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMLN2 - character - Datum-Region for grid coordinates -c DATENLN2 - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITLN2 - character - Units for coordinates (e.g., KM) diff --git a/CALPUFF_SRC/CALPUFF/lwcsubs.for b/CALPUFF_SRC/CALPUFF/lwcsubs.for deleted file mode 100644 index 070720b..0000000 --- a/CALPUFF_SRC/CALPUFF/lwcsubs.for +++ /dev/null @@ -1,372 +0,0 @@ -c---------------------------------------------------------------------- - subroutine rdr2daux(io,dout,dinp,mxnx,mxny,nx,ny,lcmprs,clab12) -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.0.0 Level: 140521 RDR2DAUX -c D. Strimaitis -c -c --- PURPOSE: Read NX*NY words of 2-D real array -c (possibly with compression) -c -c --- INPUTS: -c IO - integer - Unit number of input file -c DINP(nx,ny) - real array - Data array from file -c MXNX,MXNY - integers - Dimensions of output data array -c NX,NY - integers - Dimensions of input data array -c LCMPRS - logocal - Compression flag -c -c --- OUTPUT: -c DOUT(mxnx,mxny) - real array - Data array to calling routine -c CLAB12 - character*12- Data label -c -c --- RDR2DAUX called by: AUX1, RDAUX -c --- RDR2DAUX calls: UNCOMPRS -c---------------------------------------------------------------------- - real dinp(nx,ny) - real dout(mxnx,mxny) - character*12 clab12 - character*15 clab15 - logical lcmprs - - nxy=nx*ny - mxnxy=mxnx*mxny - nchar=12 - - if(mxnxy.LT.nxy) then - write(*,*)'ERROR in RDR2DAUX: actual input array will not ', - & 'fit in output array!' - write(*,*)'Input array NX, NY: ',nx,ny - write(*,*)'Output array NX, NY: ',mxnx,mxny - stop - - elseif(nx.EQ.mxnx .AND. ny.EQ.mxny) then -c --- Input and output arrays have same shape so simple read if not -c --- compressed. Use DINP as the work array if compressed. - if(lcmprs) then - read(io) n - call UNCOMPRS(dinp,n,io,nxy,nchar,clab12,clab15,dout) - else - read(io) clab12,dout - endif - - else -c --- Input array smaller than output array, so read and then -c --- transfer by element. Use output array as the work array -c --- if compressed. - if(lcmprs) then - read(io) n - call UNCOMPRS(dout,n,io,nxy,nchar,clab12,clab15,dinp) - else - read(io) clab12,dinp - endif - - do j=1,ny - do i=1,nx - dout(i,j)=dinp(i,j) - enddo - enddo - - endif - - return - end - -c---------------------------------------------------------------------- - subroutine rdi2daux(io,iout,iinp,mxnx,mxny,nx,ny,lcmprs,clab12) -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.0.0 Level: 140521 RDI2DAUX -c D. Strimaitis -c -c --- PURPOSE: Read NX*NY words of 2-D integer array -c (no compression allowed) -c -c --- INPUTS: -c IO - integer - Unit number of input file -c IINP(nx,ny) - int. array - Data array from file -c MXNX,MXNY - integers - Dimensions of output data array -c NX,NY - integers - Dimensions of input data array -c LCMPRS - logocal - Compression flag -c -c --- OUTPUT: -c IOUT(mxnx,mxny) - int. array - Data array to calling routine -c CLAB12 - character*12- Data label -c -c --- RDI2DAUX called by: AUX1, RDAUX -c --- RDI2DAUX calls: none -c---------------------------------------------------------------------- - integer iinp(nx,ny) - integer iout(mxnx,mxny) - character*12 clab12 - character*15 clab15 - logical lcmprs - - nxy=nx*ny - mxnxy=mxnx*mxny - nchar=12 - - if(lcmprs) then - write(*,*)'ERROR in RDI2DAUX: Data compression option ', - & 'is NOT implemented' - stop - endif - - if(mxnxy.LT.nxy) then - write(*,*)'ERROR in RDI2DAUX: actual input array will not ', - & 'fit in output array!' - write(*,*)'Input array NX, NY: ',nx,ny - write(*,*)'Output array NX, NY: ',mxnx,mxny - stop - - elseif(nx.EQ.mxnx .AND. ny.EQ.mxny) then -c --- Input and output arrays have same shape so simple read - read(io) clab12,iout - - else -c --- Input array smaller than output array, so read and then -c --- transfer by element. - read(io) clab12,iinp - do j=1,ny - do i=1,nx - iout(i,j)=iinp(i,j) - enddo - enddo - - endif - - return - end - -c---------------------------------------------------------------------- - subroutine avgcldmr(qcz,tkz,patmz,qcup,zupbot,zuptop,zface,nzp1, - & zbot,ztop,ldb,cldamr,fzcld,cldt,cldp) -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.0.0 Level: 140521 AVGCLDMR -c D. Strimaitis -c -c --- PURPOSE: Obtain average LWC from vertical profile data -c Average is "in-cloud", so only LWC>0 contributes -c T,P "in-cloud" average is calculated the same way -c and assumes that T,P are constant in each layer -c -c --- INPUTS: -c QCZ(mxnz) - real array - Cloud water mixing ratio (g/kg) profile -c TKZ(mxnz) - real array - Temperature (K) profile @ layer heights -c PATMZ(mxnz) - real array - Pressure (atm) profile @ layer heights -c QCUP - real - Cloud water mixing ratio (g/kg) aloft -c (ZUPBOT - real - Bottom (mAGL) of cloud layers aloft) -c (ZUPTOP - real - Top (mAGL) of cloud layers aloft) -c ZUPBOT/ZUPTOP not currently used -c ZFACE(mxnzp1) - real array - Cell face heights (m) for each layer -c NZP1 - integer - Number of cell face heights (NZ + 1) -c ZBOT - real - Bottom (mAGL) of layer to be averaged -c ZTOP - real - Top (mAGL) of layer to be averaged -c LDB - logical - Debug output flag -c -c Parameters: -c MXNZ, MXNZP1, IO6 -c -c --- OUTPUT: -c CLDAMR - real - Average in-cloud liquid water mixing -c ratio (g/kg) for layer -c FZCLD - real - Fraction of interval ZTOP-ZBOT with -c LWC>0 -c CLDT - real - Associated temperature (K) -c CLDP - real - Associated pressure (atm) -c -c --- AVGCLDMR called by: CHEM -c --- AVGCLDMR calls: ZFIND -c---------------------------------------------------------------------- -c --- Include parameters - include 'params.puf' - - real qcz(mxnz),tkz(mxnz) - real zface(mxnzp1),patmz(mxnz) - logical ldb - -c --- Averaging height range -c --- Set averaging limits to model domain faces (keep orig range) - zabot=zbot - zatop=ztop - zabot=MAX(zabot,zface(1)) - zabot=MIN(zabot,zface(nzp1)) - zatop=MAX(zatop,zface(1)) - zatop=MIN(zatop,zface(nzp1)) - -c --- Find the grid layers containing the bottom, average, and top - zbar=0.5*(zabot+zatop) - call ZFIND(zabot,zface,nzp1,ibot) - call ZFIND(zbar, zface,nzp1,ibar) - call ZFIND(zatop,zface,nzp1,itop) - -c --- Initially no cloud water - cldamr=0.0 - fzcld=0.0 - cldt=tkz(ibar) - cldp=patmz(ibar) - - if(ibot.EQ.itop) then -c --- Just 1 layer for average - cldamr=qcz(ibot) - if(cldamr.GT.0.0) fzcld=1.0 - cldt=tkz(ibot) - cldp=patmz(ibot) - - else -c --- 2 or more layers -c --- Get average in-cloud mixing ratio (do not average zeroes) - sumqc=0.0 -c --- Cloud thickness - sumdz=0.0 -c --- In-cloud T,P weighted by LWC - sumtq=0.0 - sumpq=0.0 - -c --- Partial layer from ZABOT to ZFACE(ibot+1) - if(qcz(ibot).GT.0.0) then - dz=zface(ibot+1)-zabot - sumdz=sumdz+dz - dzq=dz*qcz(ibot) - sumqc=sumqc+dzq - sumtq=sumtq+dzq*tkz(ibot) - sumpq=sumpq+dzq*patmz(ibot) - endif - -c --- Partial layer from ZFACE(itop) to ZATOP - if(qcz(itop).GT.0.0) then - dz=zatop-zface(itop) - sumdz=sumdz+dz - dzq=dz*qcz(itop) - sumqc=sumqc+dzq - sumtq=sumtq+dzq*tkz(itop) - sumpq=sumpq+dzq*patmz(itop) - endif - -c --- Remaining are full layers between IBOT+1 and ITOP-1 - i1=ibot+1 - i2=itop-1 - if(i2.GE.i1) then - do i=i1,i2 - if(qcz(i).GT.0.0) then - dz=zface(i+1)-zface(i) - sumdz=sumdz+dz - dzq=dz*qcz(i) - sumqc=sumqc+dzq - sumtq=sumtq+dzq*tkz(i) - sumpq=sumpq+dzq*patmz(i) - endif - enddo - endif - -c --- Compute average - if(sumdz.GT.0.0) then - cldamr=sumqc/sumdz - cldt=sumtq/sumqc - cldp=sumpq/sumqc - fzcld=sumdz/(ztop-zbot) - endif - endif - -c *** Not Active *** -cc --- Treatment for interaction with clouds at top of model domain -cc --- Averaging layer must extend into the top model layer -cc --- (use linear weight to soften transition) - weight=0.0 -c if(qcup.GT.0.0) then -c zlo=zface(nzp1-1) -c if(ztop.GT.zlo) then -c weight=(ztop-zlo)/(zface(nzp1)-zlo) -c weight=AMIN1(weight,1.0) -c endif -cc --- Bottom of any cloud layer aloft must touch the model-top -c if(zupbot.LE.zface(nzp1)) then -cc --- Use the maximum of the average computed above and the -cc --- weighted average of the cloud water aloft -c cldamr=AMAX1(cldamr,weight*qcup) -c endif -c endif -c *** Not Active *** - - if(ldb) then - write(io6,*) 'AVGCLDMR: zbot,ztop,cldamr = ',zbot,ztop,cldamr - write(io6,*) ' weight,qcup = ',weight,qcup - write(io6,*) ' T(K),P(atm) = ',cldt,cldp - write(io6,*) ' zabot,zatop = ',zabot,zatop - write(io6,*) ' ibot,itop = ',ibot,itop - write(io6,*) ' sumqc,sumdz,fzcld= ',sumqc,sumdz,fzcld - endif - - return - end - -c---------------------------------------------------------------------- - subroutine makep3d -c---------------------------------------------------------------------- -c -c --- CALPUFF Version: TNG-7.0.0 Level: 140521 MAKEP3D -c D. Strimaitis -c -c --- PURPOSE: Estimate the 3D pressure (atm) at the face heights -c -c --- INPUTS: -c Common block /GRIDNEST/ variables: -c ngrid -c Common block /METHD/ variables: -c nxm(mxmetdom),nym(mxmetdom),nzm,zfacem(mxnzp1) -c Common block /METHR/ variables: -c temp2d(mxnx,mxny,mxmetdom),rho2d(mxnx,mxny,mxmetdom), -c tmet(mxnx,mxny,mxnz,mxmetdom) -c -c Parameters: -c MXNZ, MXNZP1, MXNX, MXNY, MXMETDOM -c -c --- OUTPUT: -c Common block /METHR/ variables: -c pmet(mxnx,mxny,mxnzp1,mxmetdom) -c -c --- MAKEP3D called by: COMP -c --- MAKEP3D calls: none -c---------------------------------------------------------------------- -c --- Include parameters - include 'params.puf' - - include 'gridnest.puf' - include 'methd.puf' - include 'methr.puf' - -c --- P2=P1* EXP(-(g/R)(z2-z1)/Tv) -c --- g=9.81 m2/s2 R=287.0 J/(kg K) -c --- Tv is average virtual temperature for layer z2-z1 (use layer T) - data gbyr/0.0341812/ - -c --- Loop over met domains - do im=1,ngrid - -c --- Set surface pressure - kz=1 - do jy=1,nym(im) - do ix=1,nxm(im) -c --- kg-Molar volume(m3) at ambient T,P computed from density - vkgmol = 28.97/rho2d(ix,jy,im) - pmet(ix,jy,kz,im)=(22.4141/vkgmol)* - & (temp2d(ix,jy,im)/273.15) - enddo - enddo - -c --- Set pressure profiles from temperature profiles - do kz=2,nzm+1 - kzm1=kz-1 - do jy=1,nym(im) - do ix=1,nxm(im) - f=-gbyr*(zfacem(kz)-zfacem(kzm1)) - pmet(ix,jy,kz,im)=pmet(ix,jy,kzm1,im)* - & EXP(f/tmet(ix,jy,kzm1,im)) - enddo - enddo - enddo - - enddo - - return - end diff --git a/CALPUFF_SRC/CALPUFF/map.puf b/CALPUFF_SRC/CALPUFF/map.puf deleted file mode 100644 index 9055ed5..0000000 --- a/CALPUFF_SRC/CALPUFF/map.puf +++ /dev/null @@ -1,59 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MAP/ -- Map Projection & Datum CALPUFF -c---------------------------------------------------------------------- - logical*4 lutm,llcc,lps,lem,llaza,lttm - character*4 utmhem - character*8 datum,pmap - character*12 daten - character*16 clat0,clon0,clat1,clat2 -c - common/map/lutm,llcc,lps,lem,llaza,lttm, - & iutmzn,feast,fnorth, - & rnlat0,relon0,rlat0,rlon0,xlat1,xlat2, - & pmap,utmhem,datum,daten,clat0,clon0,clat1,clat2 -c -c --- COMMON BLOCK /MAP/ Variables: -c -c LUTM - logical*4 - Flag for Universal Transverse Mercator -c LLCC - logical*4 - Flag for Lambert Conformal Conic -c LPS - logical*4 - Flag for Polar Stereographic -c LEM - logical*4 - Flag for Equatorial Mercator -c LLAZA - logical*4 - Flag for Lambert Azimuthal Equal Area -c LTTM - logical*4 - Flag for Tangential Transverse Mercator -c -c IUTMZN - integer - UTM zone for UTM projection -c FEAST (km) - real - False Easting at projection origin -c FNORTH (km) - real - False Northing at projection origin -c RNLAT0, - real - N. latitude & E. longitude of x=0 and y=0 -c RELON0 (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RLAT0,RLON0 - real - N. latitude & W. longitude of x=0 and y=0 -c of map projection (degrees, + = N,W) -c (Much of code written for W. Longitude, -c so RLAT0=RNLAT0 and RLON0=-RELON0 -c XLAT1, - real - Matching N. latitude(s) for projection -c XLAT2 (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c PMAP - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEM - character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUM - character - Datum-Region for grid coordinates -c DATEN - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c CLAT0 - character - Character version of RNLAT0 -c CLON0 - character - Character version of RELON0 -c CLAT1 - character - Character version of XLAT1 -c CLAT2 - character - Character version of XLAT2 - diff --git a/CALPUFF_SRC/CALPUFF/methd.puf b/CALPUFF_SRC/CALPUFF/methd.puf deleted file mode 100644 index c97f47f..0000000 --- a/CALPUFF_SRC/CALPUFF/methd.puf +++ /dev/null @@ -1,174 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /METHD/ -- Header record information from CALPUFF -c meteorological data file(s) -c---------------------------------------------------------------------- -c - logical lcalgrd - logical*4 llconfm - character*8 levmet - character*4 utmhemm - character*8 datumm,pmapm - character*12 datenm -c - common/METHD/levmet,dversm,nxm(mxmetdom),nym(mxmetdom),nzm, - 1 xgridm(mxmetdom),xgridmi(mxmetdom),xorigm(mxmetdom), - 2 yorigm(mxmetdom),xbtzm,xlat0m,xlon0m,llconfm,rlat0m,rlon0m, - 3 xlat1m,xlat2m,nssta(mxmetdom),nusta(mxmetdom),npsta(mxmetdom), - 4 nowsta(mxmetdom),nlu,iwat1,iwat2,zfacem(mxnzp1), - 5 xssta(mxss,mxmetdom),yssta(mxss,mxmetdom), - 6 xlatss(mxss,mxmetdom),xlonss(mxss,mxmetdom),xusta(mxus,mxmetdom), - 7 yusta(mxus,mxmetdom),xpsta(mxps,mxmetdom),ypsta(mxps,mxmetdom), - 8 z0(mxnx,mxny,mxmetdom),ilandu(mxnx,mxny,mxmetdom), - 9 elev(mxnx,mxny,mxmetdom),xlai(mxnx,mxny,mxmetdom), - & nears(mxnx,mxny,mxmetdom),lcalgrd, - 1 anemht,imixctdm,isigmav,ilanduin,z0in,xlaiin, - 2 elevin,xlatin,xlonin,nss,i2dmet,itimes,itimeprf, - 3 ibymet(mxmetdom),ibmmet(mxmetdom),ibdmet(mxmetdom), - 4 ibjdmet(mxmetdom),ibhmet(mxmetdom),ibsmet(mxmetdom), - 5 ieymet(mxmetdom),iemmet(mxmetdom),iedmet(mxmetdom), - 6 iejdmet(mxmetdom),iehmet(mxmetdom),iesmet(mxmetdom), - 7 iutmznm,feastm,fnorthm,pmapm,datumm,datenm,utmhemm -c -c --- COMMON BLOCK /METHD/ Variables: -c LEVMET - character- Level of CALMET that generated met file -c DVERSM - real - Dataset version number for CALMET file -c NXM(mxmetdom) - integer - Number of CALMET grid points in -c X direction -c NYM(mxmetdom) - integer - Number of CALMET grid points in -c Y direction -c NZM - integer - Number of CALMET vertical levels -c XGRIDM(mxmetdom) - real - CALMET grid spacing (m) -c XGRIDMI(mxmetdom)- real - 1/CALMET grid spacing (1/m) -c XORIGM(mxmetdom) - real - Reference X coordinate (m) of -c southwest corner of CALMET grid -c YORIGM(mxmetdom) - real - Reference Y coordinate (m) of -c southwest corner of CALMET grid -c XBTZM - real - Base time zone of CALMET data -c XLAT0M - real - Reference N LATITUDE (deg) of -c southwest corner of CALMET grid -c XLON0M - real - Reference W LONGITUDE (deg) of -c southwest corner of CALMET grid -c LLCONFM - logical - Lambert Conformal Map Projection used -c instead of UTM when TRUE -c RLAT0M, - real - N. latitude & W. longitude of x=0 and y=0 -c RLON0M (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude POS in western hemisphere -c XLAT1M, - real - Matching N. latitude(s) for projection -c XLAT2M (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c NSSTA(mxmetdom) - integer - Number of surface met. stations -c NUSTA(mxmetdom) - integer - Number of upper air stations -c NPSTA(mxmetdom) - integer - Number of precipitation stations -c NOWSTA(mxmetdom) - integer - Number of over-water stations -c NLU - integer - Number of land use categories -c IWAT1, IWAT2 - integers - Land use categories from IWAT1 through -c IWAT2 correspond to water -c ZFACEM(mxnzp1) - real - CALMET cell face heights (m) -c (NZM+1 values) -c XSSTA(mxss,mxmetdom) -c - real - X coordinate of each surface -c meteorological station -c YSSTA(mxss,mxmetdom) -c - real - Y coordinate of each surface -c meteorological station -c XLATSS(mxss,mxmetdom) -c - real - N Latitude of each surface -c meteorological station (degrees) -c YLONSS(mxss,mxmetdom) -c - real - W Longitude of each surface -c meteorological station (degrees) -c XUSTA(mxus,mxmetdom) -c - real - X coordinate of each upper air -c meteorological station -c YUSTA(mxus,mxmetdom) -c - real - Y coordinate of each upper air -c meteorological station -c XPSTA(mxps,mxmetdom) -c - real - X coordinate of each precipitation -c station -c YPSTA(mxps,mxmetdom) -c - real - Y coordinate of each precipitation -c station -c Z0(mxnx,mxny,mxmetdom) - real - Average surface roughness lengths (m) -c for each grid cell -c ILANDU(mxnx,mxny,mxmetdom) - real - Land use category for each grid cell -c NOTE: negative values indicate IRRIGATED -c land use -c ELEV(mxnx,mxny,mxmetdom) - real - Average terrain height (m) above sea -c level for each grid cell -c XLAI(mxnx,mxny,mxmetdom) - real - Leaf area index for each grid cell -c NEARS(mxnx,mxny,mxmetdom) - integer - Closest surface met. station to each -c grid point -c LCALGRD - logical - Control variable indicating if special -c meteorological fields required by -c CALGRID are stored in the met. file -c *** For METFM = 2,3 -c ANEMHT - real - Height (m) at which single-point wind -c measurements are made -c *** For METFM = 4 -c IMIXCTDM - integer - Flag to select mixing height from CTDM -c SURFACE file -c 0: select calculated mixing ht. -c 1: select observed mixing ht. -c -c ISIGMAV - integer - Flag for units of PROFILE.DAT sigma -c 0: sigma-theta (deg) -c 1: sigma-v (m/s) -c *** For METFM = 2,3,4 --- Used to initialize 2-D arrays -c ILANDUIN - integer - Single land use code for domain -c Z0IN - integer - Single roughness length (m) for domain -c XLAIIN - integer - Single leaf area index for domain -c ELEVIN - real - Single elevation (m MSL) for domain -c *** For METFM = 2,3,4 --- Used to initialize 1-D arrays -c XLATIN - real - N Latitude for single met station (deg) -c XLONIN - real - W Longitude for single met station (deg) -c *** For METFM = 1 --- Used to place surface station lat/lon -c in control file -c NSS - integer - Number of surface met. stations -c I2DMET - integer - Flag for 2 D array of sfc met -c 0: 2D arrays NOT available -c 1: 2D array available -c -c *** Timing variables -c ITIMES - integer - Flag for reading times in data records -c 0: end-time (no seconds) -c 1: begin-time / end-time with seconds -c ITIMEPRF - integer - Flag for reading times in PROFILE.DAT -c data records (METFM not 4 or 5) -c 0: end-time (no seconds) -c 1: begin-time / end-time with seconds -c IBYMET(mxmetdom) - integer - Beginning year of run (four digits) -c IBMMET(mxmetdom) - integer - Beginning month of run -c IBDMET(mxmetdom) - integer - Beginning day of run -c IBJDMET(mxmetdom) - integer - Beginning Julian day of run -c IBHMET(mxmetdom) - integer - Beginning hour of run (00-23) -c IBSMET(mxmetdom) - integer - Beginning seconds of run (0000-3599) -c IEYMET(mxmetdom) - integer - Ending year of run (four digits) -c IEMMET(mxmetdom) - integer - Ending month of run -c IEDMET(mxmetdom) - integer - Ending day of run -c IEJDMET(mxmetdom) - integer - Ending Julian day of run -c IEHMET(mxmetdom) - integer - Ending hour of run (00-23) -c IESMET(mxmetdom) - integer - Ending seconds of run (0000-3599) -c -c -c IUTMZNM - integer - UTM zone for UTM projection -c FEASTM (km) - real - False Easting at projection origin -c FNORTHM(km) - real - False Northing at projection origin -c PMAPM - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMM - character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMM - character - Datum-Region for grid coordinates -c DATENM - character - NIMA date for datum parameters -c (MM-DD-YYYY ) diff --git a/CALPUFF_SRC/CALPUFF/methr.puf b/CALPUFF_SRC/CALPUFF/methr.puf deleted file mode 100644 index c48726f..0000000 --- a/CALPUFF_SRC/CALPUFF/methr.puf +++ /dev/null @@ -1,100 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /METHR/ -- Hourly meteorological fields CALPUFF -c from the meteorological data -c file(s) -c---------------------------------------------------------------------- -c ********************************************************************** -c --- Exponent, Inc. Updates: -c ********************************************************************** -c --- Add computed 3D pressure fields (may be external in future) -c ********************************************************************** -c - common/METHR/umet(mxnx,mxny,mxnz,mxmetdom), - 1 vmet(mxnx,mxny,mxnz,mxmetdom),tmet(mxnx,mxny,mxnz,mxmetdom), - 2 ipgt(mxnx,mxny,mxmetdom),htmix(mxnx,mxny,mxmetdom), - 3 ustar(mxnx,mxny,mxmetdom),xmonin(mxnx,mxny,mxmetdom), - 4 wstar(mxnx,mxny,mxmetdom),rmm(mxnx,mxny,mxmetdom), - 5 tempss(mxss,mxmetdom),rhoss(mxss,mxmetdom), - 6 qswss(mxss,mxmetdom),ccss(mxss,mxmetdom),czenss(mxss,mxmetdom), - 7 irhss(mxss,mxmetdom),ipcode(mxss,mxmetdom),ptg(2),plexp,dptinvo, - 8 wsprf(mxprfz),wdprf(mxprfz),tprf(mxprfz),svprf(mxprfz), - 9 swprf(mxprfz),ssprf(mxprfz),zprf(mxprfz),nzprf, - & wdiv(mxnx,mxny,mxnz,mxmetdom), -c frr (09/01) - 2D fields for CALMET version >= V5.3 Lev 010901 - 1 temp2d(mxnx,mxny,mxmetdom),rho2d(mxnx,mxny,mxmetdom), - 2 qsw2d(mxnx,mxny,mxmetdom),cc2d(mxnx,mxny,mxmetdom), - 3 czen2d(mxnx,mxny,mxmetdom),irh2d(mxnx,mxny,mxmetdom), - 4 ipcode2d(mxnx,mxny,mxmetdom), - -c - Computed fields - 5 pmet(mxnx,mxny,mxnzp1,mxmetdom) -c ********************************************************************** - -c -c --- COMMON BLOCK /METHR/ Variables: -c -c UMET(mxnx,mxny,mxnz,mxmetdom) -c - real - U-component of the wind (m/s) at -c each grid point -c VMET(mxnx,mxny,mxnz,mxmetdom) -c - real - V-component of the wind (m/s) -c TMET(mxnx,mxny,mxnz,mxmetdom) -c - real - 3-D temperature field (deg. K) -c PMET(mxnx,mxny,mxnzp1,mxmetdom) -c - real - 3-D pressure field (atm) -c IPGT(mxnx,mxny,mxmetdom) -c - integer - PGT stability class (1-6) -c HTMIX(mxnx,mxny,mxmetdom) -c - real - Mixing height (m) -c USTAR(mxnx,mxny,mxmetdom) -c - real - Friction velocity (m/s) -c XMONIN(mxnx,mxny,mxmetdom) -c - real - Monin-Obukhov length (m) -c WSTAR(mxnx,mxny,mxmetdom) -c - real - Convective velocity scale (m/s) -c RMM(mxnx,mxny,mxmetdom) -c - real - Precipitation rate (mm/hr) -c TEMPSS(mxss,mxmetdom) - real - Temperature (deg. K) at each -c surface met. station -c RHOSS(mxss,mxmetdom) - real - Air density (kg/m**3) -c QSWSS(mxss,mxmetdom) - real - Short-wave solar radiation (W/m**2) -c CCSS(mxss,mxmetdom) - real - Cloud cover (tenths) -c CZENSS(mxss,mxmetdom) - real - Cosine of solar zenith angle -c IRHSS(mxss,mxmetdom) - integer - Relative humidity (%) -c IPCODE(mxss,mxmetdom) - integer - Precipitation code at each surface -c met. station -c PTG(2) - real - Default potential temperature grad. -c for stability 5,6 (deg. K/m) -c PLEXP - real - Power law exponent for wind profile -c DPTINVO - real - Strength of inversion above CBL -c (jump in potential temperature K) -c WSPRF(mxprfz) - real - Vector avg. wind speed (m/s) from -c PROFILE.DAT -c WDPRF(mxprfz) - real - Vector wind direction (deg) from -c PROFILE.DAT -c TPRF(mxprfz) - real - Temperature (K) from PROFILE.DAT -c SVPRF(mxprfz) - real - Sigma-v (m/s) from PROFILE.DAT -c SWPRF(mxprfz) - real - Sigma-w (m/s) from PROFILE.DAT -c SSPRF(mxprfz) - real - Scalar avg. wind speed (m/s) from -c PROFILE.DAT -c ZPRF(mxprfz) - real - Heights at which PROFILE.DAT data -c are provided (m) -c NZPRF - integer - Number of heights in PROFILE.DAT -c WDIV(mxnx,mxny,mxnz,mxmetdom) -c - real - Vertical divergence dw/dz (1/s) -c -c frr (09/01) - additional fields needed for CALMET V5.3 level 010901 and up -c TEMP2D(mxnx,mxny,mxmetdom) -c - real - Surface Temperature (deg. K) -c RHO2D(mxnx,mxny,mxmetdom) -c - real - Air density (kg/m**3) -c QSW2D(mxnx,mxny,mxmetdom) -c - real - Short-wave solar radiation (W/m**2) -c CC2D(mxnx,mxny,mxmetdom) -c - real - Cloud cover (tenths) -c CZEN2D(mxnx,mxny,mxmetdom) -c - real - Cosine of solar zenith angle -c IRH2D(mxnx,mxny,mxmetdom) -c - integer - Relative humidity (%) -c IPCODE2D(mxnx,mxny,mxmetdom) -c - integer - Precipitation code diff --git a/CALPUFF_SRC/CALPUFF/mflux.puf b/CALPUFF_SRC/CALPUFF/mflux.puf deleted file mode 100644 index d0263a9..0000000 --- a/CALPUFF_SRC/CALPUFF/mflux.puf +++ /dev/null @@ -1,40 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MFLUX/ -- User-Supplied Boundary Lines CALPUFF -c and arrays for Mass Flux Output -c---------------------------------------------------------------------- -c - logical*1 lbndry(mxnx,mxny) - character*16 cnambdy(mxbndry) - common/MFLUX/nbndry,npbndry(2,mxbndry),bndrygrd(2,mxptbdy), - & ymxpbm(2,mxptbdy),flxin(mxspec,mxbndry), - & flxout(mxspec,mxbndry),cnambdy,lbndry -c -c --- COMMON BLOCK /MFLUX/ Variables: -c -c NBNDRY - integer - Number of boundaries defined -c NPBNDRY(2,mxbndry) - integer - Pointer to locations in BNDRYGRD -c array containing data for each line -c where element 1 is the start and -c element 2 is the end -c BNDRYGRD(2,mxptbdy) - real - x,y coordinates (MET GRID UNITS) of -c points along each line, where -c element 1 is x, element 2 is y -c YMXPBM(2,mxptbdy) - real - Slope 'm' and intercept 'b' for line -c defined by each boundary segment -c element 1 is 'm', element 2 is 'b' -cFLXIN(mxspec,mxbndry) - real - Mass flux of each species INTO -c region for each boundary (g/s) -cFLXOUT(mxspec,mxbndry)- real - Mass flux of each species OUT of -c region for each boundary (g/s) -c CNAMBDY(mxptbdy) - C*16 - Name of boundary -c LBNDRY(mxnx,mxny) - logical - Logical marker indicating if a MET -c GRID cell contains a boundary line -c---------------------------------------------------------------------- -c NOTE: More than 1 boundary can be defined, but all are appended in -c the BNDRYGRD array. The NPBNDRY provides the index for the -c start and the end of each coast line. Also, the ordering of -c the points follows the convention that the region INTO which -c the mass moves is to the RIGHT of the line traced out by these -c points. -c Mass flux from LEFT to RIGHT is summed in the FLXIN array. -c Mass flux from RIGHT to LEFT is summed in the FLXOUT array. \ No newline at end of file diff --git a/CALPUFF_SRC/CALPUFF/modules.for b/CALPUFF_SRC/CALPUFF/modules.for deleted file mode 100644 index 88ea95a..0000000 --- a/CALPUFF_SRC/CALPUFF/modules.for +++ /dev/null @@ -1,340 +0,0 @@ -c --- This group of modules takes on the role of data declarations and -c --- included common files; initializations are also done here using -c --- data statements much like a BLOCK DATA structure. -c --- Individual modules are: -c module mroad1 -c module mroad2 -c module mqscale - -c----------------------------------------------------------------------- - module mroad1 -c----------------------------------------------------------------------- -c --- CALPUFF Version: 7.2.1 Level: 141201 |MROAD1| -c --- Constant/Scaled Road-source data -c----------------------------------------------------------------------- - integer :: nrd1,nrdseg1,nsfrds - integer, allocatable :: nptrd1(:) ! (nrd1) - integer, allocatable :: iroad1(:),newrd1(:) ! (nrdseg1) - integer, allocatable :: idsfrds(:,:) ! (mxspec,nrd1) - integer, allocatable :: ixrefrds(:) ! (nsfrds) - - character(len=16), allocatable :: srcnamrd1(:) ! (nrd1) - character(len=40), allocatable :: csfrds(:) ! (nsfrds) - - real, allocatable :: htrd1(:),sz0rd1(:),sy0rd1(:) ! (nrd1) - real, allocatable :: qrd1(:,:) ! (mxspec,nrd1) - real, allocatable :: rdlen1(:) ! (nrdseg1) - real, allocatable :: xrd1grd(:,:),yrd1grd(:,:),elrd1(:,:) ! (2,nrdseg1) - -c --- Variables: -c --------------- -c -c --- Variables for named roads -c NRD1 - integer - Number of roads -c SRCNAMRD1(nrd1) - char*16 - Road names -c HTRD1(nrd1) - real - Effective release height (m) -c SZ0RD1(nrd1) - real - Initial sigma z (m) -c SY0RD1(nrd1) - real - Initial sigma y (m) -c QRD1(mxspec,nrd1) - real - Emission rate (g/s/m) for each -c pollutant -c NPTRD1(nrd1) - real - Number of points defining road -c -c --- Variables for road-species pairs with scaled emissions -c NSFRDS - integer - Number of road-species pairs -c with emissions scaling factors -c IDSFRDS(mxspec,nrd1) - integer - Pointer to road-species pair -c index, 0 to NSFRDS -c (0 if no scaling) -c CSFRDS(nsfrds) - char*40 - List of scale-factor table names -c for road-species pairs -c IXREFRDS(nsfrds) - integer - Cross-reference pointer from -c road-species pairs to -c scale-factor tables -c -c --- Variables for road segments that emit puffs/slugs -c NRDSEG1 - integer - Number of emitting road segments -c (Total over all roads) -c IROAD1(nrdseg1) - integer - Road number for this segment -c RDLEN1(nrdseg1) - real - Road length (m) for this segment -c XRD1GRD(2,nrdseg1) - real - X coordinate of the ends of road -c segments in grid units -c (i.e., origin at (0.0,0.0)) -c YRD1GRD(2,nrdseg1) - real - Y coordinate of the ends of road -c segments in grid units -c (i.e., origin at (0.0,0.0)) -c ELRD1(2,nrdseg1) - real - Ground elevation of the ends of -c road segments (m MSL) -c NEWRD1(nrdseg1) - integer - Number of puffs/slugs released -c by each road during the current -c step -c----------------------------------------------------------------------- - end module mroad1 -c----------------------------------------------------------------------- - - -c----------------------------------------------------------------------- - module mroad2 -c----------------------------------------------------------------------- -c --- CALPUFF Version: TNG-7.1.0 Level: 141201 |MROAD2| -c --- Time-varying Road-source data -c----------------------------------------------------------------------- - integer :: nrd2,nrdseg2,nse7,nrddat - - integer, allocatable :: ixrem7(:) ! (mxspec) - integer, allocatable :: nptrd2(:) ! (nrd2) - integer, allocatable :: iroad2(:),newrd2(:) ! (nrdseg2) - - character(len=12), allocatable :: cslst7(:) ! (mxspec) - character(len=16), allocatable :: cid7(:) ! (nrd2) - - real, allocatable :: xmwem7(:) ! (mxspec) - real, allocatable :: rdlen2(:) ! (nrdseg2) - real, allocatable :: xrd2grd(:,:),yrd2grd(:,:),elrd2(:,:) ! (2,nrdseg2) - real, allocatable :: htrd2(:,:),sz0rd2(:,:),sy0rd2(:,:) ! (mxqstep,nrd2) - real, allocatable :: qrd2(:,:,:) ! (mxspec,mxqstep,nrd2) - -c --- Arrays for data stored for each RDEMARB.DAT file (nrddat files) - - integer, allocatable :: ibsrc7(:),iesrc7(:),ibdathr7(:),ibsec7(:) ! (nrddat) - integer, allocatable :: iedathr7(:),iesec7(:) ! (nrddat) - integer, allocatable :: iutmznrd2(:) ! (nrddat) - integer, allocatable :: nstep7(:),mfrd2(:) ! (nrddat) - integer, allocatable :: ndhrqb7(:,:),nsecqb7(:,:) ! (mxqstep,nrddat) - integer, allocatable :: ndhrqe7(:,:),nsecqe7(:,:) ! (mxqstep,nrddat) - - real, allocatable :: xtz7(:),t2btz7(:) ! (nrddat) - real, allocatable :: feastrd2(:),fnorthrd2(:) ! (nrddat) - real, allocatable :: rnlat0rd2(:),relon0rd2(:) ! (nrddat) - real, allocatable :: rnlat1rd2(:),rnlat2rd2(:) ! (nrddat) - - character(len=8), allocatable :: pmaprd2(:),datumrd2(:) ! (nrddat) - character(len=4), allocatable :: utmhemrd2(:),xyunitrd2(:) ! (nrddat) - character(len=12), allocatable :: datenrd2(:) ! (nrddat) - character(len=16), allocatable :: verrdarb(:) ! (nrddat) - character(len=132),allocatable :: rddat(:) ! (nrddat) - -c --- Variables: -c --------------- -c -c --- Variables for named roads -c NSE7 - integer - Number of emitted species -c CSLST7(mxspec) - char*12 - Species identifiers -c XMWEM7(mxspec) - real - Molecular weight for each species -c IXREM7(mxspec) - integer - Cross referencing array of NSE7 -c values relating species ordering -c in the emissions file to the -c ordering in the main conc. array -c NRD2 - integer - Total number of roads -c CID7(nrd2) - char*16 - Road names -c NPTRD2(nrd2) - real - Number of points defining road -c -c --- Variables for each file -c NRDDAT - integer - Total number of RDEMARB.DAT files -c RDDAT(nrddat) - char*132 - Path & filename for the input CALPUFF -c file(s) containing ROAD sources with -c arbitrarily-varying location and -c emissions -c (default: RDEMARB.DAT, for 1 file) -c MFRD2(nrddat) - integer - Flag for file type -c 0: UNFORMATTED (not supported!) -c 1: FORMATTED -c VERRDARB(nrddat) - char*16 - Version of the input CALPUFF -c file(s) containing road sources -c with arbitrarily-varying location and -c emissions -c (RDEMARB.DAT) -c IBSRC7(nrddat) - integer - Index for first source in a RDEMARB.DAT -c file -c IESRC7(nrddat) - integer - Index for last source in a RDEMARB.DAT -c file -c IBDATHR7(nrddat)- integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSEC7(nrddat) - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHR7(nrddat)- integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESEC7(nrddat) - integer - Seconds of the last data record in the -c file (0000-3599) -c XTZ7(nrddat) - real - Time zone (UTC=LST+XTZ7) -c T2BTZ7(nrddat) - real - Hours to ADD to Local Time to obtain -c Base Time (xtz7-xbtz) -c -c --- MAP Projection -c PMAPRD2(nrddat) -char*8 - Character code for map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMRD2(nrddat) -char*4 - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMRD2(nrddat) -char*8 - Datum-Region for grid coordinates -c DATENRD2(nrddat) -char*12 - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITRD2(nrddat) -char*4 - Units for coordinates (e.g., KM) -c -c IUTMZNRD2(nrddat) -integer - UTM zone for UTM projection -c FEASTRD2(nrddat) -real - False Easting (km) at projection origin -c FNORTHRD2(nrddat) -real - False Northing (km) at projection origin -c RNLAT0RD2(nrddat) -real - N. latitude & E. longitude of x=0 and y=0 -c RELON0RD2(nrddat) (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1RD2(nrddat) - real - Matching N. latitude(s) for projection -c RNLAT2RD2(nrddat) (deg) (Used only if PMAP3= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c -c --- Variables for road-segments that emit puffs/slugs -c --- (other properties are taken from the (nrd2) arrays) -c NRDSEG2 - integer - Number of emitting road segments -c (Total over all roads) -c IROAD2(nrdseg2) - integer - Road number for this segment -c RDLEN2(nrdseg2) - real - Road length (m) for this segment -c XRD2GRD(2,nrdseg2) - real - X coordinate of the ends of road -c segments in grid units -c (i.e., origin at (0.0,0.0)) -c YRD2GRD(2,nrdseg2) - real - Y coordinate of the ends of road -c segments in grid units -c (i.e., origin at (0.0,0.0)) -c ELRD2(2,nrdseg2) - real - Ground elevation of the ends of -c road segments (m MSL) -c -c --- Variable data --- -c -c NSTEP7(nrddat) - integer - Number of emission steps in -c current timestep for each file -c NDHRQB7(mxqstep,nrddat) & NSECQB7(mxqstep,nrddat) -c - integer - Starting time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c NDHRQE7(mxqstep,nrddat) & NSECQE7(mxqstep,nrddat) -c - integer - Ending time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c HTRD2(mxqstep,nrd2) - real - Effective height (mAGL) -c SY0RD2(mxqstep,nrd2) - real - Initial sigma y (m) -c SZ0RD2(mxqstep,nrd2) - real - Initial sigma z (m) -c QRD2(mxspec,mxqstep,nrd2) -c - real - Emission rate (g/m/s) for each -c pollutant -c NEWRD2(nrdseg2) - integer - Number of puffs/slugs released -c by each road during the current -c step -c -c----------------------------------------------------------------------- - end module mroad2 -c----------------------------------------------------------------------- - - -c----------------------------------------------------------------------- - module mqscale -c----------------------------------------------------------------------- -c --- CALPUFF Version: TNG-7.1.0 Level: 141201 |MQSCALE| -c --- Emission-Rate Scaling Factors (control file sources) -c----------------------------------------------------------------------- - integer, parameter :: nqsftype = 9 - integer :: nqsfval(nqsftype) - integer :: nqsfcol(nqsftype),nqsfrow(nqsftype) - integer :: mapivary(6) - character(len=24) :: cqsftype(nqsftype) - real :: wqsf(5,13),tqsf(11,13) - - integer :: nqsftab - integer, allocatable :: iqsftype(:) ! (nqsftab) - real, allocatable :: qsftab(:,:) ! (mxqsf,nqsftab) - character(len=40), allocatable :: cqsfname(:) ! (nqsftab) - -c --- Assignments: -c ----------------- - data nqsfval/1, 12, 7, - & 24, 168, 288, - & 6, 36, 12/ - data nqsfcol/1, 12, 7, - & 24, 24, 24, - & 6, 6, 12/ - data nqsfrow/1, 1, 1, - & 1, 7, 12, - & 1, 6, 1/ - data mapivary/1, 4, 2, 6, 8, 9/ - data cqsftype/ 'CONSTANT1 ', - & 'MONTH12 ','DAY7 ', - & 'HOUR24 ','HOUR24_DAY7 ', - & 'HOUR24_MONTH12 ','WSP6 ', - & 'WSP6_PGCLASS6 ','TEMPERATURE12 '/ -c --- NOTE --------- -c CONSTANT1 1 scaling factor -c MONTH12 12 scaling factors: months 1-12 -c DAY7 7 scaling factors: days 1-7 -c [SUNDAY,MONDAY, ... FRIDAY,SATURDAY] -c HOUR24 24 scaling factors: hours 1-24 -c HOUR24_DAY7 168 scaling factors: hours 1-24, -c repeated 7 times: -c [SUNDAY,MONDAY, ... FRIDAY,SATURDAY] -c HOUR24_MONTH12 288 scaling factors: hours 1-24, -c repeated 12 times: months 1-12 -c WSP6 6 scaling factors: wind speed classes 1-6 -c [speed classes (WSCAT)] -c WSP6_PGCLASS6 36 scaling factors: wind speed classes 1-6 -c repeated 6 times: PG classes A,B,C,D,E,F -c [speed classes (WSCAT)] -c TEMPERATURE12 12 scaling factors: temp(K) classes 1-12 -c [temperature classes (TKCAT)] -c ----------------- -c -c --- Variables: -c --------------- -c -c --- Variables for defining emission-rate scaling factors -c NQSFTAB - integer - Number of tables of -c emissions scaling factors -c IQSFTYPE(nqsftab) - integer - Index of scale-factor type of -c each table -c CQSFNAME(nqsftab) - char*40 - Name of each scale-factor table -c QSFTAB(mxqsf,nqsftab) - real - Emission scale-factors -c NQSFTYPE - integer - Number of types of -c emissions scaling factors -c CQSFTYPE(nqsftype) - char*24 - Name of each scale-factor type -c MAPIVARY(6) - integer - Map pointer from the 6 IVARY -c choices to the corresponding -c CQSFTYPE() index -c NQSFVAL(nqsftype) - integer - Number of scaling factors for -c each type -c (Max must = MXQSF in /params/) -c NQSFCOL(nqsftype) - integer - Number of print columns for each -c NQSFROW(nqsftype) - integer - Number of print rows for each -c -c --- Temperature and wind speed classes by source type (13) -c WQSF(5,13) - real - Wind speed class boundaries (m/s) -c (boundary is upper limit of class) -c TQSF(11,13) - real - Temperature class boundaries (K) -c (boundary is upper limit of class) -c Source Types are: -c 1 = Point Constant Emissions -c 2 = Point Variable Emissions (no WS/T class used) -c 3 = Poly. Area Constant Emissions -c 4 = Poly. Area Variable Emissions (no WS/T class used) -c 5 = Line Constant Emissions -c 6 = Line Variable Emissions (no WS/T class used) -c 7 = Volume Constant Emissions -c 8 = Grid Volume Variable Emissions (no WS/T class used) -c 9 = Boundary Condition -c (10)= Flare Constant Emissions -c 11 = Flare Variable Emissions (no WS/T class used) -c 12 = Road Constant Emissions -c 13 = Road Variable Emissions (no WS/T class used) -c -c----------------------------------------------------------------------- - end module mqscale -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/msbal.puf b/CALPUFF_SRC/CALPUFF/msbal.puf deleted file mode 100644 index 9af8226..0000000 --- a/CALPUFF_SRC/CALPUFF/msbal.puf +++ /dev/null @@ -1,32 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /MSBAL/ -- arrays for Mass Balance Output CALPUFF -c---------------------------------------------------------------------- -c - logical lbc - common/MSBAL/balinp(mxspec),balout(mxspec),baltrn(mxspec), - & balwet(mxspec),baldry(mxspec),baltot(mxspec,2), - & balinpbc(mxspec),baloutbc(mxspec),baltrnbc(mxspec), - & balwetbc(mxspec),baldrybc(mxspec),baltotbc(mxspec,2), - & lbc -c -c --- COMMON BLOCK /MSBAL/ Variables: -c -c BALINP(mxspec) - real - Mass of each species emitted -c during current hour (g) -c BALOUT(mxspec) - real - Mass of each species advected -c during current hour (g) -c BALTRN(mxspec) - real - Mass of each species transformed -c during current hour ( +/- g) -c BALWET(mxspec) - real - Mass of each species removed (wet -c depletion) during current hour (g) -c BALDRY(mxspec) - real - Mass of each species removed (dry -c depletion) during current hour (g) -c BALTOT(mxspec,2) - real - Mass of each species in domain at -c end of current hour (g) below(1) -c and above(2) surface mixed layer -c -c --- Above array names are repeated with 'BC' appended to store the -c --- corresponding information for mass that enters domain through -c --- the boundary conditions -c -c LBC - logical - Boundary condition mass reported? diff --git a/CALPUFF_SRC/CALPUFF/nesthd.puf b/CALPUFF_SRC/CALPUFF/nesthd.puf deleted file mode 100644 index 88f7577..0000000 --- a/CALPUFF_SRC/CALPUFF/nesthd.puf +++ /dev/null @@ -1,81 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /NESTHD/ -- Header record information from CALPUFF -c nested meteorological data file -c that is read and tested, but not -c used -c (Subset of /METHD/) -c---------------------------------------------------------------------- -c - logical lcalgrdx - logical*4 llconfmx - character*8 levmetx - character*4 utmhemmx - character*8 datummx,pmapmx - character*12 datenmx -c - common/NESTHD/levmetx,dversmx,nzmx, - 1 xbtzmx,xlat0mx,xlon0mx,llconfmx,rlat0mx,rlon0mx,xlat1mx,xlat2mx, - 2 nlux,iwat1x,iwat2x,zfacemx(mxnzp1),lcalgrdx, - 3 i2dmetx,itimesx,itimeprfx, - 4 iutmznmx,feastmx,fnorthmx,pmapmx,datummx,datenmx,utmhemmx -c -c --- COMMON BLOCK /METHD/ Variables: (without the 'x' trailer) -c LEVMET - character- Level of CALMET that generated met file -c DVERSM - real - Dataset version number for CALMET file -c NZM - integer - Number of CALMET vertical levels -c XBTZM - real - Base time zone of CALMET data -c XLAT0M - real - Reference N LATITUDE (deg) of -c southwest corner of CALMET grid -c XLON0M - real - Reference W LONGITUDE (deg) of -c southwest corner of CALMET grid -c LLCONFM - logical - Lambert Conformal Map Projection used -c instead of UTM when TRUE -c RLAT0M, - real - N. latitude & W. longitude of x=0 and y=0 -c RLON0M (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude POS in western hemisphere -c XLAT1M, - real - Matching N. latitude(s) for projection -c XLAT2M (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c NLU - integer - Number of land use categories -c IWAT1, IWAT2 - integers - Land use categories from IWAT1 through -c IWAT2 correspond to water -c ZFACEM(mxnzp1) - real - CALMET cell face heights (m) -c (NZM+1 values) -c LCALGRD - logical - Control variable indicating if special -c meteorological fields required by -c CALGRID are stored in the met. file -c I2DMET - integer - Flag for 2 D array of sfc met -c 0: 2D arrays NOT available -c 1: 2D array available -c -c *** Timing variables -c ITIMES - integer - Flag for reading times in data records -c 0: end-time (no seconds) -c 1: begin-time / end-time with seconds -c ITIMEPRF - integer - Flag for reading times in PROFILE.DAT -c data records (METFM not 4 or 5) -c 0: end-time (no seconds) -c 1: begin-time / end-time with seconds -c -c -c IUTMZNM - integer - UTM zone for UTM projection -c FEASTM (km) - real - False Easting at projection origin -c FNORTHM(km) - real - False Northing at projection origin -c PMAPM - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMM - character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMM - character - Datum-Region for grid coordinates -c DATENM - character - NIMA date for datum parameters -c (MM-DD-YYYY ) diff --git a/CALPUFF_SRC/CALPUFF/newsoa.puf b/CALPUFF_SRC/CALPUFF/newsoa.puf deleted file mode 100644 index 653dd99..0000000 --- a/CALPUFF_SRC/CALPUFF/newsoa.puf +++ /dev/null @@ -1,14 +0,0 @@ -c---------------------------------------------------------------------- -c -c Common block for new SOA module CALPUFF -c -c---------------------------------------------------------------------- -c - real bckoc - - common/NEWSOA/bckoc -c -c --- COMMON BLOCK /NEWSOA/ Variables: -c -c bckoc - real - Background conc. of primary OC (ug/m3) -c diff --git a/CALPUFF_SRC/CALPUFF/nh3z.dat b/CALPUFF_SRC/CALPUFF/nh3z.dat deleted file mode 100644 index 924aba0..0000000 --- a/CALPUFF_SRC/CALPUFF/nh3z.dat +++ /dev/null @@ -1,18 +0,0 @@ -NH3Z.DAT 1.0 Monthly NH3 for each model layer -1 -Prepared by User -PPB -MONTH_LAYER -10 -JANUARY : 0.2186 0.2186 0.2125 0.2054 0.1918 0.1645 0.1460 0.1228 0.0993 0.0903 -FEBRUARY : 0.2186 0.2186 0.2125 0.2054 0.1918 0.1645 0.1460 0.1228 0.0993 0.0903 -MARCH : 0.5416 0.5416 0.5394 0.5394 0.5348 0.4955 0.4431 0.3636 0.2412 0.1847 -APRIL : 0.5416 0.5416 0.5394 0.5394 0.5348 0.4955 0.4431 0.3636 0.2412 0.1847 -MAY : 0.5416 0.5416 0.5394 0.5394 0.5348 0.4955 0.4431 0.3636 0.2412 0.1847 -JUNE : 0.6458 0.6458 0.6378 0.6339 0.6139 0.5699 0.5287 0.4508 0.3354 0.2660 -JULY : 0.6458 0.6458 0.6378 0.6339 0.6139 0.5699 0.5287 0.4508 0.3354 0.2660 -AUGUST : 0.6458 0.6458 0.6378 0.6339 0.6139 0.5699 0.5287 0.4508 0.3354 0.2660 -SEPTEMBER : 0.5107 0.5107 0.4986 0.4869 0.4691 0.4334 0.3763 0.2981 0.1921 0.1400 -OCTOBER : 0.5107 0.5107 0.4986 0.4869 0.4691 0.4334 0.3763 0.2981 0.1921 0.1400 -NOVEMBER : 0.5107 0.5107 0.4986 0.4869 0.4691 0.4334 0.3763 0.2981 0.1921 0.1400 -DECEMBER : 0.2186 0.2186 0.2125 0.2054 0.1918 0.1645 0.1460 0.1228 0.0993 0.0903 diff --git a/CALPUFF_SRC/CALPUFF/nima.crd b/CALPUFF_SRC/CALPUFF/nima.crd deleted file mode 100644 index fb463a1..0000000 --- a/CALPUFF_SRC/CALPUFF/nima.crd +++ /dev/null @@ -1,34 +0,0 @@ -c************************************************************ -c -c --- BUILD manufactored NIMA INCLUDE statement -c --- NIMA.CRD -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - Parameter (ndt = 132) - Parameter (nd = 234) -c -c --- Stamp this NIMA include file - Character*12 daten - Parameter (daten='02-21-2003 ') -c - Character*60 geodat1, geodat2, geodat3 - Character*8 datcod - Character*52 datum - Character*20 atlas - Character*12 dateb,dstamp -c - Real*4 dxmod, dymod, dzmod - Real*8 dradim, dflat, dec2 -c - Integer*4 dattyp -c - common /datr4/ dxmod(nd), dymod(nd), dzmod(nd) - common /datr8/ dradim(nd), dflat(nd), dec2(nd) - common /datchr/ datcod(nd), geodat1(nd), geodat2(nd), - 1 geodat3(nd), atlas(ndt), datum(ndt), - 2 dstamp,dateb - common /dati4/ kmax, nudat, dattyp(nd) -c diff --git a/CALPUFF_SRC/CALPUFF/nongrd.puf b/CALPUFF_SRC/CALPUFF/nongrd.puf deleted file mode 100644 index c18f719..0000000 --- a/CALPUFF_SRC/CALPUFF/nongrd.puf +++ /dev/null @@ -1,26 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /NONGRD/ - Discrete (non-gridded) receptor CALPUFF -c information -c---------------------------------------------------------------------- -c - character*80 rgrpnam - - common/NONGRD/NREC,XNG(mxrec),YNG(mxrec),ZNG(mxrec),ELEVNG(mxrec), - & nrgrp,irgrp(mxrec),rgrpnam(mxrgrp) -c -c -c --- COMMON BLOCK /NONGRD/ Variables: -c NREC - integer - Number of discrete (non-gridded) -c receptors -c XNG(mxrec) - real - X coordinate of the receptor (met. -c grid units w/ origin at (0.0,0.0)) -c YNG(mxrec) - real - Y coordinate of the receptor (met. -c grid units w/ origin at (0.0,0.0)) -c ZNG(mxrec) - real - Z coordinate of the receptor -c (height above ground, m) -c ELEVNG(mxrec) - real - Ground-level elevation (m) above -c sea level at the receptor -c NRGRP - integer - Number of receptor groups -c IRGRP(mxrec) - integer - Pointer to identify the group to -c which each receptor belongs -c RGRPNAM(mxrgrp) - char*80 - Name of each receptor group diff --git a/CALPUFF_SRC/CALPUFF/numparm.puf b/CALPUFF_SRC/CALPUFF/numparm.puf deleted file mode 100644 index 0d8c2b4..0000000 --- a/CALPUFF_SRC/CALPUFF/numparm.puf +++ /dev/null @@ -1,36 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /NUMPARM/ -- Parameters used in the CALPUFF -c numerical plume rise algorithm -c---------------------------------------------------------------------- -c - common/NUMPARM/gravi,rgas,zmin,ds0,nstep,slast,rp,alphap(mxent), - 1 betap(mxent),xcat(mxentp1),nent,phicheck -c -c --- COMMON BLOCK /NUMPARM/ Variables: -c -c GRAVI - real - Acceleration due to gravity (m/s**2) -c RGAS - real - Gas constant (m**2/s**2/deg. K) -c ZMIN - real - Minimum plume centerline height (m) -c DS0 - real - Step size (m) in the numerical plume -c rise algorithm -c NSTEP - integer - Internal save frequency of plume rise -c calculations (i.e., every DS*NSTEP meters) -c (NOTE: this the frequency with which the -c results are saved internally -- not that -c passed back from the NUMRISE routine) -c SLAST - real - Termination distance (m) of the plume rise -c calculation -c RP - real - Radiation coefficient (kg/m**2/deg. K**3/s) -c ALPHAP(mxent) - real array - Perturbed entrainment coefficients -c (parallel) -c BETAP(mxent) - real array - Perturbed entrainment coefficients -c (normal) -c XCAT(mxentp1) - real array - Downwind distances (m) for which each -c perturbed entrainment coefficient -c (ALPHAP, BETAP) is valid (NENT+1 values -c for NENT entrainment coefficients). -c NENT - integer - Number of perturbed entrainment -c coefficients entered -c PHICHECK - real - plume axis elevation angle (radians) at -c which PRIME module checks for building -c wake 'capture' diff --git a/CALPUFF_SRC/CALPUFF/options.puf b/CALPUFF_SRC/CALPUFF/options.puf deleted file mode 100644 index e1c6074..0000000 --- a/CALPUFF_SRC/CALPUFF/options.puf +++ /dev/null @@ -1,16 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /OPTIONS/ -- Slug specific information CALPUFF -c---------------------------------------------------------------------- -c - logical lsigex -c - common/OPTIONS/lsigex -c -c --- COMMON BLOCK /OPTIONS/ Variable: -c -c LSIGEX - real -.TRUE. implies use of exact receptor -c specific sigma values (sy,sz). -c -.FALSE. implies use of interpolated -c slug end-point sigma values (sy,sz). -c -c --------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/outpt.puf b/CALPUFF_SRC/CALPUFF/outpt.puf deleted file mode 100644 index e4fa301..0000000 --- a/CALPUFF_SRC/CALPUFF/outpt.puf +++ /dev/null @@ -1,104 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /OUTPT/ -- Output option flags CALPUFF -c---------------------------------------------------------------------- -c - logical ldebug,lcomprs - common/OUTPT/ioutu,icon,ivis,it2d,irho,idry,iwet,iovers,ifog, - 1 icprt,idprt,iwprt,icfrq,idfrq,iwfrq,iprtu,ioutop(7,mxspec), - 2 imesg,imflx,imbal,iqaplot,ipftrak,inrise, - 3 msource,ldebug,ipfdeb,npfdeb,nn1,nn2,lcomprs -c -c --- COMMON BLOCK /OUTPT/ Variables: -c -c IOUTU - integer - Units for binary data output: -c 1 = mass - g/m3 or g/m2/s -c 2 = odour - odour_units -c 3 = radiation - Bq/m3 or Bq/m2/s -c ICON - integer - Flag controlling creation of an -c output CONCENTRATION file -c (0=do not create, 1=create) -c IVIS - integer - Flag controlling creation of an -c output VISIBILITY file -c (0=do not create, 1=create) -c IT2D - integer - Flag controlling creation of an -c output 2D Temperature file -c (0=do not create, 1=create) -c IRHO - integer - Flag controlling creation of an -c output 2D Density file -c (0=do not create, 1=create) -c IDRY - integer - Flag controlling creation of an -c output DRY FLUX file -c (0=do not create, 1=create) -c IWET - integer - Flag controlling creation of an -c output WET FLUX file -c (0=do not create, 1=create) -c IOVERS - integer - Flag controlling the Dataset Version -c for the binary output files above -c (1=v2.1, 2=v2.2) -c IFOG - integer - Flag controlling creation of an -c output FOG Model file -c (0=do not create, 1=create) -c ICPRT - integer - Flag controlling line printer output -c of concentrations -c (0=do not print, 1=print) -c IDPRT - integer - Flag controlling line printer output -c of dry fluxes -c (0=do not print, 1=print) -c IWPRT - integer - Flag controlling line printer output -c of wet fluxes -c (0=do not print, 1=print) -c ICFRQ - integer - Print interval (hours) for line -c printer concentration output -c IDFRQ - integer - Print interval (hours) for line -c printer dry flux output -c IWFRQ - integer - Print interval (hours) for line -c printer wet flux output -c IPRTU - integer - Units for printing output: -c 1) g/m**3 (conc) g/m**2/s (dep) -c 2) mg/m**3 (conc) mg/m**2/s (dep) -c 3) ug/m**3 (conc) ug/m**2/s (dep) -c 4) ng/m**3 (conc) ng/m**2/s (dep) -c 5) odour units -c 11) TBq/m**3 TBq/m**2/s -c 12) GBq/m**3 GBq/m**2/s -c 13) Bq/m**3 Bq/m**2/s -c IOUTOP(7,mxspec) - real - Control variables indicating -c which species concentrations are -c printed (1,-), stored on disk (2,-), -c which dry fluxes are -c printed (3,-), stored on disk (4,-), -c which wet fluxes are -c printed (5,-), stored on disk (6,-), -c which mass fluxes are -c stored on disk (7,-) -c IMESG - integer - Flag controlling output of runtime -c messages to the screen tracking the -c progress of the run -c IMFLX - integer - Flag controlling creation of an -c output MASS FLUX file -c (0=do not create, 1=create) -c IMBAL - integer - Flag controlling creation of an -c output MASS BALANCE file -c (0=do not create, 1=create) -c IQAPLOT - integer - Flag controlling creation of set of -c QA plot files -c (0=do not create, 1=create) -c IPFTRAK - integer - Flag controlling creation of an -c output PUFF TRACKING file -c (0=do not create, -c 1=create with output every timestep -c 2=create with output every sampling -c step) -c INRISE - integer - Flag controlling creation of an -c output NUMERICAL RISE data file -c (0=do not create, 1=create) -c MSOURCE - integer - Individual source contribution saved? -c (0 = no, 1 = yes) -c LDEBUG - logical - Debug switch (debug output if .TRUE.) -c IPFBUG - integer - ID of first puff tracked in DEBUG -c NPFBUG - integer - Number of puffs tracked in DEBUG -c NN1 - integer - Met. period to start DEBUG output -c NN2 - integer - Met. period to endt DEBUG output -c LCOMPRS - logical - Compress option for binary output -c fields (T=compress on, F=compress -c off) diff --git a/CALPUFF_SRC/CALPUFF/params.cal b/CALPUFF_SRC/CALPUFF/params.cal deleted file mode 100644 index 6a77e6b..0000000 --- a/CALPUFF_SRC/CALPUFF/params.cal +++ /dev/null @@ -1,12 +0,0 @@ -c---------------------------------------------------------------------- -c --- PARAMETER statements CALUTILS -c---------------------------------------------------------------------- -c --- Specify parameters - parameter(mxvar=60,mxcol=200) -c -c --- CONTROL FILE READER definitions: -c MXVAR - Maximum number of variables in each input group -c MXCOL - Maximum length (bytes) of a control file input record -c---------------------------------------------------------------------- - - \ No newline at end of file diff --git a/CALPUFF_SRC/CALPUFF/params_keep.puf b/CALPUFF_SRC/CALPUFF/params_keep.puf deleted file mode 100644 index 93d4370..0000000 --- a/CALPUFF_SRC/CALPUFF/params_keep.puf +++ /dev/null @@ -1,300 +0,0 @@ -c---------------------------------------------------------------------- -c --- PARAMETER statements CALPUFF -c---------------------------------------------------------------------- -c --- Specify model version - character*12 mver, mlevel, mmodel - parameter(mver='7.2.1',mlevel='150618') - parameter(mmodel='CALPUFF') -c -c --- Specify parameters -c parameter(mxpuff=100000) - parameter(mxpuff=300000) - parameter(mxspec=35) - parameter(mxnx=400,mxny=400,mxnz=12) - parameter(mxnxg=400,mxnyg=400,mxrec=10000,mxrgrp=20) - parameter(mxrfog=40) - parameter(mxss=350,mxus=99,mxps=700) - parameter(mxpt1=200,mxpt2=200,mxarea=200,mxvert=5) - parameter(mxfl1=1,mxfl2=200) - parameter(mxlines=24,mxlngrp=1,mxvol=200) -c parameter(mxlines=24,mxlngrp=1,mxvol=6670) - parameter(mxqsf=288) - parameter(mxqstep=30) - parameter(mxrise=50) - parameter(mxtrak=200) - parameter(mxpdep=20,mxint=9) - parameter(mxoz=725) - parameter(mxaq=mxoz) - parameter(mxaux=5) - parameter(mxhill=20,mxtpts=25,mxrect=1000,mxcntr=21) - parameter(mxprfz=50) - parameter(mxent=10,mxntr=50,mxnw=5000) - parameter(mxvalz=10) - parameter(mxcoast=10,mxptcst=5000) - parameter(mxbndry=10,mxptbdy=5000) ! keep mxbndry LE 20 - parameter(mxmetdat=60, mxmetdom=5, mxemdat=12) - parameter(mxmetsav=2) - parameter(mxsg=39) - parameter(io3=3,io4=4,io5=1,io6=2,io8=8,io9=9) - parameter(io10=10,io11=11,io12=12,io13=13,io14=14,io15=15) - parameter(io19=19,io20=20,io22=22,io23=23,io24=24) - parameter(io25=25,io28=28,io29=29,io30=30,io31=31,io32=32) - parameter(io35=35,io36=36,io37=37,io38=38,io40=40) - parameter(iomesg=0) - parameter(iordx=96,iotrk=97,iotab=98,iox=99) -c --- Set starting io unit index for file types that may have multiple -c --- files open - parameter(io7=100) - parameter(iopt2=io7+2*mxmetdom) - parameter(iofl2=iopt2+mxemdat) - parameter(ioar2=iofl2+mxemdat) - parameter(iovol=ioar2+mxemdat) - parameter(iord2=iovol+mxemdat) -c -c -c --- Compute derived parameters - parameter(mxbc=2*mxnx+2*mxny) - parameter(mxnzp1=mxnz+1) - parameter(mxvertp1=mxvert+1) - parameter(mxnxy=mxnx*mxny) - parameter(mxnxyg=mxnxg*mxnyg) - parameter(mxgsp=mxnxg*mxnyg*mxspec) - parameter(mxrsp=mxrec*mxspec) - parameter(mxcsp=mxrect*mxspec) - parameter(mx2=2*mxspec,mx5=5*mxspec,mx7=7*mxspec) - parameter(mxp2=2+mxspec,mxp3=3+mxspec) - parameter(mxp4=4+mxspec,mxp6=6+mxspec) - parameter(mxp7=7+mxspec,mxp8=8+mxspec,mxp14=mxspec+14) - parameter(mxp11=11+mxspec) - parameter(mxpuf6=6*mxpuff) - parameter(mxlev=mxprfz) - parameter(mxprfp1=mxprfz+1) - parameter(mxentp1=mxent+1) - parameter(mxgrup=mxspec) - parameter(mxspar=mxspec*mxarea,mxspln=mxspec*mxlines) - parameter(mxsppt1=mxspec*mxpt1,mxspvl=mxspec*mxvol) - parameter(mxspfl=mxspec*mxfl1,mxspbc=mxspec*mxbc) - parameter(mxssdom=mxss*mxmetdom) -c -c --- Specify parameters for sizing GUI: - parameter(mxavar=1) - parameter(mxlvar=1) - parameter(mxpvar=1) - parameter(mxvvar=1) -c -c --- GENERAL PARAMETER definitions: -c MXPUFF - Maximum number of active puffs allowed on the -c computational grid at one time -c MXSLUG - Maximum number of active slugs allowed on the -c computational grid at one time (can be set to -c one if the slug option is not used) -c MXSPEC - Maximum number of chemical species. N.B.: Changes -c to MXSPEC may also require code changes to BLOCK DATA -c and READCF. -c MXGRUP - Maximum number of Species-Groups. Results for grouped -c species are added together and reported using the -c name of the group, rather than the name of one of the -c species in the group. (MXGRUP = MXSPEC since specie -c names are used as group names whenever group names are -c not provided) -c MXNX - Maximum number of METEOROLOGICAL grid cells in -c the X direction -c MXNY - Maximum number of METEOROLOGICAL grid cells in -c the Y direction -c MXNZ - Maximum number of vertical layers in -c the METEOROLOGICAL grid -c MXNXG - Maximum number of SAMPLING grid cells in -c the X direction -c MXNYG - Maximum number of SAMPLING grid cells in -c the Y direction -c MXREC - Maximum number of non-gridded receptors -c MXRGRP - Maximum number of discrete receptor groups -c MXRFOG - Maximum number of distances used when MFOG=1 -c NOTE: There are NPT1+NPT2 receptor 'trails', with -c MXRFOG receptors on each, so -c MXREC >= (NPT1+NPT2)*MXRFOG -c MXSS - Maximum number of surface meteorological stations -c in the CALMET data -c MXUS - Maximum number of upper air stations in the CALMET -c data -c MXPS - Maximum number of precipitation stations in the -c CALMET data -c MXBC - Maximum number of sources used to represent boundary -c conditions (inlux of background mass); source -c segments span the computational domain perimeter -c MXPT1 - Maximum number of point sources with constant -c emission parameters -c MXPT2 - Maximum number of point sources with time-varying -c emission parameters -c MXFL1 - Maximum number of flare sources with constant -c emission parameters -c MXFL2 - Maximum number of flare sources with time-varying -c emission parameters -c MXAREA - Maximum number of polygon area sources with constant -c emission parameters (i.e., non-gridded area sources) -c MXVERT - Maximum number of vertices in polygon area source -c MXLINES- Maximum number of line sources -c MXLNGRP- Maximum number of groups of line sources -c MXVOL - Maximum number of volume sources -c MXQSTEP - Maximum number of emission periods within one timestep -c (for sources with variable emissions) -c MXRISE - Maximum number of points in computed plume rise -c tabulation for buoyant area and line sources -c MXPDEP - Maximum number of particle species dry deposited -c (typically set to MXSPEC) -c MXINT - Maximum number of particle size intervals used -c in defining mass-weighted deposition velocities -c MXOZ - Maximum number of ozone data stations (for use in the -c chemistry module) -c MXAQ - Maximum number of Air Quality data stations (e.g. -c H2O2 data stations for aqueous chemistry module) -c MXAUX - Maximum number of either 2D or 3D variables in -c auxiliary CALMET output file -c MXHILL - Maximum number of subgrid-scale (CTSG) terrain -c features -c MXTPTS - Maximum number of points used to obtain flow -c factors along the trajectory of a puff over the hill -c MXRECT - Maximum number of complex terrain (CTSG) receptors -c MXCNTR - Maximum number of hill height contours (CTDM ellipses) -c MXPRFZ - Maximum number of vertical levels of met. data in -c CTDM PROFILE file -c MXLEV - Maximum number of vertical levels of met. data -c allowed in the CTSG module (set to MXPRFZ in the -c current implementation of CALPUFF) -c MXENT - Maximum number of perturbed entrainment coefficients -c entered -c MXNTR - Maximum number of downwind distances for which -c numerical plume rise will be reported -c MXNW - Maximum number of downwind distances for numerical -c plume rise integration (should be set equal to -c SLAST/DS) -c MXVALZ - Maximum number of heights above ground at which valley -c widths are found for each grid cell -c MXCOAST - Maximum number of coasts provided in COASTLN.DAT file -c MXPTCST - Maximum number of points used to store all coastlines -c MXBNDRY - Maximum number of boundaries provided in FLUXBDY.DAT -c MXPTBDY - Maximum number of points used to store all boundaries -c MXMETDAT - Maximum number of CALMET.DAT files for one grid -c MXMETDOM - Maximum number of CALMET.DAT domains used in run -c MXEMDAT - Maximum number of variable emissions files (each type) -c MXMETSAV - Maximum number of met periods for which source tables -c (e.g. numerical rise) are saved -c MXQSF - Maximum number of emission scaling factors of one type -c (Check actual max used in /QSCALE/ assignments) -c -c --- CONTROL FILE READER definitions: -c MXSG - Maximum number of input groups in control file -c -c --- FORTRAN I/O unit numbers: -c IO3 - Restart file (RESTARTB.DAT) - input - unformatted -c IO4 - Restart file (RESTARTE.DAT) - output - unformatted -c IO5 - Control file (CALPUFF.INP) - input - formatted -c IO6 - List file (CALPUFF.LST) - output - formatted -c -c IO7 - Meteorological data file - input - unformatted -c (CALMET.DAT) -c -c IO8 - Concentration output file - output - unformatted -c (CONC.DAT) -c IO9 - Dry flux output file - output - unformatted -c (DFLX.DAT) -c IO10 - Wet flux output file - output - unformatted -c (WFLX.DAT) -c IO11 - Visibility output file - output - unformatted -c (VISB.DAT) -c IO12 - Fog plume data output file - output - unformatted -c (FOG.DAT) -c IO13 - 2D Temperature output file - output - unformatted -c (TK2D.DAT) -c IO14 - 2D Density output file - output - unformatted -c (RHO2D.DAT) -c IO15 - Boundary Condition file - input - unformatted -c (BCON.DAT) -c IO19 - Buoyant line sources file - input - free format -c (LNEMARB.DAT) with arbitrarily -c varying location & emissions -c IO20 - User-specified deposition - input - formatted -c velocities (VD.DAT) -c IO22 - Hourly ozone monitoring data - input - formatted -c (OZONE.DAT) -c IO23 - Hourly H2O2 monitoring data - input - formatted -c (H2O2.DAT) -c IO24 - User-specified chemical - input - formatted -c transformation rates -c (CHEM.DAT) -c IO25 - User-specified coast line(s) - input - free format -c for sub-grid TIBL module -c (COASTLN.DAT) -c IO28 - CTSG hill specifications from - input - formatted -c CTDM terrain processor -c (HILL.DAT) -c IO29 - CTSG receptor specifications - input - formatted -c from CTDM receptor generator -c (RECS.DAT) -c IO30 - Tracking puff/slug data - output - formatted -c (DEBUG.DAT) -c IO31 - CTDM "tower" data - input - formatted -c (PROFILE.DAT) -c IO32 - CTDM surface layer parameters - input - formatted -c (SURFACE.DAT) -c IO35 - User-specified boundary lines(s)- input- free format -c for mass flux calculations -c (FLUXBDY.DAT) -c IO36 - Mass flux data - output - formatted -c (MASSFLX.DAT) -c IO37 - Mass balance data - output - formatted -c (MASSBAL.DAT) -c IO38 - Numerical Rise output data - output - formatted -c (RISE.DAT) -c IOPT2 - 1st Pt. source emissions file - input - unformatted -c (PTEMARB.DAT) with arbitrarily or free fmt -c varying point source emissions -c IOFL2 - 1st FLARE source emissions file- input - free format -c (FLEMARB.DAT) with arbitrarily -c varying location & emissions -c IOAR2 - 1st Buoyant area sources file - input - free format -c (BAEMARB.DAT) with arbitrarily -c varying location & emissions -c IOVOL - 1st Volume source file - input - unformatted -c (VOLEMARB.DAT) with arbitrarily or free fmt -c varying location & emissions -c IORD2 - 1st ROAD sources file - input - free format -c (RDEMARB.DAT) with arbitrarily -c varying source data -c IOMESG - Fortran unit number for screen- output - formatted -c output (NOTE: This unit is -c NOT opened -- it must be a -c preconnected unit to the screen -c -- Screen output can be suppressed -c by the input "IMESG" in the -c control file) -c IOTRK - Fortran unit number for - output - unformatted -c puff-tracking data file -c IOTAB - Fortran unit number for - scratch - direct access -c tabulated source data for each -c puff -c IOX - Fortran unit number for - scratch - formatted -c temporary scratch file: -c "Doc" records written to header of output files -c Numerical rise output records (temporary) -c IORDX - Fortran unit number for - scratch - formatted -c temporary scratch file used to process -c road-source segments (control-file) -c -c -c --- GUI memory control parameters: variable emissions scaling factors -c for areas, lines, points, and volumes require much memory in GUI. -c To reduce GUI memory requirement, set one or more of the -c following parameters to ZERO when such scaling is not required. -c These parameters have no effect on CALPUFF, but are read by the -c GUI at execution time. -c -c MXAVAR - Using scaled area sources? (1:yes, 0:no) -c MXLVAR - Using scaled line sources? (1:yes, 0:no) -c MXPVAR - Using scaled point sources? (1:yes, 0:no) -c MXVVAR - Using scaled volume sources? (1:yes, 0:no) -c -c -c ----------------------------------------------------------------- - - \ No newline at end of file diff --git a/CALPUFF_SRC/CALPUFF/pdf.puf b/CALPUFF_SRC/CALPUFF/pdf.puf deleted file mode 100644 index 18f87de..0000000 --- a/CALPUFF_SRC/CALPUFF/pdf.puf +++ /dev/null @@ -1,27 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /PDF/ -- PDF dispersion variables CALPUFF -c---------------------------------------------------------------------- -c - logical lpdf - common/pdf/lpdf,swupf,swdnf,szupb,szdnb,wup,wdn,zup,zdn, - & wtup,wtdn,risq,ryz,dhfac,rfacsq -c -c --- COMMON BLOCK /PDF/ Variables: -c LPDF - logical - PDF computation active when .TRUE. -c SWUPF - real - Updraft (sigma-w / full sigma-w)**2 -c SWDNF - real - Downdraft (sigma-w / full sigma-w)**2 -c SZUPB - real - Updraft BID**2 term (m2) -c SZDNB - real - Downdraft BID**2 term (m2) -c WUP - real - Updraft w (indirect path)(m/s) -c WDN - real - Downdraft w (direct path)(m/s) -c ZUP - real - Updraft puff ht (m) -c ZDN - real - Downdraft puff ht (m) -c WTUP - real - Updraft path weight (indirect path) -c WTDN - real - Downdraft path weight (direct path) -c RISQ - real - Initial plume radius (squared) at CBL -c top (m^2) -c RYZ - real - Growth rate of elliptical plume -c crossection (m**2/s**2) -c DHFAC - real - Effective rise factor, where effective -c rise given by t*dhfac/SQRT(risq+ryz*t^2) -c RFACSQ - real - Gradual rise adj to BID**2 diff --git a/CALPUFF_SRC/CALPUFF/pt1.puf b/CALPUFF_SRC/CALPUFF/pt1.puf deleted file mode 100644 index 39c50c1..0000000 --- a/CALPUFF_SRC/CALPUFF/pt1.puf +++ /dev/null @@ -1,79 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /PT1/ -- Emission parameters for sources CALPUFF -c with constant emission characeristics -c---------------------------------------------------------------------- - character*16 cnampt1 - character*40 csfpt1 -c - common/PT1/XPT1GRD(mxpt1),YPT1GRD(mxpt1),HTSTAK(mxpt1), - 1 ELSTAK(mxpt1),DIAM(mxpt1),EXITW(mxpt1),TSTAK(mxpt1), - 2 IDOWNW(mxpt1),QSTAK(mxspec,mxpt1),NPT1, - 3 syipt1(mxpt1),szipt1(mxpt1),fmfpt1(mxpt1),zplatpt1(mxpt1), - 4 NEWPT1(mxpt1),BWIDTH(36,mxpt1),BHT(36,mxpt1), - 5 BLN1(36,mxpt1),XBADJ1(36,mxpt1),YBADJ1(36,mxpt1),IPTU,NSPT1, - 6 IDSFPT1(mxspec,mxpt1),IXREFPT1(mxsppt1), - 7 FQCVPT1(mxpt1),CNAMPT1(mxpt1),CSFPT1(mxsppt1) -c -c --- COMMON BLOCK /PT1/ Variables: -c XPT1GRD(mxpt1) - real - X coordinate of the stack (in met. -c grid units w/ origin at (0.0,0.0)) -c YPT1GRD(mxpt1) - real - Y coordinate of the stack (in met. -c grid units w/ origin at (0.0,0.0)) -c HTSTAK(mxpt1) - real - Stack height (m) -c ELSTAK(mxpt1) - real - Stack base elevation (m) above -c sea level -c DIAM(mxpt1) - real - Stack diameter (m) -c EXITW(mxpt1) - real - Exit velocity (m/s) -c TSTAK(mxpt1) - real - Exit temperature (deg. K) -c IDOWNW(mxpt1) - real - Building downwash flag (0=no, 1=yes) -c QSTAK(mxspec,mxpt1) - real - Emission rate (g/s) for each -c pollutant -c NPT1 - integer - Number of sources with constant -c emission parameters -c SYIPT1(mxpt1) - real - Initial sigma-y (m) [optional] -c SZIPT1(mxpt1) - real - Initial sigma-z (m) [optional] -c FMFPT1(mxpt1) - real - Momentum flux factor (0 or 1) -c ZPLATPT1(mxpt1) - real - Platform height (m AGL) [optional] -c NEWPT1(mxpt1) - integer - Number of puffs released by each -c source during the current time step -c BWIDTH(36,mxpt1) - real - Wind direction specific building -c widths (m) -c BHT(36,mxpt1) - real - Wind direction specific building -c heights (m) -c BLN1(36,mxpt1) - real - Wind direction specific building -c lengths (m) -c XBADJ1(36,mxpt1) - real - Wind direction specific along-wind -c distance from stack to center of -c upwind face of projected building, -c x-axis lies along the flow (m) -c YBADJ1(36,mxpt1) - real - Wind direction specific cross-wind -c distance from stack to center of -c upwind face of projected building, -c x-axis lies along the flow (m) -c IPTU - integer - Units for emission rates in -c control file -c 1: g/s -c 2: kg/hr -c 3: lb/hr -c 4: ton/yr -c 5: Odour Unit * m**3/s -c 6: Odour Unit * m**3/min -c 7: metric tons/yr -c 8: Bq/s (Bq = becquerel = disintegrations/s) -c 9: GBq/yr -c NSPT1 - integer - Number of source-species pairs -c with emissions scaling factors -c IDSFPT1(mxspec,mxpt1) - integer - Pointer to point-species pair -c index, 0 to NSPT1 -c (0 if no scaling) -c IXREFPT1(mxsppt1) - integer - Cross-reference pointer from -c point-species pairs to -c scale-factor tables -c CSFPT1(mxsppt1) - c*40 arr - List of scale-factor table names -c for point-species pairs -c -c CNAMPT1(mxpt1) - c*16 arr - Source names -c -c FQCVPT1(mxpt1) - real - Fraction of emission rate captured -c in the cavity - diff --git a/CALPUFF_SRC/CALPUFF/pt2.puf b/CALPUFF_SRC/CALPUFF/pt2.puf deleted file mode 100644 index 1833849..0000000 --- a/CALPUFF_SRC/CALPUFF/pt2.puf +++ /dev/null @@ -1,168 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /PT2/ -- Pt. source emission parameters CALPUFF -c Arbitrarily-varying (PTEMARB) -c---------------------------------------------------------------------- -c - character*12 cslst2 - character*16 cid2 - - logical*4 lutmpt2,llccpt2,lpspt2,lempt2,llazapt2,lttmpt2 - character*4 utmhempt2,xyunitpt2 - character*8 datumpt2,pmappt2 - character*12 datenpt2 - - common/PT2/NPT2,NSE2,MFPT2(mxemdat), - 1 IBSRC2(mxemdat),IESRC2(mxemdat), - 2 IBDATHR2(mxemdat),IBSEC2(mxemdat),IEDATHR2(mxemdat), - 3 IESEC2(mxemdat),XTZ2(mxemdat),T2BTZ2(mxemdat), - 4 XMWEM2(mxspec),IXREM2(mxspec),TIEM2(8,mxpt2), - 5 BHT2(36,mxpt2),BWD2(36,mxpt2),BLN2(36,mxpt2), - 6 XBADJ2(36,mxpt2),YBADJ2(36,mxpt2),ZPLATPT2(mxpt2), - 7 lutmpt2(mxemdat),llccpt2(mxemdat),lpspt2(mxemdat), - 8 lempt2(mxemdat),llazapt2(mxemdat),lttmpt2(mxemdat), - 9 iutmznpt2(mxemdat),feastpt2(mxemdat),fnorthpt2(mxemdat), - & rnlat0pt2(mxemdat),relon0pt2(mxemdat), - 1 rnlat1pt2(mxemdat),rnlat2pt2(mxemdat),NSTEP2(mxemdat), - 2 NDHRQB2(mxqstep,mxemdat),NSECQB2(mxqstep,mxemdat), - 3 NDHRQE2(mxqstep,mxemdat),NSECQE2(mxqstep,mxemdat), - 4 TSTAK2(mxqstep,mxpt2),EXITW2(mxqstep,mxpt2), - 5 SYIPT2(mxqstep,mxpt2),SZIPT2(mxqstep,mxpt2), - 6 QSTAK2(mxspec,mxqstep,mxpt2),NEWPT2(mxpt2), - 7 FQCVPT2(mxpt2), - 8 CSLST2(mxspec),CID2(mxpt2), - 9 pmappt2(mxemdat),utmhempt2(mxemdat),datumpt2(mxemdat), - & datenpt2(mxemdat),xyunitpt2(mxemdat) -c -c --- COMMON BLOCK /PT2/ Variables: -c NPT2 - integer - Number of pt. sources in the file -c NSE2 - integer - Number of emitted species in the file -c MFPT2(mxemdat) - integer - Flag for file type -c 0: UNFORMATTED -c 1: FORMATTED -c IBSRC2(mxemdat) - integer - Index for first source in a PTEMARB.DAT -c file -c IESRC2(mxemdat) - integer - Index for last source in a PTEMARB.DAT -c file -c IBDATHR2(mxemdat)- integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSEC2(mxemdat) - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHR2(mxemdat)- integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESEC2(mxemdat) - integer - Seconds of the last data record in the -c file (0000-3599) -c XTZ2(mxemdat) - real - Time zone (UTC=LST+XTZ2) -c T2BTZ2(mxemdat) - real - Hours to ADD to Local Time to obtain -c Base Time (xtz3-xbtz) -c XMWEM2(mxspec) - real - Molecular weight for each species -c IXREM2(mxspec) - integer - Cross referencing array of NSE2 -c values relating species ordering -c in the emissions file to the -c ordering in the main conc. array -c TIEM2(8,mxpt2) - real - Time-invariant data for arbitrarily- -c varying point source emissions -c (1,-) = X coordinate of source (in -c met. grid units -- converted -c from UTM data in PTEMARB file) -c (2,-) = Y coordinate of source (in -c met. grid units -- converted -c from UTM data in PTEMARB file) -c (3,-) = Stack height (m) -c (4,-) = Stack diameter (m) -c (5,-) = Stack base elevation (m) -c (6,-) = Building downwash flag -c 0. No downwash -c 1. Downwash bldgs on surface -c 2. Downwash bldgs raised -c (7,-) = Vertical momentum flux factor -c (0.0 to 1.0) to simulate rain -c hat structures -c (8,-) = User-defined flag (e.g., -c fuel code) -c ZPLATPT2(mxpt2) - real - Platform height for elevated bldgs (m) -c (provided if BDW flag is 2.) -c BHT2(36,mxpt2) - real - Array of direction-specific bldg hts -c (above platform if BDW flag is 2.) -c for each 10 deg. from N (m) -c BWD2(36,mxpt2) - real - Array of direction-specific building -c widths for each 10 deg. from N (m) -c BLN2(36,mxpt2) - real - Wind direction specific building -c lengths (m) -c XBADJ2(36,mxpt2) - real - Wind direction specific along-wind -c distance from stack to center of -c upwind face of projected building, -c x-axis lies along the flow (m) -c YBADJ2(36,mxpt2) - real - Wind direction specific cross-wind -c distance from stack to center of -c upwind face of projected building, -c x-axis lies along the flow (m) -c -c --- MAP Projection Variables --- -c -c LUTMPT2(mxemdat) - logical*4 - Flag for Universal Transverse Mercator -c LLCCPT2(mxemdat) - logical*4 - Flag for Lambert Conformal Conic -c LPSPT2(mxemdat) - logical*4 - Flag for Polar Stereographic -c LEMPT2(mxemdat) - logical*4 - Flag for Equatorial Mercator -c LLAZAPT2(mxemdat) - logical*4 - Flag for Lambert Azimuthal Equal Area -c LTTMPT2(mxemdat) - logical*4 - Flag for Tangential Transverse Mercator -c -c IUTMZNPT2(mxemdat) - integer - UTM zone for UTM projection -c FEASTPT2(mxemdat) - real - False Easting (km) at projection origin -c FNORTHPT2(mxemdat) - real - False Northing (km) at projection origin -c RNLAT0PT2(mxemdat),- real - N. latitude & E. longitude of x=0 and y=0 -c RELON0PT2(mxemdat) (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1PT2(mxemdat), - real - Matching N. latitude(s) for projection -c RNLAT2PT2(mxemdat) (deg) (Used only if PMAP3= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c -c --- Variable data --- -c NSTEP2(mxemdat) - integer - Number of emission steps in -c current timestep -c NDHRQB2(mxqstep,mxemdat) & NSECQB2(mxqstep,mxemdat) -c - integer - Starting time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c NDHRQE2(mxqstep,mxemdat) & NSECQE2(mxqstep,mxemdat) -c - integer - Ending time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c TSTAK2(mxqstep,mxpt2) - real - Exit temperature (deg. K) -c EXITW2(mxqstep,mxpt2) - real - Exit velocity (m/s) -c SYIPT2(mxqstep,mxpt2) - real - Initial sigma-y (m) -c SZIPT2(mxqstep,mxpt2) - real - Initial sigma-z (m) -c QSTAK2(mxspec,mxqstep,mxpt2) - real - Emission rate (g/s) for each -c NEWPT2(mxpt2) - integer - Number of puffs released by each -c source during the current time step -c FQCVPT2(mxpt2) - real - Fraction of emission rate -c captured in the cavity -c -c --- Character data --- -c CSLST2(mxspec) - char*12 - Species identifiers -c CID2(mxpt2) - char*16 - Source identifiers -c -c PMAPPT2(mxemdat) - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMPT2(mxemdat)- character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMPT2(mxemdat) - character - Datum-Region for grid coordinates -c DATENPT2(mxemdat) - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITPT2(mxemdat)- character - Units for coordinates (e.g., KM) diff --git a/CALPUFF_SRC/CALPUFF/puff.puf b/CALPUFF_SRC/CALPUFF/puff.puf deleted file mode 100644 index ca20ed1..0000000 --- a/CALPUFF_SRC/CALPUFF/puff.puf +++ /dev/null @@ -1,169 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /PUFF/ -- Puff characteristics CALPUFF -c---------------------------------------------------------------------- -c - common/puff/xpb(mxpuff),ypb(mxpuff),zpb(mxpuff), - 1 zimax(mxpuff),ziold(mxpuff),zitibl(mxpuff), - 2 sigyb(mxpuff),sigzb(mxpuff),xtotb(mxpuff), - 3 tmtotb(mxpuff),zfinal(mxpuff),xfinal(mxpuff),bidfnl(mxpuff), - 4 fb(mxpuff),fm(mxpuff),xbfin(mxpuff),xmfin(mxpuff),zbfin(mxpuff), - 5 zmfin(mxpuff),stipdw(mxpuff),qu(mxspec,mxpuff),qm(mxspec,mxpuff), - 6 irlsnum(mxpuff),isrcnum(mxpuff),isrctyp(mxpuff), - 7 ipufcd(mxpuff),elbase(mxpuff), - 8 tcon(3,2,mxpuff),npuffs,isplit(mxpuff),iemstep(mxpuff), - 9 idw0(mxpuff),ht0(mxpuff),exitw0(mxpuff),diam0(mxpuff), - 1 ws0(mxpuff),istab0(mxpuff),sqrts0(mxpuff),srat0(mxpuff), - 2 temit0(mxpuff),hb0(mxpuff),hw0(mxpuff),heff20(mxpuff), - 3 iru0(mxpuff),sigv0(mxpuff),sigw0(mxpuff),el0(mxpuff), - 4 plexp0(mxpuff),zly0(mxpuff),r0(mxpuff), - 5 sysrc0(mxpuff),szsrc0(mxpuff), - 6 xshift0(mxpuff),sy0(mxpuff),sz0(mxpuff), - 7 puffo3(mxpuff),puffh2o2(mxpuff) -c -c --- COMMON BLOCK /PUFF/ Variables: -c XPB(mxpuff) - real - Met. grid X coordinate of puff center -c (or youngest end of slug) -c YPB(mxpuff) - real - Met. grid Y coordinate of puff center -c (or youngest end of slug) -c ZPB(mxpuff) - real - Height above ground (m) of puff center -c ZIMAX(mxpuff) - real - Highest mixing ht. (m) to which puff -c has been exposed -c ZIOLD(mxpuff) - real - Previous hour's mixing ht. (m) for the -c puff -c ZITIBL(mxpuff) - real - Current TIBL height (m) for the puff -c <0: no TIBL interaction anticipated -c =0: TIBL interaction possible, but puff -c has not crossed coastline -c >0: TIBL active -c SIGYB(mxpuff) - real - Sigma y (m) for the puff center (or -c youngest end of slug) without BID -c SIGZB(mxpuff) - real - Sigma z (m) for the puff center (or -c youngest end of slug) without BID -c XTOTB(mxpuff) - real - Total integrated travel distance (m) of -c the puff (or youngest end of slug) at -c start of step -c TMTOTB(mxpuff) - real - Total integrated travel time (s) of -c the puff (or youngest end of slug) at -c start of step -c ZFINAL(mxpuff) - real - Final effective plume height (m) of -c the puff center (or youngest end of -c slug) -c (i.e., stack height + plume rise) -c XFINAL(mxpuff) - real - Distance to final plume rise (m) -c BIDFNL(mxpuff) - real - Buoyancy-enhanced sigma, squared (m^2) -c FB(mxpuff) - real - Buoyancy flux (m**4/s**3) -c FM(mxpuff) - real - Momentum flux (m**4/s**2) -c XBFIN(mxpuff) - real - Distance to final buoyant rise (m) -c XMFIN(mxpuff) - real - Distance to final momentum rise (m) -c ZBFIN(mxpuff) - real - Height of final buoyant rise (m) -c ZMFIN(mxpuff) - real - Height of final momentum rise (m) -c STIPDW(mxpuff) - real - Stack-tip downwash magnitude (m) -c QU(mxspec,mxpuff) - real - Pollutant mass (g) in the layer above -c the mixing height -c QM(mxspec,mxpuff) - real - Pollutant mass (g) in the layer below -c the mixing height -c IRLSNUM(mxpuff) - integer - The number of the puff released this -c ISRCNUM(mxpuff) - integer - step from source #ISRCNUM -c ISRCTYP(mxpuff) - integer - of type ISRCTYP -c Source Types are: -c 1 = Point Constant Emissions -c 2 = Point Variable Emissions -c 3 = Poly. Area Constant Emissions -c 4 = Poly. Area Variable Emissions -c 5 = Line Constant Emissions -c 6 = Line Variable Emissions -c 7 = Volume Constant Emissions -c 8 = Volume Variable Emissions -c 9 = Boundary Condition -c 10 = Flare Constant Emissions -c 11 = Flare Variable Emissions -c 12 = Road Constant Emissions -c 13 = Road Variable Emissions -c IPUFCD(mxpuff) - integer - Puff status code: -c 1 = Puff within mixed layer & Gaussian -c 2 = Puff within mixed layer & uniform -c 3 = Puff above mixed layer & Gaussian -c 4 = Puff above mixed layer & uniform -c 5 = Puff currently above mixed layer -c (but previously below) & Gaussian -c 6 = Puff currently above mixed layer -c (but previously below) & uniform -c 11 = Slug within mixed layer & Gaussian -c 12 = Slug within mixed layer & uniform -c 13 = Slug above mixed layer & Gaussian -c 14 = Slug above mixed layer & uniform -c 15 = Slug currently above mixed layer -c (but previously below) & Gaussian -c 16 = Slug currently above mixed layer -c (but previously below) & uniform -c 99 = Puff/slug off computational grid -c ELBASE(mxpuff) - real - Stack base elevation (m) of source -c emitting current puff/slug -c TCON(3,2,mxpuff) - real - Average puff concentrations -c (g/m**3) within each puff -c (1,-,-) = SO4 -c (2,-,-) = NOx (NO + NO2 as NO2) -c (3,-,-) = TNO3 (HNO3 + NO3 as NO3) -c (-,1,-) = within mixed layer -c (-,2,-) = above mixed layer -c NPUFFS - integer - Total number of puffs or slugs -c---------------------------------------------------------------------- -c ----- Puff Splitting Information ----- -c---------------------------------------------------------------------- -c ISPLIT(mxpuff) - integer - Flag indicating if puff may be split -c 0: Do not split this puff -c 1: Split this puff -c---------------------------------------------------------------------- -c ----- Data associated with puff at the time of release ----- -c---------------------------------------------------------------------- -c IEMSTEP(mxpuff) - integer - The emission-step index for period when -c puff was released (variable emissions) -c (>1 if emissions vary within timestep) -c IDW0(mxpuff) - integer - Downwash flag: 0 = no bldg downwash -c 1 = H-S downwash -c 2 = S-S downwash -c 3 = PRIME downwash -c (primary source) -c 4 = PRIME downwash -c (cavity source) -c HT0(mxpuff) - real - Height at which puff was released (m) -c EXITW0(mxpuff) - real - Exit velocity (m/s) -c DIAM0(mxpuff) - real - Stack diameter (m) -c WS0(mxpuff) - real - Stack height wind speed (m/s) -c ISTAB0(mxpuff) - real - Stability class -c SQRTS0(mxpuff) - real - SQRT of the stability parameter "S" -c SRAT0(mxpuff) - real - Ratio of vector to scalar wind speed -c TEMIT0(mxpuff) - real - Duration of emission (s) -c HB0(mxpuff) - real - Direction-specific building height (m) -c HW0(mxpuff) - real - Direction-specific building width (m) -c HEFF20(mxpuff) - real - Height of gradual rise at 2*HB (m) -c ZLY0(mxpuff) - real - Effective line length based on sigma-y -c at 3*HL -c R0(mxpuff) - real - Effective source radius based on sigma-z -c at 3*HL -c IRU0(mxpuff) - integer - Rural(0)/Urban(1) indicator -c SIGV0(mxpuff) - real - Sigma-v velocity (m/s) -c SIGW0(mxpuff) - real - Sigma-w velocity (m/s) -c EL0(mxpuff) - real - Monin-Obukhov length (m) -c PLEXP0(mxpuff) - real - Power law wind shear exponent -c SYSRC0(mxpuff) - real - Initial sigma-y (m) for source -c SZSRC0(mxpuff) - real - Initial sigma-z (m) for source -c---------------------------------------------------------------------- -c XSHIFT0(mxpuff) - real - Distance from source to the end of -c the cavity (+15%) for a point source -c with PRIME downwash (m) -c [puff contributions are not computed -c over this distance] -c --- OR --- -c XSHIFT0(mxpuff) - real - Distance of center of element on line -c source from upwind edge (m) -c---------------------------------------------------------------------- -c SY0(mxpuff) - real - Initial sigma-y (m) due to -c downwash (line source), or other effects -c SZ0(mxpuff) - real - Initial sigma-z (m) due to -c downwash (line source), or other effects -c---------------------------------------------------------------------- -c ----- Puff Chemistry Data (MCHEM=6,7) ----- -c---------------------------------------------------------------------- -c PUFFO3(mxpuff) - real - Puff O3 conc (ppb) -c PUFFH2O2(mxpuff) - real - Puff H2O2 conc (ppb) diff --git a/CALPUFF_SRC/CALPUFF/qa.puf b/CALPUFF_SRC/CALPUFF/qa.puf deleted file mode 100644 index 97a8801..0000000 --- a/CALPUFF_SRC/CALPUFF/qa.puf +++ /dev/null @@ -1,19 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /QA/ -- Model QA parameters CALPUFF -c---------------------------------------------------------------------- -c - character*12 ver,level - character*8 rtime - character*10 rdate -c - common/QA/ncommout,rcpu,ver,level,rdate,rtime -c -c --- COMMON BLOCK /QA/ Variables: -c NCOMMOUT - integer - Number of comment lines written to -c RCPU - real - Computed CPU time of the run -c VER - character*12 - Version number of CALPUFF -c LEVEL - character*12 - Level number of CALPUFF -c RDATE - character*8 - System date at start of run -c (MM-DD-YYYY) -c RTIME - character*8 - System time at start of run -c (HH:MM:SS) diff --git a/CALPUFF_SRC/CALPUFF/qscale.puf b/CALPUFF_SRC/CALPUFF/qscale.puf deleted file mode 100644 index 567b1e2..0000000 --- a/CALPUFF_SRC/CALPUFF/qscale.puf +++ /dev/null @@ -1,67 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /QSCALE/ -- Emission(Q) CALPUFF -c --- Scaling-Factor(SF) Definition -c---------------------------------------------------------------------- - character(len=16) :: cqsftyp(9) - integer :: nqsftyp, nqsfval(9) - integer :: nqsfcol(9),nqsfrow(9) - integer :: mapvary(6) - real :: wqsf(5,13),tqsf(11,13) - - common/QSCALE/ nqsftyp, nqsfval,nqsfcol,nqsfrow, - 1 cqsftyp,mapvary, wqsf,tqsf - - -c --- Variables: -c --------------- -c -c NQSFTYP - integer - Number of scaling factor types -c (MUST equal array dimension) -c CQSFTYP(9) - char*16 - Scaling factor type names: -c -c CONSTANT1 1 scaling factor -c MONTH12 12 scaling factors: months 1-12 -c DAY7 7 scaling factors: days 1-7 -c [SUNDAY,MONDAY, ... FRIDAY,SATURDAY] -c HOUR24 24 scaling factors: hours 1-24 -c HOUR24_DAY7 168 scaling factors: hours 1-24, -c repeated 7 times: SUNDAY, MONDAY, ... -c HOUR24_MONTH12 288 scaling factors: hours 1-24, -c repeated 12 times: months 1-12 -c WSP6 6 scaling factors: wind speed classes 1-6 -c [speed classes defined in Group 12] -c WSP6_PGCLASS6 36 scaling factors: wind speed classes 1-6 -c repeated 6 times: PG classes A,B,C,D,E,F -c [speed classes defined in Group 12] -c TEMPERATURE12 12 scaling factors: temperature classes 1-12 -c [temperature(K) classes defined in Group 12] -c -c MAPVARY(6) - integer - Map pointer from the 6 IVARY -c choices to the corresponding -c CQSFTYP() index -c -c NQSFVAL(9) - integer - Number of scaling factors for -c each type -c (Max must = MXQSF in /params/) -c NQSFCOL(9) - integer - Number of print columns for each -c NQSFROW(9) - integer - Number of print rows for each -c -c --- Temperature and wind speed classes by source type (13) -c WQSF(5,13) - real - Wind speed class boundaries (m/s) -c (boundary is upper limit of class) -c TQSF(11,13) - real - Temperature class boundaries (K) -c (boundary is upper limit of class) -c Source Types are: -c 1 = Point Constant Emissions -c 2 = Point Variable Emissions (no WS/T class used) -c 3 = Poly. Area Constant Emissions -c 4 = Poly. Area Variable Emissions (no WS/T class used) -c 5 = Line Constant Emissions -c 6 = Line Variable Emissions (no WS/T class used) -c 7 = Volume Constant Emissions -c 8 = Grid Volume Variable Emissions (no WS/T class used) -c 9 = Boundary Condition (no WS/T class used) -c (10)= Flare Constant Emissions -c 11 = Flare Variable Emissions (no WS/T class used) -c 12 = Road Constant Emissions -c 13 = Road Variable Emissions (no WS/T class used) diff --git a/CALPUFF_SRC/CALPUFF/restarthd.puf b/CALPUFF_SRC/CALPUFF/restarthd.puf deleted file mode 100644 index 184b57b..0000000 --- a/CALPUFF_SRC/CALPUFF/restarthd.puf +++ /dev/null @@ -1,71 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /RESTARTHD/ -- Header record information CALPUFF -c in RESTART file -c---------------------------------------------------------------------- -c - character*16 rstrtnam,rstrtver - character*64 rstrtmod - - common/RESTARTHD/rstrtnam,rstrtver,rstrtmod, - & ntabpt1,nmetpt1,nsrcpt1, - & ntabpt2,nmetpt2,nqempt2,nsrcpt2, - & ntabar1,nmetar1,nsrcar1, - & ntabar2,nmetar2,nqemar2,nsrcar2, - & ntabln1,nmetln1,nsrcln1, - & ntabln2,nmetln2,nqemln2,nsrcln2, - & ntabvl1,nmetvl1,nsrcvl1, - & ntabvl2,nmetvl2,nqemvl2,nsrcvl2 -c -c --- COMMON BLOCK /RESTARTHD/ Variables: -c RSTRTNAM - character- Dataset name -c RSTRTVER - character- Dataset version -c RSTRTMOD - character- Dataset modifier (doc) -c -c -c -c---------------------------------------------------------------------- -c --- The following information is not used (080520), but retained -c --- for future potential use -c---------------------------------------------------------------------- -c --- Control File Line Sources -c NTABLN1 - integer - Number of points in table -c NMETLN1 - integer - Number of met periods stored -c NSRCLN1 - integer - Number of sources stored -c --- Variable Emissions File Line Sources -c NTABLN2 - integer - Number of points in table -c NMETLN2 - integer - Number of met periods stored -c NQEMLN2 - integer - Number of emission periods stored -c NSRCLN2 - integer - Number of sources stored -c -c --- The following source types do not currently use tables from -c --- past met periods, and should be configured to generate no -c --- data records in the RESTART file. -c -c --- Control File Point Sources -c NTABPT1 - integer - Number of points in table -c NMETPT1 - integer - Number of met periods stored -c NSRCPT1 - integer - Number of sources stored -c --- Variable Emissions File Point Sources -c NTABPT2 - integer - Number of points in table -c NMETPT2 - integer - Number of met periods stored -c NQEMPT2 - integer - Number of emission periods stored -c NSRCPT2 - integer - Number of sources stored -c --- Control File Area Sources -c NTABAR1 - integer - Number of points in table -c NMETAR1 - integer - Number of met periods stored -c NSRCAR1 - integer - Number of sources stored -c --- Variable Emissions File Area Sources -c NTABAR2 - integer - Number of points in table -c NMETAR2 - integer - Number of met periods stored -c NQEMAR2 - integer - Number of emission periods stored -c NSRCAR2 - integer - Number of sources stored -c --- Control File Volume Sources -c NTABVL1 - integer - Number of points in table -c NMETVL1 - integer - Number of met periods stored -c NSRCVL1 - integer - Number of sources stored -c --- Variable Emissions File Volume Sources -c NTABVL2 - integer - Number of points in table -c NMETVL2 - integer - Number of met periods stored -c NQEMVL2 - integer - Number of emission periods stored -c NSRCVL2 - integer - Number of sources stored -c---------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CALPUFF/slug.puf b/CALPUFF_SRC/CALPUFF/slug.puf deleted file mode 100644 index b959c96..0000000 --- a/CALPUFF_SRC/CALPUFF/slug.puf +++ /dev/null @@ -1,28 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /SLUG/ -- Slug parameters CALPUFF -c---------------------------------------------------------------------- -c - common/slug/xpe(mxpuff),ype(mxpuff),zpe(mxpuff),sigye(mxpuff), - 1 sigze(mxpuff),xtote(mxpuff),tmtote(mxpuff),speed0(mxpuff) -c -c --- COMMON BLOCK /SLUG/ Variables: -c XPE(mxpuff) - real - Met. grid X coordinate of -c oldest end of slug -c YPE(mxpuff) - real - Met. grid Y coordinate of -c oldest end of slug -c ZPE(mxpuff) - real - Height above ground (m) of -c oldest end of slug after rise -c (i.e., stack height + plume rise) -c SIGYE(mxpuff) - real - Sigma y (m) for the -c oldest end of slug without BID -c SIGZE(mxpuff) - real - Sigma z (m) for the -c oldest end of slug without BID -c XTOTE(mxpuff) - real - Total integrated travel distance (m) of -c the oldest end of slug -c TMTOTE(mxpuff) - real - Total integrated travel time (s) of -c the oldest end of slug -c---------------------------------------------------------------------- -c ----- Data associated with slug at the time of release ----- -c---------------------------------------------------------------------- -c SPEED0(mxpuff) - real - Transport (elongation) speed of fresh -c slug (m/s) diff --git a/CALPUFF_SRC/CALPUFF/soa.puf b/CALPUFF_SRC/CALPUFF/soa.puf deleted file mode 100644 index 4d71626..0000000 --- a/CALPUFF_SRC/CALPUFF/soa.puf +++ /dev/null @@ -1,15 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /SOA/ -- Data used in SOA module CALPUFF -c -c---------------------------------------------------------------------- -c - logical larom,lbiog - common/SOA/LBIOG,LAROM,AMO,VC2NX -c -c --- COMMON BLOCK /SOA/ Variables: -c -c LBIOG - logical - Biogenic species emitted/modeled ? -c LAROM - logical - Aromatic species emitted/modeled ? -c AMO - real - Organic mass of fine particulates (ug/m3) -c VC2NX - real - VOC / NOX ratio (after reaction) -c diff --git a/CALPUFF_SRC/CALPUFF/soadat.puf b/CALPUFF_SRC/CALPUFF/soadat.puf deleted file mode 100644 index a2483f6..0000000 --- a/CALPUFF_SRC/CALPUFF/soadat.puf +++ /dev/null @@ -1,31 +0,0 @@ -c---------------------------------------------------------------------- -c -c Data used in new SOA module CALPUFF -c -c---------------------------------------------------------------------- -c - integer NORG - parameter (NORG = 7) -c - real MW_ORG(NORG), HVAP(NORG), KOM(NORG) -c -c Variables: -c NORG - integer - Number of condensable species -c MW_ORG - real - Mol. wt. of condensable species -c KOM - real - Partition coefficients (m3/ug) -c HVAP - real - Heat of vaporization (KJ/Mol) -c - DATA KOM / 0.1586, 0.0057, !TOL - & 0.1257, 0.0042, !XYL - & 0.0229, !ALKH - & 0.0150,0.0020 / !PAH -c - DATA HVAP / 72.67 , 72.67, !TOL - & 72.67 , 72.67, !XYL - & 72.67 , !ALKH - & 72.67 , 72.67 / !PAH - DATA MW_ORG / 2 * 92.0, 2 * 106.0, 226.0, 2 * 156.0 / -C -C Gas constant in KJ/mol-K - REAL RKJMOLK - PARAMETER (RKJMOLK = 8.31451E-3) diff --git a/CALPUFF_SRC/CALPUFF/srctab.puf b/CALPUFF_SRC/CALPUFF/srctab.puf deleted file mode 100644 index 300ff7d..0000000 --- a/CALPUFF_SRC/CALPUFF/srctab.puf +++ /dev/null @@ -1,50 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /SRCTAB/ -- Source-related Arrays CALPUFF -c (Rise and Downwash Tables) -c---------------------------------------------------------------------- -c --- These are work arrays named for numerical plume rise variables -c --- and PRIME downwash variables for wake and cavity properties for -c --- point sources, but are used (where appropriate) to store -c --- similar variables for other source types. -c---------------------------------------------------------------------- - - common/SRCTAB/NTR,NWK,NCV, - 1 XTR(mxrise),ZTR(mxrise),RTR(mxrise),HTR(mxrise), - 2 XWK(mxrise),SYWK(mxrise),SZWK(mxrise),DRWK(mxrise), - 3 XCV(mxrise),SYCV(mxrise),SZCV(mxrise) -c -c --- COMMON BLOCK /SRCTAB/ Variables: -c -c NTR - integer - Number of points in trajectory arrays -c NWK - integer - Number points in wake arrays -c NCV - integer - Number points in cavity arrays -c XTR(mxrise) - real - Downwind distance (m) for trajectory, -c Or, for buoyant line sources, -c Distance from furthest upwind -c part of group of line sources, -c to points at which rise is -c tabulated -c ZTR(mxrise) - real - Height above ground (m) for trajectory -c Or, for buoyant line sources, -c Computed rise at each XTR, -c for puff released at the point -c farthest upwind -c - ** note ** - Element 1 is at "XFB", the point -c in the group of line sources that -c is furthest downwind, while element -c NTR is at final rise. -c RTR(mxrise) - real - Plume radius (m) -c HTR(mxrise) - real - Plume rise (m) without streamline -c modifications (used for BID) -c XWK(mxrise) - real - Downwind distance (m) from primary -c source in wake region -c SYWK(mxrise) - real - Sigma-y (m) for primary source -c SZWK(mxrise) - real - Sigma-z (m) for primary source -c DRWK(mxrise) - real - Plume growth rate expressed as -c d/dx(plume radius) for equivalent -c top-hat -c XCV(mxrise) - real - Downwind distance (m) from cavity -c source in wake region -c SYCV(mxrise) - real - Sigma-y (m) for cavity source -c SZCV(mxrise) - real - Sigma-z (m) for cavity source -c diff --git a/CALPUFF_SRC/CALPUFF/tibl.puf b/CALPUFF_SRC/CALPUFF/tibl.puf deleted file mode 100644 index c1b5116..0000000 --- a/CALPUFF_SRC/CALPUFF/tibl.puf +++ /dev/null @@ -1,23 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /TIBL/ -- Current TIBL Arrays CALPUFF -c---------------------------------------------------------------------- -c - parameter (mxtibl=10) - common/TIBL/ntibl,ixtibl(mxtibl),iytibl(mxtibl),mdtibl(mxtibl), - & htibl(mxtibl),tstibl(mxtibl), - & x2zi1,x2zi2,xupgrd -c -c --- COMMON BLOCK /TIBL/ Variables: -c -c NTIBL - integer - Number of sampling sub-steps defined -c I[X,Y]TIBL(mxtibl) - integer - Cell (i,j) for surface properties -c MDTIBL(mxtibl) - integer - MET grid domain for I[X,Y]TIBL -c HTIBL(mxtibl) - real - Average TIBL height (m) for sub-step -c TSTIBL(mxtibl) - real - Sampling time for sub-step as a -c fraction of full sampling step -c x2zi1 - real - Effective distance (m) from coast to -c start transition to CALMET mixing hts -c x2zi2 - real - Effective distance (m) from coast to -c stop transition to CALMET mixing hts -c xupgrd - real - Distance (met grid) upwind of source -c to search for a coast segment \ No newline at end of file diff --git a/CALPUFF_SRC/CALPUFF/trak.puf b/CALPUFF_SRC/CALPUFF/trak.puf deleted file mode 100644 index a1ad1ea..0000000 --- a/CALPUFF_SRC/CALPUFF/trak.puf +++ /dev/null @@ -1,62 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /TRAK/ -- arrays for PUFF-TRACKING Output CALPUFF -c---------------------------------------------------------------------- -c - common/TRAK/idathrtrak(mxtrak),isectrak(mxtrak), - & xkmtrak(mxtrak),ykmtrak(mxtrak),hmtrak(mxtrak), - & sytrak(mxtrak),sztrak(mxtrak),zitrak(mxtrak), - & zimaxtrak(mxtrak),tsectrak(mxtrak),dmtrak(mxtrak), - & icodetrak(mxtrak),irlstrak,isrctrak,ityptrak,ntrk -c -c --- COMMON BLOCK /TRAK/ Variables: -c -c IDATHRTRAK(mxtrak) - integer - Date-Hour of snapshot (YYYYJJJHH) -c ISECTRAK(mxtrak) - integer - Second of snapshot (SSSS) -c (10:36PM - HH=22 SSSS=2160) -c XKMTRAK(mxtrak) - real - X coordinate (km) of puff center -c (or youngest end of slug) -c YKMTRAK(mxtrak) - real - Y coordinate (km) of puff center -c (or youngest end of slug) -c HMTRAK(mxtrak) - real - Height above ground (m) of puff center -c SYTRAK(mxtrak) - real - Sigma y (m) for the puff center (or -c youngest end of slug) with BID -c SZTRAK(mxtrak) - real - Sigma z (m) for the puff center (or -c youngest end of slug) with BID -c ZITRAK(mxtrak) - real - Last mixing ht. (m) for the puff -c ZIMAXTRAK(mxtrak) - real - Highest mixing ht. (m) to which puff -c has been exposed -c TSECTRAK(mxtrak) - real - Total integrated travel time (s) of -c the puff (or youngest end of slug) -c DMTRAK(mxtrak) - real - Total integrated travel distance (m) of -c the puff (or youngest end of slug) -c ICODETRAK(mxtrak) - integer - Puff status code: -c 1 = Puff within mixed layer & Gaussian -c 2 = Puff within mixed layer & uniform -c 3 = Puff above mixed layer & Gaussian -c 4 = Puff above mixed layer & uniform -c 5 = Puff currently above mixed layer -c (but previously below) & Gaussian -c 6 = Puff currently above mixed layer -c (but previously below) & uniform -c 11 = Slug within mixed layer & Gaussian -c 12 = Slug within mixed layer & uniform -c 13 = Slug above mixed layer & Gaussian -c 14 = Slug above mixed layer & uniform -c 15 = Slug currently above mixed layer -c (but previously below) & Gaussian -c 16 = Slug currently above mixed layer -c (but previously below) & uniform -c 99 = Puff/slug off computational grid -c ISRCTRAK - integer - Source ID number -c ITYPTRAK - integer - Source type number -c Source Types are: -c 1 = Point Constant Emissions -c 2 = Point Variable Emissions -c 3 = Poly. Area Constant Emissions -c 4 = Poly. Area Variable Emissions -c 5 = Line Constant Emissions -c 6 = Line Variable Emissions -c 7 = Volume Constant Emissions -c 8 = Grid Volume Variable Emissions -c 9 = Boundary Condition -c NTRK - integer - Number of tracking steps stored diff --git a/CALPUFF_SRC/CALPUFF/vol1.puf b/CALPUFF_SRC/CALPUFF/vol1.puf deleted file mode 100644 index 5e25486..0000000 --- a/CALPUFF_SRC/CALPUFF/vol1.puf +++ /dev/null @@ -1,53 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /VOL1/ -- Volume source data for discrete CALPUFF -c sources with constant emissions -c---------------------------------------------------------------------- - character*16 CNAMVL1 - character*40 csfvl1 -c - common/VOL1/XVL1GRD(mxvol),YVL1GRD(mxvol),HTVL1(mxvol), - 1 ELVL1(mxvol),SY0VL1(mxvol),SZ0VL1(mxvol),QVL1(mxspec,mxvol), - 2 NEWVL1(mxvol),NVL1,IVLU,NSVL1, - 3 IDSFVL1(mxspec,mxvol),IXREFVL1(mxspvl), - 4 CNAMVL1(mxvol),CSFVL1(mxspvl) -c -c --- COMMON BLOCK /VOL1/ Variables: -c -c XVL1GRD(mxvol) - real - X coordinate of a volume -c source in grid units -c (i.e., origin at (0.0,0.0)) -c YVL1GRD(mxvol) - real - Y coordinate of a volume -c source in grid units -c (i.e., origin at (0.0,0.0)) -c HTVL1(mxvol) - real - Effective release height (m) -c ELVL1(mxvol) - real - Ground elevation (m) above sea -c level -c SY0VL1(mxvol) - real - Initial sigma y (m) -c SZ0VL1(mxvol) - real - Initial sigma z (m) -c QVL1(mxspec,mxvol) - real - Emission rate (g/s) for each -c pollutant -c NVL1 - integer - Number of volume sources -c NEWVL1(mxvol) - integer - Number of puffs released by each -c source during the current step -c IVLU - integer - Units for emission rates in -c control file -c 1: g/s -c 2: kg/hr -c 3: lb/hr -c 4: ton/yr -c 5: Odour Unit * m**3/s -c 6: Odour Unit * m**3/min -c 7: metric tons/yr -c 8: Bq/s (Bq = becquerel = disintegrations/s) -c 9: GBq/yr -c NSVL1 - integer - Number of source-species pairs -c with emissions scaling factors -c IDSFVL1(mxspec,mxvol) - integer - Pointer to volume-species pair -c index, 0 to NSVL1 -c (0 if no scaling) -c IXREFVL1(mxspvl) - integer - Cross-reference pointer from -c volume-species pairs to -c scale-factor tables -c CSFVL1(mxspvl) - c*40 arr - List of scale-factor table names -c for volume-species pairs -c CNAMVL1(mxvol) - c*16 arr - Source names diff --git a/CALPUFF_SRC/CALPUFF/vol2.puf b/CALPUFF_SRC/CALPUFF/vol2.puf deleted file mode 100644 index d7b30e4..0000000 --- a/CALPUFF_SRC/CALPUFF/vol2.puf +++ /dev/null @@ -1,137 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /VOL2/ -- Volume source data for sources CALPUFF -c with variable characterisitics -c in VOLEMARB.DAT files -c---------------------------------------------------------------------- -c - character*12 cslst4 - character*16 cid4 - - logical*4 lutmvl2,llccvl2,lpsvl2,lemvl2,llazavl2,lttmvl2 - character*4 utmhemvl2,xyunitvl2 - character*8 datumvl2,pmapvl2 - character*12 datenvl2 - - common/VOL2/ NVL2,NSE4, - 1 IBSRC4(mxemdat),IESRC4(mxemdat), - 2 IBDATHR4(mxemdat),IBSEC4(mxemdat),IEDATHR4(mxemdat), - 3 IESEC4(mxemdat),XTZ4(mxemdat),T2BTZ4(mxemdat), - 4 XMWEM4(mxspec),IXREM4(mxspec), - 5 lutmvl2(mxemdat),llccvl2(mxemdat),lpsvl2(mxemdat), - 6 lemvl2(mxemdat),llazavl2(mxemdat),lttmvl2(mxemdat), - 7 iutmznvl2(mxemdat),feastvl2(mxemdat),fnorthvl2(mxemdat), - 8 rnlat0vl2(mxemdat),relon0vl2(mxemdat), - 9 rnlat1vl2(mxemdat),rnlat2vl2(mxemdat),NSTEP4(mxemdat), - & NDHRQB4(mxqstep,mxemdat),NSECQB4(mxqstep,mxemdat), - 1 NDHRQE4(mxqstep,mxemdat),NSECQE4(mxqstep,mxemdat), - 2 XVL2GRD(mxqstep,mxvol),YVL2GRD(mxqstep,mxvol), - 3 HTVL2(mxqstep,mxvol),ELVL2(mxqstep,mxvol), - 4 SY0VL2(mxqstep,mxvol),SZ0VL2(mxqstep,mxvol), - 5 QVL2(mxspec,mxqstep,mxvol),NEWVL2(mxvol), - 6 CSLST4(mxspec),CID4(mxvol), - 7 pmapvl2(mxemdat),utmhemvl2(mxemdat),datumvl2(mxemdat), - 8 datenvl2(mxemdat),xyunitvl2(mxemdat) - - -c -c --- COMMON BLOCK /VOL2/ Variables: -c NVL2 - integer - Number of volume sources -c NSE4 - integer - Number of emitted species in the file -c IBSRC4(mxemdat) - integer - Index for first source in a VOLEMARB.DAT -c file -c IESRC4(mxemdat) - integer - Index for last source in a VOLEMARB.DAT -c file -c IBDATHR4(mxemdat)- integer - Date/hour at beginning of period for -c the first data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IBSEC4(mxemdat) - integer - Seconds of the first data record in the -c file (0000-3599) -c IEDATHR4(mxemdat)- integer - Date/hour at end of period for -c the last data record in the file -c (YYYYJJJHH, where YYYY=year, -c JJJ=Julian day, HH=hour [00-23 LST]) -c IESEC4(mxemdat) - integer - Seconds of the last data record in the -c file (0000-3599) -c XTZ4(mxemdat) - real - Time zone (UTC=LST+XTZ4) -c T2BTZ4(mxemdat) - real - Hours to ADD to Local Time to obtain -c Base Time (xtz3-xbtz) -c XMWEM4(mxspec) - real - Molecular weight for each species -c IXREM4(mxspec) - integer - Cross referencing array of NSE4 -c values relating species ordering -c in the emissions file to the -c ordering in the main conc. array -c -c --- MAP Projection Variables --- -c -c LUTMVL2(mxemdat) - logical*4 - Flag for Universal Transverse Mercator -c LLCCVL2(mxemdat) - logical*4 - Flag for Lambert Conformal Conic -c LPSVL2(mxemdat) - logical*4 - Flag for Polar Stereographic -c LEMVL2(mxemdat) - logical*4 - Flag for Equatorial Mercator -c LLAZAVL2(mxemdat) - logical*4 - Flag for Lambert Azimuthal Equal Area -c LTTMVL2(mxemdat) - logical*4 - Flag for Tangential Transverse Mercator -c -c IUTMZNVL2(mxemdat) - integer - UTM zone for UTM projection -c FEASTVL2(mxemdat) - real - False Easting (km) at projection origin -c FNORTHVL2(mxemdat) - real - False Northing (km) at projection origin -c RNLAT0VL2(mxemdat),- real - N. latitude & E. longitude of x=0 and y=0 -c RELON0VL2(mxemdat) (deg) of map projection (Used only if PMAP = -c LCC, PS, EM, TTM or LAZA) -c NOTE: longitude neg in western hemisphere -c RNLAT1VL2(mxemdat), - real - Matching N. latitude(s) for projection -c RNLAT2VL2(mxemdat) (deg) (Used only if PMAP3= LCC, PS, or EM) -c LCC : Projection cone slices through -c Earth's surface at XLAT1 and XLAT2 -c PS : Projection plane slices through -c Earth at XLAT1 -c EM : Projection cylinder slices through -c Earth at [+/-] XLAT1 -c -c --- Variable data --- -c -c NSTEP4(mxemdat) - integer - Number of emission steps in -c current timestep -c NDHRQB4(mxqstep,mxemdat) & NSECQB4(mxqstep,mxemdat) -c - integer - Starting time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c NDHRQE4(mxqstep,mxemdat) & NSECQE4(mxqstep,mxemdat) -c - integer - Ending time for which -c emissions data in current set of -c records is valid -c (YYYYJJJHH & SSSS) -c XVL2GRD(mxqstep,mxvol) - real - X coordinate of a volume -c source in grid units -c (i.e., origin at (0.0,0.0)) -c YVL2GRD(mxqstep,mxvol) - real - Y coordinate of a volume -c source in grid units -c (i.e., origin at (0.0,0.0)) -c HTVL2(mxqstep,mxvol) - real - Effective release height (m) -c ELVL2(mxqstep,mxvol) - real - Ground elevation (m) above sea -c level -c SY0VL2(mxqstep,mxvol) - real - Initial sigma y (m) -c SZ0VL2(mxqstep,mxvol) - real - Initial sigma z (m) -c QVL2(mxspec,mxqstep,mxvol) -c - real - Emission rate (g/s) for each -c pollutant -c NEWVL2(mxvol) - integer - Number of puffs released by each -c source during the current step -c -c --- Character data --- -c CSLST4(mxspec) - char*12 - Species identifiers -c CID4(mxvol) - char*16 - Source identifiers -c -c PMAPVL2(mxemdat) - character - Character code for output map projection -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c UTMHEMVL2(mxemdat)- character - Base hemisphere for UTM projection -c (S=southern, N=northern) -c DATUMVL2(mxemdat) - character - Datum-Region for grid coordinates -c DATENVL2(mxemdat) - character - NIMA date for datum parameters -c (MM-DD-YYYY ) -c XYUNITVL2(mxemdat)- character - Units for coordinates (e.g., KM) diff --git a/CALPUFF_SRC/CALPUFF/wakedat.puf b/CALPUFF_SRC/CALPUFF/wakedat.puf deleted file mode 100644 index 7a72f94..0000000 --- a/CALPUFF_SRC/CALPUFF/wakedat.puf +++ /dev/null @@ -1,105 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WAKEDAT/ -- Parameters used in the CALPUFF -c PRIME wake and streamline -c subroutines -c --- COMMON BLOCK /WAKECSIG/-- Parameters used in the call -c to SETCSIG to set dispersion -c environment at building top (BT) -c and at rlease height (RH) -c---------------------------------------------------------------------- -c - logical lrurl - common/WAKEDAT/Hb,Wb,xLb,Rb,HR,xLR,xLC, - & xbadj,ybadj,Ub,ubkps,Urh, - & nwak,xwak(mxrise),szwak(mxrise),sywak(mxrise), - & drwak(mxrise),xzvwak,xyvwak, - & nwakisc,xwakisc(mxrise),drwakisc(mxrise), - & ncav,xcav(mxrise),szcav(mxrise),sycav(mxrise), - & xzvcav,xyvcav,fqcav,cbyqcav,istab,lrurl -c - common/WAKECSIG/idopty_bt,idoptz_bt,iru_bt,uavg_bt,kst_bt, - & el_bt,bvf_bt,tsigv_bt,tsigw_bt,symin_bt, - & szmin_bt,zht_bt,zmix_bt, - & idopty_rh,idoptz_rh,iru_rh,uavg_rh,kst_rh, - & el_rh,bvf_rh,tsigv_rh,tsigw_rh,symin_rh, - & szmin_rh,zht_rh,zmix_rh, - & ix_btrh,iy_btrh,md_btrh -c -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WAKEDAT/ Variables: -c---------------------------------------------------------------------- -c -c HB - real - Building height (m) -c WB - real - Building width (crosswind) - (m) -c XLB - real - Building length (alongwind) - (m) -c RB - real - Scale length (m) -c HR - real - Maximum cavity height (m) above ground -c XLR - real - Length of downwind cavity (m) from -c downwind face of building -c XLC - real - Length of roof cavity (m) -c XBADJ - real - Distance along the wind from the stack to -c the origin of the building (upwind center -c of effective building) -c YBADJ - real - Distance crosswind from the stack to -c the origin of the building (upwind center -c of effective building) -c Ub - real - Wind speed (m/s) at the height of bldg -c ubkps - real - Wind speed (km/s) used to relate distance -c and time when /WAKEDAT/ arrays are computed -c Urh - real - Wind speed (m/s) at release height -c -c NWAK - integer - Number of downwind distances at which -c wake properties are tabulated (LE mxrise) -c XWAK(mxrise) - real - Downwind distance (m) from primary source -c SZWAK(mxrise) - real - Sigma-z (m) at position XWAK, with BID -c SYWAK(mxrise) - real - Sigma-y (m) at position XWAK, with BID -c DRWAK(mxrise) - real - Plume growth rate at position XWAK expressed -c as d/dx(plume radius) for equivalent top-hat -c XZVWAK - real - Virtual distance increment (m) that produces -c the wake sigma-z at the end of the table -c when added to the distance from the source -c XYVWAK - real - Virtual distance increment (m) that produces -c the wake sigma-y at the end of the table -c when added to the distance from the source -c NWAKISC - integer - Number of downwind distances at which ISC -c wake properties are tabulated (LE mxrise) -c XWAKISC(mxrise) - real - Downwind ISC distance(m) from primary source -c DRWAKISC(mxrise) - real - Plume growth rate at XWAKISC expressed -c as d/dx(plume radius) for equivalent top-hat -c NCAV - integer - Number of downwind distances at which -c wake properties of cavity source are -c tabulated (LE mxntr) -c XCAV(mxrise) - real - Downwind distance (m) from primary source -c SZCAV(mxrise) - real - Sigma-z (m) for cavity source -c SYCAV(mxrise) - real - Sigma-y (m) for cavity source -c XZVCAV - real - Virtual distance increment (m) that produces -c the cavity sigma-z at the end of the table -c when added to the distance from the source -c XYVCAV - real - Virtual distance increment (m) that produces -c the cavity sigma-y at the end of the table -c when added to the distance from the source -c FQCAV - real - Fraction of plume mass captured by cavity -c CBYQCAV - real - Chi/Q at centerline in the cavity -c ISTAB - integer - PG stability class -c LRURL - logical - Rural dispersion when .TRUE. -c -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WAKECSIG/ Variables: -c --- All names below have _BT added if building-top values or -c --- have _RH added if release-height values -c---------------------------------------------------------------------- -c IDOPTY - integer - Sigma-y method -c IDOPTZ - integer - Sigma-z method -c IRU - integer - Rural flag (rural=0 ; urban=1) -c UAVG - real - Transport wind speed (m/s) -c KST - integer - PGT stability class -c EL - real - Monin-Obukhov length (m) -c BVF - real - Brunt-Vaisala freq (1/s) -c TSIGV - real - Sigma-v (m/s) -c TSIGW - real - Sigma-w (m/s) -c SYMIN - real - Sigma-y floor (m) -c SZMIN - real - Sigma-z floor (m) -c ZHT - real - Height (m AGL) -c ZMIX - real - Mixing height (m) -c IX_BTRH,IY_BTRH,MD_BTRH -c - integer - Grid location of source near building diff --git a/CALPUFF_SRC/CALPUFF/wakedfsn.puf b/CALPUFF_SRC/CALPUFF/wakedfsn.puf deleted file mode 100644 index 09e0eb9..0000000 --- a/CALPUFF_SRC/CALPUFF/wakedfsn.puf +++ /dev/null @@ -1,40 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WAKEDFSN/ -- Parameters used in the CALPUFF -c PRIME turbulence and diffusion -c subroutines -c---------------------------------------------------------------------- -c - real rurliz(6),rurliy(6),urbniz(6),urbniy(6) - common/WAKEDFSN/afac,xbyrmax,wiz0,wiy0,wfz,wfy, - & dua_ua,xdecay,xdecayi, - & rurliz,rurliy,urbniz,urbniy, - & ambiz,ambiy -c -c --- COMMON BLOCK /WAKEDFSN/ Variables: -c -c AFAC - real - Diffusion transitions to ambient (with -c virtual source) when wake turbulence decays -c to AFAC*(ambient turbulence intensity) for -c PG classes 4, 5, and 6 -c XBYRMAX - real - Upper limit on distance from upwind face -c of bldg to transition point for ambient -c diffusion -c WIZ,WIY - real - Base Turbulence intensities in wake -c WFZ,WFY - real - Scaling factors for sigmaz and sigmay -c DUA_UA - real - [Ua-U]/Ua in wake at downwind face of bldg -c U: average speed in wake -c Ua: ambient speed -c DECAY - real - Exponent for turbulence intensity change -c with distance from downwind face of bldg -c DECAYI - real - 1/DECAY -c -c --- Ambient turbulence intensities inferred from Briggs (1973) -c --- "Diffusion estimation for small emissions", ATDL-106; -c RURLIZ(6) - real - Rural turbulence intensities in z -c RURLIY(6) - real - Rural turbulence intensities in y -c URBNIZ(6) - real - Urban turbulence intensities in z -c URBNIY(6) - real - Urban turbulence intensities in y -c -c --- Current ambient turbulence intensities -c AMBIZ - real - Turbulence intensity in z (vertical) -c AMBIY - real - Turbulence intensity in y (horizontal) diff --git a/CALPUFF_SRC/CALPUFF/wetdat.puf b/CALPUFF_SRC/CALPUFF/wetdat.puf deleted file mode 100644 index 51cf674..0000000 --- a/CALPUFF_SRC/CALPUFF/wetdat.puf +++ /dev/null @@ -1,13 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WETDAT/ -- Wet deposition data CALPUFF -c---------------------------------------------------------------------- -c - common/WETDAT/wa(2,mxspec) -c -c --- COMMON BLOCK /WETDAT/ Variables: -c -c WA(2,mxspec) - real - Array of scavenging coefficients -c (1/sec) for each pollutant and -c precipitation type -c (1,-) = liquid precipitation -c (2,-) = frozen precipitation diff --git a/CALPUFF_SRC/CALPUFF/wrkspc.puf b/CALPUFF_SRC/CALPUFF/wrkspc.puf deleted file mode 100644 index 4f0a335..0000000 --- a/CALPUFF_SRC/CALPUFF/wrkspc.puf +++ /dev/null @@ -1,22 +0,0 @@ -c---------------------------------------------------------------------- -c --- COMMON BLOCK /WRKSPC/ -- Temporary work arrays CALPUFF -c---------------------------------------------------------------------- -c - common/WRKSPC/tmp1(mxnx,mxny),nw1,tmp2(mxnx,mxny),nw2, - 1 tmp3(mxrec),tmp4(mxrec),tmp5(mxrect),tmp6(mxrect), - 2 tmp7(mxnxg,mxnyg),tmp8(mxnxg,mxnyg) -c -c --- COMMON BLOCK /WRKSPC/ Variables: -c -c TMP1(mxnx,mxny) - real - Work array number 1 -c NW1 - integer - Length of work array TMP1 -c (in words) -c TMP2(mxnx,mxny) - real - Work array number 2 -c NW2 - integer - Length of work array TMP2 -c (in words) -c TMP3(mxrec) - real - Work array number 3 -c TMP4(mxrec) - real - Work array number 4 -c TMP5(mxrect) - real - Work array number 5 -c TMP6(mxrect) - real - Work array number 6 -c TMP7(mxnxg,mxnyg) - real - Work array number 7 -c TMP8(mxnxg,mxnyg) - real - Work array number 8 diff --git a/CALPUFF_SRC/CTGPROC/blockdat.crd b/CALPUFF_SRC/CTGPROC/blockdat.crd deleted file mode 100644 index c87c405..0000000 --- a/CALPUFF_SRC/CTGPROC/blockdat.crd +++ /dev/null @@ -1,1374 +0,0 @@ - BLOCK DATA DATUMS -c -c************************************************************ -c -c --- BUILD manufactored BLOCK DATA routine -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - INCLUDE 'nima.crd' - data kmax,nudat /234,132/ -c -c --- Set date-stamp for this BLOCK DATA file - data dateb /'02-21-2003 '/ -c --- Set checking date stamp here - data dstamp /'02-21-2003 '/ -c - data datum / - *'WGS-84 : WGS 84 ', - *'WGS-84 : EMG 96 ', - *'WGS-84 : GRS 80 ', - *'WGS-72 : WGS 72 ', - *'NWS : 6370KM Sphere ', - *'ESRI REFERENCE : Normal Sphere (6371) ', - *'ADINDAN : Clarke 1880 ', - *'AFGOOYE : Krassovsky 1940 ', - *'ARC 1950 : Clarke 1880 ', - *'ARC 1960 : Clarke 1880 ', - *'AYABELLE LIGHTHOUSE : Clarke 1880 ', - *'BISSAU : International 1924 ', - *'CAPE : Clarke 1880 ', - *'CARTHAGE : Clarke 1880 ', - *'DABOLA : Clarke 1880 ', - *'EUROPEAN 1950 : International 1924 ', - *'LEIGON : Clarke 1880 ', - *'LIBERIA 1964 : Clarke 1880 ', - *'MASSAWA : Bessel 1841 ', - *'MERCHICH : Clarke 1880 ', - *'MINNA : Clarke 1880 ', - *'M-PORALOKO : Clarke 1880 ', - *'NORTH SAHARA 1959 : Clarke 1880 ', - *'OLD EGYPTIAN 1907 : Helmert 1906 ', - *'POINT 58 : Clarke 1880 ', - *'POINTE NOIRE 1948 : Clarke 1880 ', - *'SCHWARZECK : Bessel 1841 ', - *'SIERRA LEONE 1960 : Clarke 1880 ', - *'TANANARIVE OBSERVATORY 1925 : International 1924 ', - *'VOIROL 1874 : Clarke 1880 ', - *'VOIROL 1960 : Clarke 1880 ', - *'AIN EL ABD 1970 : International 1924 ', - *'BUKIT RIMPAH : Bessel 1841 ', - *'DJAKARTA (BATAVIA) : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'GUNUNG SEGARA : Bessel 1841 ', - *'HERAT NORTH : International 1924 ', - *'HONG KONG 1963 : International 1924 ', - *'HU-TZU-SHAN : International 1924 ', - *'INDIAN : Everest (1830) ', - *'INDIAN : Everest (1956) ', - *'INDIAN : Everest ', - *'INDIAN 1954 : Everest (1830) ', - *'INDIAN 1960 : Everest (1830) ', - *'INDIAN 1975 : Everest (1830) ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'KANDAWALA : Everest (1830) ', - *'KERTAU 1948 : Everest (1948) ', - *'KOREAN GEODETIC SYSTEM 1995 : WGS 84 ', - *'NAHRWAN : Clarke 1880 ', - *'OMAN : Clarke 1880 ', - *'PULKOVO 1942 : Krassovsky 1940 ', - *'QATAR NATIONAL : International 1924 ', - *'SOUTH ASIA : Modified Fischer 1960', - *'TIMBALAI 1948 : Everest ', - *'TOKYO : Bessel 1841 ', - *'AUSTRALIAN GEODETIC 1966 : Australian National ', - *'AUSTRALIAN GEODETIC 1984 : Australian National ', - *'COORD SYSTEM 1937 OF ESTONIA : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'EUROPEAN 1979 : International 1924 ', - *'HERMANNSKOGEL : Bessel 1841 ', - *'IRELAND 1965 : Modified Airy ', - *'ORD SURV OF GREAT BRITAIN 36 : Airy ', - *'ROME 1940 : International 1924 ', - *'S-42 (PULKOVO 1942) : Krassovsky 1940 ', - *'S-JTSK : Bessel 1841 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'NORTH AMERICAN 1927 : Clarke 1866 ', - *'NORTH AMERICAN 1983 : GRS 80 ', - *'BOGOTA OBSERVATORY : International 1924 ', - *'CAMPO INCHAUSPE 1969 : International 1924 ', - *'CHUA ASTRO : International 1924 ', - *'CORREGO ALEGRE : International 1924 ', - *'PROVISIONAL S. AMERICAN 1956 : International 1924 ', - *'PROVISIONAL S. CHILEAN 1963 : International 1924 ', - *'SOUTH AMERICAN 1969 : South American 1969 ', - *'SIRGAS : GRS 80 ', - *'YACARE : International 1924 ', - *'ZANDERIJ : International 1924 ', - *'ANTIGUA ISLAND ASTRO 1943 : Clarke 1880 ', - *'ASCENSION ISLAND 1958 : International 1924 ', - *'ASTRO DOS 71/4 : International 1924 ', - *'BERMUDA 1957 : Clarke 1866 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'DECEPTION ISLAND : Clarke 1880 ', - *'FORT THOMAS 1955 : Clarke 1880 ', - *'GRACIOSA BASE SW 1948 : International 1924 ', - *'HJORSEY 1955 : International 1924 ', - *'ISTS 061 ASTRO 1968 : International 1924 ', - *'L. C. 5 ASTRO 1961 : Clarke 1866 ', - *'MONTSERRAT ISLAND ASTRO 1958 : Clarke 1880 ', - *'NAPARIMA, BWI : International 1924 ', - *'OBSERVAT. METEOROLOGICO 1939 : International 1924 ', - *'PICO DE LAS NIEVES : International 1924 ', - *'PORTO SANTO 1936 : International 1924 ', - *'PUERTO RICO : Clarke 1866 ', - *'QORNOQ : International 1924 ', - *'SAO BRAZ : International 1924 ', - *'SAPPER HILL 1943 : International 1924 ', - *'SELVAGEM GRANDE 1938 : International 1924 ', - *'TRISTAN ASTRO 1968 : International 1924 ', - *'ANNA 1 ASTRO 1965 : Australian National ', - *'GAN 1970 : International 1924 ', - *'ISTS 073 ASTRO 1969 : International 1924 ', - *'KERGUELEN ISLAND 1949 : International 1924 ', - *'MAHE 1971 : Clarke 1880 ', - *'REUNION : International 1924 ', - *'AMERICAN SAMOA 1962 : Clarke 1866 ', - *'ASTRO BEACON E 1945 : International 1924 ', - *'ASTRO TERN ISLAND (FRIG) 61 : International 1924 ', - *'ASTRONOMICAL STATION 1952 : International 1924 ', - *'BELLEVUE (IGN) : International 1924 ', - *'CAMP AREA ASTRO : International 1924 ', - *'CANTON ASTRO 1966 : International 1924 ', - *'CHATHAM ISLAND ASTRO 1971 : International 1924 ', - *'DOS 1968 : International 1924 ', - *'EASTER ISLAND 1967 : International 1924 ', - *'GEODETIC DATUM 1949 : International 1924 ', - *'GUAM 1963 : Clarke 1866 ', - *'GUX l ASTRO : International 1924 ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'JOHNSTON ISLAND 1961 : International 1924 ', - *'KUSAIE ASTRO 1951 : International 1924 ', - *'LUZON : Clarke 1866 ', - *'MIDWAY ASTRO 1961 : International 1924 ', - *'OLD HAWAIIAN : Clarke 1866 ', - *'PITCAIRN ASTRO 1967 : International 1924 ', - *'SANTO (DOS) 1965 : International 1924 ', - *'VITI LEVU 1916 : Clarke 1880 ', - *'WAKE-ENIWETOK 1960 : Hough ', - *'WAKE ISLAND ASTRO 1952 : International 1924 '/ - data datcod / - *'WGS-84 ','WGS-96 ','WGS-G ','WGS-72 ','NWS-84 ', - *'ESR-S ','ADI-M ','ADI-E ','ADI-F ','ADI-A ', - *'ADI-C ','ADI-D ','ADI-B ','AFG ','ARF-M ', - *'ARF-A ','ARF-H ','ARF-B ','ARF-C ','ARF-D ', - *'ARF-E ','ARF-F ','ARF-G ','ARS-M ','ARS-A ', - *'ARS-B ','PHA ','BID ','CAP ','CGE ', - *'DAL ','EUR-F ','EUR-T ','LEH ','LIB ', - *'MAS ','MER ','MIN-A ','MIN-B ','MPO ', - *'NSD ','OEG ','PTB ','PTN ','SCK ', - *'SRL ','TAN ','VOI ','VOR ','AIN-A ', - *'AIN-B ','BUR ','BAT ','EUR-H ','EUR-S ', - *'GSE ','HEN ','HKD ','HTN ','IND-B ', - *'IND-I ','IND-P ','INF-A ','ING-A ','ING-B ', - *'INH-A ','INH-A1 ','IDN ','KAN ','KEA ', - *'KGS ','NAH-A ','NAH-B ','NAH-C ','FAH ', - *'PUK ','QAT ','SOA ','TIL ','TOY-M ', - *'TOY-A ','TOY-C ','TOY-B ','TOY-B1 ','AUA ', - *'AUG ','EST ','EUR-M ','EUR-A ','EUR-E ', - *'EUR-G ','EUR-K ','EUR-B ','EUR-I ','EUR-J ', - *'EUR-L ','EUR-C ','EUR-D ','EUS ','HER ', - *'IRL ','OGB-M ','OGB-A ','OGB-B ','OGB-C ', - *'OGB-D ','MOD ','SPK-A ','SPK-B ','SPK-C ', - *'SPK-D ','SPK-E ','SPK-F ','SPK-G ','CCD ', - *'CAC ','NAS-C ','NAS-B ','NAS-A ','NAS-D ', - *'NAS-V ','NAS-W ','NAS-Q ','NAS-R ','NAS-E ', - *'NAS-F ','NAS-G ','NAS-H ','NAS-I ','NAS-J ', - *'NAS-O ','NAS-P ','NAS-N ','NAS-T ','NAS-U ', - *'NAS-L ','NAR-A ','NAR-E ','NAR-B ','NAR-C ', - *'NAR-H ','NAR-D ','BOO ','CAI ','CHU ', - *'COA ','PRP-M ','PRP-A ','PRP-B ','PRP-C ', - *'PRP-D ','PRP-E ','PRP-F ','PRP-G ','PRP-H ', - *'HIT ','SAN-M ','SAN-A ','SAN-B ','SAN-C ', - *'SAN-D ','SAN-E ','SAN-F ','SAN-J ','SAN-G ', - *'SAN-H ','SAN-I ','SAN-K ','SAN-L ','SIR ', - *'YAC ','ZAN ','AIA ','ASC ','SHB ', - *'BER ','CAC ','DID ','FOT ','GRA ', - *'HJO ','ISG ','LCF ','ASM ','NAP ', - *'FLO ','PLN ','POS ','PUR ','QUO ', - *'SAO ','SAP ','SGM ','TDC ','ANO ', - *'GAA ','IST ','KEG ','MIK ','REU ', - *'AMA ','ATF ','TRN ','ASQ ','IBE ', - *'CAZ ','CAO ','CHI ','GIZ ','EAS ', - *'GEO ','GUA ','DOB ','IDN ','JOH ', - *'KUS ','LUZ-A ','LUZ-B ','MID ','OHA-M ', - *'OHA-A ','OHA-B ','OHA-C ','OHA-D ','OHI-M ', - *'OHI-A ','OHI-B ','OHI-C ','OHI-D ','PIT ', - *'SAE ','MVS ','ENW ','WAK '/ - data atlas / - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'AUSTRALIA ', - *'AUSTRALIA ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN '/ - data geodat1 / - *'Global coverage [WGS-84 reference ellipsoid and geoid] ', - *'Global coverage [WGS-EGM96 geoid for the Earth Gravitational', - *'Global coverage [GRS-80 ITRF reference ellipsoid] ', - *'Global coverage [WGS-72 reference ellipsoid and geoid] ', - *'Global Sphere (WGS84) ', - *'Global Reference Sphere ', - *'MEAN FOR Ethiopia, Sudan ', - *'Burkina Faso ', - *'Cameroon ', - *'Ethiopia ', - *'Mali ', - *'Senegal ', - *'Sudan ', - *'Somalia ', - *'MEAN FOR Botswana, Lesotho, Malawi, Swaziland, Zaire, Zambia', - *'Botswana ', - *'Burundi ', - *'Lesotho ', - *'Malawi ', - *'Swaziland ', - *'Zaire ', - *'Zambia ', - *'Zimbabwe ', - *'MEAN FOR Kenya, Tanzania ', - *'Kenya ', - *'Tanzania ', - *'Djibouti ', - *'Guinea-Bissau ', - *'South Africa ', - *'Tunisia ', - *'Guinea ', - *'Egypt ', - *'Tunisia ', - *'Ghana ', - *'Liberia ', - *'Eritrea ', - *'Morocco ', - *'Cameroon ', - *'Nigeria ', - *'Gabon ', - *'Algeria ', - *'Egypt ', - *'Burkina Faso, Niger ', - *'Congo ', - *'Namibia ', - *'Sierra Leone ', - *'Madagascar ', - *'Tunisia, Algeria ', - *'Algeria ', - *'Bahrain Island ', - *'Saudi Arabia ', - *'Bangka and Belitung Islands (Indonesia) ', - *'Sumatra (Indonesia) ', - *'Iran ', - *'Iraq, Israel, Jordan, Kuwait, Lebanon, Saudi Arabia, Syria ', - *'Kalimantan (Indonesia) ', - *'Afghanistan ', - *'Hong Kong ', - *'Taiwan ', - *'Bangladesh ', - *'India, Nepal ', - *'Pakistan ', - *'Thailand ', - *'Vietnam (near 16N) ', - *'Con Son Island (Vietnam) ', - *'Thailand ', - *'Thailand ', - *'Indonesia ', - *'Sri Lanka ', - *'West Malaysia, Singapore ', - *'South Korea ', - *'Masirah Island (Oman) ', - *'United Arab Emirates ', - *'Saudi Arabia ', - *'Oman ', - *'Russia ', - *'Qatar ', - *'Singapore ', - *'Brunei, East Malaysia (Sarawak and Sabah) ', - *'MEAN FOR Japan, Okinawa, South Korea ', - *'Japan ', - *'Okinawa ', - *'South Korea ', - *'South Korea ', - *'Australia, Tasmania ', - *'Australia, Tasmania ', - *'Estonia ', - *'MEAN FOR Austria, Belgium, Denmark, Finland, France, Federal', - *'MEAN FOR Austria, Denmark, France, Federal Republic of Germa', - *'Cyprus ', - *'England, Channel Islands, Scotland, Shetland Islands ', - *'England, Ireland, Scotland, Shetland Islands ', - *'Greece ', - *'Sardinia (Italy) ', - *'Sicily (Italy) ', - *'Malta ', - *'Norway, Finland ', - *'Portugal, Spain ', - *'MEAN FOR Austria, Finland, Netherlands, Norway, Spain, Swede', - *'Yugoslavia (Prior to 1990), Slovenia, Croatia, Bosnia and He', - *'Ireland ', - *'MEAN FOR England, Isle of Man, Scotland, Shetland Islands, W', - *'England ', - *'England, Isle of Man, Wales ', - *'Scotland, Shetland Islands ', - *'Wales ', - *'Sardinia ', - *'Hungary ', - *'Poland ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Latvia ', - *'Kazakhstan ', - *'Albania ', - *'Romania ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Florida, Bahamas ', - *'MEAN FOR CONTIGUOUS US(CONUS) ', - *'MEAN FOR Arizona, Arkansas, California, Colorado, Idaho, Iow', - *'MEAN FOR Alabama, Connecticut, Delaware, District of Columbi', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands (East of 180W) ', - *'Aleutian Islands (West of 180W) ', - *'Bahamas (Excluding San Salvador Island) ', - *'San Salvador Island ', - *'MEAN FOR Canada (Including Newfoundland) ', - *'Alberta, British Columbia ', - *'MEAN FOR Newfoundland, New Brunswick, Nova Scotia, Quebec ', - *'Manitoba, Ontario ', - *'Northwest Territories, Saskatchewan ', - *'Yukon ', - *'Canal Zone ', - *'MEAN FOR Antigua Island, Barbados, Barbuda, Caicos Islands, ', - *'MEAN FOR Belize, Costa Rica, El Salvador, Guatemala, Hondura', - *'Cuba ', - *'Greenland (Hayes Peninsula) ', - *'Mexico ', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands ', - *'Canada ', - *'CONTIGUOUS US (CONUS) ', - *'Hawaii ', - *'Mexico, Central America ', - *'Colombia ', - *'Argentina ', - *'Paraguay ', - *'Brazil ', - *'MEAN FOR Bolivia, Chile, Colombia, Ecuador, Guyana, Peru, Ve', - *'Bolivia ', - *'Northern Chile (near 19S) ', - *'Southern Chile (near 43S) ', - *'Colombia ', - *'Ecuador ', - *'Guyana ', - *'Peru ', - *'Venezuela ', - *'Southern Chile (near 53S) ', - *'MEAN FOR Argentina, Bolivia, Brazil, Chile, Colombia, Ecuado', - *'Argentina ', - *'Bolivia ', - *'Brazil ', - *'Chile ', - *'Colombia ', - *'Ecuador (Excluding Galapagos Islands) ', - *'Baltra, Galapagos Islands ', - *'Guyana ', - *'Paraguay ', - *'Peru ', - *'Trinidad and Tobago ', - *'Venezuela ', - *'South America ', - *'Uruguay ', - *'Suriname ', - *'Antigua, Leeward Islands ', - *'Ascension Island ', - *'St. Helena Island ', - *'Bermuda Islands ', - *'Bahamas, Florida ', - *'Deception Island (Antarctica) ', - *'Nevis, St. Kitts, Leeward Islands ', - *'Faial, Graciosa, Pico, Sao Jorge, Terceira Islands (Azores) ', - *'Iceland ', - *'South Georgia Island ', - *'Cayman Brac Island ', - *'Montserrat, Leeward Islands ', - *'Trinidad and Tobago ', - *'Corvo and Flores Islands (Azores) ', - *'Canary Islands ', - *'Porto Santo, Madeira Islands ', - *'Puerto Rico, Virgin Islands ', - *'South Greenland ', - *'Sao Miguel, Santa Maria Islands (Azores) ', - *'East Falkland Island ', - *'Salvage Islands ', - *'Tristan da Cunha ', - *'Cocos Islands ', - *'Republic of Maldives ', - *'Diego Garcia ', - *'Kerguelen Island ', - *'Mahe Island ', - *'Mascarene Islands ', - *'American Samoa Islands ', - *'Iwo Jima ', - *'Tern Island ', - *'Marcus Island ', - *'Efate and Erromango Islands ', - *'Camp McMurdo Area (Antarctica) ', - *'Phoenix Islands ', - *'Chatham Island (New Zealand) ', - *'Gizo Island (New Georgia Islands) ', - *'Easter Island ', - *'New Zealand ', - *'Guam ', - *'Guadalcanal Island ', - *'Indonesia ', - *'Johnston Island ', - *'Caroline Islands, Federal States of Micronesia ', - *'Philippines (Excluding Mindanao Island) ', - *'Mindanao Island ', - *'Midway Islands ', - *'MEAN FOR Hawaiian Islands ', - *'Hawaii ', - *'Kauai ', - *'Maui ', - *'Oahu ', - *'Old Hawaiian (Mean) ', - *'Old Hawaiian Hawaii ', - *'Old Hawaiian Kauai ', - *'Old Hawaiian Maui ', - *'Old Hawaiian Oahu ', - *'Pitcairn Island ', - *'Espirito Santo Island ', - *'Viti Levu Island (Fiji Islands) ', - *'Marshall Islands ', - *'Wake Atoll '/ - data geodat2 / - *' ', - *' Model (EGM) vertical datum] ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *', Zimbabwe ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' Republic of Germany (Prior to 1 January 1993), Gibraltar, G', - *'ny (Prior to 1 January 1993), Netherlands, Switzerland ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'n, Switzerland ', - *'rzegovina, Serbia ', - *' ', - *'ales ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'a, Kansas, Montana, Nebraska, Nevada, New Mexico, North Dako', - *'a, Florida, Georgia, Illinois, Indiana, Kentucky, Louisiana,', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'Cuba, Dominican Republic, Grand Cayman, Jamaica, Turks Islan', - *'s, Nicaragua ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'nezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'r, Guyana, Paraguay, Peru, Trinidad and Tobago, Venezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data geodat3 / - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'reece, Italy, Luxembourg, Netherlands, Norway, Portugal, Spa', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ta, Oklahoma, Oregon, South Dakota, Texas, Utah, Washington,', - *' Maine, Maryland, Massachusetts, Michigan, Minnesota, Missis', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ds ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data dattyp / - * 1, 2, 3, 4, 5, - * 6, 7, 7, 7, 7, - * 7, 7, 7, 8, 9, - * 9, 9, 9, 9, 9, - * 9, 9, 9, 10, 10, - * 10, 11, 12, 13, 14, - * 15, 16, 16, 17, 18, - * 19, 20, 21, 21, 22, - * 23, 24, 25, 26, 27, - * 28, 29, 30, 31, 32, - * 32, 33, 34, 35, 35, - * 36, 37, 38, 39, 40, - * 41, 42, 43, 44, 44, - * 45, 45, 46, 47, 48, - * 49, 50, 50, 50, 51, - * 52, 53, 54, 55, 56, - * 56, 56, 56, 56, 57, - * 58, 59, 60, 60, 60, - * 60, 60, 60, 60, 60, - * 60, 60, 60, 61, 62, - * 63, 64, 64, 64, 64, - * 64, 65, 66, 66, 66, - * 66, 66, 66, 66, 67, - * 68, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 70, 70, 70, 70, - * 70, 70, 71, 72, 73, - * 74, 75, 75, 75, 75, - * 75, 75, 75, 75, 75, - * 76, 77, 77, 77, 77, - * 77, 77, 77, 77, 77, - * 77, 77, 77, 77, 78, - * 79, 80, 81, 82, 83, - * 84, 85, 86, 87, 88, - * 89, 90, 91, 92, 93, - * 94, 95, 96, 97, 98, - * 99, 100, 101, 102, 103, - * 104, 105, 106, 107, 108, - * 109, 110, 111, 112, 113, - * 114, 115, 116, 117, 118, - * 119, 120, 121, 122, 123, - * 124, 125, 125, 126, 127, - * 127, 127, 127, 127, 128, - * 128, 128, 128, 128, 128, - * 129, 130, 131, 132/ - data dradim / - *.6378137D+07,.6378137D+07,.6378137D+07,.6378135D+07,.6370000D+07, - *.6370997D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378245D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6377397D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378200D+07,.6378249D+07,.6378249D+07,.6377484D+07, - *.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6377397D+07,.6377397D+07,.6378388D+07,.6378388D+07, - *.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377276D+07, - *.6377301D+07,.6377310D+07,.6377276D+07,.6377276D+07,.6377276D+07, - *.6377276D+07,.6377276D+07,.6378160D+07,.6377276D+07,.6377304D+07, - *.6378137D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378245D+07,.6378388D+07,.6378155D+07,.6377299D+07,.6377397D+07, - *.6377397D+07,.6377397D+07,.6377397D+07,.6377397D+07,.6378160D+07, - *.6378160D+07,.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377397D+07, - *.6377340D+07,.6377563D+07,.6377563D+07,.6377563D+07,.6377563D+07, - *.6377563D+07,.6378388D+07,.6378245D+07,.6378245D+07,.6378245D+07, - *.6378245D+07,.6378245D+07,.6378245D+07,.6378245D+07,.6377397D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378137D+07,.6378137D+07,.6378137D+07,.6378137D+07, - *.6378137D+07,.6378137D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378137D+07, - *.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07,.6378388D+07, - *.6378206D+07,.6378206D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378206D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378160D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07, - *.6378206D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378388D+07,.6378160D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378206D+07,.6378388D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378249D+07,.6378270D+07,.6378388D+07/ - data dflat / - *.2982572D+03,.2982572D+03,.2982572D+03,.2982600D+03,.1000000D+21, - *.1000000D+21,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2983000D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2991528D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2983000D+03,.2934650D+03,.2934650D+03,.2991528D+03, - *.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2991528D+03,.2991528D+03,.2970000D+03,.2970000D+03, - *.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.2982470D+03,.3008017D+03,.3008017D+03, - *.2982572D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2983000D+03,.2970000D+03,.2983000D+03,.3008017D+03,.2991528D+03, - *.2991528D+03,.2991528D+03,.2991528D+03,.2991528D+03,.2982500D+03, - *.2982500D+03,.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2991528D+03, - *.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03, - *.2993250D+03,.2970000D+03,.2983000D+03,.2983000D+03,.2983000D+03, - *.2983000D+03,.2983000D+03,.2983000D+03,.2983000D+03,.2991528D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2982572D+03,.2982572D+03,.2982572D+03,.2982572D+03, - *.2982572D+03,.2982572D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982572D+03, - *.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03, - *.2949787D+03,.2949787D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2949787D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2982500D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03, - *.2949787D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2970000D+03,.2982470D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2949787D+03,.2970000D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03/ - data dec2 / - *.6694380D-02,.6694380D-02,.6694380D-02,.6694318D-02,.0000000D+00, - *.0000000D+00,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6693422D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6674372D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6693422D-02,.6803511D-02,.6803511D-02,.6674372D-02, - *.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6674372D-02,.6674372D-02,.6722670D-02,.6722670D-02, - *.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6694609D-02,.6637847D-02,.6637847D-02, - *.6694380D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6693422D-02,.6722670D-02,.6693422D-02,.6637847D-02,.6674372D-02, - *.6674372D-02,.6674372D-02,.6674372D-02,.6674372D-02,.6694542D-02, - *.6694542D-02,.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6674372D-02, - *.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02, - *.6670540D-02,.6722670D-02,.6693422D-02,.6693422D-02,.6693422D-02, - *.6693422D-02,.6693422D-02,.6693422D-02,.6693422D-02,.6674372D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6694380D-02,.6694380D-02,.6694380D-02,.6694380D-02, - *.6694380D-02,.6694380D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694380D-02, - *.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02, - *.6768658D-02,.6768658D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6768658D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6694542D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02, - *.6768658D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6722670D-02,.6694609D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6768658D-02,.6722670D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02/ - data dxmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -166.000, -118.000, -134.000, -165.000, - * -123.000, -128.000, -161.000, -43.000, -143.000, - * -138.000, -153.000, -125.000, -161.000, -134.000, - * -169.000, -147.000, -142.000, -160.000, -157.000, - * -175.000, -79.000, -173.000, -136.000, -263.000, - * -83.000, -130.000, -112.000, -130.000, -90.000, - * 639.000, 31.000, -81.000, -92.000, -74.000, - * -186.000, -130.000, -106.000, -148.000, 616.000, - * -88.000, -189.000, -73.000, -123.000, -150.000, - * -143.000, -384.000, -377.000, -117.000, -103.000, - * -403.000, -333.000, -156.000, -637.000, 282.000, - * 295.000, 283.000, 217.000, 198.000, 182.000, - * 209.000, 210.000, -24.000, -97.000, -11.000, - * 0.000, -247.000, -249.000, -243.000, -346.000, - * 28.000, -128.000, 7.000, -679.000, -148.000, - * -148.000, -158.000, -146.000, -147.000, -133.000, - * -134.000, 374.000, -87.000, -87.000, -104.000, - * -86.000, -86.000, -84.000, -97.000, -97.000, - * -107.000, -87.000, -84.000, -86.000, 682.000, - * 506.000, 375.000, 371.000, 371.000, 384.000, - * 370.000, -225.000, 28.000, 23.000, 26.000, - * 24.000, 15.000, 24.000, 28.000, 589.000, - * -2.000, -8.000, -8.000, -9.000, -5.000, - * -2.000, 2.000, -4.000, 1.000, -10.000, - * -7.000, -22.000, -9.000, 4.000, -7.000, - * 0.000, -3.000, 0.000, -9.000, 11.000, - * -12.000, 0.000, -2.000, 0.000, 0.000, - * 1.000, 0.000, 307.000, -148.000, -134.000, - * -206.000, -288.000, -270.000, -270.000, -305.000, - * -282.000, -278.000, -298.000, -279.000, -295.000, - * 16.000, -57.000, -62.000, -61.000, -60.000, - * -75.000, -44.000, -48.000, -47.000, -53.000, - * -61.000, -58.000, -45.000, -45.000, 0.000, - * -155.000, -265.000, -270.000, -205.000, -320.000, - * -73.000, -2.000, 260.000, -7.000, -104.000, - * -73.000, -794.000, 42.000, 174.000, -10.000, - * -425.000, -307.000, -499.000, 11.000, 164.000, - * -203.000, -355.000, -289.000, -632.000, -491.000, - * -133.000, 208.000, 145.000, 41.000, 94.000, - * -115.000, 145.000, 114.000, 124.000, -127.000, - * -104.000, 298.000, 175.000, 230.000, 211.000, - * 84.000, -100.000, 252.000, -24.000, 189.000, - * 647.000, -133.000, -133.000, 912.000, 61.000, - * 89.000, 45.000, 65.000, 58.000, 201.000, - * 229.000, 185.000, 205.000, 198.000, 185.000, - * 170.000, 51.000, 102.000, 276.000/ - data dymod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -15.000, -14.000, -2.000, -11.000, - * -20.000, -18.000, -14.000, -163.000, -90.000, - * -105.000, -5.000, -108.000, -73.000, -105.000, - * -19.000, -74.000, -96.000, -6.000, -2.000, - * -23.000, -129.000, 253.000, -108.000, 6.000, - * 37.000, -117.000, -77.000, 29.000, 40.000, - * 405.000, 146.000, -84.000, -93.000, -130.000, - * -93.000, 110.000, -129.000, 51.000, 97.000, - * 4.000, -242.000, -247.000, -206.000, -250.000, - * -236.000, 664.000, 681.000, -132.000, -106.000, - * 684.000, -222.000, -271.000, -549.000, 726.000, - * 736.000, 682.000, 823.000, 881.000, 915.000, - * 818.000, 814.000, -15.000, 787.000, 851.000, - * 0.000, -148.000, -156.000, -192.000, -1.000, - * -130.000, -283.000, -10.000, 669.000, 507.000, - * 507.000, 507.000, 507.000, 506.000, -48.000, - * -48.000, 150.000, -98.000, -96.000, -101.000, - * -96.000, -96.000, -95.000, -103.000, -88.000, - * -88.000, -95.000, -107.000, -98.000, -203.000, - * -122.000, -111.000, -112.000, -111.000, -111.000, - * -108.000, -65.000, -121.000, -124.000, -121.000, - * -124.000, -130.000, -130.000, -121.000, 76.000, - * 151.000, 160.000, 159.000, 161.000, 135.000, - * 152.000, 204.000, 154.000, 140.000, 158.000, - * 162.000, 160.000, 157.000, 159.000, 139.000, - * 125.000, 142.000, 125.000, 152.000, 114.000, - * 130.000, 0.000, 0.000, 0.000, 0.000, - * 1.000, 0.000, 304.000, 136.000, 229.000, - * 172.000, 175.000, 188.000, 183.000, 243.000, - * 169.000, 171.000, 159.000, 175.000, 173.000, - * 196.000, 1.000, -1.000, 2.000, -2.000, - * -1.000, 6.000, 3.000, 26.000, 3.000, - * 2.000, 0.000, 12.000, 8.000, 0.000, - * 171.000, 120.000, 13.000, 107.000, 550.000, - * 213.000, 151.000, 12.000, 215.000, 167.000, - * 46.000, 119.000, 124.000, 359.000, 375.000, - * -169.000, -92.000, -249.000, 72.000, 138.000, - * 141.000, 21.000, -124.000, 438.000, -22.000, - * -321.000, -435.000, -187.000, -220.000, -948.000, - * 118.000, 75.000, -116.000, -234.000, -769.000, - * -129.000, -304.000, -38.000, -199.000, 147.000, - * -22.000, -248.000, -209.000, -15.000, -79.000, - * 1777.000, -77.000, -79.000, -58.000, -285.000, - * -279.000, -290.000, -290.000, -283.000, -228.000, - * -222.000, -233.000, -233.000, -226.000, 165.000, - * 42.000, 391.000, 52.000, -57.000/ - data dzmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, 204.000, 218.000, 210.000, 206.000, - * 220.000, 224.000, 205.000, 45.000, -294.000, - * -289.000, -292.000, -295.000, -317.000, -295.000, - * -278.000, -283.000, -293.000, -302.000, -299.000, - * -303.000, 145.000, 27.000, -292.000, 431.000, - * 124.000, -151.000, -145.000, 364.000, 88.000, - * 60.000, 47.000, 115.000, 122.000, 42.000, - * 310.000, -13.000, 165.000, -291.000, -251.000, - * 101.000, -91.000, 227.000, 219.000, -1.000, - * 7.000, -48.000, -50.000, -164.000, -141.000, - * 41.000, 114.000, -189.000, -203.000, 254.000, - * 257.000, 231.000, 299.000, 317.000, 344.000, - * 290.000, 289.000, 5.000, 86.000, 5.000, - * 0.000, 369.000, 381.000, 477.000, 224.000, - * -95.000, 22.000, -26.000, -48.000, 685.000, - * 685.000, 676.000, 687.000, 687.000, 148.000, - * 149.000, 588.000, -121.000, -120.000, -140.000, - * -120.000, -120.000, -130.000, -120.000, -135.000, - * -149.000, -120.000, -120.000, -119.000, 480.000, - * 611.000, 431.000, 434.000, 434.000, 425.000, - * 434.000, 9.000, -77.000, -82.000, -78.000, - * -82.000, -84.000, -92.000, -77.000, 480.000, - * 181.000, 176.000, 175.000, 179.000, 172.000, - * 149.000, 105.000, 178.000, 165.000, 187.000, - * 188.000, 190.000, 184.000, 188.000, 181.000, - * 201.000, 183.000, 194.000, 178.000, 195.000, - * 190.000, 0.000, 4.000, 0.000, 0.000, - * -1.000, 0.000, -318.000, 90.000, -29.000, - * -6.000, -376.000, -388.000, -390.000, -442.000, - * -371.000, -367.000, -369.000, -379.000, -371.000, - * 93.000, -41.000, -37.000, -48.000, -41.000, - * -44.000, -36.000, -44.000, -42.000, -47.000, - * -33.000, -44.000, -33.000, -33.000, 0.000, - * 37.000, -358.000, 62.000, 53.000, -494.000, - * 296.000, 181.000, -147.000, 225.000, -38.000, - * -86.000, -298.000, 147.000, 365.000, 165.000, - * 81.000, 127.000, 314.000, -101.000, -189.000, - * 53.000, 72.000, 60.000, -609.000, 435.000, - * 50.000, -229.000, 103.000, -134.000, -1262.000, - * 426.000, -272.000, -333.000, -25.000, 472.000, - * 239.000, -375.000, 113.000, -752.000, 111.000, - * 209.000, 259.000, -751.000, 5.000, -202.000, - * -1124.000, -51.000, -72.000, 1227.000, -181.000, - * -183.000, -172.000, -190.000, -182.000, -346.000, - * -348.000, -337.000, -355.000, -347.000, 42.000, - * 84.000, -36.000, -38.000, 149.000/ - END diff --git a/CALPUFF_SRC/CTGPROC/calutils.for b/CALPUFF_SRC/CTGPROC/calutils.for deleted file mode 100644 index da778d3..0000000 --- a/CALPUFF_SRC/CTGPROC/calutils.for +++ /dev/null @@ -1,2953 +0,0 @@ -c------------------------------------------------------------------------------ -c --- CALUTILS -- CALPUFF SYSTEM UTILITIES -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 141010 -c -c Copyright (c) 2014 by Exponent, Inc. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c --- Coordinates -c subroutine xtractll -c --- Year 2000 -c subroutine yr4 -c subroutine yr4c -c subroutine qayr4 -c --- Date/Time -c subroutine julday -c subroutine grday -c subroutine dedat -c subroutine deltt -c subroutine incr -c subroutine indecr -c subroutine incrs -c subroutine deltsec -c subroutine midnite -c subroutine basrutc -c subroutine utcbasr -c --- Control file -c subroutine filcase -c subroutine readin -c subroutine altonu -c subroutine deblnk -c subroutine deplus -c subroutine tright -c subroutine tleft -c subroutine setvar -c subroutine allcap -c --- System -c subroutine datetm -c subroutine fmt_date -c subroutine etime -c subroutine undrflw -c subroutine comline -c --- Error -c subroutine open_err -c ----------------------------- -c -c --- UPDATE -c --- V2.6.0-V7.0.0 141010 :Add error-report for file-open -c New : OPEN_ERR -c --- V2.58-V2.6.0 140318(MBN):Use F95 intrinsic procedures for date and time. -c Modified: DATETM -c Removed obsolete Compaq, Microsoft, and HP -c compiler codes, and removed getcl -c Modified: COMLINE -c --- V2.571-V2.58 110225(DGS):Add variable type 5 to control file processor -c to allow character array variables -c Modified: READIN, ALTONU, SETVAR -c --- V2.57-V2.571 090511(DGS):Add routine to reformat a date string -c New : FMT_DATE -c --- V2.56-V2.57 090202(DGS): Increase control file line length to 200 -c characters -c Modified: PARAMS.CAL, READIN -c Activate CPU clock using F95 system routine -c Modified: DATETM -c --- V2.55-V2.56 080407(DGS): Exponential notation processing in ALTONU did -c not properly interpret an entry without a -c decimal point. -c --- V2.54-V2.55 070327(DGS): Format for output time zone stringin BASRUTC -c wrote zone zero as 'UTC+0 0' instead of -c 'UTC+0000' -c Add RETURN statement to BASRUTC and UTCBASR -c --- V2.53-V2.54 061020(DGS): Allow negative increments in INCRS -c --- V2.52-V2.53 060626(DGS): Remove routine GLOBE1 (move to COORDLIB) -c --- V2.51-V2.52 060519(DGS): Modify search for '=' in READIN to allow -c for blanks between c*12 variable name and -c the '=' sign (internal blanks are not removed -c after V2.2) -c --- V2.5-V2.51 051019 (KAM): Add Albers Conical Equal Area projection -c in GLOBE1 -c --- V2.4-V2.5 041123 (FRR): add subroutine BASRUTC to convert real -c base time zone to character UTC time zone -c and UTCBASR for the backward conversion -c --- V2.3-V2.4 041029 (DGS): Add routine INCRS to change time by a -c number of seconds -c Add routine MIDNITE - converts timestamp -c from day N, time 0000 -c to day N-1, time 2400 -c --- V2.2-V2.3 040330 (DGS): Replace filename strings c*70 with c*132 -c (FILCASE, COMLINE) -c Allow for spaces within pathnames by adding -c new TLEFT and TRIGHT trim subroutines -c --- V2.1-V2.2 030528 (DGS): Screen for valid UTM zone using -c absolute value (S. Hem. zones are -c negative) in GLOBE1 -c --- V2.0-V2.1 030402 (DGS): Remove routine GLOBE -c Split DEBLNK action (removes ' ', '+') -c into DEBLNK and DEPLUS -c Add routine UNDRFLW -c Add false Easting and Northing (GLOBE1) -c Add TYPE argument to XTRACTLL -c Change format XTRACTLL (f16) to (f16.0) -c --- V1.1-V2.0 021018 (DGS): Add routines for new COORDS -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input (YR4C) -c -c -c---------------------------------------------------------------------- - subroutine xtractll(io,type,clatlon,rlatlon) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 XTRACTLL -c D. Strimaitis EarthTech -c -c --- PURPOSE: Extract the real latitude or longitude from a character -c string that contains the N/S or E/W convention -c character, and express result as either North Latitude -c or East Longitude -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (010713) (DGS) -c - Add TYPE argument for QA -c - Change format (f16) to (f16.0) to satisfy different -c compilers -c -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c TYPE - char*4 - LAT or LON -c CLATLON - char*16 - Latitude or longitude (degrees), with -c 1 character that denotes convention -c (e.g. 'N 45.222' or '-35.999s') -c -c --- OUTPUT: -c RLATLON - real - North Latitude or East Longitude -c (degrees) -c -c --- XTRACTLL called by: (utility) -c --- XTRACTLL calls: DEBLNK, ALLCAP -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' - - character*1 cstor1(mxcol),cstor2(mxcol) - character*16 clatlon, clatlon2 - character*4 type - logical ltype - - ltype=.FALSE. - -c --- Initialize character variables for output - clatlon2=' ' - do i=1,20 - cstor2(i)=' ' - enddo - -c --- Was valid type provided? - if(type.NE.'LAT ' .AND. type.NE.'LON ') then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'Invalid type: ',type - write(io,*) 'Expected LAT or LON' - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Pass c*16 string into storage array 1 - do i=1,16 - cstor1(i)=clatlon(i:i) - enddo -c --- Pad out to position 20 - do i=17,20 - cstor1(i)=' ' - enddo - -c --- Remove blank characters from string, place in storage array 2 -c --- (Use a 20-character field here for a margin at end of string) - call DEBLNK(cstor1,1,20,cstor2,nlim) -c -c --- Convert lower case letters to upper case - call ALLCAP(cstor2,nlim) - -c --- Interpret valid convention character (N,S,E,W) - nchar=0 - ichar=0 - ilat=0 - ilon=0 - - do i=1,nlim - if(cstor2(i).EQ.'N') then - ilat=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'S') then - ilat=2 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'W') then - ilon=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'E') then - ilon=2 - ichar=i - nchar=nchar+1 - endif - enddo - -c --- Was 1 valid character found? - if(nchar.NE.1) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character is missing or repeated' - write(io,*) 'Lat/Lon = ',clatlon - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Was valid character the right type? - if(type.EQ.'LAT ' .AND. ilat.EQ.0) ltype=.TRUE. - if(type.EQ.'LON ' .AND. ilon.EQ.0) ltype=.TRUE. - if(LTYPE) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character does not match type' - write(io,*) 'Lat/Lon = ',clatlon - write(io,*) 'type = ',type - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Remove character from string - do i=ichar,nlim - cstor2(i)=cstor2(i+1) - enddo - -c --- Search for position of decimal point - ipt=0 - do i=1,nlim - if(cstor2(i).EQ.'.') ipt=i - enddo - -c --- Add a decimal point if needed - if(ipt.EQ.0) then - cstor2(nlim)='.' - endif - -c --- Pass resulting "number" back into c*16 variable - do i=1,nlim - clatlon2(i:i)=cstor2(i) - enddo - -c --- Get real part - read(clatlon2,'(f16.0)') rlatlon - -c --- Convert to either N. Lat. or E. Lon., if needed - if(ilat.EQ.2) then - rlatlon=-rlatlon - elseif(ilon.EQ.1) then - rlatlon=-rlatlon - endif - -c --- Condition longitude to be -180 to +180 - if(ilon.GT.0) then - if(rlatlon.GT.180.) then - rlatlon=rlatlon-360. - elseif(rlatlon.LT.-180.) then - rlatlon=rlatlon+360. - endif - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4(io,iyr,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 991104 YR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year (YYYY or YY) -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c --- YR4 called by: Input routines reading 'year' data -c --- YR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - - ierr=0 - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.iyylo) then - iyr=(icclo+1)*100+iyr - else - iyr=icclo*100+iyr - endif - else -c --- Year not recognized - ierr=1 - write(io,*)'ERROR in YR4 --- Year not recognized: ',iyr - write(*,*)'ERROR in YR4 --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4c(iyr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 020828 YR4C -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year (CURRENT) -c -c --- UPDATE -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input -c -c --- INPUTS: -c IYR - integer - Year (YYYY or YY) -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c -c --- YR4C called by: host subroutines -c --- YR4C calls: none -c---------------------------------------------------------------------- -c --- Set parameters for converting a current year (1999 - 2098) -c --- Use KCCLO as century digits for years GE KYYLO - data kyylo/99/, kcclo/19/ - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.kyylo) then - iyr=(kcclo+1)*100+iyr - else - iyr=kcclo*100+iyr - endif - else -c --- Year not recognized - write(*,*)'ERROR in YR4C --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine qayr4(io,iyr,metrun,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 991104 QAYR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Defines century and year markers to use in converting -c --- 2-digit year to 4-digit year -c --- The IBYR (YYYY) must be provided in the control file -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year provided for start of run -c METRUN - integer - Flag to run period in met file -c 0 = do not run period -c 1 = run period -c -c --- OUTPUT: -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- QAYR4 called by: host subroutines -c --- QAYR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - -c --- Sets parameters for the starting century marker (CC) and the -c --- 2-digit year (YY) used as the marker between the starting century -c --- and the next century. For example, if CC=19 and YY=30, then a -c --- year less than 30 (say 15) is assumed to be 2015. Any year -c --- greater than or equal to 30 (say 56) is assumed to be 1956. - -c --- Set number of years prior to start of simulation that must not -c --- be placed in the next century - data ibackyr/50/ - - ierr=0 - -c --- Expect explicit starting year (YYYY) -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) -c --- Back up IBACKYR years to set IYYLO - kyr=iyr-ibackyr -c --- Extract starting 2-digit century and 2-digit year - icclo=kyr/100 - iyylo=kyr-icclo*100 - -c --- Warn user that control file input is used to convert to YYYY - iyr1=icclo*100+iyylo - iyr2=(icclo+1)*100+iyylo-1 - write(io,*) - write(io,*)'-------------------------------------------------' - write(io,*)'NOTICE: Starting year in control file sets the' - write(io,*)' expected century for the simulation. All' - write(io,*)' YY years are converted to YYYY years in' - write(io,*)' the range: ',iyr1,iyr2 - write(io,*)'-------------------------------------------------' - write(io,*) - else - ierr=1 - write(*,*) - write(*,*)'--------------------------------------------' - write(*,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(*,*)' and must always be provided' - endif - write(*,*)'--------------------------------------------' - write(*,*) - write(io,*) - write(io,*)'-------------------------------------------' - write(io,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(io,*)' and must always be provided' - endif - write(io,*)'-------------------------------------------' - write(io,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine julday(io,iyr,imo,iday,ijuldy) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 000602 JULDAY -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the Julian day number from the Gregorian -c date (month, day) -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c -c --- OUTPUT: -c IJUL - integer - Julian day -c -c --- JULDAY called by: host subroutines -c --- JULDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12) - data kday/0,31,59,90,120,151,181,212,243,273,304,334/ -c -c --- Check for valid input data - ierr=0 -c --- Check for valid month - if(imo.lt.1.or.imo.gt.12)ierr=1 -c --- Check for valid day in 30-day months - if(imo.eq.4.or.imo.eq.6.or.imo.eq.9.or.imo.eq.11)then - if(iday.gt.30)ierr=1 - else if(imo.eq.2)then - if(mod(iyr,4).eq.0)then -c --- February in a leap year - if(iday.gt.29)ierr=1 - else -c --- February in a non-leap year - if(iday.gt.28)ierr=1 - endif - else -c --- Check for valid day in 31-day months - if(iday.gt.31)ierr=1 - endif -c - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. JULDAY' - write(io,*)'Invalid date - IYR = ',iyr,' IMO = ', - 1 imo,' IDAY = ',iday - write(*,*) - stop 'Halted in JULDAY -- see list file.' - endif -c -c --- Compute the Julian day - ijuldy=kday(imo)+iday - if(imo.le.2)return - if(mod(iyr,4).EQ.0)ijuldy=ijuldy+1 -c - return - end -c---------------------------------------------------------------------- - subroutine grday(io,iyr,ijul,imo,iday) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 000602 GRDAY -c J. Scire, SRC -c -c --- PURPOSE: Compute the Gregorian date (month, day) from the -c Julian day -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IJUL - integer - Julian day -c -c --- OUTPUT: -c IMO - integer - Month -c IDAY - integer - Day -c -c --- GRDAY called by: host subroutines -c --- GRDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12,2) - data kday/31,59,90,120,151,181,212,243,273,304,334,365, - 1 31,60,91,121,152,182,213,244,274,305,335,366/ -c -c - ileap=1 - if(mod(iyr,4).eq.0)ileap=2 - if(ijul.lt.1.or.ijul.gt.kday(12,ileap))go to 11 -c - do 10 i=1,12 - if(ijul.gt.kday(i,ileap))go to 10 - imo=i - iday=ijul - if(imo.ne.1)iday=ijul-kday(imo-1,ileap) - return -10 continue -c -11 continue - write(io,12)iyr,ijul -12 format(//2x,'ERROR in SUBR. GRDAY -- invalid Julian day '//2x, - 1 'iyr = ',i5,3x,'ijul = ',i5) - write(*,*) - stop 'Halted in GRDAY -- see list file.' - end -c------------------------------------------------------------------------------ - subroutine dedat(idathr,iyr,ijul,ihr) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 941215 DEDAT -c --- J. Scire, SRC -c -c --- Decode a date-time variable -c -c --- INPUTS: -c IDATHR - integer - Date-time variable (YYYYJJJHH) -c -c --- OUTPUT: -c IYR - integer - Year of precip. data (4 digits) -c IJUL - integer - Julian day number of precip. data -c IHR - integer - Ending hour (1-24) of precip. data -c -c --- DEDAT called by: host subroutines -c --- DEDAT calls: none -c------------------------------------------------------------------------------ -c -c --- decode date and time - iyr=idathr/100000 - ijul=idathr/100-iyr*1000 - ihr=idathr-iyr*100000-ijul*100 -c - return - end -c------------------------------------------------------------------------------ - subroutine deltt(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jleng) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 941215 DELTT -c --- J. Scire, SRC -c -c --- Compute the difference (in hours) between two dates & times -c --- (time #2 - time #1) -c -c --- INPUTS: -c J1YR - integer - Year of date/time #1 -c J1JUL - integer - Julian day of date/time #1 -c J1HR - integer - Hour of date/time #1 -c J2YR - integer - Year of date/time #2 -c J2JUL - integer - Julian day of date/time #2 -c J2HR - integer - Hour of date/time #2 -c -c --- OUTPUT: -c JLENG - integer - Difference (#2 - #1) in hours -c -c --- DELTT called by: host subroutines -c --- DELTT calls: none -c------------------------------------------------------------------------------ -c - jmin=min0(j1yr,j2yr) -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the first date/hour - if(j1yr.eq.jmin)then - j1=0 - else - j1=0 - j1yrm1=j1yr-1 - do 10 i=jmin,j1yrm1 - if(mod(i,4).eq.0)then - j1=j1+8784 - else - j1=j1+8760 - endif -10 continue - endif - j1=j1+(j1jul-1)*24+j1hr -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the second date/hour - if(j2yr.eq.jmin)then - j2=0 - else - j2=0 - j2yrm1=j2yr-1 - do 20 i=jmin,j2yrm1 - if(mod(i,4).eq.0)then - j2=j2+8784 - else - j2=j2+8760 - endif -20 continue - endif - j2=j2+(j2jul-1)*24+j2hr -c -c --- compute the time difference (in hours) - jleng=j2-j1 -c - return - end -c---------------------------------------------------------------------- - subroutine incr(io,iyr,ijul,ihr,nhrinc) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 000602 INCR -c J. Scire, SRC -c -c --- PURPOSE: Increment the time and date by "NHRINC" hours -c -c --- UPDATE -c --- 000602 (DGS): add message to "stop" -c --- 980304 (DGS): Allow for a negative "increment" of -c up to 24 hours -c --- 980304 (DGS): Allow for arbitrarily large nhrinc -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year -c IJUL - integer - Current Julian day -c IHR - integer - Current hour (00-23) -c NHRINC - integer - Time increment (hours) -c -c NOTE: "NHRINC" must >= -24 -c Hour is between 00-23 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c -c --- INCR called by: host subroutines -c --- INCR calls: none -c---------------------------------------------------------------------- -c -c --- Check nhrinc - if(nhrinc.lt.-24) then - write(io,*)'ERROR IN SUBR. INCR -- Invalid value of NHRINC ', - 1 '-- NHRINC = ',nhrinc - write(*,*) - stop 'Halted in INCR -- see list file.' - endif - -c --- Save increment remaining (needed if nhrinc > 8760) - nleft=nhrinc -c -c --- Process change in hour - if(nhrinc.gt.0)then -c -10 ninc=MIN0(nleft,8760) - nleft=nleft-ninc -c -c --- Increment time - ihr=ihr+ninc - if(ihr.le.23)return -c -c --- Increment day - ijul=ijul+ihr/24 - ihr=mod(ihr,24) -c -c --- ILEAP = 0 (non-leap year) or 1 (leap year) - if(mod(iyr,4).eq.0)then - ileap=1 - else - ileap=0 - endif -c - if(ijul.gt.365+ileap) then -c --- Update year - iyr=iyr+1 - ijul=ijul-(365+ileap) - endif -c -c --- Repeat if more hours need to be added - if(nleft.GT.0) goto 10 -c - elseif(nhrinc.lt.0)then -c --- Decrement time - ihr=ihr+nhrinc - if(ihr.lt.0)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - endif -c - return - end -c------------------------------------------------------------------------------ - subroutine indecr(io,iyr,ijul,ihr,idelt,ihrmin,ihrmax) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 7.0.0 Level: 961014 INDECR -c --- J. Scire, SRC -c -c --- Increment or decrement a date/time by "IDELT" hours -c --- (-24 <= IDELT <= 24) -c --- Allows specification of 0-23 or 1-24 hour clock -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Input Year -c IJUL - integer - Input Julian day -c IHR - integer - Input hour (ihrmin <= IHR <= ihrmax) -c IDELT - integer - Change in time (hours) -- must be -c between -24 to +24, inclusive -c IHRMIN - integer - Minimum hour (i.e., either 0 or 1) -c IHRMAX - integer - Maximum hour (i.e., either 23 or 24) -c -c --- OUTPUT: -c IYR - integer - Year after change of "IDELT" hours -c IJUL - integer - Julian day after change of "IDELT" hours -c IHR - integer - Hour after change of "IDELT" hours -c -c --- INDECR called by: host subroutines -c --- INDECR calls: none -c------------------------------------------------------------------------------ -c - if(iabs(idelt).gt.24)then - write(io,10)'IDELT',iyr,ijul,ihr,idelt,ihrmin,ihrmax -10 format(/1x,'ERROR in subr. INDECR -- invalid "',a,'" -- ', - 1 ' iyr,ijul,ihr,idelt,ihrmin,ihrmax = ',6i10) - write(*,987) -987 format(1x,'ERROR in run - see the .LST file') - stop - endif - if(ihr.lt.ihrmin.or.ihr.gt.ihrmax)then - write(io,10)'IHR',iyr,ijul,ihr,idelt,ihrmin,ihrmax - write(*,987) - stop - endif -c - if(idelt.lt.0)then -c --- idelt is negative - ihr=ihr+idelt - if(ihr.lt.ihrmin)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - else -c --- idelt is positive or zero - ihr=ihr+idelt - if(ihr.gt.ihrmax)then - ihr=ihr-24 - ijul=ijul+1 - if(mod(iyr,4).eq.0)then - ndays=366 - else - ndays=365 - endif - if(ijul.gt.ndays)then - ijul=1 - iyr=iyr+1 - endif - endif - endif -c - return - end -c---------------------------------------------------------------------- - subroutine incrs(io,iyr,ijul,ihr,isec,nsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 061020 INCRS -c D. Strimaitis, EARTH TECH -c -c --- PURPOSE: Increment the time and date by "NSEC" seconds -c -c --- UPDATE -c --- V2.54 (061020) from V2.4 (041029) (DGS) -c - Allow negative increment -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year (YYYY) -c IJUL - integer - Current Julian day (JJJ) -c IHR - integer - Current hour (00-23) -c ISEC - integer - Current second (0000-3599) -c NSEC - integer - Time increment (seconds) -c Parameters: IO6 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c ISEC - integer - Updated seconds (0000-3599) -c -c --- INCRS called by: host subroutines -c --- INCRS calls: INCR -c---------------------------------------------------------------------- - - if(nsec.GE.0) then -c --- Increment seconds - isec=isec+nsec - if(isec.GE.3600) then - nhrinc=isec/3600 - isec=MOD(isec,3600) - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - - else -c --- Decrement seconds - isec=isec+nsec - if(isec.LT.0) then -c --- Earlier hour - ksec=-isec - if(ksec.GE.3600) then -c --- Back up at least 1 hour - nhrinc=ksec/3600 - ksec=MOD(ksec,3600) - nhrinc=-nhrinc - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - isec=-ksec - if(isec.LT.0) then -c --- Back up 1 more hour - nhrinc=-1 - isec=3600+isec - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - endif - - endif - - return - end -c---------------------------------------------------------------------- - subroutine deltsec(ndhrb,nsecb,ndhre,nsece,ndelsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 041029 DELTSEC -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Compute the difference (in seconds) between two dates & -c times (timeE - timeB) -c -c --- INPUTS: -c NDHRB - integer - Beginning year & hour (YYYYJJJHH) -c NSECB - integer - Beginning second (SSSS) -c NDHRE - integer - Ending year & hour (YYYYJJJHH) -c NSECE - integer - Ending second (SSSS) -c -c --- OUTPUT: -c NDELSEC - integer - Length of interval (seconds) -c -c --- DELTSEC called by: host subroutines -c --- DELTSEC calls: DELTT -c---------------------------------------------------------------------- -c -c --- Extract year, Julian day, and hour from date-time variables -c --- Beginning - j1yr=ndhrb/100000 - iyyjjj=ndhrb/100 - j1jul=iyyjjj-j1yr*1000 - j1hr=ndhrb-iyyjjj*100 -c --- Ending - j2yr=ndhre/100000 - iyyjjj=ndhre/100 - j2jul=iyyjjj-j2yr*1000 - j2hr=ndhre-iyyjjj*100 - -c --- Find difference between hours (in seconds) - call DELTT(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jdelhr) - ndelsec=jdelhr*3600 - -c --- Add difference between seconds - ndelsec=ndelsec+(nsece-nsecb) - - return - end -c---------------------------------------------------------------------- - subroutine midnite(io,ctrans,iyr,imo,iday,ijul, - & kyr,kmo,kday,kjul) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 041029 MIDNITE -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Converts date/time at midnight between day N, 0000 -c and day N-1, 2400. Direction is determined by the -c CTRANS instruction. -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c CTRANS - character - Instruction 'TO 24h' or 'TO 00h' -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c IJUL - integer - Julian day -c -c --- OUTPUT: -c KYR - integer - Year -c KMO - integer - Month -c KDAY - integer - Day -c KJUL - integer - Julian day -c -c --- MIDNITE called by: host subroutines -c --- MIDNITE calls: JULDAY, INCR, GRDAY -c---------------------------------------------------------------------- - character*6 ctrans - - ierr =0 - -c --- Get Julian day from month/day if needed - if(ijul.LE.0) call JULDAY(io,iyr,imo,iday,ijul) - - kyr=iyr - kmo=imo - kday=iday - kjul=ijul - - if(ctrans.EQ.'TO 24h') then -c --- Convert from 0000 on ijul to 2400 on kjul - ihr=0 - nhr=-1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - elseif(ctrans.EQ.'TO 00h') then -c --- Convert from 2400 on ijul to 0000 on kjul - ihr=23 - nhr=1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - else - ierr=1 - endif - - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. MIDNITE' - write(io,*)'Invalid instruction: ',ctrans - write(io,*)' Expected: TO 24h' - write(io,*)' OR : TO 00h' - write(*,*) - stop 'Halted in MIDNITE -- see list file.' - endif - - return - end -c---------------------------------------------------------------------- - subroutine utcbasr(axtz,xbtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 070327 UTCBASR -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts character string UTC time zone -c to real base time zone -c -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Add RETURN statement -c -c --- INPUT: -c AXTZ - char*8 - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c --- OUTPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) -c -c --- UTCBASR called by: host subroutines -c --- UTCBASR calls: none -c---------------------------------------------------------------------- - character*8 axtz - - read(axtz(4:6),'(i3)')ihr - read(axtz(7:8),'(i2)')imin - if(ihr.lt.0)imin=-imin - - xbtz=ihr+imin/60. - -c --- Flip sign as base time convention is opposite UTC/GMT - xbtz=-xbtz - - return - end -c---------------------------------------------------------------------- - subroutine basrutc(xbtz,axtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 070327 BASRUTC -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts real base time zone to character string -c UTC time zone -c -c --- UPDATE -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Fix output format of time zone string for zone=0 -c - Add RETURN statement -c -c --- INPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) - -c --- OUTPUT: -c AXTZ - real - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c -c --- BASRUTC called by: host subroutines -c --- BASRUTC calls: none -c---------------------------------------------------------------------- - character*8 axtz - - ixbtz=int(xbtz) -c convert fractional real to minutes - imin=(xbtz-ixbtz)*60 - ixbtz=ixbtz*100+imin - -c --- Define time as "UTC-HHMM" (hours/minutes) - axtz(1:3)="UTC" - -c --- Flip sign as base time zone is minus UTC zone - if (xbtz.gt.0.) then - axtz(4:4)="-" - else - axtz(4:4)="+" - endif -c --- Make sure time zone is written as 4 digits - write(axtz(5:8),'(i4.4)')abs(ixbtz) - - return - end -c---------------------------------------------------------------------- - subroutine filcase(lcfiles,cfile) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 FILCASE -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all characters within a file name to lower -c case (if LCFILES=T) or UPPER CASE (if LCFILES=F). -c -c --- UPDATE -c --- V2.2 (950610) to V2.3 (040330) DGS -c - Replace filename strings c*70 with c*132 -c -c --- INPUTS: -c -c LCFILES - logical - Switch indicating if all characters in the -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c CASE letters (LCFILES=F). -c CFILE - char*132- Input character string -c -c --- OUTPUT: -c -c CFILE - char*132- Output character string with -c letters converted -c -c --- FILCASE called by: READFN -c --- FILCASE calls: none -c---------------------------------------------------------------------- -c - character*132 cfile - character*1 cchar,clc(29),cuc(29) - logical lcfiles -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - if(lcfiles)then -c -c --- Convert file name to lower case letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.cuc(j))then - cfile(i:i)=clc(j) - go to 52 - endif - enddo -52 continue - enddo - else -c -c --- Convert file name to UPPER CASE letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.clc(j))then - cfile(i:i)=cuc(j) - go to 62 - endif - enddo -62 continue - enddo - endif -c - return - end -c---------------------------------------------------------------------- - subroutine readin(cvdic,ivleng,ivtype,ioin,ioout,lecho, - 1 i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15,i16,i17,i18, - 2 i19,i20,i21,i22,i23,i24,i25,i26,i27,i28,i29,i30,i31,i32,i33,i34, - 3 i35,i36,i37,i38,i39,i40,i41,i42,i43,i44,i45,i46,i47,i48,i49,i50, - 4 i51,i52,i53,i54,i55,i56,i57,i58,i59,i60) -c---------------------------------------------------------------------- -c *** Change number of characters in line from 150 to 200 *** -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 110225 READIN -c J. Scire -c -c --- PURPOSE: Read one input group of the free formatted control -c file -- allows comments within the input file -- -c ignores all text except that within delimiters -c -c --- NOTE: All variables (real, integer, logical, -c or character) must be 4 bytes -c --- NOTE: Character*4 array uses only one character -c per word -- it must be dimensioned large -c enough to accommodate the number of characters -c in the variable field -c -c --- UPDATE -c --- V2.58 (110225) from V2.57 (090202) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.57 (090202) from V2.52 (060519) (DGS) -c - Increase max line length from 150 to 200 -c (requires MXCOL=200) -c --- V2.52 (060519) from V2.3 (040330) (DGS) -c - Search for '=' beyond position 14 because blanks are -c not automatically removed within string -c --- V2.3 (040330) from V2.1 (030402) (DGS) -c - Preserve spaces within character variables -c --- V2.1 (030402) from V2.0 (000602) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c -c --- INPUTS: -c -c CVDIC(mxvar) - character*12 array - Variable dictionary -c containing up to "MXVAR" -c variable names -c IVLENG(mxvar) - integer array - Dimension of each variable -c (dim. of scalars = 1) -c IVTYPE(mxvar) - integer array - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c IOIN - integer - Fortran unit of control file -c input -c IOOUT - integer - Fortran unit of list file -c output -c LECHO - logical - Control variable determining -c if input data are echoed to -c list file (IOOUT) -c Parameters: MXVAR, MXCOL -c -c --- OUTPUT: -c -c I1, I2, ... - integer arrays - Variables being read -c (integer array locally, but can be a real, -c integer, logical, or character*4 array in -c the calling routine) -c -c --- READIN called by: host subroutines -c --- READIN calls: DEBLNK, ALTONU, SETVAR, ALLCAP, DEPLUS, -c TRIGHT, TLEFT -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - integer*4 i1(*),i2(*),i3(*),i4(*),i5(*),i6(*),i7(*),i8(*),i9(*), - 1 i10(*),i11(*),i12(*),i13(*),i14(*),i15(*),i16(*),i17(*),i18(*), - 2 i19(*),i20(*),i21(*),i22(*),i23(*),i24(*),i25(*),i26(*),i27(*), - 3 i28(*),i29(*),i30(*),i31(*),i32(*),i33(*),i34(*),i35(*),i36(*), - 4 i37(*),i38(*),i39(*),i40(*),i41(*),i42(*),i43(*),i44(*),i45(*), - 5 i46(*),i47(*),i48(*),i49(*),i50(*),i51(*),i52(*),i53(*),i54(*), - 6 i55(*),i56(*),i57(*),i58(*),i59(*),i60(*) - integer*4 ivleng(mxvar),jdex(mxvar),ivtype(mxvar) -c - logical*4 lv - logical lecho -c - character*12 cvdic(mxvar),cvar,cblank - character*4 cv(mxcol) - character*1 cstor1(mxcol),cstor2(mxcol) -c --- Intermediate scratch arrays - character*1 cstor3(mxcol),cstor4(mxcol) - character*1 cdelim,ceqls,ce,cn,cd,comma,cblnk -c - data cblank/' '/ - data cdelim/'!'/,ceqls/'='/,ce/'E'/,cn/'N'/,cd/'D'/,comma/','/ - data cblnk/' '/ -c - ilim2=99 - do 2 i=1,mxvar - jdex(i)=1 -2 continue -c -c --- begin loop over lines -c -c --- read a line of input -5 continue - read(ioin,10)cstor1 -10 format(200a1) - if(lecho)write(ioout,7)cstor1 -7 format(1x,200a1) -c -c --- check if this is a continuation line - if(ilim2.gt.0)go to 16 -c -c --- continuation line -- find the second delimiter - do 12 i=1,mxcol - if(cstor1(i).eq.cdelim)then - ilim2=i - go to 14 - endif -12 continue -14 continue - il2=ilim2 - if(il2.eq.0)il2=mxcol -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blank characters from string within delimiters -c call deblnk(cstor1,1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- -c --- Remove blank characters on right side - call TRIGHT(cstor1,1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- - icom=0 -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) - go to 55 -c -16 continue - ibs=1 -c -c --- begin loop over delimiter pairs -17 continue - if(ibs.ge.mxcol)go to 5 -c -c --- find location of delimiters - do 20 i=ibs,mxcol - if(cstor1(i).eq.cdelim)then - ilim1=i - if(ilim1.eq.mxcol)go to 22 - ip1=ilim1+1 - do 18 j=ip1,mxcol - if(cstor1(j).eq.cdelim)then - ilim2=j - go to 22 - endif -18 continue -c -c --- second delimiter not on this line - ilim2=0 - go to 22 - endif -20 continue -c -c --- no delimiters found -- skip line and read next line of text - go to 5 -22 continue - ibs=ilim2+1 - if(ilim2.eq.0)ibs=mxcol+1 -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blanks from string within delimiters -c il2=ilim2 -c if(il2.eq.0)il2=mxcol -c call deblnk(cstor1,ilim1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- - il2=ilim2 - if(il2.eq.0)il2=mxcol -c --- Remove blank characters on right side - call TRIGHT(cstor1,ilim1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) -c -c --- search for equals sign (cstor2(1) is delimiter; cstor2(2) is -c --- first letter of variable; cstor2(3) is earliest '=' can occur) -c --- (060519) Search entire string as now there may be blanks before '=' -c do 30 i=3,14 - do 30 i=3,nlim - if(cstor2(i).eq.ceqls)then - ieq=i - go to 32 - endif -30 continue -c -c --- "END" within delimiters signifies the end of the read for -c --- this input group - if(cstor2(2).eq.ce.and.cstor2(3).eq.cn.and.cstor2(4).eq.cd)return - write(ioout,31)(cstor2(n),n=1,nlim) -31 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable too long (Equals sign not found in string) -- ', - 2 'CSTOR2 = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- CVAR is character*12 variable name -32 continue - cvar=cblank - ieqm1=ieq-1 -c --- Grab string to left of '=', and remove blanks - call deblnk(cstor2,1,ieqm1,cstor3,keqm1) -c --- Pass string to variable name - do 40 i=2,keqm1 - il=i-1 - cvar(il:il)=cstor3(i) -40 continue -c -c --- find the variable name in the variable dictionary - do 50 i=1,mxvar - if(cvar.eq.cvdic(i))then - nvar=i - go to 52 - endif -50 continue - write(ioout,51)cvar,(cvdic(n),n=1,mxvar) -51 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable not found in variable dictionary'/ - 2 1x,'Variable: ',a12/ - 3 1x,'Variable Dictionary: ',9(a12,1x)/ - 4 10(22x,9(a12,1x)/)) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -52 continue -c --- Assign current variable type - itype=ivtype(nvar) -c -c --- Check for invalid value of variable type - if(itype.le.0.or.itype.ge.6)then - write(ioout,53)itype,nvar,ivtype(nvar),cvdic(nvar) -53 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Invalid value of variable type -- ITYPE must be 1, 2, 3, ', - 2 '4, or 5'/1x,'ITYPE = ',i10/1x,'NVAR = ',i10/1x, - 3 'IVTYPE(nvar) = ',i10/1x,'CVDIC(nvar) = ',a12) - write(*,*) - stop 'Halted in READIN -- see list file.' - endif -c -c --- search for comma - icom=ieq -c -c --- beginning of loop over values within delimiters -55 continue - ivb=icom+1 -c -c --- if reaches end of line, read next line - if(ivb.gt.nlim)go to 5 - do 60 i=ivb,nlim - if(cstor2(i).eq.comma)then - icom=i - go to 64 - endif -60 continue -c -c --- no comma found - icom=0 - ive=nlim-1 -c -c --- comma between last value and delimiter is allowed - if(cstor2(ivb).eq.cdelim.and.cstor2(ive).eq.comma)go to 17 -c -c --- if no comma & last non-blank character is not a delimiter, -c --- then the input is in error - if(cstor2(nlim).eq.cdelim)go to 66 - write(ioout,63)cstor1 -63 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'If a string within delimiters covers more than one line, ', - 2 'the last character in the line must be a comma'/ - 3 1x,'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -64 continue -c -c --- value of variable is contained in elements IVB to IVE of -c --- CSTOR2 array -c --- Include comma for variable type 5 (character array) so that it -c --- can be used outside of READIN to parse the array values from the -c --- single string that is returned - if(itype.EQ.5) then - ive=icom - else - ive=icom-1 - endif -66 continue -c ncar=ive-ivb+1 - index=jdex(nvar) -c -c --- Convert character string to numeric or logical value -c (if ITYPE = 1,2, or 3) -- If 4 or 5 transfer characters to the -c work array CV) - -c --- Remove all blanks from variable string if type is numeric or -c --- logical; otherwise, trim left and right side of string - if(itype.LT.4) then - call deblnk(cstor2,ivb,ive,cstor4,nv) -c --- Remove '+' characters as well (is this needed?) - if(nv.gt.0) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call deplus(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - else -c --- Pass variable string into cstor4 - nv=ive-ivb+1 - do k=1,nv - cstor4(k)=cstor2(ivb+k-1) - enddo - do k=nv+1,mxcol - cstor4(k)=cblnk - enddo -c --- Remove blank characters on right side of character variable -c --- if last character is either a blank or comma - if(cstor4(nv).EQ.cblnk .OR. - & cstor4(nv).EQ.comma) call TRIGHT(cstor2,ivb,ive,cstor4,nv) -c --- Remove blank characters on left side of character variable - if(nv.GT.0 .AND. cstor4(1).EQ.cblnk) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call TLEFT(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - endif -c -c --- check that array bounds are not exceeded - if(index+irep-1.gt.ivleng(nvar))go to 201 -c - go to (101,102,103,104,105,106,107,108,109,110,111,112,113,114, - 1 115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130, - 2 131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146, - 3 147,148,149,150,151,152,153,154,155,156,157,158,159,160),nvar -c -c --- code currently set up to handle up to 60 variables/source group - write(ioout,71)nvar,(cstor2(n),n=1,nlim) -71 format(/1x,'ERROR IN SUBR. READIN -- Current code ', - 1 'configuration allows up to 60 variables per source group'/ - 2 1x,'No. variables (NVAR) = ',i10/ - 3 1x,'Input data (CSTOR2) = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- transfer value into output variable -101 continue - call setvar(itype,irep,rlno,ino,lv,cv,i1(index),i1(index), - 1 i1(index),i1(index)) - go to 161 -102 continue - call setvar(itype,irep,rlno,ino,lv,cv,i2(index),i2(index), - 1 i2(index),i2(index)) - go to 161 -103 continue - call setvar(itype,irep,rlno,ino,lv,cv,i3(index),i3(index), - 1 i3(index),i3(index)) - go to 161 -104 continue - call setvar(itype,irep,rlno,ino,lv,cv,i4(index),i4(index), - 1 i4(index),i4(index)) - go to 161 -105 continue - call setvar(itype,irep,rlno,ino,lv,cv,i5(index),i5(index), - 1 i5(index),i5(index)) - go to 161 -106 continue - call setvar(itype,irep,rlno,ino,lv,cv,i6(index),i6(index), - 1 i6(index),i6(index)) - go to 161 -107 continue - call setvar(itype,irep,rlno,ino,lv,cv,i7(index),i7(index), - 1 i7(index),i7(index)) - go to 161 -108 continue - call setvar(itype,irep,rlno,ino,lv,cv,i8(index),i8(index), - 1 i8(index),i8(index)) - go to 161 -109 continue - call setvar(itype,irep,rlno,ino,lv,cv,i9(index),i9(index), - 1 i9(index),i9(index)) - go to 161 -110 continue - call setvar(itype,irep,rlno,ino,lv,cv,i10(index),i10(index), - 1 i10(index),i10(index)) - go to 161 -111 continue - call setvar(itype,irep,rlno,ino,lv,cv,i11(index),i11(index), - 1 i11(index),i11(index)) - go to 161 -112 continue - call setvar(itype,irep,rlno,ino,lv,cv,i12(index),i12(index), - 1 i12(index),i12(index)) - go to 161 -113 continue - call setvar(itype,irep,rlno,ino,lv,cv,i13(index),i13(index), - 1 i13(index),i13(index)) - go to 161 -114 continue - call setvar(itype,irep,rlno,ino,lv,cv,i14(index),i14(index), - 1 i14(index),i14(index)) - go to 161 -115 continue - call setvar(itype,irep,rlno,ino,lv,cv,i15(index),i15(index), - 1 i15(index),i15(index)) - go to 161 -116 continue - call setvar(itype,irep,rlno,ino,lv,cv,i16(index),i16(index), - 1 i16(index),i16(index)) - go to 161 -117 continue - call setvar(itype,irep,rlno,ino,lv,cv,i17(index),i17(index), - 1 i17(index),i17(index)) - go to 161 -118 continue - call setvar(itype,irep,rlno,ino,lv,cv,i18(index),i18(index), - 1 i18(index),i18(index)) - go to 161 -119 continue - call setvar(itype,irep,rlno,ino,lv,cv,i19(index),i19(index), - 1 i19(index),i19(index)) - go to 161 -120 continue - call setvar(itype,irep,rlno,ino,lv,cv,i20(index),i20(index), - 1 i20(index),i20(index)) - go to 161 -121 continue - call setvar(itype,irep,rlno,ino,lv,cv,i21(index),i21(index), - 1 i21(index),i21(index)) - go to 161 -122 continue - call setvar(itype,irep,rlno,ino,lv,cv,i22(index),i22(index), - 1 i22(index),i22(index)) - go to 161 -123 continue - call setvar(itype,irep,rlno,ino,lv,cv,i23(index),i23(index), - 1 i23(index),i23(index)) - go to 161 -124 continue - call setvar(itype,irep,rlno,ino,lv,cv,i24(index),i24(index), - 1 i24(index),i24(index)) - go to 161 -125 continue - call setvar(itype,irep,rlno,ino,lv,cv,i25(index),i25(index), - 1 i25(index),i25(index)) - go to 161 -126 continue - call setvar(itype,irep,rlno,ino,lv,cv,i26(index),i26(index), - 1 i26(index),i26(index)) - go to 161 -127 continue - call setvar(itype,irep,rlno,ino,lv,cv,i27(index),i27(index), - 1 i27(index),i27(index)) - go to 161 -128 continue - call setvar(itype,irep,rlno,ino,lv,cv,i28(index),i28(index), - 1 i28(index),i28(index)) - go to 161 -129 continue - call setvar(itype,irep,rlno,ino,lv,cv,i29(index),i29(index), - 1 i29(index),i29(index)) - go to 161 -130 continue - call setvar(itype,irep,rlno,ino,lv,cv,i30(index),i30(index), - 1 i30(index),i30(index)) - go to 161 -131 continue - call setvar(itype,irep,rlno,ino,lv,cv,i31(index),i31(index), - 1 i31(index),i31(index)) - go to 161 -132 continue - call setvar(itype,irep,rlno,ino,lv,cv,i32(index),i32(index), - 1 i32(index),i32(index)) - go to 161 -133 continue - call setvar(itype,irep,rlno,ino,lv,cv,i33(index),i33(index), - 1 i33(index),i33(index)) - go to 161 -134 continue - call setvar(itype,irep,rlno,ino,lv,cv,i34(index),i34(index), - 1 i34(index),i34(index)) - go to 161 -135 continue - call setvar(itype,irep,rlno,ino,lv,cv,i35(index),i35(index), - 1 i35(index),i35(index)) - go to 161 -136 continue - call setvar(itype,irep,rlno,ino,lv,cv,i36(index),i36(index), - 1 i36(index),i36(index)) - go to 161 -137 continue - call setvar(itype,irep,rlno,ino,lv,cv,i37(index),i37(index), - 1 i37(index),i37(index)) - go to 161 -138 continue - call setvar(itype,irep,rlno,ino,lv,cv,i38(index),i38(index), - 1 i38(index),i38(index)) - go to 161 -139 continue - call setvar(itype,irep,rlno,ino,lv,cv,i39(index),i39(index), - 1 i39(index),i39(index)) - go to 161 -140 continue - call setvar(itype,irep,rlno,ino,lv,cv,i40(index),i40(index), - 1 i40(index),i40(index)) - go to 161 -141 continue - call setvar(itype,irep,rlno,ino,lv,cv,i41(index),i41(index), - 1 i41(index),i41(index)) - go to 161 -142 continue - call setvar(itype,irep,rlno,ino,lv,cv,i42(index),i42(index), - 1 i42(index),i42(index)) - go to 161 -143 continue - call setvar(itype,irep,rlno,ino,lv,cv,i43(index),i43(index), - 1 i43(index),i43(index)) - go to 161 -144 continue - call setvar(itype,irep,rlno,ino,lv,cv,i44(index),i44(index), - 1 i44(index),i44(index)) - go to 161 -145 continue - call setvar(itype,irep,rlno,ino,lv,cv,i45(index),i45(index), - 1 i45(index),i45(index)) - go to 161 -146 continue - call setvar(itype,irep,rlno,ino,lv,cv,i46(index),i46(index), - 1 i46(index),i46(index)) - go to 161 -147 continue - call setvar(itype,irep,rlno,ino,lv,cv,i47(index),i47(index), - 1 i47(index),i47(index)) - go to 161 -148 continue - call setvar(itype,irep,rlno,ino,lv,cv,i48(index),i48(index), - 1 i48(index),i48(index)) - go to 161 -149 continue - call setvar(itype,irep,rlno,ino,lv,cv,i49(index),i49(index), - 1 i49(index),i49(index)) - go to 161 -150 continue - call setvar(itype,irep,rlno,ino,lv,cv,i50(index),i50(index), - 1 i50(index),i50(index)) - go to 161 -151 continue - call setvar(itype,irep,rlno,ino,lv,cv,i51(index),i51(index), - 1 i51(index),i51(index)) - go to 161 -152 continue - call setvar(itype,irep,rlno,ino,lv,cv,i52(index),i52(index), - 1 i52(index),i52(index)) - go to 161 -153 continue - call setvar(itype,irep,rlno,ino,lv,cv,i53(index),i53(index), - 1 i53(index),i53(index)) - go to 161 -154 continue - call setvar(itype,irep,rlno,ino,lv,cv,i54(index),i54(index), - 1 i54(index),i54(index)) - go to 161 -155 continue - call setvar(itype,irep,rlno,ino,lv,cv,i55(index),i55(index), - 1 i55(index),i55(index)) - go to 161 -156 continue - call setvar(itype,irep,rlno,ino,lv,cv,i56(index),i56(index), - 1 i56(index),i56(index)) - go to 161 -157 continue - call setvar(itype,irep,rlno,ino,lv,cv,i57(index),i57(index), - 1 i57(index),i57(index)) - go to 161 -158 continue - call setvar(itype,irep,rlno,ino,lv,cv,i58(index),i58(index), - 1 i58(index),i58(index)) - go to 161 -159 continue - call setvar(itype,irep,rlno,ino,lv,cv,i59(index),i59(index), - 1 i59(index),i59(index)) - go to 161 -160 continue - call setvar(itype,irep,rlno,ino,lv,cv,i60(index),i60(index), - 1 i60(index),i60(index)) -c -161 continue - jdex(nvar)=jdex(nvar)+irep -c -c --- continue reading values for this array until array is filled -c --- or delimiter is reached - if(icom.ne.0.and.jdex(nvar).le.ivleng(nvar))go to 55 - go to 17 -201 continue - iatt=index+irep-1 - write(ioout,202)cvdic(nvar),ivleng(nvar),iatt,cstor1 -202 format(/1x,'ERROR IN SUBR. READIN -- Error in input data', - 1 1x,'Array bounds exceeded -- Variable: ',a12,3x,' Declared ', - 2 'dimension = ',i8/1x,'Input attempted to element ',i8/1x, - 3 'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' - end -c---------------------------------------------------------------------- - subroutine altonu(ioout,alp,ncar,itype,irep,rlno,ino,lv,cv) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 110225 ALTONU -c --- J. Scire -c -c --- PURPOSE: Convert a character string into a real, integer or -c logical variable -- also compute the repetition factor -c for the variable -c -c --- UPDATES -c --- V2.58 (110225) from V2.56 (080407) (DGS) -c - Add ITYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.56 (080407) from V1.0 (000602) (DGS) -c - Treat case in which exponential notation is used -c without a decimal point. Pointer had been left at -c 'zero' which placed the decimal location in front of -c a number so that 2e02 became 0.2e02 instead of 2.0e02 -c - Trap case where no number appears in front the E or D -c in exponential notation -c -c --- 000602 (DGS): add message to "stop" -c -c --- INPUTS: -c IOOUT - integer - Fortran unit of list file -c output -c ALP(ncar) - character*1 array - Characters to be converted -c NCAR - integer - Number of characters -c ITYPE - integer - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c -c Parameter: MXCOL -c -c --- OUTPUT: -c IREP - integer - Repetition factor for value -c RLNO - real - Real variable produced from -c character string -c INO - integer - Integer variable produced from -c character string -c LV - logical*4 - Logical variable produced from -c character string -c CV(mxcol) - character*4 - Character*4 variable produced -c from character string -c (NOTE: Only 1 (NOT 4) -c character(s) per word) -c -c --- ALTONU called by: READIN -c --- ALTONU calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real*8 rno,xmult,ten - integer num2(mxcol) - logical*4 lv - character*4 cv(mxcol) - character*1 alp(ncar),alpsv,ad(17),astar,adec -c - data ad/'0','1','2','3','4','5','6','7','8','9','-', -c --- num2 = 0 1 2 3 4 5 6 7 8 9 11 - 1 '*','.','E','D','T','F'/ -c --- num2 = 12 13 14 15 16 17 - data astar/'*'/,adec/'.'/,ten/10.0d0/ -c -c --- If dealing with a character*4 variable, transfer characters -c into the work array CV (ONE character per 4-byte word) - if(itype.eq.4 .OR. itype.eq.5)then - do 5 i=1,ncar - cv(i)(1:1)=alp(i) -5 continue -c -c --- NOTE: Repetition factor refers to the number of -c characters in the field, if ITYPE = 4, 5 - irep=ncar - return - endif -c -c --- Convert character array elements into numeric codes - do 30 i=1,ncar - alpsv=alp(i) - do 20 j=1,17 - if(alpsv.eq.ad(j))then - num2(i)=j - if(j.lt.11)num2(i)=j-1 - go to 30 - endif -20 continue - write(ioout,21)(alp(n),n=1,ncar) -21 format(/1x,'ERROR IN SUBR. ALTONU -- Unrecognizable character ', - 1 'in input -- Character string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -30 continue -c -c --- Locally classify variable type (1=real, 2=integer, 3=logical) - do 40 i=1,ncar - if(num2(i).le.12)go to 40 - if(num2(i).ge.16)then -c -c --- logical variable ("T", "F") - jtype=3 - go to 41 - else -c -c --- real variable (".", "E", "D") - jtype=1 - go to 41 - endif -40 continue -c -c --- integer variable - jtype=2 -41 continue -c -c --- determine if repetition factor "*" is used - do 50 i=1,ncar - if(alp(i).eq.astar)then - istar=i - go to 51 - endif -50 continue - istar=0 -51 continue - if(istar.ne.0)go to 400 - irep=1 - go to (101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) -55 format(/1x,'ERROR IN SUBR. ALTONU -- JTYPE must be 1, 2, or 3 ', - 1 '-- JTYPE = ',i3/3x,'Text string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- REAL number w/o "*" -c -------------------------------------------------------------------- -c --- Determine sign -- ISTAR is position of array containing "*" -c (ISTAR = 0 if no repetition factor) -101 continue - if(num2(1+istar).eq.11)then - isgn=-1 - istart=istar+2 - else - isgn=1 - istart=istar+1 - endif -c -c --- Locate decimal point - idec=0 - do 109 i=istart,ncar - if(alp(i).eq.adec)then - if(idec.eq.0)then - idec=i - go to 109 - endif -c -c --- More than one decimal point found - write(ioout,120)(alp(n),n=1,ncar) -120 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid real variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif -109 continue -c -c --- Search for E or D - do 110 i=istart,ncar - if(num2(i).eq.14.or.num2(i).eq.15)then - istop=i-1 - go to 111 - endif -110 continue - istop=ncar -111 continue - -c --- 080407 Update: -c --- Correct for missing decimal point before decoding - if(idec.EQ.0) idec=istop+1 -c --- Trap missing number in front of E,D - if(istop.LT.1 .OR. istart.GT.istop) then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - write(*,*)'Missing number!' - stop 'Halted in ALTONU -- see list file.' - endif -c -c --- Convert integer numerics to real number - rno=0.0 - do 130 i=istart,istop - if(i.eq.idec)go to 130 - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=idec-i - if(iexp.gt.0)iexp=iexp-1 - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rno=rno+xmult*num2(i) - -130 continue -c -c --- Account for minus sign (if present) - rno=isgn*rno - rlno=rno -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - if(istop.eq.ncar)return -c -c --- Find exponent (istop+1 is position in array containing E or D) - isgn=1 - istart=istop+2 - if(num2(istart).ne.11)go to 135 - isgn=-1 - istart=istart+1 -135 continue - if(istart.gt.ncar)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - rexp=0.0 - do 140 i=istart,ncar - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=ncar-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rexp=rexp+xmult*num2(i) -140 continue - xmult=1.0 - if(rexp.ne.0.0)xmult=ten**(isgn*rexp) - rno=rno*xmult - rlno=rno -c -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - return -c -c -------------------------------------------------------------------- -c --- INTEGER variables -c -------------------------------------------------------------------- -201 continue - if(num2(1+istar).ne.11)go to 228 - isgn=-1 - istart=istar+2 - go to 229 -228 continue - isgn=1 - istart=istar+1 -229 continue - ino=0 - do 230 i=istart,ncar - if(num2(i).ge.10)go to 208 - iexp=ncar-i - xmult=1.0 - if(iexp.ne.10)xmult=ten**iexp - ino=ino+xmult*num2(i)+0.5 -230 continue - ino=isgn*ino -c -c --- Also set real variable in case of improper input - rlno=ino - return -208 continue - write(ioout,220)(alp(n),n=1,ncar) -220 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid integer variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- LOGICAL variables -c -------------------------------------------------------------------- -301 continue - if(ncar-istar.ne.1)go to 308 - if(num2(istar+1).eq.16)then -c -c --- Variable = T - lv=.true. - return - else if(num2(istar+1).eq.17)then -c -c --- Variable = F - lv=.false. - return - endif -308 continue - write(ioout,320)(alp(n),n=1,ncar) -320 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid logical variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c --- Determine repetition factor -400 continue - irep=0 -c -c --- ISTAR is the position of array containing "*" - istrm1=istar-1 - do 430 i=1,istrm1 - if(num2(i).ge.10)go to 408 - iexp=istrm1-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - irep=irep+xmult*num2(i)+0.5 -430 continue - go to(101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -408 continue - write(ioout,420)(alp(n),n=1,ncar) -420 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid repetition factor ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - end -c---------------------------------------------------------------------- - subroutine deblnk(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 DEBLNK -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank or "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (980918) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without blanks within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEBLNK called by: (utility) -c --- DEBLNK calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cblnk)go to 10 -c -c --- transfer non-blank character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine deplus(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 DEPLUS -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for plus begins -c IL2 - integer - Array element at which search -c for plus ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without plus within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEPLUS called by: (utility) -c --- DEPLUS calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk,cplus - data cblnk/' '/,cplus/'+'/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cplus)go to 10 -c -c --- transfer non-plus character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine tright(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 TRIGHT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the RIGHT of the last non-blank character -c in the string before il2. Also remove the character -c at il2 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=3, il2=21 -c CSTOR1 : 2 for this run ! -c Position : 000000000111111111122 -c 123456789012345678901 -c CSTOR2 : for this run! -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with right-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TRIGHT called by: (utility) -c --- TRIGHT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of last non-blank character - klast=0 - il2m1=il2-1 - do k=ilim1,il2m1 - if(cstor1(k).NE.cblnk) klast=k - enddo - -c --- Transfer all characters in range up to klast - ind=0 - if(klast.GT.0) then - do k=ilim1,klast - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif -c --- Add last character in range if non-blank - if(cstor1(il2).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(il2) - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine tleft(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 TLEFT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the LEFT of the first non-blank character -c in the string after ilim1. Also remove the character -c at ilim1 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=2, il2=19 -c CSTOR1 : 2 for this run ! -c Position : 123456789111111111122 -c 012345678901 -c CSTOR2 : 2for this run -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with left-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TLEFT called by: (utility) -c --- TLEFT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of first non-blank character - kfrst=0 - ilim1p1=ilim1+1 - do k=il2,ilim1p1,-1 - if(cstor1(k).NE.cblnk) kfrst=k - enddo - - ind=0 -c --- Pass first character in range if non-blank - if(cstor1(ilim1).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(ilim1) - endif - -c --- Transfer all characters in range from kfrst - if(kfrst.GT.0) then - do k=kfrst,il2 - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine setvar(itype,irep,xx,jj,ll,cv,xarr,jarr,larr,carr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 110225 SETVAR -c --- J. Scire -c -c --- PURPOSE: Fill the output variable or array with the value read -c from the input file -c -c --- UPDATE -c --- V2.58 (110225) from V1.0 (950122) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c -c --- INPUTS: -c -c ITYPE - integer - Variable type (1=real, 2=integer, -c 3=logical, 4=character*4, -c 5=character*4 includes commas) -c IREP - integer - Repetition factor -c If ITYPE = 4, IREP refers to the -c number of characters in the field) -c XX - real - Real value read from input -c file (Used only if ITYPE=1) -c JJ - integer - Integer value read from input -c file (Used only if ITYPE=2) -c LL - logical*4 - Logical value read from input -c file (Used only if ITYPE=3) -c CV(mxcol) - character*4 - Character*4 values read from input -c file (Used only if ITYPE=4) -c -c PARAMETER: MXCOL -c -c --- OUTPUT: -c -c XARR(*) - real array - Output real array (or scalar if -c IREP=1) -- Used only if ITYPE=1 -c JARR(*) - integer array - Output integer array (or scalar if -c IREP=1) -- Used only if ITYPE=2 -c LARR(*) - logical array - Output logical array (or scalar if -c IREP=1) -- Used only if ITYPE=3 -c CARR(*) - character*4 - Output character*4 array (or -c scalar if IREP=1) -- Used only if -c ITYPE=4 -c -c --- SETVAR called by: READIN -c --- SETVAR calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real xarr(*) - integer jarr(*) - logical*4 larr(*),ll - character*4 carr(*),cv(mxcol) -c - go to(10,20,30,40,50),itype -c -c --- real variable -10 continue - do 15 i=1,irep - xarr(i)=xx -15 continue - return -c -c --- integer variable -20 continue - do 25 i=1,irep - jarr(i)=jj -25 continue - return -c -c --- logical variable -30 continue - do 35 i=1,irep - larr(i)=ll -35 continue - return -c -c --- character*4 variable string -40 continue - do 45 i=1,irep - carr(i)=cv(i) -45 continue - return -c -c --- character*4 variable string -50 continue - do 55 i=1,irep - carr(i)=cv(i) -55 continue - return - - end -c---------------------------------------------------------------------- - subroutine allcap(cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 950122 ALLCAP -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all lower case letters within a character -c string to upper case -c -c --- INPUTS: -c -c CSTOR2(mxcol) - character*1 array - Input character string -c NLIM - integer - Length of string (characters) -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string with -c lower case letters converted -c to upper case -c -c --- ALLCAP called by: READIN -c --- ALLCAP calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor2(mxcol),cchar,clc(29),cuc(29) -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - do 100 i=1,nlim - cchar=cstor2(i) -c - do 50 j=1,29 - if(cchar.eq.clc(j))then - cstor2(i)=cuc(j) - go to 52 - endif -50 continue -52 continue -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine datetm(rdate,rtime,rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 140318 DATETM -c --- J. Scire -c -c --- PURPOSE: Get system date and time from system clock, and -c elapsed CPU time -c --- UPDATES -c --- V2.57-V2.6.0 140318(MBN):Remove obsolete Lahey F77L code, -c and etime calls. -c --- V1.0-V2.57 090202 (DGS): Activate CPU time (F95 call) -c -c --- INPUTS: none -c -c --- OUTPUT: rdate - C*10 - Current system date (MM-DD-YYYY) -c rtime - C*8 - Current system time (HH:MM:SS) -c rcpu - real - CPU time (sec) from system utility -c -c --- DATETM called by: SETUP, FIN -c --- DATETM calls: DATE_AND_TIME (F95) -c CPU_TIME (F95) -c YR4C -c---------------------------------------------------------------------- - character*8 rtime - character*10 rdate - -c --- Local store - character*11 stime - character*8 sdate - -c --- Set initial base CPU time to -1. - data rcpu0/-1./ - SAVE rcpu0 - -c --- System date in CCYYMMDD -c --- System clock in HHMMSS.sss, where sss = thousandths of seconds - call DATE_AND_TIME(sdate,stime) -c --- Pass to output formats (MM-DD-YYYY) and (HH:MM:SS) - rdate=' - - ' - rdate(1:2)=sdate(5:6) - rdate(4:5)=sdate(7:8) - rdate(7:10)=sdate(1:4) - rtime=' : : ' - rtime(1:2)=stime(1:2) - rtime(4:5)=stime(3:4) - rtime(7:8)=stime(5:6) -c --- Get CPU time from F95 intrinsic procedure - call CPU_TIME(rcpu1) - -c --- Construct 4-digit year from current 2-digit year (if found) - read(rdate(7:10),'(i4)') iyr - call YR4C(iyr) - write(rdate(7:10),'(i4)') iyr - -c --- Update base CPU time on first call - if(rcpu0.LT.0.0) rcpu0=rcpu1 - -c --- Return CPU time difference from base - rcpu=rcpu1-rcpu0 - -cc --- DEBUG -c write(*,*)'DATETM: stime,rcpu0,rcpu1,rcpu = ', -c & stime,rcpu0,rcpu1,rcpu - - return - end -c---------------------------------------------------------------------- - subroutine fmt_date(io,fmt1,fmt2,sdate) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 090511 FMT_DATE -c D. Strimaitis -c -c --- PURPOSE: Change the format of a date string -c -c --- INPUTS: -c io - integer - Listfile output unit number -c fmt1 - character*12 - Input date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c sdate - character*12 - Date string to convert -c fmt2 - character*12 - Output date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c -c --- OUTPUT: -c sdate - character*12 - Converted date string -c -c --- FMT_DATE called by: (any) -c --- FMT_DATE calls: ALLCAP -c---------------------------------------------------------------------- - character*12 fmt1,fmt2,sdate - character*3 month3(12),month3uc(12),amon3 - character*1 amon(3) - integer io - -c --- Set abbreviation names for months - data month3/'Jan','Feb','Mar','Apr','May','Jun', - & 'Jul','Aug','Sep','Oct','Nov','Dec'/ - data month3uc/'JAN','FEB','MAR','APR','MAY','JUN', - & 'JUL','AUG','SEP','OCT','NOV','DEC'/ - -c --- Extract input month, day and year - if(fmt1(1:10).EQ.'MM-DD-YYYY') then - read(sdate(1:2),'(i2)') imon - read(sdate(4:5),'(i2)') iday - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'DD-MM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:5),'(i2)') imon - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'YYYY-MM-DD') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') imon - read(sdate(9:10),'(i4)') iday - elseif(fmt1(1:10).EQ.'YYYY-DD-MM') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') iday - read(sdate(9:10),'(i4)') imon - elseif(fmt1(1:11).EQ.'DD-MMM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:6),'(3a1)') amon - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - elseif(fmt1(1:11).EQ.'MMM-DD-YYYY') then - read(sdate(1:3),'(3a1)') amon - read(sdate(5:6),'(i2)') iday - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - else - write(io,*)'FMT_DATE: Invalid input format = ',fmt1 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Check for valid month index - if(imon.LT.1 .OR. imon.GT.12) then - write(io,*)'FMT_DATE: Invalid month in date = ',sdate - write(io,*)' for input format = ',fmt1 - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Create output date string - if(fmt2(1:10).EQ.'MM-DD-YYYY') then - sdate='MM-DD-YYYY ' - write(sdate(1:2),'(i2.2)') imon - write(sdate(4:5),'(i2.2)') iday - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'DD-MM-YYYY') then - sdate='DD-MM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - write(sdate(4:5),'(i2.2)') imon - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'YYYY-MM-DD') then - sdate='YYYY-MM-DD ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') imon - write(sdate(9:10),'(i2.2)') iday - elseif(fmt2(1:10).EQ.'YYYY-DD-MM') then - sdate='YYYY-DD-MM ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') iday - write(sdate(9:10),'(i2.2)') imon - elseif(fmt2(1:11).EQ.'DD-MMM-YYYY') then - sdate='DD-MMM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - sdate(4:6)=month3(imon) - write(sdate(8:11),'(i4.4)') iyear - elseif(fmt2(1:11).EQ.'MMM-DD-YYYY') then - sdate='MMM-DD-YYYY ' - sdate(1:3)=month3(imon) - write(sdate(5:6),'(i2.2)') iday - write(sdate(8:11),'(i4.4)') iyear - else - write(io,*)'FMT_DATE: Invalid output format = ',fmt2 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - - return - end -c---------------------------------------------------------------------- - subroutine etime(rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 941215 ETIME -c --- J. Scire, SRC -c -c --- PURPOSE: Dummy system CPU time routine for PC -c DO NOT USE THIS ROUTINE ON SUNs -c -c --- INPUTS: none -c -c --- OUTPUT: RCPU - real - CPU time (sec) -- set to zero for PC -c -c --- ETIME called by: DATETM -c --- ETIME calls: none -c---------------------------------------------------------------------- - rcpu=0.0 -c - return - end -c---------------------------------------------------------------------- - subroutine undrflw(lflag) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 030402 UNDRFLW -c D. Strimaitis, Earth Tech Inc. -c -c --- PURPOSE: This routine takes advantage of the Lahey F77L routine -c UNDER0 to set underflows to zero. When other compilers -c are used, there may be a similar routine. If none -c exists, place a dummy statement here and use compiler -c switches to configure the NDP response to an underflow. -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c---------------------------------------------------------------------- - logical lflag - -cc --- Lahey F77L Compiler (begin) -cc ------------------------------- -cc --- Lahey F77 compiler -- set underflows ( < 10**-38 ) to zero -c call UNDER0(lflag) -cc --- Lahey F77L Compiler (end) - -c --- Dummy (no action on underflows) -c ----------------------------------- - lflag=.TRUE. -c --- Dummy (end) - - return - end -c---------------------------------------------------------------------- - subroutine comline(ctext) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 040330 COMLINE -c J. Scire, SRC -c -c --- PURPOSE: Call the compiler-specific system routine that will -c pass back the command line argument after the text -c that executed the program -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c --- UPDATE -c --- V2.3 (040330) to V2.6.0 (040330) MBN -c - Removed obsolete Compaq, Microsoft, and HP compiler codes -c - Removed getcl (Lahey-only function not needed) -c --- V2.2 (960521) to V2.3 (040330) DGS -c - Replace strings c*70 with c*132 -c -c --- INPUTS: -c -c CTEXT - character*132 - Default command line argument #1 -c -c --- OUTPUT: -c -c CTEXT - character*132 - Command line argument #1 -c If command line argument is -c missing, CTEXT is not changed -c -c --- COMLINE called by: SETUP -c --- COMLINE calls: IARGC, GETARG - compiler routines -c -c---------------------------------------------------------------------- -c - character*132 ctext,cdeflt -c -c --- The following is for any system without a command line routine -c --- and is also used as a default - cdeflt=ctext -c -c ---------------- -c --- Intel ifort, Lahey lf95, and GNU gfortran compilers: -c ---------------- - numargs=IARGC() - if(numargs.ge.1)then - call GETARG(1,ctext) - endif -c -c --- If no command line arguments, use default - if(ctext(1:1).eq.' ')ctext=cdeflt - - return - end - -c---------------------------------------------------------------------- - subroutine open_err(iolst,cfrom,cftype,cfname,iunit) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 7.0.0 Level: 141010 OPEN_ERR -c D. Strimaitis, Exponent Inc. -c -c --- PURPOSE: Report error in opening a file -c -c --- INPUTS: -c IOLST - integer - Unit number of output list file -c (<0 if not available) -c CFROM - char* - Called-From string to report error -c CFTYPE - char* - File-type string -c CFNAME - char* - File-name string -c IUNIT - integer - File unit number -c -c --- OUTPUT: -c -c --- OPEN_ERR called by: () -c --- OPEN_ERR calls: -c---------------------------------------------------------------------- - implicit none - -c --- Declare arguments - character(len=*) :: cfrom,cftype,cfname - integer :: iolst, iunit - - if(iolst.GT.0) then - write(iolst,*) - write(iolst,*)'ERROR opening '//TRIM(cftype) - write(iolst,*)' File Name: '//TRIM(cfname) - write(iolst,*)' File Unit: ',iunit - write(iolst,*)'Problem reported from '//TRIM(cfrom) - write(iolst,*) - write(iolst,*)'The file may not exist in this location' - write(iolst,*)'Check the spelling of the name and the location' - write(*,*) - stop 'ERROR: File not found -- see list file' - else - write(*,*) - write(*,*)'ERROR opening '//TRIM(cftype) - write(*,*)' File Name: '//TRIM(cfname) - write(*,*)' File Unit: ',iunit - write(*,*)'Problem reported from '//TRIM(cfrom) - write(*,*) - write(*,*)'The file may not exist in this location' - write(*,*)'Check the spelling of the name, and the location' - stop - endif - - end - diff --git a/CALPUFF_SRC/CTGPROC/coordlib.for b/CALPUFF_SRC/CTGPROC/coordlib.for deleted file mode 100644 index fae8945..0000000 --- a/CALPUFF_SRC/CTGPROC/coordlib.for +++ /dev/null @@ -1,8190 +0,0 @@ -c---------------------------------------------------------------------- -c --- COORDLIB -- COORDINATE SYSTEM UTILITIES -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 070921 -c -c Copyright (c) 2003-2007 by Exponent, Inc. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c -c --- Interface routines -c subroutine GLOBE1 -c subroutine GLOBE -c subroutine NIMADATE -c subroutine COORDSVER -c -c --- Coordinate transformation engine -c subroutine COORDS -c (and subroutines) -c ----------------------------- -c -c --- UPDATE -c -c --- V1.98-V1.99 070921 (DGS): Modify UTM section of PJINIT in -c COORDS to fix erroneous non-zero -c false Northing when converting S. -c hemisphere locations to UTM-N -c coordinates -c Initialize full work arrays DWRK, -c DWRK2, TDUM to zero -c Initialize UTMOUT to zero -c -c --- V1.97-V1.98 060911 (DGS): Changes in COORDS that allow a higher -c level of FORTRAN error checking. -c -c --- V1.96-V1.97 060626 (DGS): Add subroutine GLOBE1 (from CALUTILS) -c after removing link to CALUTILS -c components -c -c --- V1.95-V1.96 051010 (KAM): ADD ALBERS CONICAL EQUAL AREA (ACEA) -c PROJECTION AS ONE OF THE SUPPORTED -c PROJECTIONS IN SUBROUTINE COORDS. -c -c --- V1.94-V1.95 050126 (GEM): FORBID UTM CONVERSION TO BE DONE -c FOR A NON-USGS SPHEROID. ADDED AN ERROR -c STRING TO THE COORDS CALL BETWEEN IRET -c AND DSTAMPIN. ADDED THE IRET CODE 99 -c FOR THE CASE WHEN THE FORBIDDEN UTM -c CONVERSION IS ENCOUNTERED. ALSO FIXED -c THE UTM TO UTM CASE WHEN THE OUTPUT UTM -c ZONE IS NOT SPECIFIED. USES THE INPUT -c (OR NATURAL) ZONE TO AVOID ZEROES. -C (GEM): Added IRET=98 error code for a LAZA -c projection with a datum that is not a -c sphere (e.g. not NWS-84 or ESR-S). -c (GEM): LAZA Projection: removed assignment -c of 6370 km earth radius (NWS-84 datum) -c when a value less than 6000 km is -c found. This assignment can override -c a requested radius of 6371 (ESR-S -c datum) if the NWS-84 datum is used -c with any valid projection prior to the -c request for ESR-S. LAZA(NWS-84) -c coordinate distances from the -c projection origin are about 0.016% -c smaller than LAZA(ESR-S). -c (DGS): Introduce subroutine COORDSVER -c --- V1.93-V1.94 041007 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY WHEN -c MOVING FROM ONE DATUM TO ANOTHER - A -c CONTINUATION OF THE FIX IN THE -c PREVIOUS VERSION. -c --- V1.92-V1.93 040713 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY AND -c FIXED THE CASE WHERE NWS-84 UNDER -c UTM USE DID NOT HAVE A VALID ELLIPSE -c MODEL INPUT -c --- V1.91-V1.92 031201 (GEM): CORRECTED CASE WHERE ONLY A CHANGE -C IN THE SAME PROJECTION IS DESIRED -c --- V1.9-V1.91 031017 (GEM): CORRECTED WGS 72 AND FIXED ELLIPSOID -c INITIALIZATION -c --- V1.15-V1.9 030905 (GEM): MAPLIB VERSION 1.9 030905 -c Rename MAPLIB system to COORDLIB -c --- V1.14-V1.15 030528 (DGS): MAPLIB VERSION 1.85 030528 -c --- V1.13-V1.14 030402 (DGS): MAPLIB VERSION 1.84 030402 -c --- V1.12-V1.13 030307 (DGS): MAPLIB VERSION 1.83 030307 -c NIMA Date now C*12 (MM-DD-YYYY ) -c --- V1.11-V1.12 030221 (DGS): Add routine to pass NIMA date -c --- V1.1-V1.11 030217 (DGS): Revise COORDS error message -c --- V1.0-V1.1 030117 (DGS): Add date stamp to COORDS call -c MAPLIB VERSION 1.8A 011403 -c -c---------------------------------------------------------------------- - subroutine globe1(cmapi,iutmzni,tmsfi,xlat1i,xlat2i,rlati,rloni, - & feasti,fnorti, - & cmapo,iutmzno,tmsfo,xlat1o,xlat2o,rlato,rlono, - & feasto,fnorto, - & caction,vecti,vecto) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 060626 GLOBE1 -c D. Strimaitis -c -c --- PURPOSE: Setup for coordinate transformation routine COORDS -c -c --- UPDATE -c --- V1.97(060626) (DGS) -c - Transferred from CALUTILS -c - Remove calls to DEBLNK and ALLCAP to isolate -c --- ...CALUTILS... -c --- V2.3 (051019) from V2.2 (030528) (KAM) -c - Add Albers Conical Equal Area projection -c --- V2.2 (030528) from V2.1 (030402) (DGS) -c - Screen for valid UTM zone using absolute value -c (S. Hem. zones are negative) -c --- V2.1 (030402) from V2.0 (021018) (DGS) -c - Add False Easting & Northing inputs -c -c --- INPUTS: -c CMAPI - char*8 - Map projection of input coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNI - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFI - real - Scale Factor for TM projection -c XLAT1I - real - Matching Equator-ward N.Latitude -c XLAT2I - real - Matching Pole-ward N.Latitude -c RLATI - real - Map origin N.Latitude -c RLONI - real - Map origin E.Longitude -c FEASTI - real - False Easting (km) at proj. origin -c FNORTI - real - False Northing (km) at proj. origin -c CMAPO - char*8 - Map projection of output coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNO - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFO - real - Scale Factor for TM projection -c XLAT1O - real - Matching Equator-ward N.Latitude -c XLAT2O - real - Matching Pole-ward N.Latitude -c RLATO - real - Map origin N.Latitude -c RLONO - real - Map origin E.Longitude -c FEASTO - real - False Easting (km) at proj. origin -c FNORTO - real - False Northing (km) at proj. origin -c -c -c --- OUTPUT: -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c -c -c --- GLOBE1 called by: (utility) -c --- GLOBE1 calls: none -c---------------------------------------------------------------------- - - character*1 cstor1(20),cstor2(20),clc(26),cuc(26) - - real*8 vecti(9),vecto(9) - character*12 caction - character*8 cmapi,cmapo - - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - & 'j','k','l','m','p','q','r','s','t','v','w','y','z'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - & 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z'/ - -c --- Set action string for conversion -c ------------------------------------ -c --- Initialize character variables for output - do i=1,20 - cstor1(i)=' ' - cstor2(i)=' ' - enddo - do i=1,8 - j=i+9 - cstor1(i)=cmapi(i:i) - cstor1(j)=cmapo(i:i) - enddo - cstor1(9)='2' -c --- Remove blank characters from string, place in storage array 2 - nlim=0 - do i=1,17 - if(cstor1(i).NE.' ') then -c --- Transfer non-blank character into array 2 - nlim=nlim+1 - cstor2(nlim)=cstor1(i) - endif - enddo -c --- Convert lower case letters to upper case - do i=1,nlim - do j=1,26 - if(cstor2(i).EQ.clc(j)) then - cstor2(i)=cuc(j) - go to 52 - endif - enddo -52 continue - enddo -c --- Transfer characters to action string - do i=1,12 - caction(i:i)=cstor2(i) - enddo - -c --- Set transformation vectors -c ------------------------------ -c --- Initialize transformation vectors - vecti(1)=999.0D0 - vecto(1)=999.0D0 - do i=2,9 - vecti(i)=0.0D0 - vecto(i)=0.0D0 - enddo - -c --- Input coords - if(cmapi.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzni).GT.0 .AND. - & IABS(iutmzni).LT.61) vecti(1)=DBLE(iutmzni) - else -c --- Matching points / origin - vecti(4)=DBLE(xlat1i) - vecti(5)=DBLE(xlat2i) - vecti(6)=DBLE(rloni) - vecti(7)=DBLE(rlati) - endif - if(cmapi.EQ.'TM') then -c --- TM Scale Factor - vecti(1)=DBLE(tmsfi) - endif - if(cmapi.EQ.'TM'.or.cmapi.EQ.'LCC'.or.cmapi.EQ.'LAZA'.or. - & cmapi.EQ.'ACEA') then - vecti(8)=DBLE(feasti) - vecti(9)=DBLE(fnorti) - endif - -c --- Output coords - if(cmapo.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzno).GT.0 .AND. - & IABS(iutmzno).LT.61) vecto(1)=DBLE(iutmzno) - else -c --- Matching points / origin - vecto(4)=DBLE(xlat1o) - vecto(5)=DBLE(xlat2o) - vecto(6)=DBLE(rlono) - vecto(7)=DBLE(rlato) - endif - if(cmapo.EQ.'TM') then -c --- TM Scale Factor - vecto(1)=DBLE(tmsfo) - endif - if(cmapo.EQ.'TM'.or.cmapo.EQ.'LCC'.or.cmapo.EQ.'LAZA'.or. - & cmapo.EQ.'ACEA') then - vecto(8)=DBLE(feasto) - vecto(9)=DBLE(fnorto) - endif - - return - end -c---------------------------------------------------------------------- - subroutine globe(iolst,caction,cdatumi,vecti,cdatumo,vecto, - & xinp4,yinp4,xout4,yout4,izone,utmhem) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 050126 GLOBE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Driver for coordinate transformation routine COORDS -c translates CALPUFF system information and provides -c fixed inputs -c -c --- UPDATE -c -c --- V1.13 (030307) to V1.95 (050126) -c - Added ESTRNG string to COORDS call for error message -c text. (GEM) -c - Added VERDOC string to COORDS call for identification -c text (DGS) -c --- V1.12 (030217) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c --- V1.1 (030117) to V1.11 (030217) (DGS) -c - Revise return error message -c --- V1.0 () to V1.1 (030117) (DGS) -c - Add date stamp to COORDS calls -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c CDATUMI - char*8 - Datum-region code for input coords -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CDATUMO - char*8 - Datum-region code for output coords -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c XINP4 - real*4 - Input Easting(km) (or E.Longitude deg) -c YINP4 - real*4 - Input Northing(km) (or N.Latitude deg) -c -c -c --- OUTPUT: -c XOUT4 - real*4 - Output Easting(km) (or E.Longitude deg) -c YOUT4 - real*4 - Output Northing(km) (or N.Latitude deg) -c IZONE - integer - UTM zone of output -c UTMHEM - char*4 - Hemisphere for UTM projection (N or S) -c -c --- GLOBE called by: (utility) -c --- GLOBE calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - logical ldb - - character*4 utmhem - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set debug output logical - ldb=.FALSE. - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - -c --- Convert output coordinates to single precision - xout4=SNGL(xyzio(1)) - yout4=SNGL(xyzio(2)) - utmzn=SNGL(utmout) - izone=NINT(utmzn) - -c --- Format UTM zone to CALPUFF convention - utmhem='N' - if(izone.LT.0) then - utmhem='S' - izone=-izone - endif - - if(LDB) then - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine nimadate(date) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 030905 NIMADATE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Passes the NIMA date from common to calling program -c -c --- UPDATE -c --- V1.13 (030307) to V1.9 (030905) (GEM) -c - Change to NIMA.CRD for MAPLIB VERSION 1.9 -c --- V1.12 (030221) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c -c --- INPUTS: -c none -c -c --- OUTPUT: -c DATE - char*12 - NIMA database date -c -c --- NIMADATE called by: (utility) -c --- NIMADATE calls: none -c---------------------------------------------------------------------- - include 'nima.crd' - character*12 date - - date=daten - - return - end -c---------------------------------------------------------------------- - subroutine coordsver(iolst,verdoc) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 050126 COORDSVER -c D. Strimaitis EarthTech -c -c --- PURPOSE: Accesses the COORDS version information by making one -c generic call to COORDS (like GLOBE) -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c -c --- OUTPUT: -c VERDOC - char*50 - COORDS version information -c -c --- COORDSVER called by: (utility) -c --- COORDSVER calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecti/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecto/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Set up converter for a null translation of lat/lon - xinp4= -90.0 - yinp4=45.0 - caction='LL2LL ' - cdatumi='WGS-84 ' - cdatumo='WGS-84 ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - - return - end -C---------------------------------------------------------------------- - SUBROUTINE COORDS(IO,IUNIT,IMODE,IPROJ,IDATMI,IDATMO,IPREC, - 1 CVECTI,CVECTO,NVEC,XYZIN,NC,XDATUM,NDAT,XYZIO,UTMOUT,IRET, - 2 ESTRNG,DSTAMPIN,VERDOC) -C---------------------------------------------------------------------- -C -C --- COORDLIB Version: 1.99 Level: 070921 COORDS -C -C --- Program was written by Gary Moore -C -C --- PROGRAM NOTES FOLLOW: -C -C --- Version 1.1 argument change -C -C --- IDATMI(O) - FULL CHARACTER STRING FOR GUI SUPPLIED (IRANK REMOVED) -C --- XDATUM,NDAT - PASS FULL ARRAY OF USER DEFINED DATUM INFO (DP) -C -C --- (1) - MAJOR RADIUS -C --- (2) - INVERSE FLATTENING -C --- (3) - ECCENTRICITY SQUARED -C --- (4) - DX -C --- (5) - DY -C --- (6) - DZ -C -C --- Version 1.2 argument change -C -C --- UTMOUT a double precision output UTM zone is used in the convert -C --- program as output to tell what UTM each point has been translated -C --- TO. -C -C --- Version 1.3 changes -C -C --- Addition of LL2ZONE subroutine for extracting the natural UTM zone -C --- when going FROM LCC TO UTMS - otherwise there is no way of knowing -C --- added extra projection calls in places to retrieve the geodetic -C --- coordinates. -C -C --- Version 1.4 changes -C -C --- Fixed the use of the FROM ellipsoid model for the final projection -C --- and changed to it to the TO ellipsoid model. Fixed the DAT2DAT and -C --- DATSHFT routines so that the proper reverse transformation proceedure -C --- is done (note - changed presentation figures) -C -C --- Version 1.5 changes -C -C --- Added more options for transformation - PS = Polar Stereographic -C --- and EM = Equatorial Mercator. Note - both of these will generally -C --- be used on a spherical earth represented by Datum 220, but can -C --- be projected to an ellipical surface - unlike the azimuthal -C --- projections that can only be done on a sphere. The LAZA was hardwired -C --- to do only a sphere with a radius of 6370 km (before it could float -C --- incorrectly). -C -C --- The block data variables were modified to accomodate the new NIMA -C --- data base. Block data call was moved to the INIT subroutine which -C --- sets up variables for COORDS and outputs several arrays for use with -C --- GUI's -C -C --- The NIMA data base use resulted in a considerable set of code -C --- revisions including (1) 8 Character Datum ID use for selecting the -C --- Datum (2) use of a 21 character ellipsoid string check (3) use of -C --- a revised 118 character region string. -C -C --- An INCLUDE file 'NIMA.CRD' was used to insert the NIMA common -C --- blocks into routines. -C -C --- version 1.6 changes -C -C --- Made several upgrades including: -C -C --- (1) adds a date check to make sure the block data is the right -C --- version. This requires adding an extra argument to COORDS -C -C --- (2) adds the Tranverse Mercator projection (TM) -C -C --- (3) add error codes for projections -C -C --- (4) allows the user input 'to' (output) utm zone to work -c -c --- Changed the ordering of CVECTI/CVECTO elements 4-7 to be consistent -c --- across all transformations, rather than following the USGS element -c --- definitions. Lat/Lon of origin of EM and PS projections is accepted -c --- and the corresponding false Easting/Northing values are computed -c --- and applied. The elements of the transformation vector are: -c (1) UTM Zone (for UTM), or Scale Factor (for TM) -c (2) radius of major axis of earth - (used for Azimuthal projections) -c (3) not currently used -c (4) True N. Latitude #1 (where applicable) -c (5) True N. Latitude #2 (where applicable) -c (6) E. Longitude of projection origin (where applicable) -c (7) N. Latitude of projection origin (where applicable) -c (8) False Easting (where applicable) -c (9) False Northing (where applicable) -C -C --- Version 1.7 changes -C -C --- Moved false northing determination of TO projections to a point -C --- where they occur AFTER a datum shift -C -C --- Added dummy arrays to keep longitude/latitudes from being written -C --- over. -C -C --- Removed writes to standard output so DLL's can be directly made -C -C --- Removed external date check changes to an internal one -C -C --- Further revisions to PS and EM cases the user cannot input a -C --- false northing and easting - and error is returned if they do -C -C --- Fixed PS2PS and EM2EM cases -C -C --- Version 1.8 changes -C -C --- Dealt with a major issue of projection initialization that is done -C --- with INZONE. Initialization is done when the UTM zone changes. Software -C --- was added to make sure this happens. -C -C --- The PS/EM projections had consistency problems when the offset is -C --- calculated with a 0.0 rather than a true longitude - the true longitude -C --- was used. -C -C --- An error in the PS/EM projection was corrected when the input -C --- parameter vector was found to be using an incorrect latitude of -C --- true scale. -C -C --- Error warnings were included to make sure that no false eastings -C --- or northings are input by the user of the PS and EM projections. -C -C --- Version 1.81 changes -C -C --- Modified USGS routines to force initialization every time by -C --- setting the switch array to zero for all projections on each call -C -C --- Added DGS approach to checking date stamp using DATEN and DATEB -C -C --- Added include for the block data (blockdat.crd) -C -C --- Version 1.82 changes -C -C --- Fixed the TM insertion of scaling factor - moved it from the USGS -C --- Element # 3 (CVECT element #4) to the CVECT element #1 normally -C --- (UTM ZONE) - the UTM zone is now set to 999. There is a mapping -C --- of the UTM ZONE to the USGS element 3 and a resetting of the -C --- UTM zone to 999 before entering the USGS subroutines. -C -C --- Scale false Easting/Northing to METERS -C --- Correct false Easting/Northing assignments after processing -C -C --- Convert main program to the CALPUFF Version/Level designation -C --- where Level is YYMMDD -C -C --- Added date-stamp argument DSTAMPIN to re-assign DSTAMP if the -C --- argument is non-blank -C -C --- Version 1.83 changes -C -C --- NIMA date variables changed from C*10 to C*12 -C --- DAT2DAT does not transform to/from WGS84 if input/output datum -C is for a sphere -C -C --- Version 1.84 changes -C -C --- Recast UTM-to-UTM conversions to properly handle zone overrides -C by adding IOVUTM: -C 0) finds native output UTM zone for output UTMs -C 1) no change to input coordinates when inzone=iozone -C 2) uses zone override for output UTMs -C -C --- Version 1.85 Level: 030528 changes -C -C --- Fix Polar Stereographic (PS) dummy array initialization which -C did not include the Earth Radius for spherical datum, and clarify -C code (remove unneeded dummy arrays) -c -c --- Take absolute value of UTM zone when testing for valid values -c (UTM is negative in S. Hemisphere) -c -C -C --- Version 1.9 Level: 030905 changes -C -C --- NEW BLOCK DATA!!!! The new block data was created by version 1.3 -C of BUILD.FOR which utilizes new data sources for DATUMs. These new -C files include: -C -C --- (1) New HEADER.TXT which defines two new global datum and removes -C one spherical earth datum (based on NAD 27). The two new datums -C are functionally equivalent and they serve as a placeholder to -C assure users they have the proper DATUM -C -C --- (2) New Datum data files GEOTRANS_02-21-2003.dat and ellips.dat -C These new data files are required since the DATUM listing text -C file produced by NIMA is not available for the latest changes -C in datum definitions. Instead the user is referred to the data -C files used by the NIMA GEOTRANS geocalculator. The ellips.dat -C file contains the parameters defining 23 ellipsoid models used -C to define the datums. These are matched by two character codes -C to the differences in geocentric coordinates of each datum -C relative to WGS-84 found in GEOTRANS_02-21-2003. The -C GEOTRANS_02-21-2003.dat file contains five new local datums - -C all which are Hawaian Island local variants. -C -C --- (3) NEWDATUM.TXT is a new file that has been added to allow insertion -C of new datums into the proper place in the master list of local -C datums. This file also allows one to add descriptive text (3 lines) -C describing the valid region or conditions of the datum. -C -C --- (4) Introduced the WGS72 global data and added formulas -C to deal with the coordinate transformations between WGS84. -C -C --- Version 1.91 Level: 031017 changes -C -C --- Made a change to TPARIN and TPARIO - Placed ellipsoid -C --- parameters in locations 14 (major radius) and 15 (eccentricity -C --- squared). Also forces the first pass initialization of GZTP0 -C --- to use the parameters rather than default to a CLARKE 1866. -C --- Also fixed a typo so that the USGS WGS 72 ellipsoid model in -C --- the USGS programs is used. -C -C --- Version 1.93 Level: 041307 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere). Also fixed a problem with NWS-84 and -C --- UTM combination where there is no difference in the results when -C --- going to and from this DATUM from other DATUMS. For UTM the 6371 km -C --- spherical ellipse model must be used when the 6370Km sphere is used -C --- because of USGS program input array conflicts. -C -C --- Version 1.94 Level: 041007 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere) when going from one DATUM to another. This -C --- is a continuation of the change made in version 1.93. -C -C --- Version 1.95 Level: 050126 changes -C -C --- Made it impossible to use a non-USGS earth spheroid when using UTM's -C --- Essentially reversed an attempted fix under version 1.93. -C --- EMG-96 is aliased to GRS 80 ellipsoid model. -C -C--------------- -C *** ALERT *** -C--------------- -C - COORDS versions prior to 1.93 used the Clark 1866 spheroid for -C - UTM conversions when a datum with a non-USGS earth spheroid is -C - specified. An example of this is the NWS-84 datum. -C - The UTM/NWS-84 fix implemented in version 1.93 and present in -C - version 1.94 whould have used a mixture of ESRI and Clarke 1866 -C - owing to the fix being applied only to one side of the -C - transformation. One should never mix versions 1.93 and 1.94 -C - with prior versions. ONE SHOULD NOT USE VERSIONS 1.93 and 1.94 -C - owing to the inconsistent nature of the transformation!!!! -C -C --- Added another IRET error code (IRET = 99) for this case. Added an -C --- error string (50 characters) between IRET and DSTAMPIN to the call -C --- to COORDS to return the error message text. -C -C --- Added yet another IRET error code (IRET = 98) for the case when -C --- one tries to use LAZA with a datum that is not a sphere (e.g. not -C --- (NWS-84 or ESR-S). -c -c --- Added VERDOC string to argument list for COORDS identification -c --- text. -c -c --- LAZA Projection: removed assignment of 6370 km earth radius -c --- (NWS-84 datum) when a value less than 6000 km is found. This -c --- assignment can override a requested radius of 6371 (ESR-S datum) -c --- if the NWS-84 datum is used with any valid projection prior to the -c --- request for ESR-S. LAZA(NWS-84) coordinate distances from the -c --- projection origin are about 0.016% smaller than LAZA(ESR-S). -c --- This undoes a change made in version 1.5. -C -C --- Fixed the case for a UTM to UTM transformation when the output UTM -C --- zone is not specified by the user. The UTM zone is set to the -C --- input UTM zone (or the natural UTM if it estimated) in order that -C --- the proper UTM zone is presented in the output rather than zero. -C --- This fix addresses a situation that arises in the coordinate -C --- conversion GUI. -C -C --- Version 1.96 Level: 051010 changes -C -C --- Add Albers Conical Equal Area projection as one of the supported -C --- projections. -C -C --- Version 1.98 Level: 060911 changes -C -c --- Changes that allow a higher level of FORTRAN error checking: -c --- Replace the constant 4 with an I*4 variable (IUNIT4) in -c calls to GTPZ0 from COORDS (to/from lat-lon). -c --- Set GTPZ0 argument LENGTH=100 (for direct access files that -c are not used). -c --- Replace constant 0 with I*4 variable (INSPHZERO) in argument 1 -c of SPHDZ0 call in GTPZ0 -c --- Change FUNCTION ADJLZ0 argument name and reassign to LON within -c (sub is called with a computed argument that should not be -c changed within subroutine) -c --- SAVE9 is undefined first time in PJINIT; set to zero in DATA - -C -C --- Version 1.99 Level: 070921 changes -C -c --- Modify UTM section of PJINIT to fix erroneous non-zero false -c --- Northing when converting S. hemisphere locations to UTM-N -c --- coordinates. Main subroutine also changed to remove patches -c --- that had corrected this problem when converting from lat/lon to -c --- UTM-N. The bug only affected conversions to N. hemisphere UTM -c --- coordinates when the location was in the S. hemisphere. The -c --- coordinates returned were actually in UTM-S. -c -c --- Initialize full real*8 work arrays DWRK, DWRK2, TDUM to zero. -c -c --- Initialize UTMOUT to zero. -C -C---------------------------------------------------------------------- -C -C --- PROGRAM FUNCTION: -C -C --- THIS IS THE MAIN DRIVER PROGRAM FOR THE MOLODENSKY DATUM -C --- CONVERSION AND THE USGS GCTP PROJECTION CONVERSION SOFTWARE. -C -C --- INPUT VARIABLES -C -C --- IO = LOGICAL FORTRAN UNIT FOR OUTPUT -C --- IUNIT = 10 CHARACTER UNITS STRING - 'METERS ' OR 'KILOMETERS' -C --- IMODE = 0 - USES DATA IN BLOCK DATA -C --- 1 - USER DEFINED DATUM INFORMATION (FROM) -C --- 2 - USER DEFINED DATUM INFORMATION (TO) -C --- 3 - USER DEFINED DATUM INFORMATION (FROM-TO) -C --- IPROJ = 12 CHARACTER PROJECTION ACTION STRING EG 'LL2UTM ' -C --- IDATMI = 8 CHARACTER INPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IDATMO = 8 CHARACTER OUTPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IPREC = 0 - SINGLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- 1 - DOUBLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- CVECTI = 1-D VECTOR OF INPUT PROJECTION PARAMETERS (DP) -C --- CVECTO = 1-D VECTOR OF OUTPUT PROJECTION PARAMETERS (DP) -C --- NVEC = NUMBER OF PARAMETERS IN THE CVECT ARRAYS -C --- XYZIN = 1-D ARRAY OF INPUT COORDINATES (X,Y,Z) (DP) -C --- NC = NUMBER OF VALID ELEMENTS IN XYZIN(O) (2 OR 3) (X,Y) OR (X,Y,Z) -C --- XDATUM = 1-D VECTOR OF DATUM DEFINITION PARAMETERS -C --- NDAT = NUMBER OF DATUM DEFINITION PARAMETERS (NORMALLY = 6) -C --- DSTAMPIN = 12 CHARACTER DATE STRING (MM-DD-YYYY ) FOR CHECKING -C --- NIMA PARAMS AND BLOCKDATA (Leave blank for default) - -C -C --- OUTPUT VARIABLES -C -C --- XYZIO = 1-D ARRAY OF OUTPUT COORDINATES (X,Y,Z) (DP) -C --- UTMOUT = UTM ZONE OF THE OUTPUT TO TRANSFORMATION (DP) -C --- IRET = RETURN FLAG (0) - SUCCESSFUL -C --- ESTRNG = 50 CHARACTER STRNG CONTAINING ERROR MESSAGE -C --- VERDOC = 50 character string containing COORDS version and level -C -C --- THIS PROGRAM CALLS: -C -C --- GTPZ0 - USGS GCTP MAIN SUBROUTINE -C --- ERRFLG - ERROR PRINTS FOR GTPZ0 -C --- DAT2DAT - MOLODENSKY DATUM SHIFT -C -C --- All NIMA BASED COMMON BLOCKS AND SUPPORTIVE DECLARATIVE -C --- STATEMENTS HAVE BEEN LUMPED INTO A SINGLE INCLUDE FILE -C --- CALLED 'NIMA.CRD' -C -c---------------------------------------------------------------------- -C - PARAMETER (MP = 64) -C - CHARACTER*128 FN27,FN83 - CHARACTER*50 IERR(12) - CHARACTER*50 ESTRNG, VERDOC - CHARACTER*12 JPROJ(MP),IPROJ - CHARACTER*8 IDATMI,IDATMO - CHARACTER*7 IPATH1,IPATH2 - CHARACTER*10 IUNIT - CHARACTER*21 ELIPSI,ELIPSO - CHARACTER*52 IDSTRNG - CHARACTER*12 DSTAMPIN -C - INTEGER*4 INSYS,INZONE,INUNIT,INSPH,IPR,JPR,LEMSG,LPARM,LN27, - 1 LN83,LENGTH,IOSYS,IOZONE,IOUNIT,IFLG - -c --- V1.98 (060911) - INTEGER*4 IUNIT4 - - INTEGER*4 SYSFLG(2,MP) - Integer*4 irnkin,irnkio - Integer*4 io,lpr, iret -C - Real*4 xdum,dxshft,dyshft,dzshft -C - REAL*8 CRDIN(2),TPARIN(15),CRDIO(2),TPARIO(15),DWRK(15), - 1 DWRK2(15) - REAL*8 XYZIN(NC), XYZIO(NC), CVECTI(NVEC), CVECTO(NVEC) - REAL*8 TDUM(15),XDATUM(NDAT) - Real*8 xlonin,xlatin,xlonio,xlatio - Real*8 flonin,flatin,flonio,flatio - Real*8 dd,dms,drad,dflt - Real*8 utmout - Real*8 TCRDIN(2),TCRDIO(2) -C -C --- Include the NIMA database - INCLUDE 'nima.crd' -C - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -C -C --- DEFAULT CONTROL SETTINGS AND ALLOWED PROJECTIONS - DATA IPATH1,IPATH2 /'NAD27SP','NAD83SP'/ - DATA LEMSG,LPARM,LN27,LN83 /16,17,18,19/ -c DATA IPR,JPR /0,0/ - DATA IPR,JPR /1,1/ - DATA JPROJ/ - * 'LL2LL ','LL2UTM ','LL2LCC ','LL2LAZA ', - * 'LL2PS ','LL2EM ','LL2TM ','LL2ACEA ', - * 'UTM2LL ','UTM2UTM ','UTM2LCC ','UTM2LAZA ', - * 'UTM2PS ','UTM2EM ','UTM2TM ','UTM2ACEA ', - * 'LCC2LL ','LCC2UTM ','LCC2LCC ','LCC2LAZA ', - * 'LCC2PS ','LCC2EM ','LCC2TM ','LCC2ACEA ', - * 'LAZA2LL ','LAZA2UTM ','LAZA2LCC ','LAZA2LAZA ', - * 'LAZA2PS ','LAZA2EM ','LAZA2TM ','LAZA2ACEA ', - * 'PS2LL ','PS2UTM ','PS2LCC ','PS2LAZA ', - * 'PS2PS ','PS2EM ','PS2TM ','PS2ACEA ', - * 'EM2LL ','EM2UTM ','EM2LCC ','EM2LAZA ', - * 'EM2PS ','EM2EM ','EM2TM ','EM2ACEA ', - * 'TM2LL ','TM2UTM ','TM2LCC ','TM2LAZA ', - * 'TM2PS ','TM2EM ','TM2TM ','TM2ACEA ', - * 'ACEA2LL ','ACEA2UTM ','ACEA2LCC ','ACEA2LAZA ', - * 'ACEA2PS ','ACEA2EM ','ACEA2TM ','ACEA2ACEA '/ - DATA SYSFLG/0,0,0,1,0,4,0,11,0,6,0,5,0,9,0,3, - * 1,0,1,1,1,4,1,11,1,6,1,5,1,9,1,3, - * 4,0,4,1,4,4,4,11,4,6,4,5,4,9,4,3, - * 11,0,11,1,11,4,11,11,11,6,11,5,11,9,11,3, - * 6,0,6,1,6,4,6,11,6,6,6,5,6,9,6,3, - * 5,0,5,1,5,4,5,11,5,6,5,5,5,9,5,3, - * 9,0,9,1,9,4,9,11,9,6,9,5,9,9,9,3, - * 3,0,3,1,3,4,3,11,3,6,3,5,3,9,3,3/ - DATA TDUM /15*1.0D0/ -C - FN27(1:7) = IPATH1 - FN83(1:7) = IPATH2 - LPR = IO - -c --- V1.98 (060911) -c --- Set units variable for steps with conversion to/from lat-lon - iunit4=4 -c --- Define record-length argument for GTPZ0 - length=100 - -c---------------------------------------------------------------------- -c --- Set the COORDS version and level string - - verdoc=' --- COORDLIB Version: 1.99 Level: 070921 ' - -c---------------------------------------------------------------------- - -C -C --- SET IRET TO ZERO - IRET = 0 -C -C --- PROPERLY INITIALIZE ESTRNG to BLANKS (NOT NULLS) - DO K = 1,50 - ESTRNG(K:K) = ' ' - ENDDO -C -C --- SPECIAL CHECK FOR NWS-84 SPHERE JUST IN CASE A LAZA PROJECTION -C --- IS DESIRED. A SPHERE FLAG IS INITIALIZED HERE (TO ZERO). IT IS -C --- SET TO 1 IF THE ELLIPSOID MODEL IS A SPHERE. - IBALLI = 0 - IBALLO = 0 - IF(IDATMI.EQ.'NWS-84')IBALLI = 1 - IF(IDATMO.EQ.'NWS-84')IBALLO = 1 -C -C --- Establish the date-stamp value - if(dstampin(1:1).NE.' ') dstamp=dstampin -C -C --- NOW FINDS OUT IF THE USER EXPECTED DATE STRING MATCHES THE -C --- ONE FOUND IN THE NIMA TEXT FILE - IF(DSTAMP.NE.DATEN)THEN - IRET = 10 - IERR(1)='DATE STAMP FAILURE FOR NIMA.CRD! ' - ESTRNG = IERR(1) - RETURN - ENDIF -C -C --- NOW FINDS OUT IF WE HAVE THE RIGHT BLOCK DATA FILE - IF(DSTAMP.NE.DATEB)THEN - IRET = 20 - IERR(2)='DATE STAMP FAILURE FOR BLOCKDATA! ' - ESTRNG = IERR(2) - RETURN - ENDIF -C -C --- IMMEDIATELY FINDS THE PROPER DATUM FROM THE PRESTORED SET - IRNKIN = 0 - IRNKIO = 0 - IF(IMODE.EQ.0)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 222 - ENDIF - ENDDO -222 CONTINUE - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 232 - ENDIF - ENDDO -232 CONTINUE - ENDIF - IF(IMODE.EQ.1)THEN - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 332 - ENDIF - ENDDO -332 CONTINUE - ENDIF - IF(IMODE.EQ.2)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 322 - ENDIF - ENDDO -322 CONTINUE - ENDIF -C -C --- IMMEDIATE CHECK FOR ILLEGAL DATUM POINTER - IF(IMODE.EQ.0)THEN - IF(IRNKIN.LT.1.OR.IRNKIN.GT.ND)THEN - IRET = 60 - IERR(6)='INPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(6) - RETURN - ENDIF - IF(IRNKIO.LT.1.OR.IRNKIO.GT.ND)THEN - IRET = 70 - IERR(7)='OUTPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(7) - RETURN - ENDIF - ENDIF -C -C --- CHECKS OPERATION MODE - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C --- NOW ESTABLISHES THE TRANSFORMATION TYPE - DO K = 1,MP - IF(JPROJ(K).EQ.IPROJ)THEN - INSYS = SYSFLG(1,K) - IOSYS = SYSFLG(2,K) - GOTO 101 - ENDIF - ENDDO - IRET = 40 - IERR(4) = 'THE PROJECTION PAIR IS UNDEFINED OR NOT ALLOWED! ' - ESTRNG = IERR(4) - RETURN - 101 CONTINUE -C -C --- NOW CHECKS FOR IMPROPER EASTING AND NORTHING OFFSETS FOR PS AND EM -C --- PROJECTIONS - IF((INSYS.EQ.5.OR.INSYS.EQ.6).AND.CVECTI(9).NE.0.0D+00)THEN - IRET = 80 - IERR(8) = 'ILLEGAL INPUT OF (FROM) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(8) - ENDIF - IF((IOSYS.EQ.5.OR.IOSYS.EQ.6).AND.CVECTO(9).NE.0.0D+00)THEN - IRET = 90 - IERR(9) = 'ILLEGAL INPUT OF (TO) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(9) - ENDIF -C -C --- NOW ESTABLISHES THE PROPER UNITS -C --- LL = DECIMAL DEGREES -C --- UTM,LCC,LAZA,PS,MC,ACEA = METERS OR KILOMETERS - XMULTI = 1.0 - IF(INSYS.EQ.0)THEN - INUNIT = 4 - ELSE - INUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTI = 1000.0 - ELSE - XMULTI = 1.0 - ENDIF - ENDIF - XMULTO = 1.0 - IF(IOSYS.EQ.0)THEN - IOUNIT = 4 - ELSE - IOUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTO = 0.001 - ELSE - XMULTO = 1.0 - ENDIF - ENDIF -C -C --- SINGLE PRECISION CHECK - SINGLE PRECISION IS NOT YET SUPPORTED - IF(IPREC.EQ.0)THEN - IRET = 50 - IERR(5) = 'NICE TRY - SINGLE PRECISION COORDS ARE ILLEGAL! ' - ESTRNG = IERR(5) - RETURN - ENDIF -c -c --- Store the ELon and NLat of the projection origin (DD) - FLONIN=CVECTI(6) - FLONIO=CVECTO(6) - FLATIN=CVECTI(7) - FLATIO=CVECTO(7) -C -C --- FILLS THE INPUT COORDINATES ARRAY CRDIN AND THE TPARIN ARRAY - CRDIN(1) = XYZIN(1)*DBLE(XMULTI) - CRDIN(2) = XYZIN(2)*DBLE(XMULTI) - IF(NVEC.GT.16)THEN - IRET = 60 - IERR(6) = 'TRUNCATED PROJECTION PARAMETER VECTOR! ' - ESTRNG = IERR(6) - NVEC = 16 - ENDIF - DO K = 1,15 - TPARIN(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTI(1)) - INZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIN(K-1) = CVECTI(K)*DBLE(XMULTI) - ELSE -C --- ASSIGN DIRECTLY FROM INPUT VECTOR - TPARIN(K-1) = CVECTI(K) - ENDIF - ENDDO -C -C --- FILLS THE TPARIO ARRAY (ALSO NEEDED) - DO K = 1,15 - TPARIO(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTO(1)) - IOZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIO(K-1) = CVECTO(K)/DBLE(XMULTO) - ELSE -C --- ASSIGN DIRECTLY FROM OUTPUT VECTOR - TPARIO(K-1) = CVECTO(K) - ENDIF - ENDDO - -c --- Initialize full work arrays - do k = 1,15 - dwrk(k) = 0.0D+00 - dwrk2(k) = 0.0D+00 - tdum(k) = 0.0D+00 - enddo - -c --- Initialize output variable UTMOUT - utmout = 0.0D+00 -C -C --- Now converts the TPARIN, TPARIO FROM DD to DDDMMMSSS.SS -C --- UTM's - IF(INSYS.EQ.1)THEN - DD = TPARIN(1) - CALL DD2DMS(DD,DMS) - TPARIN(1) = DMS - DD = TPARIN(2) - CALL DD2DMS(DD,DMS) - TPARIN(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(INSYS.EQ.4.OR.INSYS.EQ.3)THEN - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(3) = DMS - DD = TPARIN(4) - CALL DD2DMS(DD,DMS) - TPARIN(4) = DMS - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- EM & PS's (Note shift of arguments) - IF(INSYS.EQ.5.OR.INSYS.EQ.6)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - TPARIN(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(INSYS.EQ.9)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS -C --- NOW SWAP FROM CVECTI ELEMENT 1 TO USGS ELEMENT 3 - TPARIN(3) = CVECTI(1) - INZONE = 999 - ENDIF -C --- LAZA's - IF(INSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIN(1).LT.6000000.0D+00)THEN -C TPARIN(1) = 6370000.0D+00 -C ENDIF - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- UTM's - IF(IOSYS.EQ.1)THEN - DD = TPARIO(1) - CALL DD2DMS(DD,DMS) - TPARIO(1) = DMS - DD = TPARIO(2) - CALL DD2DMS(DD,DMS) - TPARIO(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(IOSYS.EQ.4.OR.IOSYS.EQ.3)THEN - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(3) = DMS - DD = TPARIO(4) - CALL DD2DMS(DD,DMS) - TPARIO(4) = DMS - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C --- EM AND PS's (Note shift of arguments) - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - TPARIO(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(IOSYS.EQ.9)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS -C --- NOW SWAP FROM CVECTO ELEMENT 1 TO USGS ELEMENT 3 - TPARIO(3) = CVECTO(1) - IOZONE = 999 - ENDIF -C --- LAZA's - IF(IOSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIO(1).LT.6000000.0D+00)THEN -C TPARIO(1) = 6370000.0D+00 -C ENDIF - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C -C --- NOW ESTABLISHES THE PROPER ELLIPSOID MODEL PARAMETERS - IF(IMODE.EQ.0.OR.IMODE.EQ.2)THEN - IDSTRNG = DATUM(DATTYP(IRNKIN)) - ELIPSI = IDSTRNG(32:52) - INSPH = -1 -c -c --- Special alias for EMG 96 - if(elipsi.eq.'EMG 96 ')INSPH = 8 - IF(ELIPSI.EQ.'Clarke 1866 ')INSPH = 0 - IF(ELIPSI.EQ.'Clarke 1880 ')INSPH = 1 - IF(ELIPSI.EQ.'Bessel 1841 ')INSPH = 2 - IF(ELIPSI.EQ.'International 1967 ')INSPH = 3 - IF(ELIPSI.EQ.'International 1909 ')INSPH = 4 - IF(ELIPSI.EQ.'WGS 72 ')INSPH = 5 - IF(ELIPSI.EQ.'Everest (1830) ')INSPH = 6 - IF(ELIPSI.EQ.'WGS 66 ')INSPH = 7 - IF(ELIPSI.EQ.'GRS 80 ')INSPH = 8 - IF(ELIPSI.EQ.'Airy ')INSPH = 9 - IF(ELIPSI.EQ.'Everest (1956) ')INSPH = 10 - IF(ELIPSI.EQ.'Modified Airy ')INSPH = 11 - IF(ELIPSI.EQ.'WGS 84 ')INSPH = 12 - IF(ELIPSI.EQ.'Modified Fischer 1960')INSPH = 13 - IF(ELIPSI.EQ.'Australian National ')INSPH = 14 - IF(ELIPSI.EQ.'Krassovsky 1940 ')INSPH = 15 - IF(ELIPSI.EQ.'Hough ')INSPH = 16 - IF(ELIPSI.EQ.'Mercury 1960 ')INSPH = 17 - IF(ELIPSI.EQ.'Modified Mercury 1968')INSPH = 18 - IF(ELIPSI.EQ.'Normal Sphere (6371) ')INSPH = 19 - IF(ELIPSI.EQ.'International 1924 ')INSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(INSPH.LT.0.AND.INSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmi -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(INSPH.EQ.19)IBALLI = 1 - IF(INSYS.EQ.11.AND.IBALLI.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmi -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF - IF(IMODE.EQ.0.OR.IMODE.EQ.1)THEN - IDSTRNG = DATUM(DATTYP(IRNKIO)) - ELIPSO = IDSTRNG(32:52) - IOSPH = -1 -c -c --- Special alias for EMG 96 - if(elipso.eq.'EMG 96 ')IOSPH = 8 - IF(ELIPSO.EQ.'Clarke 1866 ')IOSPH = 0 - IF(ELIPSO.EQ.'Clarke 1880 ')IOSPH = 1 - IF(ELIPSO.EQ.'Bessel 1841 ')IOSPH = 2 - IF(ELIPSO.EQ.'International 1967 ')IOSPH = 3 - IF(ELIPSO.EQ.'International 1909 ')IOSPH = 4 - IF(ELIPSO.EQ.'WGS 72 ')IOSPH = 5 - IF(ELIPSO.EQ.'Everest (1830) ')IOSPH = 6 - IF(ELIPSO.EQ.'WGS 66 ')IOSPH = 7 - IF(ELIPSO.EQ.'GRS 80 ')IOSPH = 8 - IF(ELIPSO.EQ.'Airy ')IOSPH = 9 - IF(ELIPSO.EQ.'Everest (1956) ')IOSPH = 10 - IF(ELIPSO.EQ.'Modified Airy ')IOSPH = 11 - IF(ELIPSO.EQ.'WGS 84 ')IOSPH = 12 - IF(ELIPSO.EQ.'Modified Fischer 1960')IOSPH = 13 - IF(ELIPSO.EQ.'Australian National ')IOSPH = 14 - IF(ELIPSO.EQ.'Krassovsky 1940 ')IOSPH = 15 - IF(ELIPSO.EQ.'Hough ')IOSPH = 16 - IF(ELIPSO.EQ.'Mercury 1960 ')IOSPH = 17 - IF(ELIPSO.EQ.'Modified Mercury 1968')IOSPH = 18 - IF(ELIPSO.EQ.'Normal Sphere (6371) ')IOSPH = 19 - IF(ELIPSO.EQ.'International 1924 ')IOSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(IOSPH.LT.0.AND.IOSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmo -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(IOSPH.EQ.19)IBALLO = 1 - IF(IOSYS.EQ.11.AND.IBALLO.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmo -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF -C -C --- STICKS THE ELLIPSOID PARAMETERS INTO ELEMENTS 1,2 OF -C --- TPARIN, TPARIO - IF(INSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIN(1) = DRADIM(IRNKIN) - TPARIN(2) = DEC2(IRNKIN) - ENDIF - IF(IOSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIO(1) = DRADIM(IRNKIO) - TPARIO(2) = DEC2(IRNKIO) - ENDIF -C -C --- SPECIAL SET FOR ELLIPSOID PARAMETERS IN TPARIN AND TPARIO ELEMENTS 14,15 - TPARIN(14) = DRADIM(IRNKIN) - TPARIN(15) = DEC2(IRNKIN) - TPARIO(14) = DRADIM(IRNKIO) - TPARIO(15) = DEC2(IRNKIO) -C -C-------------------------------------------------------------------- -C --- CRDIN = COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C --- INSYS = CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C --- INZONE = CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C --- TPARIN = PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C --- INUNIT = CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I* -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C -C --- INSPH = INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C --- 0 = CLARKE 1866 1 = CLARKE 1880 -C --- 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C --- 4 = INTERNATIONAL 1909 5 = WGS 72 -C --- 6 = EVEREST 7 = WGS 66 -C --- 8 = GRS 1980 9 = AIRY -C --- 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C --- 12 = WGS 84 13 = SOUTHEAST ASIA -C --- 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C --- 16 = HOUGH 17 = MERCURY 1960 -C --- 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C --- 20 = INTERNATIONAL 1924 -C -C --- IPR = PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C --- JPR = PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C --- LEMSG = LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C --- LPARM = LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C --- LN27 = LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C --- FN27 = FILE NAME OF NAD 1927 SPCS PARAMETERS -C --- LN83 = LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C --- FN83 = FILE NAME OF NAD 1983 SPCS PARAMETERS -C --- LENGTH = RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C -C--------------------------------------------------------------------- -C -C --- SETS IN NEW DATUM PARAMETERS AND CHECK FOR BAD MODE FLAG - IF(IMODE.EQ.1)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.2)THEN - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.3)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C********************************************************************** -C -C --- Now converts TLAT1 for EM,PS to LATITUDE OF TRUE SCALE -C --- and takes the Latitude of origin of projection and changes -C --- it to a false northing -C -C********************************************************************** -C -C --- (FROM) INPUT DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(INSYS.EQ.6.OR.INSYS.EQ.5)THEN -C -C --- SET COORDINATE ORIGIN AS THE PS POINT DESIRED - TCRDIN(1) = FLONIN - TCRDIN(2) = FLATIN -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIN(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE ADDED TO THE -C --- PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,INSYS,INZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) -C -C --- ERROR PROCESSING - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF -C -C --- NOW SHIFTS THE INPUT COORDS FROM DOMAIN CENTER TO THE POLE -C --- ASSUMES SINCE ONE IS NOT PUTTING IN OFFSETS THAT THE DATA -C --- COMING IN IS ALREADY OFFSET AND MUST BE SET TO THE POLE - CRDIN(1) = CRDIN(1) + TCRDIO(1) - CRDIN(2) = CRDIN(2) + TCRDIO(2) - ENDIF -C********************************************************************** -C -C --- OUTPUT (TO) DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(IOSYS.EQ.6.OR.IOSYS.EQ.5)THEN -C -C --- SET DOMAIN CENTER AS THE PS POINT DESIRED - TCRDIN(1) = FLONIO - TCRDIN(2) = FLATIO -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIO(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE SUBTRACTED -C --- FROM THE PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,IOSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,IOSYS,IOZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) -C -C --- ERROR PROCESSING - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - ENDIF -C********************************************************************** -C -C --- DOES A COMPLETE CYCLE PROJ/DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,0,TDUM,4,IOSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,0,TDUM,IUNIT4,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES ONLY A DATUM SHIFT - IF(INSYS.EQ.0.AND.IOSYS.EQ.0)THEN - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - UTMOUT = DBLE(INZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - FROM PROJ/DATUM TO LL (GEODETIC) - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.EQ.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE FROM LL (GEODETIC) TO DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.EQ.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 DATUM TRANSFORMATION - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IABS(IOZONE).GT.60)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 2 PROJECTION FROM LAT-LON - CALL GTPZ0(CRDIN,0,INZONE,TPARIN,INUNIT,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (070921) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - PROJ ONLY - NO DATUM CHANGE - IF(IRNKIN.EQ.IRNKIO)THEN -C -C --- GOES TO LL (GEODETIC IF IOSYS = 1) TO GET UTM ZONE FOR OUTPUT - IF(IOSYS.EQ.1)THEN - IF(INSYS.NE.0)THEN - DO KK = 1,NVEC - DWRK(KK) = 0.0D0 - DWRK2(KK) = TPARIN(KK) - ENDDO - CRDIO(1) = 0.0D0 - CRDIO(2) = 0.0D0 - IDUM = INZONE - JDUM = IOZONE - JOUNIT = 4 - JOSYS = 0 - CALL GTPZ0(CRDIN,INSYS,IDUM,DWRK2,INUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,CRDIO,JOSYS,JDUM,DWRK,JOUNIT,LN27, - . LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XLONIO = CRDIO(1) - XLATIO = CRDIO(2) - ELSE - XLONIO = CRDIN(1) - XLATIO = CRDIN(2) - ENDIF -C -C --- DETERMINE IF A VALID OUTPUT ZONE IS GIVEN - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -C --- MAKE SURE WE GET A DECENT ZONE IF WE ENTERED A BOGUS ONE INITIALLY - IF(IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -c PRINT *,'HEY - LATITUDE - UTM OUT: ',XLATIO,IOZONE - ENDIF -C -C --- SPECIAL CASE UTM2UTM WHERE OVERRIDE IS DESIRED - IF(INSYS.EQ.1.AND.IOSYS.EQ.1)THEN - CRDIN(1) = CRDIO(1) - CRDIN(2) = CRDIO(2) - JNUNIT = 4 - JNSYS = 0 - IF(IOVUTM.EQ.0)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE - IF(IOVUTM.EQ.2)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT, - 2 LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE -C -C --- DO NOTHING EXCEPT UNITS CHANGE - XYZIO(1) = XYZIN(1) - XYZIO(2) = XYZIN(2) - RETURN - ENDIF - ENDIF - -C -C --- SPECIAL CASE WHERE INZONE IS PROVIDED BUT IOZONE IS NOT - IF(IABS(INZONE).GT.0.AND.IABS(INZONE).LT.61)THEN - IOZONE = INZONE - ENDIF - UTMOUT = DBLE(IOZONE) - ELSE -C -C --- REGULAR CASES - IF(INSYS.NE.IOSYS)THEN - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (070921) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - ELSE ! CASE FROM ONE PROJECTION SETTING TO ANOTHER -C -C --- STEP 1 PROJECTION TO LAT-LON -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, -c 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,4,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,IUNIT4,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 FEED CHANGE BACK TO PROJECTION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - CRDIN(1) = XLONIN - CRDIN(2) = XLATIN -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,IOZONE,TDUM,4,IOSPH,IPR,JPR, -c 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,IOZONE,TDUM,IUNIT4,IOSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - ENDIF - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XYZIO(3) = XYZIN(3) - UTMOUT = DBLE(IOZONE) - ENDIF - ENDIF -C -C--------------------------------------------------------------------- -C -C --- IOSYS = CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C --- IOZONE = CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C --- TPARIO = PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY) -C --- IOUNIT = CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I -C --- CRDIO = COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY) -C --- IFLG = RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C -C---------------------------------------------------------------------- -C -C --- PUTS THE OUTPUT INFORMATION INTO XYZIO AND SCALES -C --- NOTE THAT TCRDIO ARRAY HAS BEEN FILLED APPROPRIATELY WHEN AN -C --- OFFSET IS COMPUTED FOR PS AND EM - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - XYZIO(1) = (CRDIO(1) - TCRDIO(1))*DBLE(XMULTO) - XYZIO(2) = (CRDIO(2) - TCRDIO(2))*DBLE(XMULTO) - ELSE - XYZIO(1) = CRDIO(1)*DBLE(XMULTO) - XYZIO(2) = CRDIO(2)*DBLE(XMULTO) - ENDIF -C -C --- NOW DOES A 'TO' (OUTPUT) PROJECTION CHECK - JFLG = 1 -C IF(FLONIO.NE.0.0.AND.FLATIO.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIO,FLATIO,JFLG,IRET) -C ELSE -C IF(FLONIN.NE.0.0.AND.FLATIN.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIN,FLATIN,JFLG,IRET) -C ENDIF -C ENDIF -C - 999 CONTINUE -C 999 PRINT *,'FINISHED NORMALLY' - RETURN - END -c -c----------------------------------------------------------------------- -c --- Bring in BLOCK DATA as an include file -c----------------------------------------------------------------------- - include 'blockdat.crd' -c -c---------------------------------------------------------------------- - SUBROUTINE PRJCHK(IO,INSYS,XLON,XLAT,IFLG,IRET) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 021024 PRJCHK -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the mapping -c --- to various projections when the longitude and latitude are set to -c --- some values that are outside the bounds of the various projections. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- insys = projection type -c --- xlon = double precision longitude -c --- xlat = double precision latitude -c --- iflg = error print flag -c -c --- Program outputs are: -c -c --- iret = error number -c -c---------------------------------------------------------------------- -c - Real*8 xlon, xlat -c - Real*4 xlono,xlato -c - Integer*4 iflg,io,iret,ichk -c - ichk = 0 - xlato = sngl(xlat) - xlono = sngl(xlon) -c -c --- Test for polar stereographic mapping - if(insys.eq.6.and.abs(xlato).le.45.0)iret = iret + 100 -c -c --- Test for mercator mapping - if(insys.eq.5.and.abs(xlato).ge.45.0)iret = iret + 200 -c -c --- Test for utm mapping - if(insys.eq.1.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret - 1 + 300 -c -c --- Test for transverse mercator mapping - if(insys.eq.9.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret+ - 1 400 -c -c --- Print out - IF(ICHK.GT.0)THEN -c PRINT *,' WARNING INAPPROPIATE LATITUDE ' - WRITE(IO,'(A29)')'WARNING INAPPROPIATE LATITUDE' - ENDIF - Return - End -c---------------------------------------------------------------------- - SUBROUTINE ERRPRT(IFLG,IO,IAPP) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020623 ERRPRT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the USGS GCTP -c --- software. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- iflg = error flag -c --- iapp = application number -c---------------------------------------------------------------------- -C -C --- PRINT ERROR MESSAGES - IF(IFLG.NE.0)THEN -c PRINT *,' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - WRITE(IO,'(A35,I5)')' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - IF(IFLG.EQ.1)THEN -c PRINT *,' ILLEGAL INPUT SYSTEM CODE.' - WRITE(IO,'(A25)')'ILLEGAL INPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.2)THEN -c PRINT *,' ILLEGAL OUTPUT SYSTEM CODE.' - WRITE(IO,'(A26)')'ILLEGAL OUTPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.3)THEN -c PRINT *,' ILLEGAL INPUT UNIT CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.4)THEN -c PRINT *,' ILLEGAL OUTPUT UNIT CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.5)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR INPUT.' - WRITE(IO,'(A40)')'INCONSISTENT UNIT/SYSTEM CODES FOR INPUT' - ENDIF - IF(IFLG.EQ.6)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT.' - WRITE(IO,'(A41)')'INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT' - ENDIF - IF(IFLG.EQ.7)THEN -c PRINT *,' ILLEGAL INPUT ZONE CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT ZONE CODE' - ENDIF - IF(IFLG.EQ.8)THEN -c PRINT *,' ILLEGAL OUTPUT ZONE CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT ZONE CODE' - ENDIF - IF(IFLG.GT.8)THEN -c PRINT *,' REALLY BAD UNDETERMINED ERROR! ' - WRITE(IO,'(A30)')'REALLY BAD UNDETERMINED ERROR!' - STOP - ENDIF -c PRINT *,' WILL TRY NEXT COORDINATE SET: ' - ENDIF - RETURN - END -c---------------------------------------------------------------------- - Subroutine ll2zon(dxlon,dxlat,izone,iret) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020710 LL2ZON -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in to UTM zone for use -c --- in estimating the UTM zone of any given latitude and longitude. -c -c --- Program inputs are: -c -c --- dxlon = longitude in decimal degrees (DP) -c --- dxlat = latitude in decimal degrees (DP) -c -c --- Program outputs are: -c -c --- izone = utm zone in the range -60 < -1 and 1 < 60 -c --- iret = a return code = 100 if the longitude is funky -c -c---------------------------------------------------------------------- -c - Real*8 dxlon,dxlat -c - iret = 0 - if(dabs(dxlon).gt.180.0D0)then - iret = 100 -c Print *,'magnitude of longitude is > 180 degrees!!!!' - Return - Endif -c -c --- NH E Quad - If(dxlon.ge.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 30 + izone - endif -c -c --- NH W Quad - If(dxlon.le.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 31 - izone - endif -c -c --- SH E Quad - If(dxlon.ge.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(30 + izone) - endif -c -c --- SH W Quad - If(dxlon.le.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(31 - izone) - endif - if(izone.gt.60)izone = 60 - if(izone.lt.-60)izone = -60 - Return - End -c---------------------------------------------------------------------- - Subroutine dd2dms(dd,dms) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020624 DD2DMS -c -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- PROGRAM NOTES FOLLOW: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- Convert decimal degrees to packed degrees,mintues,econds format -c -c --- dd.ddddd to dddmmmsss.ss -c -c --- Program Inputs -c -c --- dd = decimal degrees (dp) -c -c --- Program Outputs -c -c --- dms = packed degrees minutes seconds format (dp) -c -c---------------------------------------------------------------------- -c - real*8 dd,dms - real*4 sdd -c - sdd = sngl(dd) - ideg = int(sdd) - xminit = (sdd - ideg)*60.0 - iminit = int(xminit) - xsec = (xminit - iminit)*60.0 - dms = 1000000.D0*ideg + 1000.D0*iminit + 1.0D0*xsec - return - end - -c---------------------------------------------------------------------- - Subroutine dat2dat(lpr,ipr,xlonin,xlatin,zlevin,irnkin, - 1 irnkio,xlonio,xlatio,zlevio) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 030905 DAT2DAT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c --- Added a 9999 datum designamtion to do a manual datum trasformation -c --- using user input information in the common block XDATM (version 1.1 -c --- 062002) -c -c --- Version 1.2 (071102) -c -c --- Changed calls to DATSHFT by adding IFLG so that a proper paired -c --- set of FROM-TO transformations could be made. -c -c --- Added the NIMA.CRD include. Use the new strings and pointers for -c --- handling the NIMA dataset. -c -c --- Version 1.3 102802 -c -c --- Corrected the ao,fo - ai,fi used (switched order) on from ref to -c --- output datum -c -c --- Version 1.4 030703 -c -c --- Blocked datum conversion to/from WGS84 lat-lon for sphere datums -c -c --- Version 1.9 Level: 030905 -c -c --- Add iflg values 2 and 3 to datshft calls to go to and from WGS-72 -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in one datum to the -c --- longitude,latitude in another. The program also does a shift in -c --- elevation due to a change in the geoid. -c -c --- Program inputs are: -c -c --- lpr = FORTRAN logical unit for output -c --- ipr = print flag => 0 to avoid printing -c --- xlonin = input longitude in decimal degrees (dp) -c --- xlatin = input latitude in decimal degrees (dp) -c --- zlevin = elevation of the input point of interest in meters -c --- irnkin = input datum pointer -c --- irnkio = output datum pointer -c -c --- Program outputs are: -c -c --- xlonio = output longitude in decimal degrees (dp) -c --- xlatio = output latitude in decimal degrees (dp) -c --- zlevio = revised elevation output of the input point in meters -c -c --- subroutine calls: -c -c --- DATSHFT -c -c---------------------------------------------------------------------- -c - Real*8 ai, ao, fi, fo, dx, dy, dz, xlonin, xlatin, zhti, - 1 xlonio, xlatio, zhto - Real*8 xlato,xlono,drad,dflt -c - Integer*4 iposi,iposo -c - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -c -c --- NIMA data base include - Include 'nima.crd' -c -c --- reference definition - the convention will be it is always 1! - iref = 1 -c -c --- asigns the positions - if(irnkin.ne.9999)then - iposi = irnkin - else - iposi = 0 - endif - if(irnkio.ne.9999)then - iposo = irnkio - else - iposo = 0 - endif -c -c --- Print out information - if(ipr.ne.1.and.iposi.ne.0)then - Write(lpr,'(a12,a8,1x,a50,1x,a60)')'From datum: ', - 1 datcod(iposi),datum(dattyp(iposi)),geodat1(iposi) - endif - if(ipr.ne.1.and.iposo.ne.0)then - Write(lpr,'(a10,a8,1x,a50,1x,a60)')'To datum: ', - 1 datcod(iposo),datum(dattyp(iposo)),geodat1(iposo) - endif -c -c --- datum to reference shift (i= input o = output) - if(iposi.ne.0)then - ai = dradim(iposi) - fi = 1.0/dflat(iposi) - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxmod(iposi)) - dy = dble(dymod(iposi)) - dz = dble(dzmod(iposi)) - zhti = dble(zlevin) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - zhti = dble(zlevin) - endif -c --- Transform to WGS84 only if input datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposi).eq.'WGS-72 ')then - iiflag = 2 - else - iiflag = 0 - endif - Call datshft(xlonin,xlatin,zhti,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlono,xlato,zhto) - else - xlono=xlonin - xlato=xlatin - zhto=zhti - endif -c -c --- reference to datum shift (i = input o = output) note same diffierence -c --- but a negative sign is used - this insures we get back to where -c --- we started!!!! - if(iposo.ne.0)then - ao = dradim(iref) - fo = 1.0/dflat(iref) - ai = dradim(iposo) - fi = 1.0/dflat(iposo) - dx = dble(dxmod(iposo)) - dy = dble(dymod(iposo)) - dz = dble(dzmod(iposo)) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - endif -c --- Transform from WGS84 only if output datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposo).eq.'WGS-72 ')then - iiflag = 3 - else - iiflag = 1 - endif - Call datshft(xlono,xlato,zhto,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlonio,xlatio,zhti) - else - xlonio=xlono - xlatio=xlato - zhti=zhto - endif - zlevio = sngl(zhti) -c - Return - End -c--------------------------------------------------------------------- - subroutine datshft(xloni,xlati,zhti,ai,fi,fo,ao,dx,dy,dz,iflg, - 1 xlono,xlato,zhto) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 030905 DATSHFT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Standard Modolensky Datum Transformation -c -c -c---------------------------------------------------------------------- -c -c --- Program notes -c --- Added the IFLG argument for proper FROM - TO conversions -c -c -c --- Version 1.1 -c --- Modified code constants to insure everything is DP -c --- Modified calculation of the reverse transformation. The reverse -c --- is done by subtracting the geodetics rather than inputing negative -c --- delta X,Y,Z. -c -c --- Version 1.9 Level: 030905 -c -c --- Add equations and special option to go to and from WGS-72 -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts the lat/lon/height of one datum to another -c --- assuming an earth center shift of dx,dy,dz (geoid specific) and the -c --- ellipsoid major axis and flattening of each datum. -c -c --- Input arguments - double precision -c -c --- xlati = input latitude in decimal dgrees -c --- xloni = input longitude in decimal degrees -c --- zhti = input elevation in meters -c --- ai = input major radius in meters -c --- fi = input flattening factor -c --- fo = output flattening factor -c --- ao = output major radius -c --- dx = datum to reference earth center shift in meters -c --- dy = datum to reference earth center shift in meters -c --- dz = datum to reference earth center shift in meters -c --- iflg = 0 FROM datum A TO WGS84 = 1 TO datum B FROM WGS84 -c --- iflg = 2 FROM datum A to WGS72 = 3 TO datum B FROM WGS72 -c -c --- Output arguments - double precision -c -c --- xlato = output longitude in decimal degrees -c --- xlono = output longitude in decimal degrees -c --- zhto = output elevation in meters -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - real*8 xlati,xloni,zhti,ai,fi,fo,ao,dx,dy,dz,xlato,xlono,zhto - real*8 deg2rad,rad2deg,da,df,sithet,siphi,cithet,ciphi,siphi2 - real*8 rn,rm,dlat,dlon,dh,one,two,dlat72,dh72 - real*8 es,bda,c1,c2,c3,c4,d1,d2,e1,e2,e3,e4,e5 -c -c --- compute some double precision constants - deg2rad = 0.01745329252D0 - rad2deg = 57.295779513D0 - one = 1.0D0 - two = 2.0D0 -c -c --- compute delta radius/flattening - double precision - da = ao - ai - df = fo - fi - es = two*fi - fi*fi ! eccentricity squared - bda = one - fi !pole/equator radius ratio -c -c --- compute sin,cos of theta and phi - double precision - siphi = dsin(xlati*deg2rad) - siphi2 = dsin(xlati*2.0*deg2rad) - ciphi = dcos(xlati*deg2rad) - sithet = dsin(xloni*deg2rad) - cithet = dcos(xloni*deg2rad) -c -c --- radius of curvature - prime vertical - rn = ai/dsqrt(one - es*siphi**2) -c -c --- radius of curvature - prime meridian - rm = ai*(one - es)/(one - es*siphi**2)**1.5 -c -c --- shift in latitude - c1 = -dx*siphi*cithet - dy*siphi*sithet + dz*ciphi - c2 = da*(rn*es*siphi*ciphi)/ai - c3 = df*(rm/bda + rn*bda)*siphi*ciphi - c4 = rm + zhti - dlat = (c1 + c2 + c3)/c4 - dlat72 = 4.5D0*ciphi/(ai*sin(1.0*deg2rad/3600.0)) + - 1 df*siphi2/(sin(1.0*deg2rad/3600.0)) -c -c --- shift in longitude - d1 = -dx*sithet + dy*cithet - d2 = (rn + zhti)*ciphi - dlon = d1/d2 -c -c --- shift in height - e1 = dx*ciphi*cithet - e2 = dy*ciphi*sithet - e3 = dz*siphi - e4 = da*ai/rn - e5 = df*bda*rn*siphi*siphi - dh = e1 + e2 + e3 - e4 + e5 - dh72 = 4.5D0*siphi + ai*df*siphi*siphi - da + 1.4D0 -c -c --- estimate the output arguments - if(iflg.eq.0)then - xlato = xlati + dlat*rad2deg - xlono = xloni + dlon*rad2deg - zhto = zhti + dh - endif - if(iflg.eq.1)then - xlato = xlati - dlat*rad2deg - xlono = xloni - dlon*rad2deg - zhto = zhti - dh - endif -c -c --- Special WGS-72 change 030905 - if(iflg.eq.2)then - xlato = xlati + dlat72/3600.0D0 - xlono = xloni + 0.554D0/3600.0D0 - zhto = zhti + dh72 - endif - if(iflg.eq.3)then - xlato = xlati - dlat72/3600.0D0 - xlono = xloni - 0.554D0/3600.0D0 - zhto = zhti - dh72 - endif -c - return - end -c---------------------------------------------------------------------- - Subroutine init(datloc,datnam,datid,datreg1,datreg2,datreg3, - 1 max,maxd) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 021016 INIT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Initializes the NIMA data label arrays -c -c---------------------------------------------------------------------- -c -c --- Program notes -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program does some string housekeeping and outputs the strings -c --- for use by a GUI or some other management routines. It starts -c --- with the NIMA common blocks that are input via the NIMA.CRD include -c --- block. -c -c --- Input arguments: -c -c --- MAX = maximum number of datums in the data base -c -c --- Output arguments - double precision -c -c --- DATID = 8 character ID code array for each datum -c --- DATLOC = 20 character Atlas location string array -c --- DATNAM = 50 character Datum name string array -c --- DATREG1 = 60 character Region descriptor string array - line 1 -c --- DATREG2 = 60 character Region descriptor string array - line 2 -c --- DATREG3 = 60 character Region descriptor string array - line 3 -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - CHARACTER*8 DATID(MAX) - CHARACTER*20 DATLOC(MAX) - CHARACTER*50 ISTRNG, DATNAM(MAX) - CHARACTER*60 DATREG1(MAX), DATREG2(MAX), DATREG3(MAX) -c -c --- Calls the include - Include 'nima.crd' -c -c --- First maps the DATLOC and DATNAM arrays - maxd = kmax - Do i = 1,kmax - DATLOC(i) = Atlas(dattyp(i)) - DATNAM(i) = Datum(dattyp(i)) - DATID(i) = Datcod(i) - DATREG1(i) = Geodat1(i) - DATREG2(i) = Geodat2(i) - DATREG3(i) = Geodat3(i) - Enddo -c -c --- Now compresses the Datum name string - Do k = 1,kmax - istrng = datnam(k) - Do j = 1,29 - jj = 29 - j + 1 - if(istrng(jj:jj).ne.' ')then - jbeg = jj + 2 - go to 444 - endif - Enddo -444 continue - jend = jbeg + 20 - if(jend.gt.50)jend = 50 - istrng(jbeg:jend) = istrng(30:50) - if(jend.lt.50)then - Do j = jend+1,50 - istrng(j:j) = ' ' - Enddo - endif - datnam(k) = istrng - Enddo - Return - End -C----------------------------------------------------------------------- -C GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE - VERSION 2.0.2 -C FORTRAN 77 LANGUAGE FOR IBM, AMDAHL, ENCORE, VAX, CONCURRENT, AND -C DATA GENERAL COMPUTERS -C ADJLZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ADJLZ0 (LONIN) - -c --- V1.98 (060911) -c --- Change argument name and reassign (sub is called with a computed -c --- argument that should not be changed within subroutine) - -C -C FUNCTION TO ADJUST LONGITUDE ANGLE TO MODULO 180 DEGREES. -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,PI /2.0D0,3.14159265358979323846D0/ - -c --- V1.98 (060911) - LON=LONIN -C - 020 ADJLZ0 = LON - IF (DABS(LON) .LE. PI) RETURN - TWOPI = TWO * PI - LON = LON - DSIGN (TWOPI,LON) - GO TO 020 -C - END -C ASINZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ASINZ0 (CON) -C -C THIS FUNCTION ADJUSTS FOR ROUND-OFF ERRORS IN COMPUTING ARCSINE -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - IF (DABS(CON) .GT. ONE) THEN - CON = DSIGN (ONE,CON) - ENDIF - ASINZ0 = DASIN (CON) - RETURN -C - END -C DMSPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION DMSPZ0 (SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT UNPACKED DMS TO PACKED DMS ANGLE -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,NEG - DATA CON1,CON2 /1000000.0D0,1000.0D0/ - DATA NEG /'-'/ -C - CON = DBLE (DEGS) * CON1 + DBLE (MINS) * CON2 + DBLE (SECS) - IF (SGNA .EQ. NEG) CON = - CON - DMSPZ0 = CON - RETURN -C - END -C E0FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E0FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E0). -C - IMPLICIT REAL*8 (A-Z) - DATA QUART,ONE,ONEQ,THREE,SIXT /0.25D0,1.0D0,1.25D0,3.0D0,16.0D0/ -C - E0FNZ0 = ONE - QUART * ECCNTS * (ONE + ECCNTS / SIXT * - . (THREE + ONEQ * ECCNTS)) -C - RETURN - END -C E1FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E1FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E1). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2,CON3 /0.375D0,0.25D0,0.46875D0/ - DATA ONE /1.0D0/ -C - E1FNZ0 = CON1 * ECCNTS * (ONE + CON2 * ECCNTS * - . (ONE + CON3 * ECCNTS)) -C - RETURN - END -C E2FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E2FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E2). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2 /0.05859375D0,0.75D0/ - DATA ONE /1.0D0/ -C - E2FNZ0 = CON1 * ECCNTS * ECCNTS * (ONE + CON2 * ECCNTS) -C - RETURN - END -C E3FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E3FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E3). -C - IMPLICIT REAL*8 (A-Z) -C - E3FNZ0 = ECCNTS*ECCNTS*ECCNTS*(35.D0/3072.D0) -C - RETURN - END -C E4FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E4FNZ0 (ECCENT) -C -C FUNCTION TO COMPUTE CONSTANT (E4). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ONE + ECCENT - COM = ONE - ECCENT - E4FNZ0 = DSQRT ((CON ** CON) * (COM ** COM)) -C - RETURN - END -C GTPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) -C -C ********************************************************************** -C -C INPUT **************************************************************** -C CRDIN : COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C INSYS : CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C INZONE : CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C TPARIN : PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C INUNIT : CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I*4) -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C INSPH : INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C IPR : PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C JPR : PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C LEMSG : LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C LPARM : LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C LN27 : LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C FN27 : FILE NAME OF NAD 1927 SPCS PARAMETERS -C LN83 : LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C FN83 : FILE NAME OF NAD 1983 SPCS PARAMETERS -C LENGTH : RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C OUTPUT *** ***** -C IOSYS : CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C IOZONE : CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C TPARIO : PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C IOUNIT : CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I*4) -C CRDIO : COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY). -C IFLG : RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C OTHERWISE , ERROR CODE FROM PROJECTION COMPUTATIONAL MODULE. -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 NAD27(134), NAD83(134), NADUT(54), SPTYPE(134) - INTEGER*4 SYSUNT(24), SWITCH(23), ITER - -c --- V1.98 (060911) - INTEGER*4 INSPHZERO - - INTEGER*2 INMOD, IOMOD, FWD, INV - CHARACTER*128 FN27, FN83, FILE27, FILE83 - DIMENSION CRDIN(2),CRDIO(2),TPARIN(15),TPARIO(15),COORD(2) - DIMENSION DUMMY(15), PDIN(15), PDIO(15) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /PROJZ0/ IPROJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /TOGGLE/ SWITCH -C - PARAMETER (MAXUNT=6, MAXSYS=23) - PARAMETER (FWD=0, INV=1) - DATA SYSUNT / 0 , 23*2 / - DATA PDIN/15*0.0D0/, PDIO/15*0.0D0/ - DATA INSP/999/, INPJ/999/, INZN/99999/ - DATA IOSP/999/, IOPJ/999/, IOZN/99999/ - DATA ITER /0/ - DATA JFLAG/0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C -C TABLE OF UNIT CODES AS SPECIFIED BY STATE LAWS AS OF 2/1/92 -C FOR NAD 1983 SPCS - 1 = U.S. SURVEY FEET, 2 = METERS, -C 5 = INTERNATIONAL FEET -C -C NADUT - UNIT CODES FOR THE STATES ARRANGED IN STATE NUMBER ORDER -C (FIRST TWO DIGITS OF ZONE NUMBER) -C - DATA NADUT /1, 5, 1, 1, 5, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 2, - . 1, 1, 5, 2, 1, 2, 5, 1, 2, 2, 2, 1, 1, 1, 5, 2, 1, 5, - . 2, 2, 5, 2, 1, 1, 5, 2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 2/ -C -C TABLE OF STATE PLANE ZONE TYPES: 4 = LAMBERT, 7 = POLYCONIC, -C 9 = TRANSVERSE MERCATOR, AND 20 = OBLIQUE MERCATOR -C - DATA SPTYPE / 9, 9, 4, 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - . 9, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 9, 4, 4, - . 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 9, 9, 9, 9, 9, 4, 4, - . 4, 4, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, - . 9, 9, 9,20, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 7/ -C -C SETUP -C - IOSPH = INSPH - IPEMSG = IPR - IPPARM = JPR - IPELUN = LEMSG - IPPLUN = LPARM - IPROJ = INSYS - LU27 = LN27 - FILE27 = FN27 - LU83 = LN83 - FILE83 = FN83 - LEN = LENGTH -C -C INITIALIZE SWITCH FOR EACH PROJECTION TO ZERO -C - ITER = ITER + 1 - IF (ITER .LE. 1) THEN - DO 5 I=1,15 - DUMMY(I) = 0.0D0 - 5 CONTINUE - MSYS = 2 - END IF - INSPCS = 2 - IOSPCS = 2 - IF (JFLAG.NE.0) GO TO 10 - EZ = 0.0D0 - ESZ = 0.0D0 - -c --- V1.98 (060911) -c CALL SPHDZ0(0,DUMMY) -c --- Set sphere as a variable instead of a constant - insphzero=0 - CALL SPHDZ0(insphzero,DUMMY) -C -C --- SPECIAL TREATMENT FOR STARTUP - IF(TPARIO(14).NE.0D0.AND.TPARIO(15).NE.0D0)THEN - DUMMY(1) = TPARIO(14) - DUMMY(2) = TPARIO(15) - ENDIF - JFLAG = 1 -C -C CHECK VALIDITY OF CODES FOR REFERENCE SYSTEMS. -C - 10 IF (INSYS.LT.0 .OR. INSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INSYS - 2000 FORMAT (' ILLEGAL SOURCE REFERENCE SYSTEM CODE = ',I6) - IFLG = 1 - RETURN - END IF -C - IF (IOSYS.LT.0 .OR. IOSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOSYS - 2010 FORMAT (' ILLEGAL TARGET REFERENCE SYSTEM CODE = ',I6) - IFLG = 2 - RETURN - END IF -C -C FORCE INITIALIZATION OF PROJECTIONS IF SPHEROID OR PROJECTION -C HAS CHANGED FROM PREVIOUS INPUT - OUTPUT SET -C -C -C---------------------------------------------------------------------- -C -C --- THIS SECTION IS TO BE PLACED IN ALL VERSIONS OF USGS CODE TO FORCE -C --- REINITIALIZATION EACH TIME. -C -C---------------------------------------------------------------------- - DO I = 1,MAXSYS - SWITCH(I) = 0 - ENDDO -C---------------------------------------------------------------------- -C - IF (INSPH .NE. INSP) THEN - DO 11 I = 1,MAXSYS - SWITCH(I) = 0 - 11 CONTINUE - END IF -C - IF (INSYS .GT. 0) THEN - IF (INSYS .NE. INPJ .AND. INSYS .NE. IOPJ) SWITCH(INSYS) = 0 - IF (SWITCH(INSYS) .NE. INZONE .AND. SWITCH(INSYS) .NE. IOZONE) - . SWITCH(INSYS) = 0 - END IF -C - IF (IOSYS .GT. 0) THEN - IF (IOSYS .NE. INPJ .AND. IOSYS .NE. IOPJ) SWITCH(IOSYS) = 0 - IF (SWITCH(IOSYS) .NE. INZONE .AND. SWITCH(IOSYS) .NE. IOZONE) - . SWITCH(IOSYS) = 0 - END IF -C -C CHECK FOR REPEAT OF INPUT SYSTEM -C - INMOD = 1 - IF (INSYS .EQ. 2) THEN - IF (INZONE .GT. 0) THEN - ID = 0 - IF (INSPH .EQ. 0) THEN - DO 12 I = 1,134 - IF (INZONE .EQ. NAD27(I)) ID = I - 12 CONTINUE - END IF - IF (INSPH .EQ. 8) THEN - DO 13 I = 1,134 - IF (INZONE .EQ. NAD83(I)) ID = I - 13 CONTINUE - END IF - IF (ID .NE. 0) INSPCS = SPTYPE(ID) - IF (INZONE .NE. SWITCH(INSPCS)) GO TO 15 - END IF - END IF - IF (INSP .NE. INSPH) GO TO 15 - IF (INPJ .NE. INSYS) GO TO 15 - IF (INZN .NE. INZONE) GO TO 15 - IF (INSYS .GE. 3) THEN - DO 14 I=1,15 - IF (TPARIN(I) .NE. PDIN(I)) GO TO 15 - 14 CONTINUE - END IF - INMOD = 0 - GO TO 30 -C -C SAVE INPUT SYSTEM PARAMETERS -C - 15 INSP = INSPH - INPJ = INSYS - INZN = INZONE - DO 16 I=1,15 - 16 PDIN(I) = TPARIN(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (INUNIT.LT.0 .OR. INUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2020) INUNIT - 2020 FORMAT (' ILLEGAL SOURCE UNIT CODE = ',I6) - IFLG = 3 - RETURN - END IF -C -C CHECK FOR REPEAT OF OUTPUT SYSTEM -C - 30 IOMOD = 1 - IF (IOSYS .EQ. 2) THEN - IF (IOZONE .GT. 0) THEN - ID = 0 - IF (IOSPH .EQ. 0) THEN - DO 32 I = 1,134 - IF (IOZONE .EQ. NAD27(I)) ID = I - 32 CONTINUE - END IF - IF (IOSPH .EQ. 8) THEN - DO 33 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) ID = I - 33 CONTINUE - END IF - IF (ID .NE. 0) IOSPCS = SPTYPE(ID) - IF (IOZONE .NE. SWITCH(INSPCS)) GO TO 35 - END IF - END IF - IF (IOSP .NE. INSPH) GO TO 35 - IF (IOSP .NE. IOSPH) GO TO 35 - IF (IOPJ .NE. IOSYS) GO TO 35 - IF (IOZN .NE. IOZONE) GO TO 35 - IF (IOSYS .GE. 3) THEN - DO 34 I=1,15 - IF (TPARIO(I) .NE. PDIO(I)) GO TO 35 - 34 CONTINUE - END IF - IOMOD = 0 - GO TO 80 -C -C SAVE OUTPUT SYSTEM PARAMETERS -C - 35 IOSP = INSPH - IOPJ = IOSYS - IOZN = IOZONE - DO 36 I=1,15 - 36 PDIO(I) = TPARIO(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (IOUNIT.LT.0 .OR. IOUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2030) IOUNIT - 2030 FORMAT (' ILLEGAL TARGET UNIT CODE = ',I6) - IFLG = 4 - RETURN - END IF -C - 80 IUNIT = SYSUNT(INSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) INUNIT=1 - IF (INSPH .EQ. 8 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) THEN - IND = 0 - DO 90 I = 1,134 - IF (INZONE .EQ. NAD83(I)) IND = I - 90 CONTINUE - IF (IND .NE. 0) INUNIT = NADUT( INT(INZONE/100)) - END IF - CALL UNTFZ0 (INUNIT,IUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 100 - IFLG = 5 - RETURN - 100 COORD(1) = FACTOR * CRDIN(1) - COORD(2) = FACTOR * CRDIN(2) - IUNIT = SYSUNT(IOSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) IOUNIT=1 - IF (INSPH .EQ. 8 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) THEN - IND = 0 - DO 110 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) IND = I - 110 CONTINUE - IF (IND .NE. 0) IOUNIT = NADUT( INT(IOZONE/100)) - END IF - CALL UNTFZ0 (IUNIT,IOUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 120 - IFLG = 6 - RETURN - 120 IF (INSYS.NE.IOSYS.OR.INZONE.NE.IOZONE.OR.INZONE.LE.0) GO TO 140 - CRDIO(1) = FACTOR * COORD(1) - CRDIO(2) = FACTOR * COORD(2) - RETURN -C -C COMPUTE TRANSFORMED COORDINATES AND ADJUST THEIR UNITS. -C - 140 IF (INSYS .EQ. 0) GO TO 520 - IF (INZONE.GT.60 .OR. INSYS.EQ.1) GO TO 200 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2040) INZONE - 2040 FORMAT (' ILLEGAL SOURCE ZONE NUMBER = ',I6) - IFLG = 7 - RETURN -C -C INVERSE TRANSFORMATION. -C - 200 IPROJ=INSYS - ISPHER = INSPH - IF (INSYS.GE.3) CALL SPHDZ0(INSPH,TPARIN) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE INPUT PROJECTION -C - IF (INSYS .EQ. 1 .AND. INZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - INMOD = 1 - END IF - IF (INSYS .EQ. 2 .AND. INZONE .NE. SWITCH(INSPCS)) THEN - SWITCH(2) = 0 - INMOD = 1 - END IF - IF (INZONE .NE. SWITCH(INSYS)) THEN - SWITCH(INSYS) = 0 - INMOD = 1 - END IF -C - IF (INSYS .EQ. 1) THEN - IF (INZONE.EQ.0.AND.TPARIN(1).NE.0.0D0) GO TO 211 - TPARIN(1) = 1.0D6*DBLE(6*INZONE-183) - TPARIN(2) = DSIGN(4.0D7,DBLE(INZONE)) - 211 CALL SPHDZ0(INSPH,DUMMY) - TPARIN(14) = DUMMY(1) - TPARIN(15) = DUMMY(2) - IF (INMOD .NE. 0) THEN - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - CALL PJ01Z0 (COORD,CRDIO,INV) - END IF -C - IF (INSYS .GT. 1) THEN - IF (INMOD .NE. 0) THEN - MSYS = INSPCS - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - IF (INSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,INV) - END IF -C - 500 IFLG = IERROR - DO 510 I = 1,15 - 510 TPARIN(I) = PDIN(I) - IF (IFLG .NE. 0) RETURN - CRDIO(1) = ADJLZ0(CRDIO(1)) - IF (IOSYS .EQ. 0) GO TO 920 - COORD(1) = CRDIO(1) - COORD(2) = CRDIO(2) - 520 IF (INSYS .EQ. 0 .AND. IOSYS .EQ. 0) THEN - CRDIO(1) = COORD(1) - CRDIO(2) = COORD(2) - GO TO 920 - END IF - IF (IOZONE.GT.60 .OR. IOSYS.EQ.1) GO TO 540 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2050) IOSYS - 2050 FORMAT (' ILLEGAL TARGET ZONE NUMBER = ',I6) - IFLG = 8 - RETURN -C -C FORWARD TRANSFORMATION. -C - 540 IPROJ=IOSYS - ISPHER = INSPH - IF (IOSYS.GE.3) CALL SPHDZ0(INSPH,TPARIO) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE OUTPUT PROJECTION -C - IF (IOSYS .EQ. 1 .AND. IOZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - IOMOD = 1 - END IF - IF (IOSYS .EQ. 2 .AND. IOZONE .NE. SWITCH(IOSPCS)) THEN - SWITCH(2) = 0 - IOMOD = 1 - END IF - IF (IOZONE .NE. SWITCH(IOSYS)) THEN - SWITCH(IOSYS) = 0 - IOMOD = 1 - END IF -C - IF (IOSYS .EQ. 1) THEN - TPARIO(1) = COORD(1) - TPARIO(2) = COORD(2) - CALL SPHDZ0(INSPH,DUMMY) - TPARIO(14) = DUMMY(1) - TPARIO(15) = DUMMY(2) - IF (IOMOD .NE. 0) THEN - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - CALL PJ01Z0 (COORD,CRDIO,FWD) - END IF -C - IF (IOSYS .GT. 1) THEN - IF (IOMOD .NE. 0) THEN - MSYS = IOSPCS - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - IF (IOSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,FWD) - END IF -C - 900 IFLG = IERROR - DO 910 I = 1,15 - 910 TPARIO(I) = PDIO(I) - 920 CRDIO(1) = FACTOR * CRDIO(1) - CRDIO(2) = FACTOR * CRDIO(2) - RETURN -C - END -C MLFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MLFNZ0 (E0,E1,E2,E3,PHI) -C -C FUNCTION TO COMPUTE CONSTANT (M). -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ -C - MLFNZ0 = E0 * PHI - E1 * DSIN (TWO * PHI) + E2 * DSIN (FOUR * PHI) - * - E3 * DSIN (SIX * PHI) -C - RETURN - END -C MSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL M). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ECCENT * SINPHI - MSFNZ0 = COSPHI / DSQRT (ONE - CON * CON) -C - RETURN - END -C PAKCZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKCZ0 (PAK) -C -C SUBROUTINE TO CONVERT 2 DIGIT PACKED DMS TO 3 DIGIT PACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,10000.0D0,100.0D0/ - DATA CON3,CON4 /1000000.0D0,1000.0D0/ - DATA TOL /1.0D-3/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = DMOD (CON , CON2) -C - CON = DBLE (DEGS) * CON3 + DBLE (MINS) * CON4 + SECS - IF (SGNA .EQ. NEG) CON = - CON - PAKCZ0 = CON - RETURN -C - END -C PAKDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PAKDZ0 (PAK,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT PACKED DMS TO UNPACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,1000000.0D0,1000.0D0/ - DATA TOL /1.0D-4/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = SNGL ( DMOD (CON , CON2)) - RETURN -C - END -C PAKRZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKRZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO RADIANS. -C - IMPLICIT REAL*8 (A-H,O-Z) - DATA SECRAD /0.4848136811095359D-5/ -C -C CONVERT ANGLE TO SECONDS OF ARC -C - SEC = PAKSZ0 (ANG) -C -C CONVERT ANGLE TO RADIANS. -C - PAKRZ0 = SEC * SECRAD -C - RETURN - END -C PAKSZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKSZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO SECONDS OF ARC. -C - IMPLICIT REAL*8 (A-H,M-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - DIMENSION CODE(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA CODE /1000000.0D0,1000.0D0/ - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA C1,C2 /3600.0D0,60.0D0/ - DATA TOL /1.0D-4/ -C -C SEPARATE DEGREE FIELD. -C - FACTOR = ONE - IF (ANG .LT. ZERO) FACTOR = - ONE - SEC = DABS(ANG) - TMP = CODE(1) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 360) GO TO 020 - DEG = DBLE (I) -C -C SEPARATE MINUTES FIELD. -C - SEC = SEC - DEG * TMP - TMP = CODE(2) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 60) GO TO 020 - MIN = DBLE (I) -C -C SEPARATE SECONDS FIELD. -C - SEC = SEC - MIN * TMP - IF (SEC .GT. C2) GO TO 020 - SEC = FACTOR * (DEG * C1 + MIN * C2 + SEC) - GO TO 040 -C -C ERROR DETECTED IN DMS FORM. -C - 020 WRITE (IPELUN,2000) ANG - 2000 FORMAT ('0ERROR PAKSZ0'/ - . ' ILLEGAL DMS FIELD =',F15.3) - STOP 16 -C - 040 PAKSZ0 = SEC -C - RETURN - END -C PHI1Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI1Z0 (ECCENT,QS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-1). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE /0.5D0,1.0D0/ - DATA EPSLN,TOL,NIT /1.0D-7,1.0D-10,15/ -C - PHI1Z0 = ASINZ0 (HALF * QS) - IF (ECCENT .LT. EPSLN) RETURN -C - ECCNTS = ECCENT * ECCENT - PHI = PHI1Z0 - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - COSPI = DCOS (PHI) - CON = ECCENT * SINPI - COM = ONE - CON * CON - DPHI = HALF * COM * COM / COSPI * (QS / (ONE - ECCNTS) - - . SINPI / COM + HALF / ECCENT * DLOG ((ONE - CON) / - . (ONE + CON))) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI1Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,QS - 2000 FORMAT ('0ERROR PHI1Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' QS =',D25.16) - IERROR = 001 - RETURN -C - END -C PHI2Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI2Z0 (ECCENT,TS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-2). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA TOL,NIT /1.0D-10,15/ - DATA HALFPI /1.5707963267948966D0/ -C - ECCNTH = HALF * ECCENT - PHI = HALFPI - TWO * DATAN (TS) - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - CON = ECCENT * SINPI - DPHI = HALFPI - TWO * DATAN (TS * ((ONE - CON) / - . (ONE + CON)) ** ECCNTH) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI2Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,TS - 2000 FORMAT ('0ERROR PHI2Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' TS =',D25.16) - IERROR = 002 - RETURN -C - END -C PHI3Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI3Z0 (ML,E0,E1,E2,E3) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-3). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = ML - DO 020 II = 1,NIT - DPHI = (ML + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0 - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI3Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ML,E0,E1,E2,E3 - 2000 FORMAT ('0ERROR PHI3Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ML =',D25.16,' E0 =',D25.16/ - . ' E1 =',D25.16,' E2 =',D25.16,' E3=',D25.16) - IERROR = 003 - RETURN -C - END -C PHI4Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PHI4Z0 (ECCNTS,E0,E1,E2,E3,A,B,C,PHI) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-4). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA ONE,TWO,FOUR,SIX /1.0D0,2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = A - DO 020 II = 1,NIT - SINPHI = DSIN (PHI) - TANPHI = DTAN (PHI) - C = TANPHI * DSQRT (ONE - ECCNTS * SINPHI * SINPHI) - SIN2PH = DSIN (TWO * PHI) - ML = E0 * PHI - E1 * SIN2PH + E2 * DSIN (FOUR * PHI) - . - E3 * DSIN (SIX * PHI) - MLP = E0 - TWO * E1 * DCOS (TWO * PHI) + FOUR * E2 * - . DCOS (FOUR * PHI) - SIX * E3 * DCOS (SIX * PHI) - CON1 = TWO * ML + C * (ML * ML + B) - TWO * A * - . (C * ML + ONE) - CON2 = ECCNTS * SIN2PH * (ML * ML + B - TWO * A * ML) / (TWO * C) - CON3 = TWO * (A - ML) * (C * MLP - TWO / SIN2PH) - TWO * MLP - DPHI = CON1 / (CON2 + CON3) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,E0,E1,E2,E3,A,B,C, - . ECCNTS - 2000 FORMAT ('0ERROR PHI4Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' E0 =',D25.16,' E1 =',D25.16/ - . ' E2 =',D25.16,' E3 =',D25.16/ - . ' A =',D25.16,' B =',D25.16/ - . ' C =',D25.16/ - . ' ECCENTRICITY SQUARE =',D25.16) - IERROR = 004 - RETURN -C - END -C PJINIT -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PJINIT (ISYS,ZONE,DATA) -cc ---------------------------------------------------------------------- -c --- UPDATE (for use in COORDS) -c -c --- V1.98-V1.99 070921 (DGS) -c Modify UTM section of PJINIT in to fix erroneous non-zero -c false Northing when converting S. hemisphere locations to UTM-N -c coordinates. Calls from COORDS to GTPZ0 manage the UTM zone -c (negative for S. hemisphere) so the zone alone should be used to -c set the false Northing for UTM in the S. hemisphere. Calls made -c with a positive zone MUST result in UTM-N coordinates, which are -c negative in the S. hemisphere. -c ---------------------------------------------------------------------- -C - IMPLICIT REAL*8 (A-Z) - REAL*4 SECS(5) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,ITEMP - INTEGER*4 LAND, PATH, LIMIT, IND02, IND06, IND09, ISYS, KEEPZN - INTEGER*4 SWITCH(23),I,ZONE,DEGS(5),MINS(5) - INTEGER*4 ID, IND, ITEM, ITYPE, MODE, N, MSYS - INTEGER*4 ISPHER, LUNIT, LU27, LU83, LEN, NAD27(134), NAD83(134) - CHARACTER*128 DATUM, FILE27, FILE83 - CHARACTER*32 PNAME - CHARACTER*1 SGNA(5) -C - DIMENSION DATA(15),BUFFL(15) - DIMENSION TABLE(9) - DIMENSION PR(20),XLR(20) - DIMENSION ACOEF(6),BCOEF(6) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /NORM/ Q,T,U,W,ES22,P22,SA,CA,XJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /PJ02/ ITYPE - COMMON /PJ03/ A03,LON003,X003,Y003,C,E03,ES03,NS03,RH003 - COMMON /PJ04/ A04,LON004,X004,Y004,E04,F04,NS04,RH004 - COMMON /PJ05/ A05,LON005,X005,Y005,E05,M1 - COMMON /PJ06/ A06,LON006,X006,Y006,E06,E4,FAC,MCS,TCS,IND06 - COMMON /PJ07/ A07,LON007,X007,Y007,E07,E007,E107,E207,E307,ES07, - . ML007 - COMMON /PJ08/ A08,LON008,X008,Y008,E008,E108,E208,E308,GL,NS08, - . RH008 - COMMON /PJ09/ A09,LON009,X009,Y009,ES09,ESP,E009,E109,E209,E309, - . KS009,LAT009,ML009,IND09 - COMMON /PJ10/ A10,LON010,X010,Y010,COSP10,LAT010,SINP10 - COMMON /PJ11/ A11,LON011,X011,Y011,COSP11,LAT011,SINP11 - COMMON /PJ12/ A12,LON012,X012,Y012,COSP12,LAT012,SINP12 - COMMON /PJ13/ A13,LON013,X013,Y013,COSP13,LAT013,SINP13 - COMMON /PJ14/ A14,LON014,X014,Y014,COSP14,LAT014,SINP14 - COMMON /PJ15/ A15,LON015,X015,Y015,COSP15,LAT015,P,SINP15 - COMMON /PJ16/ A16,LON016,X016,Y016 - COMMON /PJ17/ A17,LON017,X017,Y017,LAT1 - COMMON /PJ18/ A18,LON018,X018,Y018 - COMMON /PJ19/ A19,LON019,X019,Y019 - COMMON /PJ20/ LON020,X020,Y020,AL,BL,COSALF,COSGAM,E20,EL,SINALF, - . SINGAM,U0 - COMMON /PJ21/ A21,LON021,X021,Y021,PR,XLR - COMMON /PJ22/ A22,X022,Y022,A2,A4,B,C1,C3,LAND,PATH - COMMON /PJ23/ A23,LON023,X023,Y023,ACOEF,BCOEF,EC,LAT023, - . CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH -C - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE,TWO /0.0D0,0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-10/ - DATA TOL /1.0D-7/ - DATA TOL09 /1.0D-5/ - DATA NINTYD /90000000.0D0/ - DATA DG1 /0.01745329252D0/ - -c --- V1.98 (060911) -c --- Set initial value of SAVE9 - data SAVE9/0.0D0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C .................................................................... -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . U T M . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 1) THEN -C - IERROR = 0 - IF (SWITCH(1).NE.0 .AND. SWITCH(1).EQ.ZONE) RETURN - SWITCH(1) = ZONE - IF (SWITCH(9).NE.0.AND.SWITCH(9).EQ.ZONE.AND.DATA(14).EQ.SAVE) - . RETURN - KEEPZN = ZONE - ZONE = IABS(ZONE) - SAVE = DATA(1) - IF (ZONE .EQ. 0) THEN - ZONE = IDINT( ( (DATA(1) * 180.0D0 / PI) - . + (TOL09 / 3600.D0) ) / 6.D0 ) - IND = 1 - IF (DATA(1) .LT. ZERO) IND = 0 - ZONE = MOD ((ZONE + 30), 60) + IND - KEEPZN = ZONE - IF (DATA(2) .LT. ZERO) KEEPZN = -ZONE - ENDIF - IF (ZONE.LT.1 .OR. ZONE.GT.60) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,140) KEEPZN - 140 FORMAT ('0ERROR PJ01Z0'/ - . ' ILLEGAL ZONE NO. : ',I10) - IERROR = 011 - RETURN - ENDIF - BUFFL(1) = DATA(14) - BUFFL(2) = DATA(15) - BUFFL(3) = 0.9996D0 - BUFFL(4) = ZERO - BUFFL(5) = DBLE (6 * ZONE - 183) * 1.0D6 - BUFFL(6) = ZERO - BUFFL(7) = 500000.0D0 - BUFFL(8) = ZERO - -c --- COORDS -c --- Use just the ZONE provided when setting the false Northing -c IF (DATA(2) .LT. ZERO) BUFFL(8) = 10000000.0D0 - - IF (KEEPZN .LT. 0) BUFFL(8) = 10000000.0D0 - IF (BUFFL(1).NE.0.0D0.AND.BUFFL(1).NE.SAVE9) SWITCH(9) = 0 - SAVE9 = BUFFL(1) - ITEMP = IPPARM - IPPARM = 1 - DO 145 I=1,8 - DATA(I) = BUFFL(I) - 145 CONTINUE - AZ = DATA(14) - EZ = DATA(15) - SWITCH(9) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STATE PLANE . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 2) THEN -C - IERROR = 0 - IF (SWITCH(2).NE.0 .AND. SWITCH(2).EQ.ZONE) RETURN - IF (ISPHER .NE. 0 .AND. ISPHER .NE. 8) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,205) ISPHER - 205 FORMAT('0ERROR PJ02Z0'/ - . ' SPHEROID NO. ',I4,' IS INVALID FOR STATE PLANE', - . ' TRANSFORMATIONS') - IERROR = 020 - RETURN - ENDIF - IF (ZONE .GT. 0) THEN - IND02 = 0 - IF (ISPHER .EQ. 0) THEN - DO 210 I = 1,134 - IF (ZONE .EQ. NAD27(I)) IND02 = I - 210 CONTINUE - ENDIF - IF (ISPHER .EQ. 8) THEN - DO 220 I = 1,134 - IF (ZONE .EQ. NAD83(I)) IND02 = I - 220 CONTINUE - ENDIF - IF (IND02 .EQ. 0) THEN - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - ELSE - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - IF (ISPHER .EQ. 0) THEN - LUNIT = LU27 - DATUM = FILE27 - ENDIF - IF (ISPHER .EQ. 8) THEN - LUNIT = LU83 - DATUM = FILE83 - ENDIF - OPEN (UNIT=LUNIT,FILE=DATUM,STATUS='OLD',ACCESS='DIRECT', - . RECL=LEN) - READ (UNIT=LUNIT,REC=IND02) PNAME,ID,TABLE - CLOSE (UNIT=LUNIT,STATUS='KEEP') - IF (ID .LE. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,240) ZONE, ISPHER - 240 FORMAT('0ERROR PJ02Z0'/ - . ' ILLEGAL ZONE NO. : ',I8,' FOR SPHEROID NO. : ',I4) - IERROR = 021 - RETURN - ENDIF - ITYPE = ID - AZ = TABLE(1) - ES = TABLE(2) - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - ITEMP = IPPARM - IPPARM = 1 -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - DATA(3) = TABLE(4) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 9 - SWITCH(MSYS) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - DATA(3) = PAKCZ0(TABLE(6)) - DATA(4) = PAKCZ0(TABLE(5)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 4 - SWITCH(MSYS) = 0 - KSYS = 4 - GO TO 400 - ENDIF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(4)) - DATA(7) = TABLE(5) - DATA(8) = TABLE(6) - MSYS = 7 - SWITCH(MSYS) = 0 - KSYS = 7 - GO TO 700 - ENDIF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - DATA(3) = TABLE(4) - DATA(4) = PAKCZ0(TABLE(6)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - DATA(13) = ONE - MSYS = 20 - SWITCH(MSYS) = 0 - KSYS = 20 - GO TO 2000 - ENDIF -C - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ALBERS CONICAL EQUAL AREA . -C ...................................................................... -C - IF (ISYS .EQ. 3) THEN -C - IERROR = 0 - IF (SWITCH(3).NE.0 .AND. SWITCH(3).EQ.ZONE) RETURN - SWITCH(3) = 0 - A03 = AZ - E03 = EZ - ES03 = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,340) - 340 FORMAT ('0ERROR PJ03Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 031 - RETURN - END IF - LON003 = PAKRZ0 (DATA(5)) - LAT003 = PAKRZ0 (DATA(6)) - X003 = DATA(7) - Y003 = DATA(8) - SINP03 = DSIN (LAT1) - CON = SINP03 - COSP03 = DCOS (LAT1) - MS1 = MSFNZ0 (E03,SINP03,COSP03) - QS1 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT2) - COSP03 = DCOS (LAT2) - MS2 = MSFNZ0 (E03,SINP03,COSP03) - QS2 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT003) - COSP03 = DCOS (LAT003) - QS0 = QSFNZ0 (E03,SINP03,COSP03) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS03 = (MS1 * MS1 - MS2 * MS2) / (QS2 - QS1) - ELSE - NS03 = CON - END IF - C = MS1 * MS1 + NS03 * QS1 - RH003 = A03 * DSQRT (C - NS03 * QS0) / NS03 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON003,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT003,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,350) A03,ES03, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X003,Y003 - 350 FORMAT ('0INITIALIZATION PARAMETERS (ALBERS CONICAL EQUAL-AREA', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A03 - DATA(2) = ES03 - SWITCH(3) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT CONFORMAL CONIC . -C ...................................................................... -C -400 CONTINUE - IF (KSYS.EQ.4.OR.ISYS .EQ. 4) THEN -C - IERROR = 0 - IF (SWITCH(4).NE.0 .AND. SWITCH(4).EQ.ZONE) RETURN - SWITCH(4) = 0 - A04 = AZ - E04 = EZ - ES = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,440) - 440 FORMAT ('0ERROR PJ04Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 041 - RETURN - END IF - LON004 = PAKRZ0 (DATA(5)) - LAT004 = PAKRZ0 (DATA(6)) - X004 = DATA(7) - Y004 = DATA(8) - SINP04 = DSIN (LAT1) - CON = SINP04 - COSP04 = DCOS (LAT1) - MS1 = MSFNZ0 (E04,SINP04,COSP04) - TS1 = TSFNZ0 (E04,LAT1,SINP04) - SINP04 = DSIN (LAT2) - COSP04 = DCOS (LAT2) - MS2 = MSFNZ0 (E04,SINP04,COSP04) - TS2 = TSFNZ0 (E04,LAT2,SINP04) - SINP04 = DSIN (LAT004) - TS0 = TSFNZ0 (E04,LAT004,SINP04) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS04 = DLOG (MS1 / MS2) / DLOG (TS1 / TS2) - ELSE - NS04 = CON - END IF - F04 = MS1 / (NS04 * TS1 ** NS04) - RH004 = A04 * F04 * TS0 ** NS04 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON004,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT004,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,450) A04,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X004,Y004 - 450 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT CONFORMAL CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A04 - DATA(2) = ES - SWITCH(4) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - 470 FORMAT (' INITIALIZATION PARAMETERS (STATE PLANE PROJECTION)'/ - . ' ZONE NUMBER = ',I4,5X,' ZONE NAME = ',A32) - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 5) THEN -C - IERROR = 0 - IF (SWITCH(5).NE.0 .AND. SWITCH(5).EQ.ZONE) RETURN - SWITCH(5) = 0 - A05 = AZ - E05 = EZ - ES = ESZ - LON005 = PAKRZ0 (DATA(5)) - LAT1 = PAKRZ0 (DATA(6)) - M1 = DCOS(LAT1) / (DSQRT( ONE - ES * DSIN(LAT1) **2)) - X005 = DATA(7) - Y005 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON005,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,550) A05,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X005,Y005 - 550 FORMAT ('0INITIALIZATION PARAMETERS (MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' CENTRAL LONGITUDE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A05 - DATA(2) = ES - SWITCH(5) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLAR STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 6) THEN -C - IERROR = 0 - IF (SWITCH(6).NE.0 .AND. SWITCH(6).EQ.ZONE) RETURN - SWITCH(6) = 0 - A06 = AZ - E06 = EZ - ES = ESZ - E4 = E4Z - LON006 = PAKRZ0 (DATA(5)) - SAVE = DATA(6) - LATC = PAKRZ0 (SAVE) - X006 = DATA(7) - Y006 = DATA(8) - FAC = ONE - IF (SAVE .LT. ZERO) FAC =-ONE - IND06 = 0 - IF (DABS(SAVE) .NE. NINTYD) THEN - IND06 = 1 - CON1 = FAC * LATC - SINPHI = DSIN (CON1) - COSPHI = DCOS (CON1) - MCS = MSFNZ0 (E06,SINPHI,COSPHI) - TCS = TSFNZ0 (E06,CON1,SINPHI) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON006,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LATC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,650) A06,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X006,Y006 - 650 FORMAT ('0INITIALIZATION PARAMETERS (POLAR STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF Y-AXIS = ',A1,2I3,F7.3/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A06 - DATA(2) = ES - SWITCH(6) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLYCONIC . -C ...................................................................... -C - 700 CONTINUE - IF (KSYS.EQ.7.OR.ISYS .EQ. 7) THEN -C - IERROR = 0 - IF (SWITCH(7).NE.0 .AND. SWITCH(7).EQ.ZONE) RETURN - SWITCH(7) = 0 - A07 = AZ - E07 = EZ - ES07 = ESZ - E007 = E0Z - E107 = E1Z - E207 = E2Z - E307 = E3Z - LON007 = PAKRZ0 (DATA(5)) - LAT007 = PAKRZ0 (DATA(6)) - X007 = DATA(7) - Y007 = DATA(8) - ML007 = MLFNZ0 (E007,E107,E207,E307,LAT007) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON007,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT007,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,750) A07,ES07, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X007,Y007 - 750 FORMAT ('0INITIALIZATION PARAMETERS (POLYCONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A07 - DATA(2) = ES07 - SWITCH(7) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIDISTANT CONIC . -C ...................................................................... -C - IF (ISYS .EQ. 8) THEN -C - IERROR = 0 - IF (SWITCH(8).NE.0 .AND. SWITCH(8).EQ.ZONE) RETURN - SWITCH(8) = 0 - A08 = AZ - E = EZ - ES = ESZ - E008 = E0Z - E108 = E1Z - E208 = E2Z - E308 = E3Z - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,840) - 840 FORMAT ('0ERROR PJ08Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 081 - RETURN - END IF - LON008 = PAKRZ0 (DATA(5)) - LAT0 = PAKRZ0 (DATA(6)) - X008 = DATA(7) - Y008 = DATA(8) - SINPHI = DSIN (LAT1) - COSPHI = DCOS (LAT1) - MS1 = MSFNZ0 (E,SINPHI,COSPHI) - ML1 = MLFNZ0 (E008,E108,E208,E308,LAT1) - IND = 0 - IF (DATA(9) .NE. ZERO) THEN - IND = 1 - SINPHI = DSIN (LAT2) - COSPHI = DCOS (LAT2) - MS2 = MSFNZ0 (E,SINPHI,COSPHI) - ML2 = MLFNZ0 (E008,E108,E208,E308,LAT2) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS08 = (MS1 - MS2) / (ML2 - ML1) - ELSE - NS08 = SINPHI - END IF - ELSE - NS08 = SINPHI - END IF - GL = ML1 + MS1 / NS08 - ML0 = MLFNZ0 (E008,E108,E208,E308,LAT0) - RH008 = A08 * (GL - ML0) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON008,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT0,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IND .NE. 0) THEN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,850) A08,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X008,Y008 - 850 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - ELSE - IF (IPPARM .EQ. 0) WRITE (IPPLUN,860) A08,ES, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=3,4), - . X008,Y008 - 860 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - END IF - DATA(1) = A08 - DATA(2) = ES - SWITCH(8) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . TRANSVERSE MERCATOR . -C ...................................................................... -C - 900 CONTINUE - IF (KSYS.EQ.9.OR.ISYS .EQ. 9) THEN -C - IERROR = 0 - IF (DATA(1).NE.0.0D0.AND.DATA(1).NE.SAVE) SWITCH(9) = 0 - IF (SWITCH(9).NE.0 .AND. SWITCH(9).EQ.ZONE) RETURN - SWITCH(9) = 0 - SAVE = DATA(1) - A09 = AZ - E09 = EZ - ES09 = ESZ - E009 = E0Z - E109 = E1Z - E209 = E2Z - E309 = E3Z - KS009 = DATA(3) - LON009 = PAKRZ0 (DATA(5)) - LAT009 = PAKRZ0 (DATA(6)) - X009 = DATA(7) - Y009 = DATA(8) - ML009 = A09 * MLFNZ0 (E009,E109,E209,E309,LAT009) - IND09 = 1 - ESP = ES09 - IF (E09 .GE. TOL09) THEN - IND09 = 0 - ESP = ES09 / (ONE - ES09) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON009,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT009,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,950) A09,ES09,KS009, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X009,Y009 - 950 FORMAT ('0INITIALIZATION PARAMETERS (TRANSVERSE MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE FACTOR AT C. MERIDIAN =',F9.6/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A09 - DATA(2) = ES09 - SWITCH(9) = ZONE -C -C LIST UTM PROJECTION INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 1) THEN - IPPARM = ITEMP - BUFFL(1) = A09 - BUFFL(2) = ES09 - ZONE = KEEPZN - SWITCH(9) = ZONE - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,960) ZONE,BUFFL(1), - . BUFFL(2),BUFFL(3), - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . BUFFL(7),BUFFL(8) - 960 FORMAT ('0INITIALIZATION PARAMETERS (U T M PROJECTION)'/ - . ' ZONE = ',I3/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID = ',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED = ',F18.15/ - . ' SCALE FACTOR AT C. MERIDIAN = ',F9.6/ - . ' LONGITUDE OF CENTRAL MERIDIAN= ',A1,2I3,F7.3/ - . ' FALSE EASTING = ',F12.2,' METERS'/ - . ' FALSE NORTHING = ',F12.2,' METERS') - SWITCH(1) = ZONE - RETURN - END IF -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 10) THEN -C - IERROR = 0 - IF (SWITCH(10).NE.0 .AND. SWITCH(10).EQ.ZONE) RETURN - SWITCH(10) = 0 - A10 = AZZ - LON010 = PAKRZ0 (DATA(5)) - LAT010 = PAKRZ0 (DATA(6)) - X010 = DATA(7) - Y010 = DATA(8) - SINP10 = DSIN (LAT010) - COSP10 = DCOS (LAT010) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON010,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT010,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1050) A10, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X010,Y010 - 1050 FORMAT ('0INITIALIZATION PARAMETERS (STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A10 - SWITCH(10) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT AZIMUTHAL EQUAL-AREA . -C ...................................................................... -C - IF (ISYS .EQ. 11) THEN -C - IERROR = 0 - IF (SWITCH(11).NE.0 .AND. SWITCH(11).EQ.ZONE) RETURN - SWITCH(11) = 0 - A11 = AZZ - LON011 = PAKRZ0 (DATA(5)) - LAT011 = PAKRZ0 (DATA(6)) - X011 = DATA(7) - Y011 = DATA(8) - SINP11 = DSIN (LAT011) - COSP11 = DCOS (LAT011) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON011,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT011,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1150) A11, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X011,Y011 - 1150 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT AZIMUTHAL EQUAL-AREA' - . ,' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A11 - SWITCH(11) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . AZIMUTHAL EQUIDISTANT . -C ...................................................................... -C - IF (ISYS .EQ. 12) THEN -C - IERROR = 0 - IF (SWITCH(12).NE.0 .AND. SWITCH(12).EQ.ZONE) RETURN - SWITCH(12) = 0 - A12 = AZZ - LON012 = PAKRZ0 (DATA(5)) - LAT012 = PAKRZ0 (DATA(6)) - X012 = DATA(7) - Y012 = DATA(8) - SINP12 = DSIN (LAT012) - COSP12 = DCOS (LAT012) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON012,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT012,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1250) A12, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X012,Y012 - 1250 FORMAT ('0INITIALIZATION PARAMETERS (AZIMUTHAL EQUIDISTANT', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A12 - SWITCH(12) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GNOMONIC . -C ...................................................................... -C - IF (ISYS .EQ. 13) THEN -C - IERROR = 0 - IF (SWITCH(13).NE.0 .AND. SWITCH(13).EQ.ZONE) RETURN - SWITCH(13) = 0 - A13 = AZZ - LON013 = PAKRZ0 (DATA(5)) - LAT013 = PAKRZ0 (DATA(6)) - X013 = DATA(7) - Y013 = DATA(8) - SINP13 = DSIN (LAT013) - COSP13 = DCOS (LAT013) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON013,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT013,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1350) A13, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X013,Y013 - 1350 FORMAT ('0INITIALIZATION PARAMETERS (GNOMONIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A13 - SWITCH(13) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ORTHOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 14) THEN -C - IERROR = 0 - IF (SWITCH(14).NE.0 .AND. SWITCH(14).EQ.ZONE) RETURN - SWITCH(14) = 0 - A14 = AZZ - LON014 = PAKRZ0 (DATA(5)) - LAT014 = PAKRZ0 (DATA(6)) - X014 = DATA(7) - Y014 = DATA(8) - SINP14 = DSIN (LAT014) - COSP14 = DCOS (LAT014) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON014,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT014,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1450) A14, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X014,Y014 - 1450 FORMAT ('0INITIALIZATION PARAMETERS (ORTHOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A14 - SWITCH(14) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GENERAL VERTICAL NEAR-SIDE PERSPECTIVE . -C ...................................................................... -C - IF (ISYS .EQ. 15) THEN -C - IERROR = 0 - IF (SWITCH(15).NE.0 .AND. SWITCH(15).EQ.ZONE) RETURN - SWITCH(15) = 0 - A15 = AZZ - P = ONE + DATA(3) / A15 - LON015 = PAKRZ0 (DATA(5)) - LAT015 = PAKRZ0 (DATA(6)) - X015 = DATA(7) - Y015 = DATA(8) - SINP15 = DSIN (LAT015) - COSP15 = DCOS (LAT015) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON015,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT015,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1550) A15,DATA(3), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X015,Y015 - 1550 FORMAT ('0INITIALIZATION PARAMETERS (GENERAL VERTICAL NEAR-SIDE', - . ' PERSPECTIVE PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' HEIGHT OF PERSPECTIVE POINT'/ - . ' ABOVE SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A15 - SWITCH(15) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SINUSOIDAL . -C ...................................................................... -C - IF (ISYS .EQ. 16) THEN -C - IERROR = 0 - IF (SWITCH(16).NE.0 .AND. SWITCH(16).EQ.ZONE) RETURN - SWITCH(16) = 0 - A16 = AZZ - LON016 = PAKRZ0 (DATA(5)) - X016 = DATA(7) - Y016 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON016,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1650) A16, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X016,Y016 - 1650 FORMAT ('0INITIALIZATION PARAMETERS (SINUSOIDAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A16 - SWITCH(16) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIRECTANGULAR . -C ...................................................................... -C - IF (ISYS .EQ. 17) THEN -C - IERROR = 0 - IF (SWITCH(17).NE.0 .AND. SWITCH(17).EQ.ZONE) RETURN - SWITCH(17) = 0 - A17 = AZZ - LAT1 = PAKRZ0 (DATA(6)) - LON017 = PAKRZ0 (DATA(5)) - X017 = DATA(7) - Y017 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON017,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1750) A17, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X017,Y017 - 1750 FORMAT ('0INITIALIZATION PARAMETERS (EQUIRECTANGULAR PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I2,F7.3/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A17 - SWITCH(17) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MILLER CYLINDRICAL . -C ...................................................................... -C - IF (ISYS .EQ. 18) THEN -C - IERROR = 0 - IF (SWITCH(18).NE.0 .AND. SWITCH(18).EQ.ZONE) RETURN - SWITCH(18) = 0 - A18 = AZZ - LON018 = PAKRZ0 (DATA(5)) - X018 = DATA(7) - Y018 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON018,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1850) A18, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X018,Y018 - 1850 FORMAT ('0INITIALIZATION PARAMETERS (MILLER CYLINDRICAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A18 - SWITCH(18) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . VAN DER GRINTEN I . -C ...................................................................... -C - IF (ISYS .EQ. 19) THEN -C - IERROR = 0 - IF (SWITCH(19).NE.0 .AND. SWITCH(19).EQ.ZONE) RETURN - SWITCH(19) = 0 - A19 = AZZ - LON019 = PAKRZ0 (DATA(5)) - X019 = DATA(7) - Y019 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON019,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1950) A19, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X019,Y019 - 1950 FORMAT ('0INITIALIZATION PARAMETERS (VAN DER GRINTEN I', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A19 - SWITCH(19) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . OBLIQUE MERCATOR (HOTINE) . -C ...................................................................... -C - 2000 CONTINUE - IF (KSYS.EQ.20.OR.ISYS .EQ. 20) THEN -C - IERROR = 0 - IF (SWITCH(20).NE.0 .AND. SWITCH(20).EQ.ZONE) RETURN - SWITCH(20) = 0 - MODE = 0 - IF (DATA(13) .NE. ZERO) MODE = 1 - A = AZ - E20 = EZ - ES = ESZ - KS0 = DATA(3) - LAT0 = PAKRZ0 (DATA(6)) - X020 = DATA(7) - Y020 = DATA(8) - SINPH0 = DSIN (LAT0) - COSPH0 = DCOS (LAT0) - CON = ONE - ES * SINPH0 * SINPH0 - COM = DSQRT (ONE - ES) - BL = DSQRT (ONE + ES * COSPH0 ** 4 / (ONE - ES)) - AL = A * BL * KS0 * COM / CON - IF (DABS(LAT0).LT.EPSLN) TS0 = 1.0D0 - IF (DABS(LAT0).LT.EPSLN) D=1.0D0 - IF (DABS(LAT0).LT.EPSLN) EL=1.0D0 - IF (DABS(LAT0).GE.EPSLN) THEN - TS0 = TSFNZ0 (E20,LAT0,SINPH0) - CON = DSQRT (CON) - D = BL * COM / (COSPH0 * CON) - F = D + DSIGN (DSQRT (DMAX1 ((D * D - ONE), 0.0D0)) , LAT0) - EL = F * TS0 ** BL - END IF - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2050) A,ES,KS0 - 2050 FORMAT ('0INITIALIZATION PARAMETERS (OBLIQUE MERCATOR ''HOTINE''', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE AT CENTER =',F12.9) - IF (MODE .NE. 0) THEN - ALPHA = PAKRZ0 (DATA(4)) - LONC = PAKRZ0 (DATA(5)) - G = HALF * (F - ONE / F) - GAMMA = ASINZ0 (DSIN (ALPHA) / D) - LON020 = LONC - ASINZ0 (G * DTAN (GAMMA)) / BL -C -C LIST INITIALIZATION PARAMETERS (CASE B). -C - CALL RADDZ0 (ALPHA,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LONC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT0,SGNA(3),DEGS(3),MINS(3),SECS(3)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2060) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,3) - 2060 FORMAT (' AZIMUTH OF CENTRAL LINE = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - CON = DABS (LAT0) - IF (CON.GT.EPSLN .AND. DABS(CON - HALFPI).GT.EPSLN) THEN - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - 2040 FORMAT ('0ERROR PJ20Z0'/ - . ' INPUT DATA ERROR') - IERROR = 201 - RETURN - END IF - END IF - LON1 = PAKRZ0 (DATA(9)) - LAT1 = PAKRZ0 (DATA(10)) - LON2 = PAKRZ0 (DATA(11)) - LAT2 = PAKRZ0 (DATA(12)) - SINPHI = DSIN (LAT1) - TS1 = TSFNZ0 (E20,LAT1,SINPHI) - SINPHI = DSIN (LAT2) - TS2 = TSFNZ0 (E20,LAT2,SINPHI) - H = TS1 ** BL - L = TS2 ** BL - F = EL / H - G = HALF * (F - ONE / F) - J = (EL * EL - L * H) / (EL * EL + L * H) - P = (L - H) / (L + H) - CALL RADDZ0 (LON2,SGNA(3),DEGS(3),MINS(3),SECS(3)) - DLON = LON1 - LON2 - IF (DLON .LT. -PI) LON2 = LON2 - 2.D0 * PI - IF (DLON .GT. PI) LON2 = LON2 + 2.D0 * PI - DLON = LON1 - LON2 - LON020 = HALF * (LON1 + LON2) - DATAN (J * DTAN (HALF * BL * - . DLON) / P) / BL - DLON = ADJLZ0 (LON1 - LON020) - GAMMA = DATAN (DSIN (BL * DLON) / G) - ALPHA = ASINZ0 (D * DSIN (GAMMA)) - CALL RADDZ0 (LON1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT1,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT2,SGNA(4),DEGS(4),MINS(4),SECS(4)) - CALL RADDZ0 (LAT0,SGNA(5),DEGS(5),MINS(5),SECS(5)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2070) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,5) - 2070 FORMAT (' LONGITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LONGITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - IF (DABS(LAT1 - LAT2) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - CON = DABS (LAT1) - END IF - IF (CON.LE.EPSLN .OR. DABS(CON - HALFPI).LE.EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - IF (DABS(DABS(LAT0) - HALFPI) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - END IF - END IF - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - 2080 FORMAT (' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ROBINSON . -C ...................................................................... -C - IF (ISYS .EQ. 21) THEN -C - IERROR = 0 - IF (SWITCH(21).NE.0 .AND. SWITCH(21).EQ.ZONE) RETURN - SWITCH(21) = 0 - A21 = AZZ - LON021 = PAKRZ0 (DATA(5)) - X021 = DATA(7) - Y021 = DATA(8) - PR(1)=-0.062D0 - XLR(1)=0.9986D0 - PR(2)=0.D0 - XLR(2)=1.D0 - PR(3)=0.062D0 - XLR(3)=0.9986D0 - PR(4)=0.124D0 - XLR(4)=0.9954D0 - PR(5)=0.186D0 - XLR(5)=0.99D0 - PR(6)=0.248D0 - XLR(6)=0.9822D0 - PR(7)=0.31D0 - XLR(7)=0.973D0 - PR(8)=0.372D0 - XLR(8)=0.96D0 - PR(9)=0.434D0 - XLR(9)=0.9427D0 - PR(10)=0.4958D0 - XLR(10)=0.9216D0 - PR(11)=0.5571D0 - XLR(11)=0.8962D0 - PR(12)=0.6176D0 - XLR(12)=0.8679D0 - PR(13)=0.6769D0 - XLR(13)=0.835D0 - PR(14)=0.7346D0 - XLR(14)=0.7986D0 - PR(15)=0.7903D0 - XLR(15)=0.7597D0 - PR(16)=0.8435D0 - XLR(16)=0.7186D0 - PR(17)=0.8936D0 - XLR(17)=0.6732D0 - PR(18)=0.9394D0 - XLR(18)=0.6213D0 - PR(19)=0.9761D0 - XLR(19)=0.5722D0 - PR(20)=1.0D0 - XLR(20)=0.5322D0 - DO 2110 I=1,20 - 2110 XLR(I)=XLR(I) * 0.9858D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON021,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2150) A21, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X021,Y021 - 2150 FORMAT ('0INITIALIZATION PARAMETERS (ROBINSON', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A21 - SWITCH(21) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SPACE OBLIQUE MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 22) THEN -C - IERROR = 0 - IF (SWITCH(22).NE.0 .AND. SWITCH(22).EQ.ZONE) RETURN - SWITCH(22) = 0 - A22 = AZ - E = EZ - ES22 = ESZ - X022 = DATA(7) - Y022 = DATA(8) - LAND = IDINT(DATA(3)+TOL) - PATH = IDINT(DATA(4)+TOL) -C -C CHECK IF LANDSAT NUMBER IS WITHIN RANGE 1 - 5 -C - IF (LAND .GT. 0 .AND. LAND .LE. 5) THEN - IF (LAND .LE. 3) LIMIT = 251 - IF (LAND .GE. 4) LIMIT = 233 - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - IERROR = 221 - RETURN - END IF -C -C CHECK IF PATH NUMBER IS WITHIN RANGE 1 - 251 FOR LANDSATS 1 - 3 -C OR RANGE 1 - 233 FOR LANDSATS 4 - 5 -C - IF (PATH .LE. 0 .OR. PATH .GT. LIMIT) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - 2240 FORMAT ('0ERROR PJ22Z0'/ - . ' LANDSAT NUMBER ',I2,' AND / OR PATH NUMBER ',I4, - . ' ARE OUT OF RANGE') - IERROR = 221 - RETURN - END IF - P1=1440.0D0 - IF (LAND.LE.3) THEN - P2=103.2669323D0 - ALF=99.092D0*DG1 - ELSE - P2=98.8841202D0 - ALF=98.20D0*DG1 - END IF - SA=DSIN(ALF) - CA=DCOS(ALF) - IF (DABS(CA).LT.1.D-9) CA=1.D-9 - ESC=ES22*CA*CA - ESS=ES22*SA*SA - W=((ONE-ESC)/(ONE-ES22))**TWO-ONE - Q=ESS/(ONE-ES22) - T=(ESS*(TWO-ES22))/(ONE-ES22)**TWO - U=ESC/(ONE-ES22) - XJ=(ONE-ES22)**3 - P22=P2/P1 -C -C COMPUTE FOURIER COEFFICIENTS. LAM IS CURRENT VALUE OF -C LAMBDA DOUBLE-PRIME. -C - LAM=0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=FA2 - SUMA4=FA4 - SUMB=FB - SUMC1=FC1 - SUMC3=FC3 - DO 2210 I=9,81,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+4.0D0*FA2 - SUMA4=SUMA4+4.0D0*FA4 - SUMB=SUMB+4.0D0*FB - SUMC1=SUMC1+4.0D0*FC1 - SUMC3=SUMC3+4.0D0*FC3 - 2210 CONTINUE - DO 2220 I=18,72,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+TWO*FA2 - SUMA4=SUMA4+TWO*FA4 - SUMB=SUMB+TWO*FB - SUMC1=SUMC1+TWO*FC1 - SUMC3=SUMC3+TWO*FC3 - 2220 CONTINUE - LAM=90.0D0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+FA2 - SUMA4=SUMA4+FA4 - SUMB=SUMB+FB - SUMC1=SUMC1+FC1 - SUMC3=SUMC3+FC3 -C -C THESE ARE THE VALUES OF FOURIER CONSTANTS. -C - A2=SUMA2/30.D0 - A4=SUMA4/60.D0 - B=SUMB/30.D0 - C1=SUMC1/15.D0 - C3=SUMC3/45.D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2250) A22,ES22,LAND,PATH, - . X022,Y022 - 2250 FORMAT ('0INITIALIZATION PARAMETERS (SPACE OBL. MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LANDSAT NO. = ',I3/ - . ' PATH = ',I5/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS'/) - DATA(1) = A22 - DATA(2) = ES22 - SWITCH(22) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) . -C ...................................................................... -C - IF (ISYS .EQ. 23) THEN -C - IERROR = 0 - IF (SWITCH(23).NE.0 .AND. SWITCH(23).EQ.ZONE) RETURN - SWITCH(23) = 0 - A23 = AZ - EC2 = 0.6768657997291094D-02 - EC = DSQRT (EC2) - N=6 - LON023 = -152.0D0*DG1 - LAT023 = 64.0D0*DG1 - X023 = DATA(7) - Y023 = DATA(8) - ACOEF(1)=0.9945303D0 - ACOEF(2)=0.0052083D0 - ACOEF(3)=0.0072721D0 - ACOEF(4)=-0.0151089D0 - ACOEF(5)=0.0642675D0 - ACOEF(6)=0.3582802D0 - BCOEF(1)=0.0D0 - BCOEF(2)=-.0027404D0 - BCOEF(3)=0.0048181D0 - BCOEF(4)=-0.1932526D0 - BCOEF(5)=-0.1381226D0 - BCOEF(6)=-0.2884586D0 - ESPHI=EC*DSIN(LAT023) - CHIO=TWO*DATAN(DTAN((HALFPI+LAT023)/TWO)*((ONE-ESPHI)/ - . (ONE+ESPHI))**(EC/TWO)) - HALFPI - SCHIO=DSIN(CHIO) - CCHIO=DCOS(CHIO) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON023,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT023,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2350) A23,EC2, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X023,Y023 - 2350 FORMAT ('0INITIALIZATION PARAMETERS (MOD. STEREOGRAPHIC', - . ' CONFORMAL PROJECTION, ALASKA)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A23 - SWITCH(23) = ZONE - RETURN - END IF -C -C INITIALIZATION OF PROJECTION COMPLETED -C - END -C PJ01Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * U T M * -C ********************************************************************** -C - SUBROUTINE PJ01Z0 (COORD,CRDIO,INDIC) -C -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /TOGGLE/ SWITCH - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ01Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 013 - RETURN - 140 CALL PJ09Z0 (GEOG,PROJ,FWD) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 160 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 014 - RETURN - 160 CALL PJ09Z0 (PROJ,GEOG,INV) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ02Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * STATE PLANE * -C ********************************************************************** -C - SUBROUTINE PJ02Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23), ITYPE - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ02/ ITYPE - COMMON /TOGGLE/ SWITCH -C - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - 250 FORMAT ('0ERROR PJ02Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 023 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (GEOG,PROJ,FWD) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (GEOG,PROJ,FWD) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (GEOG,PROJ,FWD) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (GEOG,PROJ,FWD) - END IF -C - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - IERROR = 025 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (PROJ,GEOG,INV) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (PROJ,GEOG,INV) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (PROJ,GEOG,INV) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (PROJ,GEOG,INV) - END IF -C - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ03Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ALBERS CONICAL EQUAL AREA * -C ********************************************************************** -C - SUBROUTINE PJ03Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,C,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ03/ A,LON0,X0,Y0,C,E,ES,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ03Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 033 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - QS = QSFNZ0 (E,SINPHI,COSPHI) - RH = A * DSQRT (C - NS * QS) / NS - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 034 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - CON = RH * NS / A - QS = (C - CON * CON) / NS - IF (E .LT. TOL) GO TO 260 - CON = ONE - HALF * (ONE - ES) * DLOG ((ONE - E) / - . (ONE + E)) / E - IF ((DABS(CON) - DABS(QS)) .GT. TOL) GO TO 260 - GEOG(2) = DSIGN (HALFPI , QS) - GO TO 280 - 260 GEOG(2) = PHI1Z0 (E,QS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 035 - RETURN - 280 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ04Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT CONFORMAL CONIC * -C ********************************************************************** -C - SUBROUTINE PJ04Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,F,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ04/ A,LON0,X0,Y0,E,F,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 200 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ04Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 043 - RETURN - 200 CON = DABS (DABS (GEOG(2)) - HALFPI) - IF (CON .GT. EPSLN) GO TO 220 - CON = GEOG(2) * NS - IF (CON .GT. ZERO) GO TO 210 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ04Z0'/ - . ' POINT CANNOT BE PROJECTED') - IERROR = 044 - RETURN - 210 RH = ZERO - GO TO 230 - 220 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - RH = A * F * TS ** NS - 230 THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 045 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X*X + Y*Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - IF (RH.NE.ZERO .OR. NS.GT.ZERO) GO TO 250 - GEOG(2) = - HALFPI - GO TO 260 - 250 CON = ONE / NS - TS = (RH / (A * F)) ** CON - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 260 - IERROR = 046 - RETURN - 260 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ05Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ05Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,X0,Y0,NS,F,RH0,LAT1,M1 ************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ05/ A,LON0,X0,Y0,E,M1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ05Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 052 - RETURN - 220 IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ05Z0'/ - . ' TRANSFORMATION CANNOT BE COMPUTED AT THE POLES') - IERROR = 053 - RETURN - 240 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - PROJ(1) = X0 + A * M1 * ADJLZ0 (GEOG(1) - LON0) - PROJ(2) = Y0 - A * M1 * DLOG (TS) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 260 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 054 - RETURN - 260 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - TS = DEXP (- Y / (A * M1)) - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 055 - RETURN - 280 GEOG(1) = ADJLZ0 (LON0 + X / (A * M1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ06Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLAR STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ06Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),IND - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,E4,MCS,TCS,FAC,IND ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ06/ A,LON0,X0,Y0,E,E4,FAC,MCS,TCS,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ06Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 062 - RETURN - 220 CON1 = FAC * ADJLZ0 (GEOG(1) - LON0) - CON2 = FAC * GEOG(2) - SINPHI = DSIN (CON2) - TS = TSFNZ0 (E,CON2,SINPHI) - IF (IND .EQ. 0) GO TO 240 - RH = A * MCS * TS / TCS - GO TO 260 - 240 RH = TWO * A * TS / E4 - 260 PROJ(1) = X0 + FAC * RH * DSIN (CON1) - PROJ(2) = Y0 - FAC * RH * DCOS (CON1) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 063 - RETURN - 320 X = FAC * (PROJ(1) - X0) - Y = FAC * (PROJ(2) - Y0) - RH = DSQRT (X * X + Y * Y) - IF (IND .EQ. 0) GO TO 340 - TS = RH * TCS / (A * MCS) - GO TO 360 - 340 TS = RH * E4 / (TWO * A) - 360 GEOG(2) = FAC * PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 380 - IERROR = 064 - RETURN - 380 IF (RH .NE. ZERO) GO TO 400 - GEOG(1) = FAC * LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 GEOG(1) = ADJLZ0 (FAC * DATAN2 (X , -Y) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ07Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLYCONIC * -C ********************************************************************** -C - SUBROUTINE PJ07Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,E0,E1,E2,ML0 ************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ07/ A,LON0,X0,Y0,E,E0,E1,E2,E3,ES,ML0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ07Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 072 - RETURN - 220 CON = ADJLZ0 (GEOG(1) - LON0) - IF (DABS(GEOG(2)) .GT. TOL) GO TO 240 - PROJ(1) = X0 + A * CON - PROJ(2) = Y0 - A * ML0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 240 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - MS = MSFNZ0 (E,SINPHI,COSPHI) - CON = CON * SINPHI - PROJ(1) = X0 + A * MS * DSIN (CON) / SINPHI - PROJ(2) = Y0 + A * (ML - ML0 + MS * (ONE - DCOS(CON)) / SINPHI) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 073 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - AL = ML0 + Y / A - IF (DABS (AL) .GT. TOL) GO TO 340 - GEOG(1) = X / A + LON0 - GEOG(2) = ZERO - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 340 B = AL * AL + (X / A) ** 2 - CALL PHI4Z0 (ES,E0,E1,E2,E3,AL,B,C,GEOG(2)) - IF (IERROR .EQ. 0) GO TO 360 - IERROR = 074 - RETURN - 360 GEOG(1) = ADJLZ0 (ASINZ0 (X * C / A) / DSIN (GEOG(2)) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ08Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIDISTANT CONIC * -C ********************************************************************** -C - SUBROUTINE PJ08Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C ** PARAMETERS * A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,E0,E1,E2,E3,NS,GL,RH0 - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ08/ A,LON0,X0,Y0,E0,E1,E2,E3,GL,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 300 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ08Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 083 - RETURN - 300 ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - RH = A * (GL - ML) - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - IERROR = 084 - RETURN - 320 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - ML = GL - RH / A - GEOG(2) = PHI3Z0 (ML,E0,E1,E2,E3) - IF (IERROR .EQ. 0) GO TO 340 - IERROR = 085 - RETURN - 340 GEOG(1) = ADJLZ0 (LON0 + THETA / NS) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ09Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * TRANSVERSE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ09Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),I,IND,NIT - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS ** A,E,ES,KS0,LON0,LAT0,X0,Y0,E0,E1,E2,E3,ESP,ML0,IND - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ09/ A,LON0,X0,Y0,ES,ESP,E0,E1,E2,E3,KS0,LAT0,ML0,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,HALF,ONE,TWO,THREE /0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ - DATA FOUR,FIVE,SIX,EIGHT,NINE /4.0D0,5.0D0,6.0D0,8.0D0,9.0D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TEN /10.0D0/ - DATA EPSLN,NIT /1.0D-10,6/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ09Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 092 - RETURN - 220 DLON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (IND .EQ. 0) GO TO 240 - COSPHI = DCOS (LAT) - B = COSPHI * DSIN (DLON) - IF (DABS(DABS(B) - ONE) .GT. EPSLN) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ09Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 093 - RETURN - 230 PROJ(1) = HALF * A * KS0 * DLOG ((ONE + B) / (ONE - B)) + X0 - CON = DACOS (COSPHI * DCOS (DLON) / DSQRT (ONE - B * B)) - IF (LAT .LT. ZERO) CON =-CON - PROJ(2) = A * KS0 * (CON - LAT0) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN -C - 240 SINPHI = DSIN (LAT) - COSPHI = DCOS (LAT) - AL = COSPHI * DLON - ALS = AL * AL - C = ESP * COSPHI * COSPHI - TQ = DTAN (LAT) - T = TQ * TQ - N = A / DSQRT (ONE - ES * SINPHI * SINPHI) - ML = A * MLFNZ0 (E0,E1,E2,E3,LAT) - PROJ(1) = KS0 * N * AL * (ONE + ALS / SIX * (ONE - T + C + - . ALS / 20.0D0 * (FIVE - 18.0D0 * T + T * T + 72.0D0 * - . C - 58.0D0 * ESP))) + X0 - PROJ(2) = KS0 *(ML - ML0 + N * TQ *(ALS *(HALF + ALS / 24.0D0 * - . (FIVE - T + NINE * C + FOUR * C * C + ALS / 30.0D0 * - . (61.0D0 - 58.0D0 * T + T * T + 600.0D0 * C - - . 330.0D0 * ESP))))) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 094 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - IF (IND .EQ. 0) GO TO 340 - F = DEXP (X / (A * KS0)) - G = HALF * (F - ONE / F) - TEMP = LAT0 + Y / (A * KS0) - H = DCOS (TEMP) - CON = DSQRT ((ONE - H * H) / (ONE + G * G)) - GEOG(2) = ASINZ0 (CON) - IF (TEMP .LT. ZERO) GEOG(2) =-GEOG(2) - IF (G.NE.ZERO .OR. H.NE.ZERO) GO TO 330 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 330 GEOG(1) = ADJLZ0 (DATAN2 (G,H) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN -C - 340 CON = (ML0 + Y / KS0) / A - PHI = CON - DO 360 I = 1,NIT - DPHI = ((CON + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .LE. EPSLN) GO TO 380 - 360 CONTINUE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) NIT - 2030 FORMAT ('0ERROR PI09Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS') - IERROR = 095 - RETURN - 380 IF (DABS(PHI) .LT. HALFPI) GO TO 400 - GEOG(2) = DSIGN (HALFPI , Y) - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 SINPHI = DSIN (PHI) - COSPHI = DCOS (PHI) - TANPHI = DTAN (PHI) - C = ESP * COSPHI * COSPHI - CS = C * C - T = TANPHI * TANPHI - TS = T * T - CON = ONE - ES * SINPHI * SINPHI - N = A / DSQRT (CON) - R = N * (ONE - ES) / CON - D = X / (N * KS0) - DS = D * D - GEOG(2) = PHI - (N * TANPHI * DS / R) * (HALF - DS / 24.0D0 * - . (FIVE + THREE * T + TEN * C - FOUR * CS - NINE * ESP - . - DS / 30.0D0 * (61.0D0 + 90.0D0 * T + 298.0D0 * C + - . 45.0D0 * TS - 252.0D0 * ESP - THREE * CS))) - GEOG(1) = ADJLZ0 (LON0 + (D * (ONE - DS / SIX * (ONE + TWO * - . T + C - DS / 20.0D0 * (FIVE - TWO * C + 28.0D0 * T - - . THREE * CS + EIGHT * ESP + 24.0D0 * TS))) / COSPHI)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ10Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ10Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ10/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ10Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 102 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(G + ONE) .GT. EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ10Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 103 - RETURN - 140 KSP = TWO / (ONE + G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 104 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = TWO * DATAN (RH / (TWO * A)) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ11Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT AZIMUTHAL EQUAL-AREA * -C ********************************************************************** -C - SUBROUTINE PJ11Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ11/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ11Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 112 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .NE. -ONE) GO TO 140 - CON = TWO * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO A CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 113 - RETURN - 140 KSP = DSQRT (TWO / (ONE + G)) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 114 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - CON = RH / (TWO * A) - IF (CON .LE. ONE) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ11Z0'/ - . ' INPUT DATA ERROR') - IERROR = 115 - RETURN - 230 Z = TWO * ASINZ0 (CON) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (CON .EQ. ZERO) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ12Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * AZIMUTHAL EQUIDISTANT * -C ********************************************************************** -C - SUBROUTINE PJ12Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ12/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ12Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 122 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(DABS(G) - ONE) .GE. EPSLN) GO TO 140 - KSP = ONE - IF (G .GE. ZERO) GO TO 160 - CON = TWO * HALFPI * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 123 - RETURN - 140 Z = DACOS (G) - KSP = Z / DSIN (Z) - 160 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 124 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. (TWO * HALFPI * A)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ12Z0'/ - . ' INPUT DATA ERROR') - IERROR = 125 - RETURN - 230 Z = RH / A - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ13Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GNOMONIC * -C ********************************************************************** -C - SUBROUTINE PJ13Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ13/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ13Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 132 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GT. ZERO) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT PROJECTS INTO INFINITY') - IERROR = 133 - RETURN - 140 KSP = ONE / G - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 134 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = DATAN (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ14Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ORTHOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ14Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ14/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ14Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 142 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - KSP = ONE - IF (G.GT.ZERO .OR. DABS(G).LE.EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 143 - RETURN - 140 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 144 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. A) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ14Z0'/ - . ' INPUT DATA ERROR') - IERROR = 145 - RETURN - 230 Z = ASINZ0 (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ15Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GENERAL VERTICAL NEAR-SIDE PERSPECTIVE * -C ********************************************************************** -C - SUBROUTINE PJ15Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,P,LON0,LAT0,X0,Y0,SINPH0,COSPH0 *************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ15/ A,LON0,X0,Y0,COSPH0,LAT0,P,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ15Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 152 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GE. (ONE / P)) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 153 - RETURN - 140 KSP = (P - ONE) / (P - G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 154 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - R = RH / A - CON = P - ONE - COM = P + ONE - IF (R .LE. DSQRT (CON / COM)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ15Z0'/ - . ' INPUT DATA ERROR') - IERROR = 155 - RETURN - 230 SINZ = (P - DSQRT (ONE - R * R * COM / CON)) / - . (CON / R + R / CON) - Z = ASINZ0 (SINZ) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ16Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SINUSOIDAL * -C ********************************************************************** -C - SUBROUTINE PJ16Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ16/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ16Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 162 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS (GEOG(2)) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 163 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ16Z0'/ - . ' INPUT DATA ERROR') - IERROR = 164 - RETURN - 230 CON = DABS (GEOG(2)) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 240 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS (GEOG(2)))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ17Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIRECTANGULAR * -C ********************************************************************** -C - SUBROUTINE PJ17Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0,LAT1 ******************************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ17/ A,LON0,X0,Y0,LAT1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ17Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 172 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS(LAT1) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 173 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ17Z0'/ - . ' INPUT DATA ERROR') - IERROR = 174 - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS(LAT1) )) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ18Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MILLER CYLINDRICAL * -C ********************************************************************** -C - SUBROUTINE PJ18Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ18/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA FORTPI /0.78539816339744833D0/ - DATA ZERO,ONEQ,TWOH /0.0D0,1.25D0,2.5D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ18Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 182 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 + A * DLOG (DTAN (FORTPI + GEOG(2) / TWOH)) * ONEQ - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 183 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(1) = ADJLZ0 (LON0 + X / A) - GEOG(2) = TWOH * DATAN (DEXP (Y / A / ONEQ)) - FORTPI * TWOH - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ19Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * VAN DER GRINTEN I * -C ********************************************************************** -C - SUBROUTINE PJ19Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ19/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN/1.0D-10/ - DATA ZERO,HALF,ONE,TWO,THREE/0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ19Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 192 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (DABS(LAT) .GT. EPSLN) GO TO 140 - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 140 THETA = ASINZ0 (DMIN1(DABS (LAT /HALFPI),ONE)) - IF (DABS(LON).GT.EPSLN.AND.DABS(DABS(LAT)-HALFPI).GT.EPSLN) - . GO TO 160 - PROJ(1) = X0 - PROJ(2) = Y0 + PI * A * DSIGN( DTAN (HALF * THETA), LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 160 AL = HALF * DABS (PI / LON - LON / PI) - ASQ = AL * AL - SINTHT = DSIN (THETA) - COSTHT = DCOS (THETA) - G = COSTHT / (SINTHT + COSTHT - ONE) - GSQ = G * G - M = G * (TWO / SINTHT - ONE) - MSQ = M * M - CON = PI * A * (AL * (G - MSQ) + DSQRT (ASQ * (G - MSQ)**2 - - . (MSQ + ASQ) * (GSQ - MSQ))) / (MSQ + ASQ) - CON = DSIGN (CON , LON) - PROJ(1) = X0 + CON - CON = DABS (CON / (PI * A)) - PROJ(2) = Y0 + DSIGN (PI * A * DSQRT (ONE - CON * CON - - . TWO * AL * CON) , LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ALGORITHM DEVELOPED BY D.P. RUBINCAM, THE AMERICAN CARTOGRAPHER, -C 1981, V. 8, NO. 2, P. 177-180. -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 193 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - CON = PI * A - XX = X / CON - YY = Y / CON - XYS = XX * XX + YY * YY - C1 = -DABS(YY) * (ONE + XYS) - C2 = C1 - TWO * YY * YY + XX * XX - C3 = -TWO * C1 + ONE + TWO * YY * YY + XYS*XYS - D = YY * YY / C3 + (TWO * C2 * C2 * C2/ C3/ C3/ C3 - 9.0D0 * C1 - . * C2/ C3/ C3) / 27.0D0 - A1 = (C1 - C2 * C2/ THREE/ C3)/ C3 - M1 = TWO * DSQRT(-A1/ THREE) - CON = ((THREE * D) / A1) / M1 - IF (DABS(CON).GT.ONE) CON = DSIGN(ONE,CON) - TH1 = DACOS(CON)/THREE - GEOG(2) = (-M1 * DCOS(TH1 + PI/ THREE) - C2/ THREE/ C3) - . * DSIGN(PI,Y) - IF (DABS(XX).GE.EPSLN) GO TO 230 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 230 CONTINUE - GEOG(1) = LON0 + PI * (XYS - ONE + DSQRT(ONE + TWO * (XX * XX - . - YY * YY) + XYS * XYS))/ TWO/ XX - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ20Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * OBLIQUE MERCATOR (HOTINE) * -C ********************************************************************** -C - SUBROUTINE PJ20Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,KS0,ALPHA,LONC,LON1,LAT1,LON2,LAT2,LAT0 ** -C ********************** X0,Y0,GAMMA,LON0,AL,BL,EL ********************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ20/ LON0,X0,Y0,AL,BL,COSALF,COSGAM,E,EL,SINALF,SINGAM,U0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TOL,EPSLN /1.0D-7,1.0D-10/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - 2050 FORMAT ('0ERROR PJ20Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 204 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - DLON = ADJLZ0 (GEOG(1) - LON0) - VL = DSIN (BL * DLON) - IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 230 - UL = SINGAM * DSIGN (ONE , GEOG(2)) - US = AL * GEOG(2) / BL - GO TO 250 - 230 TS = TSFNZ0 (E,GEOG(2),SINPHI) - Q = EL / TS ** BL - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - UL = (S * SINGAM - VL * COSGAM) / T - CON = DCOS (BL * DLON) - IF (DABS(CON) .LT. TOL) GO TO 240 - US = AL * DATAN ((S * COSGAM + VL * SINGAM) / CON) / BL - IF (CON .LT. ZERO) US = US + PI * AL / BL - GO TO 250 - 240 US = AL * BL * DLON - 250 IF (DABS(DABS(UL) - ONE) .GT. EPSLN) GO TO 255 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2060) - 2060 FORMAT ('0ERROR PJ20Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 205 - RETURN - 255 VS = HALF * AL * DLOG ((ONE - UL) / (ONE + UL)) / BL - US = US - U0 - PROJ(1) = X0 + VS * COSALF + US * SINALF - PROJ(2) = Y0 + US * COSALF - VS * SINALF - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 280 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - IERROR = 206 - RETURN - 280 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - VS = X * COSALF - Y * SINALF - US = Y * COSALF + X * SINALF - US = US + U0 - Q = DEXP (- BL * VS / AL) - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - VL = DSIN (BL * US / AL) - UL = (VL * COSGAM + S * SINGAM) / T - IF (DABS (DABS (UL) - ONE) .GE. EPSLN) GO TO 300 - GEOG(1) = LON0 - GEOG(2) = DSIGN (HALFPI , UL) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 300 CON = ONE / BL - TS = (EL / DSQRT ((ONE + UL) / (ONE - UL))) ** CON - GEOG(2) = PHI2Z0 (E,TS) - CON = DCOS (BL * US / AL) - LON = LON0 - DATAN2 ((S * COSGAM - VL * SINGAM) , CON) / BL - GEOG(1) = ADJLZ0 (LON) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ21Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ROBINSON * -C ********************************************************************** -C - SUBROUTINE PJ21Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,IP1,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . PR(20),XLR(20) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ21/ A,LON0,X0,Y0,PR,XLR - COMMON /TOGGLE/ SWITCH - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ21Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 212 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - P2=DABS(GEOG(2)/5.0D0/DG1) - IP1=IDINT(P2-EPSLN) -C -C STIRLING'S INTERPOLATION FORMULA (USING 2ND DIFF.) -C USED WITH LOOKUP TABLE TO COMPUTE RECTANGULAR COORDINATES -C FROM LAT/LONG. -C - P2=P2-DBLE(IP1) - X=A*(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0)*LON - Y=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . *DSIGN(1.0D0,GEOG(2)) - PROJ(1) = X0 + X - PROJ(2) = Y0 + Y - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 213 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - YY = 2.0D0 * Y / PI / A - PHID = YY * 90.0D0 - P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - IF (IP1.EQ.0) IP1 = 1 - NN = 0 -C -C STIRLING'S INTERPOLATION FORMULA AS USED IN FORWARD TRANSFORMATION -C IS REVERSED FOR FIRST ESTIMATION OF LAT. FROM RECTANGULAR -C COORDINATES. LAT. IS THEN ADJUSTED BY ITERATION UNTIL USE OF -C FORWARD SERIES PROVIDES CORRECT VALUE OF Y WITHIN TOLERANCE. -C - 230 U = PR(IP1 + 3) - PR(IP1 + 1) - V = PR(IP1 + 3) - 2.0D0 * PR(IP1 + 2) + PR(IP1 + 1) - T = 2.0D0 * (DABS(YY) - PR(IP1 + 2))/ U - C = V / U - P2 = T * (1.0D0 - C * T * (1.0D0 - 2.0D0 * C * T)) - IF (P2.LT.0.0D0.AND.IP1.NE.1) GO TO 240 - PHID = DSIGN((P2 + DBLE(IP1)) * 5.0D0, Y) - 235 P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - P2 = P2 - DBLE(IP1) - Y1=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . * DSIGN(1.0D0,Y) - PHID = PHID - 180.0D0* (Y1 - Y) / PI / A - NN = NN + 1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,245) - IERROR = 214 - RETURN - 237 IF (DABS(Y1 - Y).GT.0.00001D0) GO TO 235 - GO TO 250 - 240 IP1 = IP1 - 1 - GO TO 230 - 245 FORMAT ('0ERROR PJ21Z0'/ - . ' TOO MANY ITERATIONS FOR INVERSE ROBINSON') - 250 GEOG(2) = PHID * DG1 -C -C CALCULATE LONG. USING FINAL LAT. WITH TRANSPOSED FORWARD -C STIRLING'S INTERPOLATION FORMULA. -C - GEOG(1)=LON0+X/A/(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0) - GEOG(1) = ADJLZ0(GEOG(1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ22Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SPACE OBLIQUE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ22Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,PATH,LAND,NN,L - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,MCS,TCS,FAC,IND ********** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - COMMON /PJ22/ A,X0,Y0,A2,A4,B,C1,C3,LAND,PATH - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ22Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 222 - RETURN - 220 IF (LAND.GE.4) GO TO 225 - LON=GEOG(1)-128.87D0*DG1+PI*TWO/251.D0*DBLE(PATH) - GO TO 230 - 225 LON=GEOG(1)-129.30D0*DG1+PI*TWO/233.D0*DBLE(PATH) - 230 LAT=GEOG(2) -C -C TEST FOR LAT. AND LONG. APPROACHING 90 DEGREES. -C - IF (LAT.GT.1.570796D0) LAT=1.570796D0 - IF (LAT.LT.-1.570796D0) LAT =-1.570796D0 - IF (LAT.GE.0) LAMPP=PI/TWO - IF (LAT.LT.0) LAMPP=1.5D0*PI - NN=0 - 231 SAV=LAMPP - L=0 - LAMTP=LON+P22*LAMPP - CL=DCOS(LAMTP) - IF (DABS(CL).LT.TOL) LAMTP=LAMTP-TOL - FAC=LAMPP-(DSIGN(ONE,CL))*DSIN(LAMPP)*PI/TWO - 232 LAMT=LON+P22*SAV - C=DCOS(LAMT) - IF (DABS(C).LT.TOL) THEN - LAMDP = SAV - GO TO 233 - END IF - XLAM=((ONE-ES)*DTAN(LAT)*SA+DSIN(LAMT)*CA)/C - LAMDP=DATAN(XLAM) - LAMDP=LAMDP+FAC - DIF=DABS(SAV)-DABS(LAMDP) - IF (DABS(DIF).LT.TOL) GO TO 233 - SAV=LAMDP - L=L+1 - IF (L.GT.50) GO TO 234 - GO TO 232 -C -C ADJUST FOR LANDSAT ORIGIN. -C - 233 RLM=PI*(16.D0/31.D0+ONE/248.D0) - RLM2=RLM+TWO*PI - NN=NN+1 - IF (NN.GE.3) GO TO 236 - IF (LAMDP.GT.RLM.AND.LAMDP.LT.RLM2) GO TO 236 - IF (LAMDP.LE.RLM) LAMPP=2.5D0*PI - IF (LAMDP.GE.RLM2) LAMPP=PI/TWO - GO TO 231 - 234 IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ22Z0'/ - . ' 50 ITERATIONS WITHOUT CONVERGENCE.') - IERROR = 223 - 236 CONTINUE -C -C LAMDP COMPUTED. NOW COMPUTE PHIDP. -C - SP=DSIN(LAT) - PHIDP=ASINZ0(((ONE-ES)*CA*SP-SA*DCOS(LAT)*DSIN(LAMT))/DSQRT(ONE - . -ES*SP*SP)) -C -C COMPUTE X AND Y -C - TANPH=DLOG(DTAN(PI/4.0D0+PHIDP/TWO)) - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE - . +Q*SDSQ))) - D=DSQRT(XJ*XJ+S*S) - X=B*LAMDP+A2*DSIN(TWO*LAMDP)+A4*DSIN(4.0D0*LAMDP)-TANPH*S/D - X=A*X - Y=C1*SD+C3*DSIN(3.0D0*LAMDP)+TANPH*XJ/D - Y=A*Y - PROJ(1)=X+X0 - PROJ(2)=Y+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 224 - RETURN - 320 X = PROJ(1) -X0 - Y = PROJ(2) -Y0 -C -C COMPUTE TRANSFORMED LAT/LONG AND GEODETIC LAT/LONG, GIVEN X,Y. -C -C BEGIN INVERSE COMPUTATION WITH APPROXIMATION FOR LAMDP. SOLVE -C FOR TRANSFORMED LONG. -C - LAMDP=X/A/B - NN=0 - 325 SAV=LAMDP - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE+Q - . *SDSQ))) - LAMDP=X/A+Y/A*S/XJ-A2*DSIN(TWO*LAMDP)-A4*DSIN(4.0D0*LAMDP) - . -(S/XJ)*(C1*DSIN(LAMDP)+C3*DSIN(3.0D0*LAMDP)) - LAMDP=LAMDP/B - DIF=LAMDP-SAV - IF (DABS(DIF).LT.TOL) GO TO 330 - NN=NN+1 - IF (NN.EQ.50) GO TO 330 - GO TO 325 -C -C COMPUTE TRANSFORMED LAT. -C - 330 SL=DSIN(LAMDP) - FAC=DEXP(DSQRT(ONE+S*S/XJ/XJ)*(Y/A-C1*SL-C3*DSIN(3.0D0*LAMDP))) - ACTAN=DATAN(FAC) - PHIDP=TWO*(ACTAN-PI/4.0D0) -C -C COMPUTE GEODETIC LATITUDE. -C - DD=SL*SL - IF (DABS(DCOS(LAMDP)).LT.TOL) LAMDP=LAMDP-TOL - SPP=DSIN(PHIDP) - SPPSQ=SPP*SPP - LAMT=DATAN(((ONE-SPPSQ/(ONE-ES))*DTAN(LAMDP)*CA-SPP*SA*DSQRT(( - . ONE+Q*DD)*(ONE-SPPSQ)-SPPSQ*U)/DCOS(LAMDP))/(ONE-SPPSQ*(ONE+U)) - . ) -C -C CORRECT INVERSE QUADRANT. -C - IF (LAMT.GE.0) SL=ONE - IF (LAMT.LT.0) SL=-ONE - IF (DCOS(LAMDP).GE.0) SCL=ONE - IF (DCOS(LAMDP).LT.0) SCL=-ONE - LAMT=LAMT-PI/TWO*(ONE-SCL)*SL - LON=LAMT-P22*LAMDP -C -C COMPUTE GEODETIC LATITUDE. -C - IF (DABS(SA).LT.TOL) LAT=ASINZ0(SPP/DSQRT((ONE-ES)*(ONE-ES) - . +ES*SPPSQ)) - IF (DABS(SA).LT.TOL) GO TO 335 - LAT=DATAN((DTAN(LAMDP)*DCOS(LAMT)-CA*DSIN(LAMT))/((ONE-ES)*SA)) - 335 CONTINUE - IF (LAND.GE.4) GO TO 370 - GEOG(1)=LON+128.87D0*DG1-PI*TWO/251.D0*DBLE(PATH) - GO TO 380 - 370 GEOG(1)=LON+129.30D0*DG1-PI*TWO/233.D0*DBLE(PATH) - 380 GEOG(2)=LAT - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ23Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) * -C ********************************************************************** -C - SUBROUTINE PJ23Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,N,J,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . ACOEF(6),BCOEF(6) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ23/ A,LON0,X0,Y0,ACOEF,BCOEF,EC,LAT0,CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ23Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 232 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) -C -C CALCULATE X-PRIME AND Y-PRIME FOR OBLIQUE STEREOGRAPHIC PROJ. -C FROM LAT/LONG. -C - SINLON = DSIN (LON) - COSLON = DCOS (LON) - ESPHI = EC *DSIN(GEOG(2)) - CHI=TWO*DATAN(DTAN((HALFPI+GEOG(2))/TWO)*((ONE-ESPHI)/(ONE - . +ESPHI))**(EC/TWO)) - HALFPI - SCHI=DSIN(CHI) - CCHI=DCOS(CHI) - G=SCHIO*SCHI+CCHIO*CCHI*COSLON - S=TWO/(ONE+G) - XP=S*CCHI*SINLON - YP=S*(CCHIO*SCHI-SCHIO*CCHI*COSLON) -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C OBLIQUE STEREOGRAPHIC TO MODIFIED-STEREOGRAPHIC COORD. -C - R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - DO 140 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 140 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - 140 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - X=XP*AR-YP*AI+BR - Y=YP*AR+XP*AI+BI - PROJ(1)=X*A+X0 - PROJ(2)=Y*A+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 234 - RETURN - 220 X = (PROJ(1) - X0)/A - Y = (PROJ(2) - Y0)/A - XP=X - YP=Y - NN=0 -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C MODIFIED-STEREOGRAPHIC CONFORMAL TO OBLIQUE STEREOGRAPHIC -C COORDINATES (XP,YP). -C - 225 R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - CR=DBLE(N)*AR - CI=DBLE(N)*AI - DR=(DBLE(N-1))*BR - DI=(DBLE(N-1))*BI - DO 230 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 230 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - CRN=DR+R*CR - CIN=DI+R*CI - DR=DBLE(N-J)*ACOEF(N-J)-S*CR - DI=DBLE(N-J)*BCOEF(N-J)-S*CI - CR=CRN - CI=CIN - 230 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - FXYR=XP*AR-YP*AI+BR-X - FXYI=YP*AR+XP*AI+BI-Y - FPXYR=XP*CR-YP*CI+DR - FPXYI=YP*CR+XP*CI+DI - DEN=FPXYR*FPXYR+FPXYI*FPXYI - DXP=-(FXYR*FPXYR+FXYI*FPXYI)/DEN - DYP=-(FXYI*FPXYR-FXYR*FPXYI)/DEN - XP=XP+DXP - YP=YP+DYP - DS=DABS(DXP)+DABS(DYP) - NN=NN+1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN ITERATING INVERSE') - IERROR = 235 - GO TO 238 - 237 IF (DS.GT.EPSLN) GO TO 225 -C -C CONVERT OBLIQUE STEREOGRAPHIC COORDINATES TO LAT/LONG. -C - 238 RH = DSQRT (XP * XP + YP * YP) - Z = TWO * DATAN (RH / TWO) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 CHI = ASINZ0 (COSZ * SCHIO + YP *SINZ * CCHIO / RH) - NN=0 - PHI=CHI - 250 ESPHI=EC*DSIN(PHI) - DPHI=TWO*DATAN(DTAN((HALFPI+CHI)/TWO)*((ONE+ESPHI)/(ONE-ESPHI)) - . **(EC/TWO)) - HALFPI - PHI - PHI = PHI + DPHI - NN = NN + 1 - IF (NN.LE.20) GO TO 257 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,255) - 255 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN CALCULATING PHI FROM CHI') - IERROR = 236 - GO TO 260 - 257 IF (DABS(DPHI).GT.EPSLN) GO TO 250 - 260 GEOG(2)=PHI - GEOG(1) = ADJLZ0 (LON0 + DATAN2(XP*SINZ, RH*CCHIO*COSZ-YP*SCHIO - . *SINZ)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C QSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION QSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL Q). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-7/ -C - IF (ECCENT .LT. EPSLN) GO TO 020 - CON = ECCENT * SINPHI - QSFNZ0 = (ONE - ECCENT * ECCENT) * (SINPHI / (ONE - CON * CON) - - . (HALF / ECCENT) * DLOG ((ONE - CON) / (ONE + CON))) - RETURN -C - 020 QSFNZ0 = TWO * SINPHI - RETURN - END -C RADDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE RADDZ0 (RAD,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT ANGLE FROM RADIANS TO SIGNED DMS -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - REAL*8 RAD,CON,RADSEC,ZERO,TOL - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,BLANK,NEG - DATA RADSEC /206264.806247D0/ - DATA ZERO,TOL /0.0D0,1.0D-4/ - DATA BLANK,NEG /' ','-'/ -C -C CONVERT THE ANGLE TO SECONDS. -C - CON = DABS(RAD) * RADSEC - ISEC = IDINT(CON + TOL) -C -C DETERMINE THE SIGN OF THE ANGLE. -C - SGNA = BLANK - IF (RAD .LT. ZERO .AND. CON .GE. 0.00005D0) SGNA = NEG - IF (CON .LT. 0.00005D0) CON = ZERO -C -C COMPUTE DEGREES PART OF THE ANGLE. -C - INTG = ISEC / 3600 - DEGS = INTG - ISEC = INTG * 3600 - CON = CON - DBLE(ISEC) - ISEC = IDINT(CON + TOL) -C -C COMPUTE MINUTES PART OF THE ANGLE. -C - MINS = ISEC / 60 - ISEC = MINS * 60 - CON = CON - DBLE(ISEC) -C -C COMPUTE SECONDS PART OF THE ANGLE. -C - SECS = SNGL(CON) -C -C INCREASE MINS IF SECS CLOSE TO 60.000 -C - IF(SECS .LT. 59.9995D0) RETURN - MINS = MINS + 1 - SECS = 0.0 -C -C INCREASE DEGS IF MINS EQUAL 60 -C - IF(MINS .LE. 59) RETURN - MINS = 0 - DEGS = DEGS + 1 -C - RETURN - END -C SERAZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) -C -C COMPUTES INTEGRAL FUNCTION OF TRANSFORMED LONG. FOR FOURIER -C CONSTANTS A2, A4, B, C1, AND C3. -C LAM IS INTEGRAL VALUE OF TRANSFORMED LONG. -C - IMPLICIT REAL*8 (A-Z) - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - DATA DG1 /0.01745329252D0/ - DATA ONE,TWO /1.0D0,2.0D0/ - LAM=LAM*DG1 - SD=DSIN(LAM) - SDSQ=SD*SD - S=P22*SA*DCOS(LAM)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ) - . *(ONE+Q*SDSQ))) - H=DSQRT((ONE+Q*SDSQ)/(ONE+W*SDSQ))*(((ONE+W*SDSQ)/ - . ((ONE+Q*SDSQ)**TWO))-P22*CA) - SQ=DSQRT(XJ*XJ+S*S) - FB=(H*XJ-S*S)/SQ - FA2=FB*DCOS(TWO*LAM) - FA4=FB*DCOS(4.0D0*LAM) - FC=S*(H+XJ)/SQ - FC1=FC*DCOS(LAM) - FC3=FC*DCOS(3.0D0*LAM) - RETURN - END -C SPHDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SPHDZ0(ISPH,PARM) -C -C SUBROUTINE TO COMPUTE SPHEROID PARAMETERS -C -C ISPH IS THE SPHEROID CODE FROM THE FOLLOWING LIST: -C 0 = CLARKE 1866 1 = CLARKE 1880 -C 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C 4 = INTERNATIONAL 1909 5 = WGS 72 -C 6 = EVEREST 7 = WGS 66 -C 8 = GRS 1980 9 = AIRY -C 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C 12 = WGS 84 13 = SOUTHEAST ASIA -C 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C 16 = HOUGH 17 = MERCURY 1960 -C 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C 20 = INTERNATIONAL 1924 -C -C PARM IS ARRAY OF PROJECTION PARAMETERS: -C PARM(1) IS THE SEMI-MAJOR AXIS -C PARM(2) IS THE ECCENTRICITY SQUARED -C -C IF ISPH IS NEGATIVE, USER SPECIFIED PROJECTION PARAMETERS ARE TO -C DEFINE THE RADIUS OF SPHERE OR ELLIPSOID CONSTANTS AS APPROPRIATE -C -C IF ISPH = 0 , THE DEFAULT IS RESET TO CLARKE 1866 -C -C **** ***** -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION PARM(15),AXIS(21),BXIS(21) -C - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PROJZ0/ IPROJ -C - DATA ZERO,ONE /0.0D0,1.0D0/ -C - DATA AXIS/6378206.4D0,6378249.145D0,6377397.155D0,6378157.5D0, - . 6378388.0D0,6378135.0D0,6377276.3452D0,6378145.0D0,6378137.0D0, - . 6377563.396D0,6377304.063D0,6377340.189D0,6378137.0D0,6378155.D0, - . 6378160.0D0,6378245.0D0,6378270.0D0,6378166.0D0,6378150.0D0, - . 6370997.0D0,6378388.0D0/ -C - DATA BXIS/6356583.8D0,6356514.86955D0,6356078.96284D0, - . 6356772.2D0,6356911.94613D0,6356750.519915D0,6356075.4133D0, - . 6356759.769356D0,6356752.314140D0,6356256.91D0,6356103.039D0, - . 6356034.448D0,6356752.314245D0,6356773.3205D0,6356774.719D0, - . 6356863.0188D0,6356794.343479D0,6356784.283666D0,6356768.337303D0 - . ,6370997.0D0,6356911.95D0/ -C - IF (ISPH.GE.0) GO TO 5 -C -C INITIALIZE USER SPECIFIED SPHERE AND ELLIPSOID PARAMETERS -C - AZZ = ZERO - AZ = ZERO - EZ = ZERO - ESZ = ZERO - E0Z = ZERO - E1Z = ZERO - E2Z = ZERO - E3Z = ZERO - E4Z = ZERO -C -C FETCH FIRST TWO USER SPECIFIED PROJECTION PARAMETERS -C - A = DABS(PARM(1)) - B = DABS(PARM(2)) - IF (A .GT. ZERO .AND. B .GT. ZERO) GO TO 13 - IF (A .GT. ZERO .AND. B .LE. ZERO) GO TO 12 - IF (A .LE. ZERO .AND. B .GT. ZERO) GO TO 11 -C -C DEFAULT NORMAL SPHERE AND CLARKE 1866 ELLIPSOID -C - JSPH = 1 - GO TO 10 -C -C DEFAULT CLARKE 1866 ELLIPSOID -C - 11 A = AXIS(1) - B = BXIS(1) - GO TO 14 -C -C USER SPECIFIED RADIUS OF SPHERE -C - 12 AZZ = A - GO TO 15 -C -C USER SPECIFIED SEMI-MAJOR AND SEMI-MINOR AXES OF ELLIPSOID -C - 13 IF (B .LE. ONE) GO TO 15 - 14 ES = ONE - (B / A)**2 - GO TO 16 -C -C USER SPECIFIED SEMI-MAJOR AXIS AND ECCENTRICITY SQUARED -C - 15 ES = B - 16 AZ = A - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - PARM(1) = A - PARM(2) = ES - RETURN -C -C CHECK FOR VALID SPHEROID SELECTION -C - 5 IF (PARM(1).NE.ZERO.AND.IPROJ.NE.1) RETURN - JSPH = IABS(ISPH) + 1 - IF (JSPH.LE.21) GO TO 10 - IERROR = 999 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,1) ISPH - 1 FORMAT('0ERROR SPHDZ0: SPHEROID CODE OF ',I5,' RESET TO 0') - ISPH = 0 - JSPH = 1 -C -C RETRIEVE A AND B AXES FOR SELECTED SPHEROID -C - 10 A = AXIS(JSPH) - B = BXIS(JSPH) - ES = ONE - (B / A)**2 -C -C SET COMMON BLOCK PARAMETERS FOR SELECTED SPHEROID -C - AZZ = 6370997.0D0 - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - AZ = A - ESZ = ES - IF (ES.EQ.ZERO) AZZ=A -C - PARM(1) = A - PARM(2) = ES - RETURN - END -C TSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION TSFNZ0 (ECCENT,PHI,SINPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL T). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE /0.5D0,1.0D0/ - DATA HALFPI /1.5707963267948966D0/ -C - CON = ECCENT * SINPHI - COM = HALF * ECCENT - CON = ((ONE - CON) / (ONE + CON)) ** COM - TSFNZ0 = DTAN (HALF * (HALFPI - PHI)) / CON -C - RETURN - END -C UNTFZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE UNTFZ0 (INUNIT,IOUNIT,FACTOR,IFLG) -C -C SUBROUTINE TO DETERMINE CONVERGENCE FACTOR BETWEEN TWO LINEAL UNITS -C -C * INPUT ........ -C * INUNIT * UNIT CODE OF SOURCE. -C * IOUNIT * UNIT CODE OF TARGET. -C -C * OUTPUT ....... -C * FACTOR * CONVERGENCE FACTOR FROM SOURCE TO TARGET. -C * IFLG * RETURN FLAG .EQ. 0 , NORMAL RETURN. -C RETURN FLAG .NE. 0 , ABNORMAL RETURN. -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION FACTRS(6,6) - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - PARAMETER (ZERO = 0.0D0, MAXUNT = 6) - DATA FACTRS /0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.2062648062470963D06 , - . 0.5729577951308231D02 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.3048006096012192D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000002000004000D01 , - . 0.0000000000000000D00 , 0.3280833333333333D01 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3280839895013124D01 , - . 0.4848136811095360D-5 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.2777777777777778D-3 , 0.0000000000000000D00 , - . 0.1745329251994330D-1 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3600000000000000D04 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.9999980000000000D00 , - . 0.3048000000000000D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 / -C - IF (INUNIT .GE. 0 .AND. INUNIT .LT. MAXUNT .AND. - . IOUNIT .GE. 0 .AND. IOUNIT .LT. MAXUNT) THEN - FACTOR = FACTRS(IOUNIT+1 , INUNIT+1) - IF (FACTOR .NE. ZERO) THEN - IFLG = 0 - RETURN - ELSE - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INUNIT,IOUNIT - 2000 FORMAT (' INCONSISTENT UNIT CODES = ',I6,' / ',I6) - IFLG = 12 - RETURN - END IF - ELSE - IF (INUNIT.LT.0 .OR. INUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) INUNIT,IOUNIT - 2010 FORMAT (' ILLEGAL SOURCE OR TARGET UNIT CODE = ',I6,' / ', - . I6) - END IF - IF (IOUNIT.LT.0 .OR. IOUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOUNIT,IOUNIT - END IF - IFLG = 11 - RETURN - END IF -C - END diff --git a/CALPUFF_SRC/CTGPROC/cpl.bat b/CALPUFF_SRC/CTGPROC/cpl.bat deleted file mode 100644 index 91cb727..0000000 --- a/CALPUFF_SRC/CTGPROC/cpl.bat +++ /dev/null @@ -1,14 +0,0 @@ -REM Compiling and linking with CTGPROC using Lahey LF95 for Windows - -lf95 ctgproc.for -o0 -co -sav -trap doi -out ctgproc.exe >cpl.txt - -del *.obj -del *.map - -rem Switch settings ------------------------------ -rem -o0 No optimization -rem -co Display the compiler options that are used -rem -sav Save local variables -rem -trap doi Trap NDP divide-by-zero (d), overflow (o), and invalid operation (i) -rem -out Name the compiled executable to "ctgproc.exe" -rem > Send compiler screen output to file "cpl.txt" diff --git a/CALPUFF_SRC/CTGPROC/filnam.ctg b/CALPUFF_SRC/CTGPROC/filnam.ctg deleted file mode 100644 index 88a01a7..0000000 --- a/CALPUFF_SRC/CTGPROC/filnam.ctg +++ /dev/null @@ -1,34 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /FILNAM/ -- File names CTGPROC -c----------------------------------------------------------------------- - character*132 runinp,runlst,luindat,ludat,prevdat,gshhsin, - & coastbln - character*132 justname - logical lcfiles - - common /FILNAM/ runinp,runlst,luindat(mxfil),ludat,prevdat, - & gshhsin,coastbln,justname(mxfil) - common /FILLOG/ lcfiles - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c runinp Path & filename for the control file [c] -c (default: CTGPROC.INP) -c runlst Path & filename for the output CTGPROC list file [c] -c (default: CTGPROC.LST) -c luindat(mxfil) Path & filename for the input LULC data file(s) [ca] -c (default: LUIN.DAT) -c ludat Path & filename for output LULC data file [c] -c (default: LU.DAT) -c prevdat Path & filename for LULC data file from a previous [c] -c application of CTGPROC (default: PREV.DAT) -c gshhsin Path and filename for raw GSHHS coastline data [c] -c coastbln Path and filename for output of processed coastline [c] -c data or input of pre-processed data -c justname(mxfil)name of each LULC DB file, no path info. [ca] -c lcfiles Switch indicating if all characters in the [l] -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c case letters (LCFILES=F). -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CTGPROC/grid.ctg b/CALPUFF_SRC/CTGPROC/grid.ctg deleted file mode 100644 index a505cd0..0000000 --- a/CALPUFF_SRC/CTGPROC/grid.ctg +++ /dev/null @@ -1,53 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /GRID/ -- Grid for output data CTGPROC -c----------------------------------------------------------------------- - logical lzone,ldatum - character*4 utmhem - character*8 datum - character*12 daten - character*16 clat0,clon0,clat1,clat2 - - common /GRID/ nx,ny,dgrid,xorigin,yorigin,xllk,yllk,xurk,yurk, - & izone,reflat,reflon,xlat1,xlat2,ictgzone, - & feast,fnorth,tmscaleo, - & lzone,ldatum,utmhem,datum,daten, - & clat0,clon0,clat1,clat2 - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c nx,ny actual number of cells in x,y (or r,theta) [i] -c dgrid (km) length of side of output grid Cartesian grid cell [r] -c (x,y)origin (km) reference coordinates of grid origin [r] -c (x,y)llk (km) reference coordinates of grid lower left-hand [r] -c corner -c (x,y)urk (km) reference coordinates of grid upper right-hand [r] -c corner -c izone base zone for UTM grid [i] -c reflat, latitude & longitude of x=0 and y=0 of map [r] -c reflon (deg) projection (Used only if PMAP= LCC, PS, EM, or LAZA) -c NOTE: longitude is East Longitude (neg in west hem) -c xlat1, matching latitude(s) used for projection [r] -c xlat2 (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through Earth's surface -c at XLAT1 and XLAT2 -c PS : Projection plane slices through Earth at XLAT1 -c EM : Projection cylinder slices through Earth at -c [+/-] XLAT1 -c ictgzone UTM zone for CTG data [i] -c feast (km) False Easting at projection origin [r] -c fnorth (km) False Northing at projection origin [r] -c tmscaleo Scaling factor for output TM projection [r] -c lzone flag indicating data and base UTM zones differ [l] -c (T = zones are different; F = zones are the same) -c ldatum flag indicating data and base DATUMS differ [l] -c (T = datums are different; F = datums are the same) -c utmhem base hemisphere for output UTM projection [c] -c (S=southern, N=northern) -c datum Datum-Region for grid coordinates [c] -c daten NIMA date for datum parameters (MM-DD-YYYY ) [c] -c clat0 character version of RLAT [c] -c clon0 character version of RLON [c] -c clat1 character version of XLAT1 [c] -c clat2 character version of XLAT2 [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CTGPROC/gspan.ctg b/CALPUFF_SRC/CTGPROC/gspan.ctg deleted file mode 100644 index cc95aff..0000000 --- a/CALPUFF_SRC/CTGPROC/gspan.ctg +++ /dev/null @@ -1,18 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /GSPAN/ -- output grid LL coordinate range CTGPROC -c----------------------------------------------------------------------- - common /GSPAN/ ylatsw,xlonsw,ylatse,xlonse, - & ylatnw,xlonnw,ylatne,xlonne - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c ylatsw north latitude of the SW corner of output grid [r] -c xlonsw west longitude of the SW corner of output grid [r] -c ylatse north latitude of the SE corner of output grid [r] -c xlonse west longitude of the SE corner of output grid [r] -c ylatnw north latitude of the NW corner of output grid [r] -c xlonnw west longitude of the NW corner of output grid [r] -c ylatne north latitude of the NE corner of output grid [r] -c xlonne west longitude of the NE corner of output grid [r] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CTGPROC/lutabs.ctg b/CALPUFF_SRC/CTGPROC/lutabs.ctg deleted file mode 100644 index 29e87f6..0000000 --- a/CALPUFF_SRC/CTGPROC/lutabs.ctg +++ /dev/null @@ -1,45 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /LUTABS/ -- Land use tabulations CTGPROC -c----------------------------------------------------------------------- -c - common/LUTABS/lumap(92),itab(mc),nzcat(mzct),nlcd92(mnlcd), - & nlcd01(mnlcd),ncorine(mcorine),nglc2k(mglc2k),numdglc(mumdglc), - & nbumodis(mmodis),ideftyp,luoutcat(mxcat),nluoutcat,lucattype -c -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c lumap(92) Land use map converting USGS 92 category system to [ia] -c the standard CALMET 38 category system -c itab(mc) Land use map converting GLOBAL 'mc' category system[ia] -c to the USGS 92 category system (mc is set in PARAMS.CTG) -c nzcat(mzct) Land use map converting New Zealand 'mzct' category[ia] -c system to USGS 92 category system (mzct is set in -c PARAMS.CTG) -c nlcd92(mnlcd) Land use map converting NLCD 1992 'mnlcd' cattegory[ia] -c system to USGS 92 category system (mnlcd is set in -c PARAMS.CTG) -c nlcd01(mnlcd) Land use map converting NLCD 2001 'mnlcd' cattegory[ia] -c system to USGS 92 category system (mnlcd is set in -c PARAMS.CTG) (as of 2005, NLCD 2001 very incomplete) -c ncorine(mcorine)Land use map converting CORINE 'mcorine' category [ia] -c system to USGS 92 category system (mcorine is set in -c PARAMS.CTG) -c nglc2k(mglc2k) Land use map converting GLC2000 'mglc2k' category [ia] -c system to USGS 92 category system (mglc2k is set in -c PARAMS.CTG) -c numdglc(mumdglc)Land use map converting UMDGLC 'mumdglc' category [ia] -c system to USGS 92 category system (mumdglc is set in -c PARAMS.CTG) -c nbumodis(mmodis) Land use map converting BU IGBP modis 'mmodis' [ia] -c category system to USGS 92 category system (mmodis -c is set in PARAMS.CTG) -c ideftyp Default land use for points incorrectly identified [i] -c as ocean (coast line processing) -c luoutcat(mxcat)List of LU categories corresponding to columns in [ia] -c output -c nluoutcat Number of LU categories in luoutcat list [i] -c lucattype Type of LU category structure [i] -c 1: Standard USGS to which LUMAP(92) applies -c 2: General without restriction on values (GENERIC) -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CTGPROC/nima.crd b/CALPUFF_SRC/CTGPROC/nima.crd deleted file mode 100644 index fb463a1..0000000 --- a/CALPUFF_SRC/CTGPROC/nima.crd +++ /dev/null @@ -1,34 +0,0 @@ -c************************************************************ -c -c --- BUILD manufactored NIMA INCLUDE statement -c --- NIMA.CRD -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - Parameter (ndt = 132) - Parameter (nd = 234) -c -c --- Stamp this NIMA include file - Character*12 daten - Parameter (daten='02-21-2003 ') -c - Character*60 geodat1, geodat2, geodat3 - Character*8 datcod - Character*52 datum - Character*20 atlas - Character*12 dateb,dstamp -c - Real*4 dxmod, dymod, dzmod - Real*8 dradim, dflat, dec2 -c - Integer*4 dattyp -c - common /datr4/ dxmod(nd), dymod(nd), dzmod(nd) - common /datr8/ dradim(nd), dflat(nd), dec2(nd) - common /datchr/ datcod(nd), geodat1(nd), geodat2(nd), - 1 geodat3(nd), atlas(ndt), datum(ndt), - 2 dstamp,dateb - common /dati4/ kmax, nudat, dattyp(nd) -c diff --git a/CALPUFF_SRC/CTGPROC/params.cal b/CALPUFF_SRC/CTGPROC/params.cal deleted file mode 100644 index 6a77e6b..0000000 --- a/CALPUFF_SRC/CTGPROC/params.cal +++ /dev/null @@ -1,12 +0,0 @@ -c---------------------------------------------------------------------- -c --- PARAMETER statements CALUTILS -c---------------------------------------------------------------------- -c --- Specify parameters - parameter(mxvar=60,mxcol=200) -c -c --- CONTROL FILE READER definitions: -c MXVAR - Maximum number of variables in each input group -c MXCOL - Maximum length (bytes) of a control file input record -c---------------------------------------------------------------------- - - \ No newline at end of file diff --git a/CALPUFF_SRC/CTGPROC/qa.ctg b/CALPUFF_SRC/CTGPROC/qa.ctg deleted file mode 100644 index 6b438c2..0000000 --- a/CALPUFF_SRC/CTGPROC/qa.ctg +++ /dev/null @@ -1,18 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /QA/ -- Model QA parameters CTGPROC -c----------------------------------------------------------------------- - character*12 ver,level - character*8 rtime - character*10 rdate -c - common/QA/ver,level,rcpu,rtime,rdate -c -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c ver version number of CTGPROC [c] -c level level number of CTGPROC [c] -c rcpu computed CPU time of the run [r] -c rtime system time at start of run (HH:MM:SS) [c] -c rdate system date at start of run (MM-DD-YY) [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CTGPROC/readctg.f b/CALPUFF_SRC/CTGPROC/readctg.f deleted file mode 100644 index 336192f..0000000 --- a/CALPUFF_SRC/CTGPROC/readctg.f +++ /dev/null @@ -1,39 +0,0 @@ - Program readctg - - parameter(in=10) - parameter(nx=464,ny=400,mxcat=38,mxhit=40) - parameter(x0=-335.0,y0=-258.0,dxy=1.0) - character*120 fin - - dimension ngrid(mxcat,nx,ny) - - fin='fort.41' - - open(in,file=fin,status='old',action='read') - - ip=0 - ngrid=0 - - 1000 read(in,*,end=2000)x,y,ilul,land,i,j,nn - ngrid(land,i,j)=nn - - ip=ip+1 - - goto 1000 - - 2000 print *,' ip=',ip - - do j=1,ny - do i=1,nx - do k=1,mxcat - ilu=ngrid(k,i,j) - if(ilu.ne.0) then - write(18,181)i,j,k,ilu - 181 format(4i6) - endif - enddo - enddo - enddo - - stop - end diff --git a/CALPUFF_SRC/CTGPROC/shores.ctg b/CALPUFF_SRC/CTGPROC/shores.ctg deleted file mode 100644 index 2130f18..0000000 --- a/CALPUFF_SRC/CTGPROC/shores.ctg +++ /dev/null @@ -1,36 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /SHORES/ -- Land/water interface info CTGPROC -c----------------------------------------------------------------------- - real xp(mxcoastp),yp(mxcoastp) - integer nshore,nspts(mxcoast),itypes(mxcoast),istart(mxcoast), - & isourcep(mxcoast),ipolyid(mxcoast) - real pxmax(mxcoast),pymax(mxcoast),pxmin(mxcoast),pymin(mxcoast) - - - common /SHORES/ nshore,nspts,itypes,istart,isourcep,ipolyid, - & xp,yp,pxmax,pymax,pxmin,pymin -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c nshore number of polygons defining land-water interface [i] -c nspts array of 'nshore' numbers of points in each polygon [i] -c itypes array of 'nshore' types of each polygon [i] -c 1 - mainland and marine island -c 2 - lake -c 3 - island in lake -c 4 - pond within island -c istart array of 'nshore' indices of start of each polygon [i] -c in the coordinate arrays (xp, yp) -c isourcep array indicating the original source of the polygon [i] -c 1 - WDBII -c 2 - WVS -c ipolyid array indicating the GSHHS_F id of the polygon [i] -c xp array of x-coordinates of the points in all [r] -c polygons, in output datum -c yp array of y-coordinates of the points in all [r] -c polygons, in output datum -c pxmax, pymax array of maximum values of x- and y-coordinates for [r] -c each of the 'nshore' polygons, in output datum -c pxmin, pymin array of minimum values of x- and y-coordinates for [r] -c each of the 'nshore' polygons, in output datum -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CTGPROC/snow.ctg b/CALPUFF_SRC/CTGPROC/snow.ctg deleted file mode 100644 index 4f39c03..0000000 --- a/CALPUFF_SRC/CTGPROC/snow.ctg +++ /dev/null @@ -1,42 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /SNOW/ CTGPROC -c----------------------------------------------------------------------- - character*120 fsngrid - character*16 datasets,datavers,datetimes - character*64 datamods - character*80 comment - - character*8 cmaps,datumsn,timezones - character*10 datens - character*4 unitss - - character*12 cactions - character*4 c4dums - - real*8 vectis(9),vectos(9) - - parameter (mxbuff=1024) - - common/SNOWCHR/datasets,datavers,datetimes,datamods - & ,cmaps,datumsn,timezones,datens,unitss - & ,cactions,c4dums,comment - - common/SNOWVAL/fsnow,fsngrid,flonorg,flatorg,flonbs,flatbs - & ,dlon,dlat,xl,xh,yl,yh,xyoff,feastis,fnortis,feasts - & ,fnorths,vectis,vectos - & ,nxt,nyt,nxs,nys,nijs,ngref,ngipp - & ,idatebeg,idateend,idate,istart - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c fsngrid Snow grid reference file name [c] -c datasets Snow data set name [c] -c datavers Snow data version name [c] -c datetime Snow data time [c] -c cmap Snow data map projection [c] -C datumsn Snow data datum [c] -C timezones Snow data time zone [c] -C datens Snow data daten [c] -C unitss Snow data units [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/CTGPROC/tiffinfo.for b/CALPUFF_SRC/CTGPROC/tiffinfo.for deleted file mode 100644 index fb26596..0000000 --- a/CALPUFF_SRC/CTGPROC/tiffinfo.for +++ /dev/null @@ -1,955 +0,0 @@ -c -c --- TIFFINFO Version: 1.03 Level: 090123 -c K. Morrison, Hatch -c -c This file contains subroutines for extracting geographic -c information from GeoTIFF files. Externally, only GET_IFD and -c READTIFF are called, the other routines only being used internally -c to read information within the GeoTIFF, allowing for byte -c flipping if needed based on the byte order in the file and on -c the host machine. -c -c----------------------------------------------------------------------- - subroutine get_ifd(ioinp,nxi,nyi,dxi,dyi,cdatumi,rlati,rloni, - & xlat1i,xlat2i,feasti,fnorthi,cproji,xorg,yorg,utmhemi,iutmzni, - & tmscalei,itifftype,ltiffreset) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 090123 GET_IFD -c K. Morrison, Hatch -c -c PURPOSE: GET_IFD reads all the tags and geokeys from the Image -c File Directory of a GeoTIFF file, passes useful fields -c back to the calling subroutine for projection and datum -c identification, and puts variables into the TIFF_TAGS -c common for subsequent use by READTIFF. -c -c UPDATES: -c Version 1.03 Level 090123 from Version 1.02 Level 070706 -c - Change resets for datum and projection -c Version 1.02 Level 070706 from Version 1.01 Level 061214 -c - Change test for UTMs -c - Include half-pixel shift in origin if GeoTIFF values -c are areas (assumed default) and not points -c -c INPUTS: IOINP (i) - input unit for the GeoTIFF file (already -c opened in the calling program) -c LTIFFRESET(l) - logical to reset the projection and datum -c -c OUTPUTS: NXI, NYI (i) - number of columns and rows in the file -c DXI, DYI (r) - spacing of pixels in X and Y -c CDATUMI (c*8) - datum of data in the file -c RLATI, RLONI (r) - reference/origin latitude and longitude -c of the projection of the data -c XLAT1I, XLAT2I (r) - equator-ward and pole-ward parallels -c FEASTI, FNORTHI (r) - false easting and northing of the data -c CPROJI (c*8) - projection of the data -c XORG, YORG (r) - coordinates of the origin of the data -c UTMHEMI (c*4) - hemisphere if data are in UTM -c IUTMZNI (i) - UTM zone if data are in UTM -c TMSCALEI (r) - TM scaling factor -c ITIFFTYPE (i) - type of TIFF (1-values,2-RGB,3-palette) -c----------------------------------------------------------------------- - logical lflip,loffset,lbig,lbig_end,lutm,lprojerr,lerror, - & ltiffreset,lpixel - integer*1 ival1(200000) - integer*2 ival2(200000),ntag,ittag,numbytes(12),ired(200000), - & igreen(200000),iblue(200000) - integer*4 itag,iltag,ivtag,ival4(200000),idum1,idum2 - real val4(200000) - real*8 val8(200000) - character*8 cdatumi,cproji - character*8 char8(1000) - character*1 char1(1000) - character*1000 char1000 - character*4 utmhemi - character*8 ctproj(16)/ - & 'LL ','TM ',' ',' ',' ', - & ' ',' ','EM ','LCC ',' ', - & 'LAZA ','ACEA ',' ',' ',' ', - & 'PS '/ - character*8 ctdatum(132)/ - & 'ADI-M ','AUA ','AUG ','AIN-A ','AFG ', - & ' ',' ',' ',' ',' ', - & ' ',' ',' ',' ',' ', - & 'BER ',' ','BOO ','BUR ',' ', - & 'CAI ','CAP ','CGE ','CHU ','COA ', - & ' ',' ',' ','OEG ','EUR-M ', - & 'EUS ',' ',' ',' ',' ', - & 'HTN ',' ','IDN ','INF-A ','INH-A ', - & ' ',' ',' ','KAN ','KEA ', - & ' ',' ','PRP-M ',' ','LEH ', - & 'LIB ',' ','LUZ-A ',' ','HEN ', - & 'MIK ',' ',' ',' ',' ', - & 'MER ','MAS ','MIN-A ',' ',' ', - & 'MPO ','NAS-C ',' ','NAR-C ','NAH-A ', - & 'NAP ',' ',' ',' ',' ', - & ' ',' ',' ',' ',' ', - & ' ','PTN ','WGS-84 ','PUK ','QAT ', - & ' ','QUO ',' ',' ',' ', - & 'SAN-M ','SAP ','SCK ',' ',' ', - & ' ','TAN ','TIL ',' ',' ', - & 'TOY-M ',' ',' ','VOI ','VOR ', - & ' ','NSD ',' ','YAC ',' ', - & 'ZAN ',' ',' ',' ',' ', - & ' ',' ',' ',' ',' ', - & ' ','WGS-72 ',' ',' ',' ', - & 'WGS-84 ',' ',' ',' ',' ', - & ' ',' '/ - common /tiff_tags/ nbitsi,iptypei,idtypei, - & idstarti,iorienti,numpixv,zorgtif, - & icmodel,icordunit,iangunit, - & lbig,lflip,zorg,zmul -c - data numbytes/1,1,2,4,8,1,1,2,4,4,4,8/ - equivalence(char1000,char1(1)) -c -c set or reset defaults for data characteristics, units, projections -c - if(ltiffreset) then - cdatumi=' ' - cproji=' ' - endif - idatum=0 - lpixel=.true. - dxi=0. - dyi=0. - rlati=-999. - rloni=-999. - feasti=0. - fnorthi=0. - xorg=0. - yorg=0. - zorg=0. - utmhemi=' ' - iutmzni=0 - tmscalei=1. - icmodel=1 - icordunt=1 - nxi=0 - nyi=0 - nbitsi=1 - iptypei=0 - iptypidx=0 - idtypei=1 - idstart=0 - iorienti=1 - numpixv=1 - ixorgtif=1 - iyorgtif=1 - zorgtif=0. - iangunt=2 - ielevunt=1 - ctrlat=-999. - ctrlon=-999. - xlat1i=0. - xlat2i=0. - tmscalec=1. - icompress=1 - ired=0 - igreen=0 - iblue=0 - iproj=-99 - lutm=.false. - lerror=.false. - lprojerr=.false. - indxpar1=0 - indxpar2=0 - indxorlon=0 - indxorlat=0 - indxfalse=0 - indxfalsn=0 - indxctrlon=0 - indxctrlat=0 - indxtmscalo=0 - indxtmscalc=0 -c -c check byte order of current platform -c - lflip=.false. - lbig=lbig_end(1) -c -c read the byte order of the file, and if it's not the same as the -c current platform, set logical for byte flipping -c first byte = 'I' (73) (INTEL) or 'M' (77) (MOTOROLA) -c - read(ioinp,rec=1) ival1(1) - if((ival1(1).eq.77.and..not.lbig).or.(ival1(1).eq.73.and.lbig)) - & lflip=.true. -c -c check the answer to the ultimate question of life, the universe, -c and everything -c - ipos=3 - call read2b(ioinp,ipos,ival2(1),lflip) - if(ival2(1).ne.42) then - write(*,*) 'Invalid TIFF ID - ',ival2 - stop - endif -c -c get the offset of the IFD and set the position to read it -c - ipos=5 - call read4b(ioinp,ipos,ival4(1),lflip) - ipos=ival4(1)+1 -c -c get the number of TAGS -c - call read2b(ioinp,ipos,ntag,lflip) -c -c read and decode the 12-byte tags -c - do i=1,ntag -c -c retain the start of the next tag -c - iopos=ipos+12 -c -c read the tag ID -c - call read24b(ioinp,ipos,itag,lflip,lbig) -c -c read the tag type: -c 1 - 1-byte unsigned integer -c 2 - 1-byte character -c 3 - 2-byte unsigned integer -c 4 - 4-byte unsigned integer -c 5 - 8-byte ratio, 2 type-4s, numerator and then denominator -c 6 - 1-byte signed integer -c 7 - 1-byte undefined -c 8 - 2-byte signed integer -c 9 - 4-byte signed integer -c 10 - 8-byte ratio, 2 type-9s, numerator and then denominator -c 11 - 4-byte real -c 12 - 8-byte real -c - call read2b(ioinp,ipos,ittag,lflip) -c -c check for end of tags -c - if(itag.eq.0.and.ittag.eq.0) exit -c -c read the number of values in this tag -c - call read4b(ioinp,ipos,iltag,lflip) -c -c if the number of bytes for the tag value(s) is too large for -c the 4-byte field, the value instead is an offset to where -c the values are stored -c - loffset=.false. - if(iltag*numbytes(ittag).gt.4) then - loffset=.true. - call read4b(ioinp,ipos,ioffset,lflip) - ipos=ioffset+1 - endif -c -c read the tag value(s) according to type -c - do j=1,iltag - if(ittag.eq.1) call read12b(ioinp,ipos,ival2(j),lbig) - if(ittag.eq.2) call read1c(ioinp,ipos,char1(j)) - if(ittag.eq.3) call read24b(ioinp,ipos,ival4(j),lflip,lbig) - if(ittag.eq.4) call read4b(ioinp,ipos,ival4(j),lflip) - if(ittag.eq.5) then - call read4b(ioinp,ipos,idum1,lflip) - call read4b(ioinp,ipos,idum2,lflip) - val4(j)=float(idum1)/float(idum2) - endif - if(ittag.eq.6) call read1b(ioinp,ipos,ival1(j)) - if(ittag.eq.7) call read1c(ioinp,ipos,char1(j)) - if(ittag.eq.8) call read2b(ioinp,ipos,ival2(j),iflip) - if(ittag.eq.9) call read4b(ioinp,ipos,ival4(j),lflip) - if(ittag.eq.10) then - call read4b(ioinp,ipos,idum1,lflip) - call read4b(ioinp,ipos,idum2,lflip) - val4(j)=float(idum1)/float(idum2) - endif - if(ittag.eq.11) call read4r(ioinp,ipos,val4(j)) - if(ittag.eq.12) call read8r(ioinp,ipos,val8(j),lflip) - enddo -c -c put the useful tags into appropriate variables -c -c number of columns and rows -c - if(itag.eq.256) nxi=ival4(1) - if(itag.eq.257) nyi=ival4(1) -c -c number of bits per value - assume additional values are the same -c as the first (RGB) -c - if(itag.eq.258) nbitsi=ival4(1) -c -c compression type - only 1 (uncompressed) supported -c - if(itag.eq.259) icompress=ival4(1) -c -c photometric interpretation -c 1 - B&W - black is zero -c 2 - RGB -c 3 - Palette -c - if(itag.eq.262) iptypei=ival4(1) -c -c strip offsets - only first value used (assumes sequential) -c - if(itag.eq.273) idstarti=ival4(1) -c -c image orientation -c 1 - left to right, top to bottom -c 4 - left to right, bottom to top -c - if(itag.eq.274) iorienti=ival4(1) -c -c number of values per pixel - only 1 or 3 supported -c - if(itag.eq.277) numpixv=ival4(1) -c -c read the palette - reduce to 0-255 from 0-65535 -c - if(itag.eq.320) then - ncrclass=iltag/3 - do kk=1,ncrclass - icount=(kk-1)*3+1 - ired(kk)=ival4(icount)/256 - igreen(kk)=ival4(icount+ncrclass)/256 - iblue(kk)=ival4(icount+2*ncrclass)/256 - enddo - endif -c -c data types for the image data -c 1 - unsigned integer -c 2 - signed integer -c 3 - real -c - if(itag.eq.339) idtypei=ival4(1) -c -c read indexing (equivalent to palette type) -c - if(itag.eq.346) iptypidx=ival4(1) -c -c read and decode GeoTIFF keys in extended tags -c -c read the pixel scale (spacing) -c - if(itag.eq.33550) then - dxi=val8(1) - dyi=val8(2) - endif -c -c read the reference point -c - if(itag.eq.33922) then - ixorgtif=int(val8(1))+1 - iyorgtif=int(val8(2))+1 - zorgtif=sngl(val8(3)) - xorg=sngl(val8(4)) - yorg=sngl(val8(5)) - zorg=sngl(val8(6)) - endif -c -c GeoKey Directory -c - if(itag.eq.34735) then -c -c read the keys, starting with #2 (#1 is simply a header) -c - do kk=5,iltag-3,4 -c -c get the ID, the TAG containg the key (0 if the value fits -c in the 4th field), the number of values, and the element -c offet in the containing tag (0 means first) or the actual -c key value if it will fit -c - keyid=ival4(kk) - intag=ival4(kk+1) - nkeyval=ival4(kk+2) - keyval=ival4(kk+3) - if(keyval.eq.32767) cycle -c -c model type - 1 is projection coordinates, 2 is lat-lon -c - if(keyid.eq.1024) icmodel=keyval -c -c pixel type - 1 is area, 2 is point -c - if(keyid.eq.1025.and.keyval.eq.2) lpixel=.false. -c -c datum may be in 1 of 3 keys, the last for UTMs -c - if(keyid.eq.2048) idatum=keyval-4200 - if(keyid.eq.2050) idatum=keyval-6200 - if(keyid.eq.3072) then - iproj=1 - lutm=.true. - idatum=keyval/100-200 - if(idatum.eq.67.or.idatum.eq.69) then - iutmzni=mod(keyval,100) - if(iutmzni.ge.3.and.iutmzni.le.23) then - utmhemi='N ' - else - iutmzni=0 - endif - endif - if(idatum.gt.121.and.idatum.lt.127) then - utmhemi='N ' - if(mod(idatum,2).eq.1) then - utmhemi='S ' - idatum=idatum-1 - endif - endif - iutmzni=mod(keyval,100) -c -c check for arbitrary zoning -c - if(iutmzni.gt.60) iutmzni=0 - endif -c -c coordinate, angle, elevation units -c coords: 1 - meters, 2 - feet, 35 - mile, 36 - kilometers -c angles: 2 - degrees, 3 - arc-minutes, 4 - arc-seconds -c elevs: 1 - meters, 2 - feet -c - if(keyid.eq.2052) icordunt=keyval-9000 - if(keyid.eq.2054) iangunt=keyval-9100 - if(keyid.eq.4099) ielevunt=keyval-9000 -c -c get the projection -c - if(keyid.eq.3075) iproj=keyval -c -c indices for various projection parameters in TAG 34736 -c - if(keyid.eq.3078) indxpar1=keyval+1 - if(keyid.eq.3079) indxpar2=keyval+1 - if(keyid.eq.3080) indxorlon=keyval+1 - if(keyid.eq.3081) indxorlat=keyval+1 - if(keyid.eq.3082) indxfalse=keyval+1 - if(keyid.eq.3083) indxfalsn=keyval+1 - if(keyid.eq.3088) indxctrlon=keyval+1 - if(keyid.eq.3089) indxctrlat=keyval+1 - if(keyid.eq.3092) indxtmscalo=keyval+1 - if(keyid.eq.3093) indxtmscalc=keyval+1 - enddo - endif -c -c extract projection parameters: -c - equator-ward ref lat -c - pole-ward reference latitude -c - projection origin longitude -c - projection origin latitude -c - false easting -c - false northing -c - projection center longitude (overridden by origin) -c - projection center latitude (overridden by origin) -c - TM scaling at origin -c - TM scaling at center (overridden by origin) -c - if(itag.eq.34736) then - if(indxpar1.gt.0) xlat1i=val8(indxpar1) - if(indxpar2.gt.0) xlat2i=val8(indxpar2) - if(indxorlon.gt.0) rloni=val8(indxorlon) - if(indxorlat.gt.0) rlati=val8(indxorlat) - if(indxfalse.gt.0) feasti=val8(indxfalse) - if(indxfalsn.gt.0) fnorthi=val8(indxfalsn) - if(indxctrlon.gt.0) ctrlon=val8(indxctrlon) - if(indxctrlat.gt.0) ctrlat=val8(indxctrlat) - if(indxtmscalo.gt.0) tmscalei=val8(indxtmscalo) - if(indxtmscalc.gt.0) tmscalec=val8(indxtmscalc) - endif -c -c reset position to read next tag -c - ipos=iopos - enddo -c -c select the datum and projection strings -c - if(iproj.eq.-99.and.icmodel.eq.2) iproj=0 - if(idatum.gt.0) cdatumi=ctdatum(idatum) - if(iproj.gt.-99.and.iproj.lt.15) cproji=ctproj(iproj+1) - if(lutm) then - cproji='UTM ' - if(iutmzni.eq.0) lprojerr=.true. - endif -c -c equate indexing with palette -c - if(iptypei.eq.0.and.iptypidx.eq.1) iptypei=3 -c -c handle overrides -c - if(rloni.lt.-998..and.ctrlon.gt.-998.) rloni=ctrlon - if(rlati.lt.-998..and.ctrlat.gt.-998.) rlati=ctrlat - if(tmscalei.eq.1..and.tmscalec.ne.1.) tmscalei=tmscalec -c -c test for supported TIFF values -c - if(icompress.ne.1) lerror=.true. -c note: iptypei value of 0 or 1 might occur for DEM files - if(iptypei.gt.3) lerror=.true. - if(numpixv.ne.1.and.numpixv.ne.3) lerror=.true. - if(idtypei.gt.3) lerror=.true. - if(iorienti.ne.1.and.iorienti.ne.4) lerror=.true. -c -c test for supported datum/projection -c - if(cproji.eq.' '.or.cdatumi.eq.' ') lprojerr=.true. -c -c print error messages and stop -c - if(lerror.or.lprojerr) then - write(*,*) 'ERROR: GEOTIFF PROCESSING STOPPED' - if(lerror) then - write(*,*) 'TIFF tag values for one of the following are' - write(*,*) ' not supported in this application:' - write(*,*) 'compression : must be 1 (uncompressed)' - write(*,*) 'photometric : must be 2 or 3 or indexed' - write(*,*) 'pixel number : must be 1 or 3' - write(*,*) 'sample type : must be 1 or 2 (integer)', - & ' or 3 (real)' - write(*,*) 'orientation : must be 1 or 4' - endif - if(lprojerr) then - write(*,*) 'GEOTIFF datum or projection are not supported' - write(*,*) ' in this application' - endif - stop - endif -c -c convert X-Y units if necessary, starting with lat-lon and then -c coordinates - output units are decimal degrees or kilometers -c - xmul=1. - if(iangunt.eq.2) xmul=1. - if(iangunt.eq.3) xmul=1./60. - if(iangunt.eq.4) xmul=1./3600. - rlati=rlati*xmul - rloni=rloni*xmul - xlat1i=xlat1i*xmul - xlat2i=xlat2i*xmul - if(icmodel.eq.1.and.ltiffreset) then - xmul=0.001 - if(icordunt.eq.1) xmul=0.001 - if(icordunt.eq.2) xmul=0.0003048 - if(icordunt.eq.35) xmul=1.609344 - if(icordunt.eq.36) xmul=1. - endif - dxi=dxi*xmul - dyi=dyi*xmul - xorg=xorg*xmul - yorg=yorg*xmul - dyi=abs(dyi) - if(iorienti.eq.1) dyi=-dyi -c -c if pixel is an area, offset the origin to the center of the pixel -c - if(lpixel) then - xorg=xorg+dxi/2. - yorg=yorg+dyi/2. - endif -c -c if origin is not pixel 1, offset the origin to the center of -c pixel 1 -c - if(ixorgtif.ne.1.or.iyorgtif.ne.1) then - xorg=xorg-(dxi*float(ixorgtif-1)) - yorg=yorg-(dyi*float(iyorgtif-1)) - endif -c - zmul=1. - if(ielevunt.eq.2) zmul=0.3048 -c - itifftype=max(1,iptypei) - return - end -c----------------------------------------------------------------------- - subroutine read1b(ioinp,ipos,ival1) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ1B -c K. Morrison, Hatch -c -c PURPOSE: READ1B reads a single-byte integer in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL1 - the integer*1 value as read -c -c----------------------------------------------------------------------- - - integer*1 ival - read(ioinp,rec=ipos) ival - ipos=ipos+1 - return - end -c----------------------------------------------------------------------- - subroutine read12b(ioinp,ipos,ival2,lbig) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ12B -c K. Morrison, Hatch -c -c PURPOSE: READ12B reads a single-byte unsigned integer in a -c direct-access file into a signed two-byte integer, -c and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LBIG - logical indicating if the machine is big-endian -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL2 - the integer*1 value as read and assigned to integer*2 -c -c----------------------------------------------------------------------- - - integer*1 ival(2) - integer*2 ival2,ivalt - logical lbig - equivalence (ivalt,ival(1)) - ivalt=0 - ind=1 - if(lbig) ind=2 - read(ioinp,rec=ipos) ival(ind) - ipos=ipos+1 - ival2=ivalt - return - end -c----------------------------------------------------------------------- - subroutine read1c(ioinp,ipos,char1) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ1C -c K. Morrison, Hatch -c -c PURPOSE: READ1B reads a single-byte character in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c CHAR1 - the characterr*1 value as read -c -c----------------------------------------------------------------------- - - character*1 char1 - read(ioinp,rec=ipos) char1 - ipos=ipos+1 - return - end -c----------------------------------------------------------------------- - subroutine read2b(ioinp,ipos,ival2,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ2B -c K. Morrison, Hatch -c -c PURPOSE: READ2B reads a two-byte integer in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL2 - the integer*1 value as read and assigned to integer*2 -c -c----------------------------------------------------------------------- - - logical lflip - integer*2 ival2,itmp2 - integer*1 itmp1(2) - equivalence (itmp2,itmp1(1)) - if(lflip) then - do i=2,1,-1 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - else - do i=1,2 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - endif - ival2=itmp2 - return - end -c----------------------------------------------------------------------- - subroutine read4b(ioinp,ipos,ival4,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ4B -c K. Morrison, Hatch -c -c PURPOSE: READ4B reads a four-byte integer in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL4 - the integer*4 value as read -c -c----------------------------------------------------------------------- - - logical lflip - integer*4 ival4,itmp4 - integer*1 itmp1(4) - equivalence (itmp4,itmp1(1)) - if(lflip) then - do i=4,1,-1 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - else - do i=1,4 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - endif - ival4=itmp4 - return - end -c----------------------------------------------------------------------- - subroutine read24b(ioinp,ipos,ival4,lflip,lbig) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ24B -c K. Morrison, Hatch -c -c PURPOSE: READ24B reads a two-byte unsigned integer in a -c direct-access file into a signed four-byte integer, -c and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c LBIG - logical indicating if the machine is big-endian -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL4 - the integer*2 value as read and assigned to integer*4 -c -c----------------------------------------------------------------------- - - logical lflip,lbig - integer*4 ival4,itmp4 - integer*1 itmp1(4) - equivalence (itmp4,itmp1(1)) - itmp4=0 - idi=1 - if(lflip) then - idi=-1 - istart=2 - if(lbig) istart=4 - else - istart=1 - if(lbig) istart=3 - endif - iend=istart+idi - do i=istart,iend,idi - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - ival4=itmp4 - return - end -c----------------------------------------------------------------------- - subroutine read4r(ioinp,ipos,val,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ4R -c K. Morrison, Hatch -c -c PURPOSE: READ4R reads a four-byte real in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c VAL - the real*4 value as read -c -c----------------------------------------------------------------------- - - logical lflip - integer*1 ival(4) - real*4 val,valt - equivalence (ival(1),valt) - istart=1 - iend=4 - indx=1 - if(lflip) then - istart=4 - iend=1 - indx=-1 - endif - do i=istart,iend,indx - read(ioinp,rec=ipos) ival(i) - ipos=ipos+1 - enddo - val=valt - return - end -c----------------------------------------------------------------------- - subroutine read8r(ioinp,ipos,val,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ8R -c K. Morrison, Hatch -c -c PURPOSE: READ8R reads an eight-byte real in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c VAL - the real*8 value as read -c -c----------------------------------------------------------------------- - - logical lflip - integer*1 ival(8) - real*8 val,valt - equivalence (ival(1),valt) - istart=1 - iend=8 - indx=1 - if(lflip) then - istart=8 - iend=1 - indx=-1 - endif - do i=istart,iend,indx - read(ioinp,rec=ipos) ival(i) - ipos=ipos+1 - enddo - val=valt - return - end - -c----------------------------------------------------------------------- - subroutine readtiff(ioinp,kcnt,iclass,rval4,ipos) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READTIFF -c K. Morrison, Hatch -c -c PURPOSE: READTIFF reads the actual data in a GeoTIFF file, -c pixel by pixel -c -c INPUTS: IOINP - the i/o unit of the data file -c KCNT - the position relative to the first value in the file -c to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c ICLASS - the integer*4 value as read -c VAL - the real*4 value as read -c -c----------------------------------------------------------------------- - - common /tiff_tags/ nbitsi,iptypei,idtypei, - & idstarti,iorienti,numpixv,zorgtif, - & icmodel,icordunit,iangunit, - & lbig,lflip,zadd,zmul -c - integer*2 ival2(3) - integer ival4 - logical lflip,lbig - real rval4 - real*8 rval8 - - ival2=0 - ival4=0 - rval4=-999. - rval8=-999.d0 -c -c branch based on the file type -c -c RGB -c - if(iptypei.eq.2) then - if(numpixv.ne.3) then - write(*,*) 'ERROR: Invalid number of values per pixel for' - write(*,*) ' RGB GeoTIFF - only 3 values supported' - stop - endif - ipos=idstarti + 1 + (kcnt-1)*3 -c -c read the triad RGB, and if 0-65535, reduce to 0-255 -c - do i=1,3 - if(nbitsi.eq.8) then - call read12b(ioinp,ipos,ival2(i),lbig) - else - call read24b(ioinp,ipos,ival4,lflip,lbig) - ival2(i)=ival4/256 - endif - enddo -c -c return value as 9 digits - RRRGGGBBB -c - iclass=(ival2(1)*1000+ival2(2)) * 1000 + ival2(3) - return -c - else -c -c palette or other -c - if(idtypei.eq.1.or.idtypei.eq.2) then - if(nbitsi.le.8) then - ipos=idstarti + 1 + (kcnt-1) - call read12b(ioinp,ipos,ival2(1),lbig) - ival4=ival2(1) - elseif(nbitsi.gt.8.and.nbitsi.le.16) then - ipos=idstarti + 1 + (kcnt-1)*2 - call read24b(ioinp,ipos,ival4,lflip,lbig) - else - ipos=idstarti + 1 + (kcnt-1)*4 - call read4b(ioinp,ipos,ival4,lflip) - endif - iclass=ival4 -c -c DEM may have integer elevation -c - if(iptypei.eq.1) rval4=(float(iclass)+zadd)*zmul -c - return -c -c real value - probably DEM -c - elseif(idtypei.eq.3) then - if(nbitsi.eq.32) then - ipos=idstarti + 1 + (kcnt-1)*4 - call read4r(ioinp,ipos,rval4,lflip) - else - ipos=idstarti + 1 + (kcnt-1)*8 - call read8r(ioinp,ipos,rval8,lflip) - rval4=sngl(rval8) - endif - rval4=(rval4+zadd)*zmul - return - else - write(*,*) 'ERROR: Undefined image values not supported' - stop - endif -c - return -c - endif - end diff --git a/CALPUFF_SRC/MAKEGEO/control.geo b/CALPUFF_SRC/MAKEGEO/control.geo deleted file mode 100644 index 2f582c3..0000000 --- a/CALPUFF_SRC/MAKEGEO/control.geo +++ /dev/null @@ -1,41 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /CONTROL/ -- Program control data MAKEGEO -c----------------------------------------------------------------------- - logical lqacell,lterr,llu2,lqamiss - logical lutm,llcc,lps,lem,llaza,lttm,lsnow - character*80 ctitle - - common /CONTROL/ lqacell,lterr,lutm,llcc,lps,lem,llaza,lttm,llu2, - & lqamiss,lsnow,iflip,nlx,nly,htfac,image,flumin, - & ctitle,ifmtgeo,idatebeg,idateend - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c lqacell flag indicating QA output for 1 grid cell [l] -c lterr flag indicating reading terrain data from file [l] -c llu2 flag indicating supplental LU data file [l] -c lutm flag indicating Universal Transverse Mercator [l] -c llcc flag indicating Lambert Conformal Conic [l] -c lps flag indicating Polar Stereographic [l] -c lem flag indicating Equatorial Mercator [l] -c llaza flag indicating Lambert Azimuthal Equal Area [l] -c lttm flag indicating Tangential Transverse Mercator [l] -c lqamiss flag indicating QA output for missing cells [l] -c lsnow flag indicating snow data processing [l] - -c ifmtgeo Varying geo.dat format [i] -c iflip location of first point in TERR.DAT file [i] -c 0 = SW corner of grid -c 1 = NW corner of grid (TERREL format) -c nlx,nly location of grid cell for QA output [i] -c htfac factor to convert terrain elevations to meters (MSL)[r] -c IMAGE Output GRD file format for SURFER IMAGE maps [i] -c 0 = Standard GRD (for SURFER 8) -c 1 = GRD ranges shifted from cell-centers to -c cell-edges (for SURFER 7) -c flumin Minimum total land use fraction for a valid cell [r] -c that is not missing. Cells with fractional LU -c totalling FLUMIN or more are renormalized to 1.0. -c ctitle 1-line title written to GEO.DAT file [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/MAKEGEO/cpl.bat b/CALPUFF_SRC/MAKEGEO/cpl.bat deleted file mode 100644 index 5138b21..0000000 --- a/CALPUFF_SRC/MAKEGEO/cpl.bat +++ /dev/null @@ -1,15 +0,0 @@ -REM Compiling and linking with MAKEGEO using Lahey LF95 for Windows - -lf95 makegeo.for -o0 -co -sav -trap doi -out makegeo.exe >cpl.txt - -del *.obj -del *.map - -rem Switch settings ------------------------------ -rem -o0 No optimization -rem -co Display the compiler options that are used -rem -sav Save local variables -rem -trap doi Trap NDP divide-by-zero (d), overflow (o), and invalid operation (i) -rem -out Name the compiled executable to "makegeo.exe" -rem > Send compiler screen output to file "cpl.txt" - diff --git a/CALPUFF_SRC/MAKEGEO/cpl.txt b/CALPUFF_SRC/MAKEGEO/cpl.txt deleted file mode 100644 index 4ae75ec..0000000 --- a/CALPUFF_SRC/MAKEGEO/cpl.txt +++ /dev/null @@ -1,76 +0,0 @@ -Lahey/Fujitsu Fortran 95 Express Release 7.20.00 S/N: 00608146772706932 -Copyright (C) 1994-2009 Lahey Computer Systems. All rights reserved. -Copyright (C) 1998-2009 FUJITSU LIMITED. All rights reserved. -Options: --nap -nc -nchk -nchkglobal -concc --ndal -ndbl -ndll -nf95 -fix --ng -nin -ninfo -ninline -li --nlst -nlong -maxfatals 50 -o0 -out makegeo.exe --npause -nprefetch -nprivate -npca -nquad --sav -nsse2 -staticlib -nstaticlink -stchk --tpp -trace -trap doi -nunroll -nvarheap --w -nwide -winconsole -nwo -nxref --zero -nzfm - -Compiling program unit makegeo at line 1: -Compiling program unit __BLKDT__ at line 245: -Compiling program unit xtractll at line 307: -Compiling program unit yr4 at line 267: -Compiling program unit yr4c at line 318: -Compiling program unit qayr4 at line 362: -Compiling program unit julday at line 449: -Compiling program unit grday at line 514: -Compiling program unit dedat at line 564: -Compiling program unit deltt at line 592: -Compiling program unit incr at line 658: -Compiling program unit indecr at line 752: -Compiling program unit incrs at line 831: -Compiling program unit deltsec at line 898: -Compiling program unit midnite at line 942: -Compiling program unit utcbasr at line 1011: -Compiling program unit basrutc at line 1047: -Compiling program unit filcase at line 1094: -Compiling program unit readin at line 1168: -Compiling program unit altonu at line 1820: -Compiling program unit deblnk at line 2156: -Compiling program unit deplus at line 2217: -Compiling program unit tright at line 2273: -Compiling program unit tleft at line 2351: -Compiling program unit setvar at line 2430: -Compiling program unit allcap at line 2526: -Compiling program unit datetm at line 2578: -Compiling program unit fmt_date at line 2670: -Compiling program unit etime at line 2805: -Compiling program unit undrflw at line 2826: -Compiling program unit comline at line 2859: -Compiling program unit setup at line 311: -Compiling program unit readcf at line 620: -Compiling program unit readhd at line 1432: -Compiling program unit comp at line 1865: -Compiling program unit wt at line 2702: -Compiling program unit wtsw at line 2797: -Compiling program unit wtswz0 at line 2960: -Compiling program unit wtswalb at line 3114: -Compiling program unit xtrctx at line 3270: -Compiling program unit wrrdat at line 3326: -Compiling program unit wredat at line 3387: -Compiling program unit out at line 3450: -Compiling program unit wrt at line 3684: -Compiling program unit wrt2 at line 3721: -Compiling program unit lrsame at line 3746: -Compiling program unit wrthead at line 3793: -Compiling program unit fin at line 3891: -Compiling program unit rdsnhd at line 3976: -Compiling program unit rdsn at line 4089: -Compiling program unit fills at line 4298: -Compiling program unit fillt at line 4365: -Compiling program unit chgtim at line 4412: -Compiling program unit timestmp at line 4488: -Compiling program unit getdate at line 4497: -Compiling program unit rollbk at line 4510: -Compiling program unit gethours at line 4538: -Encountered 0 errors, 0 warnings in file makegeo.for. -Microsoft (R) Incremental Linker Version 6.00.8447 -Copyright (C) Microsoft Corp 1992-1998. All rights reserved. - -Compiling file makegeo.for. diff --git a/CALPUFF_SRC/MAKEGEO/filnam.geo b/CALPUFF_SRC/MAKEGEO/filnam.geo deleted file mode 100644 index cbe566d..0000000 --- a/CALPUFF_SRC/MAKEGEO/filnam.geo +++ /dev/null @@ -1,37 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /FILNAM/ -- File names MAKEGEO -c----------------------------------------------------------------------- - character*132 runinp,runlst,ludat,lu2dat,terrdat,geodat, - & lugrd,tegrd,snowdat - logical lcfiles - - common /FILNAM/ runinp,runlst,ludat,lu2dat,terrdat, - & geodat,lugrd,tegrd,snowdat - common /FILLOG/ lcfiles - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c runinp Path & filename for the control file [c] -c (default: MAKEGEO.INP) -c runlst Path & filename for the output MAKEGEO list file [c] -c (default: MAKEGEO.LST) -c ludat Path & filename for the input LULC data file [c] -c (default: LU.DAT) -c lu2dat Path & filename for the supplemental LULC data file [c] -c (default: LU2.DAT) -c terrdat Path & filename for terrain data file [c] -c (default: TERR.DAT) -c snowdat Path & filename for daily snow data file [c] -c (default: SNOW.DAT) -c geodat Path & filename for the output GEO.DAT file [c] -c (default: GEO.DAT) -c lugrd Path & filename for the output Land Use GRD file [c] -c (default: QALUSE.GRD) -c tegrd Path & filename for the output Terrain GRD file [c] -c (default: QATERR.GRD) -c lcfiles Switch indicating if all characters in the [l] -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c case letters (LCFILES=F). -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/MAKEGEO/grid.geo b/CALPUFF_SRC/MAKEGEO/grid.geo deleted file mode 100644 index 47e3c64..0000000 --- a/CALPUFF_SRC/MAKEGEO/grid.geo +++ /dev/null @@ -1,41 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /GRID/ -- Grid for output data MAKEGEO -c----------------------------------------------------------------------- - character*4 utmhem - character*8 datum,pmap - character*12 daten - character*16 clat0,clon0,clat1,clat2 - - common /GRID/ nx,ny,delx,xorg,yorg, - & izone,reflat,reflon,xlat1,xlat2,feast,fnorth, - & pmap,utmhem,datum,daten,clat0,clon0,clat1,clat2 - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c nx,ny actual number of cells in x,y (or r,theta) [i] -c delx (km) length of side of output grid Cartesian grid cell [r] -c (x,y)origin (km) reference coordinates of grid origin [r] -c izone base zone for UTM grid [i] -c reflat (deg) latitude of x=0 and y=0 of Lambert grid [r] -c reflon (deg) longitude of x=0 and y=0 of Lambert grid [r] -c NOTE: longitude is East Longitude (neg in west hem) -c xlat1,xlat2(deg) standard latitudes used for Lambert conf. proj. [r] -c feast (km) False Easting at projection origin [r] -c fnorth (km) False Northing at projection origin [r] -c pmap character code for output map projection [c] -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c utmhem base hemisphere for output UTM projection [c] -c (S=southern, N=northern) -c datum Datum-Region for grid coordinates [c] -c daten NIMA date for datum parameters [c] -c clat0 character version of RLAT [c] -c clon0 character version of RLON [c] -c clat1 character version of XLAT1 [c] -c clat2 character version of XLAT2 [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/MAKEGEO/lucat.geo b/CALPUFF_SRC/MAKEGEO/lucat.geo deleted file mode 100644 index c93356c..0000000 --- a/CALPUFF_SRC/MAKEGEO/lucat.geo +++ /dev/null @@ -1,63 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /LUCAT/ -- Info about land use categories MAKEGEO -c----------------------------------------------------------------------- - integer outcat(mxocat) - - common /LUCAT/ noutcat,iwat1,iwat2,outcat,nincat,numwat, - & imiss,imiss2,cfract,nsplit,nincat0,incat0(mxcat), - & incat(mxcat),z0lu(mxcat),alblu(mxcat),bowlu(mxcat), - & soillu(mxcat),qflu(mxcat),xlailu(mxcat), - & mapcat(mxcat),iwat(mxcat), - & iredef(mxcat),nnrec(mxcat),nrec(mxcat), - & irec(mxcat,mxcat),prec(mxcat,mxcat), -c ---- Snow related arrays - & incats(mxcat),z0lus(mxcat),alblus(mxcat),bowlus(mxcat), - & soillus(mxcat),qflus(mxcat),xlailus(mxcat), - & mapcats(mxcat) - - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c noutcat number of output land use categories [i] -c iwat1,iwat2 range of output land use categories assigned to [i] -c water (inclusive) -c outcat output land use categories [ia] -c nincat number of input land use categories [i] -c numwat number of input water categories [i] -c imiss land use category assigned to cell when no land [i] -c use data are found -c imiss2 index of 'imiss' category in the 'incat' array [i] -c cfract minimum fraction of cell covered by water required[r] -c to define the dominant land use as water -c nsplit number of input land use categories than are [i] -c redefined (split) -c nincat0 number of land use categories from LU.DAT header [i] -c incat0 input land use categories read from LU.DAT header[ia] -c incat input land use categories [ia] -c z0lu surface roughness (m) for each input category [ra] -c alblu surface albedo (0 to 1) for each input category [ra] -c bowlu Bowen ratio for each input category [ra] -c soillu soil heat flux parameter for each input category [ra] -c qflu anthropogenic heat flux (W/m**2) for each input [ra] -c category -c xlailu leaf area index for each input category [ra] -c mapcat output category for each input land use category [ia] -c iwat input categories defined as water [ia] -c iredef pointer to the nsplit input land use categories [ia] -c that are redefined; 0=NOT redefined -c (nincat values) -c nnrec index of each input land use category redefined [ia] -c (nsplit values) -c nrec number of input land use categories that receive [ia] -c a portion of each redefined land use -c (nsplit values) -c irec index of each receiving input land use category [ia] -c prec percent of each redefined category that is placed[ia] -c in each receiving input land use category -c incats,z0lus,alblus,bowlus,soillus,qflus,xlailus,mapcats: Same as -c incat,z0lu,alblu,bowlu,soillu,qflu,xlailu,mapcat -C except covered by snow. - - -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/MAKEGEO/makegeo.for b/CALPUFF_SRC/MAKEGEO/makegeo.for deleted file mode 100644 index e6bd132..0000000 --- a/CALPUFF_SRC/MAKEGEO/makegeo.for +++ /dev/null @@ -1,4573 +0,0 @@ -c---------------------------------------------------------------------- -c --- MAKEGEO -- Geophysical Data Preprocessor -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 110401 MAIN -c -c Copyright (c) 1996-2011 by Exponent, Inc. -c -c --- Written by: J. Scire -c --- With changes by: Y. Zhuang, E. Insley, E. Chang and M. Fernau -c -c --- PURPOSE: -c Takes gridded fractional land use information and -c associated micrometeorological information and creates -c a CALMET GEO.DAT file by 1) calculating dominant land -c use category, 2) calculating weighted micrometeorological -c parameters, and 3) remapping to new categories if desired. -c Terrain information must be derived separately and is either -c read from a TERREL output file, or inserted manually into the -c GEO.DAT. Will also make a UAM "TERRAIN" file if requested. -c -c --- Updates -c Ver 3.2, Level 110401 from Ver 3.12, Level 110225 (DGS) -c - LU.DAT Dataset Version 2.1 with additional -c header record containing the land use codes -c - Demand that the input categories specified in the -c control file match those read from the file -c Modified: LUCAT.GEO -c READHD -c -c Ver 3.12, Level 110225 from Ver 3.11, Level 100301 (DGS) -c Updated CALUTILS.FOR to version v2.58 (110225) -c - Add control file variable type 5 (character array) and -c retain commas in string returned so that array of -c variable values can be parsed -c Modified: READIN, ALTONU, SETVAR -c Ver 3.11, Level 100301 from Ver 3.1, Level 090714 (DGS) -c - Revise control file processing to accept both new -c and old formats (add control file version record) -c - Revise QA checks on snow inputs -c Modified: READCF, SETUP -c -c Ver 3.1, Level 090714 from Ver 3.0, Level 090526 (minor) -c - Fix a bug for albedo weighting for no-snow land use types -c -c Zhong-Xiang Wu -c 7/14/2009 - -c Ver 3.0, Level 090526 from Ver 2.292, Level 080511 (Major) -c - Add snow data processing: -c New : RDSNHD,RDSN,GETHOURS,WTSW,WTSWZ0,WTSWALB, -c ROLLBK,GETDATE,TIMESTMP,CHGTIM,FILLT,FILLS -c Modified: SETUP,COMP,READCF -c -c Zhong-Xiang Wu -c 5/26/2009 -c -c Ver 2.292, Level 090511 from Ver 2.291, Level 080407 -c - CALUTILS from v2.56 Level 080407 to v2.571 Level 090511 -c Increase control file line length to 200 characters -c Activate CPU clock using F95 system routine -c Add routine to reformat a date string -c New : FMT_DATE -c Modified: PARAMS.CAL, READIN, DATETM -c - Reformat date reported to list file -c Modified: FIN -c -c Ver 2.291, Level 080407 from Ver 2.29, Level 070327 -c - CALUTILS from v2.55 Level 070327 to v2.56 Level 080407 -c Control file entries in exponential notation were not -c correct if decimal point was missing (2e-02 was read -c as 0.2e-02). -c Modified: ALTONU -c -c Ver 2.29, Level 070327 from Ver 2.28, Level 060519 (DGS) -c - CALUTILS from v2.52 Level 060519 to v2.55 Level 070327 -c Move GLOBE1 to COORDLIB -c Allow negative increments in INCRS -c Fixed format bug in subroutine BASRUTC for the case of -c time zone zero (output string was 'UTC+0 0' instead -c of 'UTC+0000' -c Modified: INCRS, UTCBASR, BASRUTC -c Removed: GLOBE1 -c -c Ver 2.28, Level 060519 from Ver 2.27, Level 060309 (DGS) -c - CALUTILS from v2.51 Level 051019 to v2.52 Level 060519 -c Variable names in control file are not processed -c correctly if there are too many characters (including -c blanks) to the left of the "=" sign (run stops in -c setup phase). -c Modified: READIN -c -c Ver 2.27, Level 060309 from Ver 2.26, Level 041230 (DGS) -c - Updated to CALUTILS V2.51 (051019) from V2.2 (0030528) -c - Filnames changed from c*70 to c*132 (for CALUTILS V2.3 -c and later) -c Modified: FILNAM.GEO -c READCF, SETUP, READHD, XTRCTX -c -c Ver 2.26, Level 041230 from Ver 2.25, Level 041013 (DGS) -c - Modify treatment of cells with incomplete land use -c (cells with a fractional LU total of less than 1.0) so -c that the replacement LU category for missing (IMISS) is -c used only if the total LU fraction is less than 0.001. -c Allow non-missing cells to have a total LU fraction as -c small as FLUMIN. Set FLUMIN in BlockData and add -c FLUMIN to input group 4a. -c Note that fractional LU for all cells are renormalized -c in WT. -c Modified: CONTROL.GEO, BLOCKDATA, READCF, SETUP, COMP -c - Add the LU2.DAT fractional land use file. This is used -c only for empty cells in the primary LU.DAT file (no -c fractional land use data in LU.DAT). -c Modified: PARAMS.GEO, FILNAM.GEO, CONTROL.GEO, -c BLOCKDATA, READCF, SETUP, COMP -c - Add filename to READHD argument list so that subroutine -c can be used for either LU.DAT or LU2.DAT files. -c Modified: READHD -c - Modify the LUSE.CLR file to change wetland color. -c - Allow the land use assigned to IMISS to be invalid (not -c an input or output LU category). This will provoke the -c following actions: -c -c 1. NO GEO.DAT file is created, and if the file exists -c from an earlier application, it is deleted. -c 2. QALUSE.GRD and QATERR.GRD are created for display. -c 3. Warnings are written to the screen and list file. -c -c This feature should be used only to identify cells with -c no land use. -c Modified: CONTROL.GEO, SETUP, READCF, COMP -c -c Ver 2.25, Level 041013 from Ver 2.24, Level 040920 (DGS) -c - Add GRD format control as a hidden option in the -c control file. This applies to GRD files that are -c plotted as image maps (not contours) -- Landuse and -c PGT. SURFER 7 required a range adjustment to properly -c register the grid cell blocks that make up the image. -c SURFER 8 registers cells properly without the -c adjustment, so the standard GRD works for both image -c and contour maps. The default for the control is the -c SURFER 8 convention in which all GRD files are alike. -c (We presume that the SURFER 7 format will seldom be -c needed.) -c Modified: CONTROL.GEO, BLOCKDATA, READCF, COMP -c -c Ver 2.24, Level 040920 from Ver 2.23, Level 030905 (DGS) -c - Enlarge format for QATERR.DAT plot-file to allow -c terrain elevations below sea level. -c -c Ver 2.23, Level 030905 from Ver 2.22, Level 030709 (DGS) -c - Change default DATUM code -c -c Ver 2.22, Level 030709 from Ver 2.21, Level 030528 (DGS) -c - Fix type assigned to LCFILES in READCF -c -c Ver 2.21, Level 030528 from Ver 2.2 Level 030402 -c J. Scire, D. Strimaitis -c - CALUTILS (Version: 2.2, Level: 030528) -c -c Ver 2.2, Level 030402 from Ver 2.1 Level 020828 D. Strimaitis -c - Rename Surfer 'CLR' file to LUSE.CLR -c - Add terrain GRD file output (tegrd=QATERR.GRD) -c - Default land use GRD file renamed (lugrd=QALUSE.DAT) -c - Updated CALUTILS (Version 2.1, Level 030402) -c - Add TYPE argument to XTRACTLL -c - New header for input LU.DAT and TERR.DAT files -c - New header for output GEO.DAT file -c -c Ver 2.1 Level 020828 from Ver 2.0, Level 011003 D. Strimaitis -c - Updated CALUTILS (Version 1.1, Level 020828) -c -c Ver 2.0, Level 011003 from Ver 1.1, Level 010206 D. Strimaitis -c - Restructure inputs for CALPUFF system control file -c - Restructure main program as subroutine COMP -c - Place system-wide utilities into an include module -c (calutil.for) -c - Change UAM option text output to a character string, -c and also remove option from control file -c (UAM file option deprecated) -c -c --- Version: 1.1 Level: 010206 -c 1) Added GRD output file and Surfer 'CLR' file for making LU -c plot (DGS) -c 2) Implement new CTGPROC output file format (i.e., with three -c header records containing dataset name and coordinate/ -c projection data) (JSS) -c 3) Miscellaneous clean up of code (JSS) -c - add version and level number definition to main program -c (remove from parameter file) -c - fix read(3... statement (to write(io3...)) -c - use standard convention for parameter names (MXNX, MXNY, -c MXCAT, MXOCAT, file unit numbers) -c - add new routine (XTRCTX) to extract text (filename) from -c a character string -c - reformat output to list file -c 4) Introduce map projection flag defining coordinate system used -c 5) Restructure input file separating optional UAM output options -c -c --- Version: 1.0 Level: 990130 DGS -c 1) Updated OUT to allow subgrid to be printed, and use (I3) -c format for cell index -c 2) Report grid of LU values to list file with 2 digits, and -c change percent labels to fraction for coverage output -c 3) Report landuse/surface parameters as table in list file -c -c --- Version: 1.0 Level: 961031 EMI -c 1) Reaaranged input file structure -- added option to create -c UAM terrain file, if N then the user doesn't need to include -c the input data lines associated with that. -c -c --- Version: 1.0 Level: 960622 EMI -c 1) Changed code to use include files for paramters -c 2) Allows input of fractional coverage used to define a cell as -c being water (CFRACT) -c 3) Added option to read in a file of terrain elevation data -c if available to make up a complete geo.dat file. -c 4) If a file of terrain elevation data is read in, HTFAC is also -c read in and then passed to GEO.DAT file (it used to always use -c 1.0) -c---------------------------------------------------------------------- - program makegeo -c -c --- Include parameters - include 'params.geo' -c --- Include common blocks - include 'qa.geo' -c -c --- Set version and level number of program (stored in /QA/ and -c --- checked against values set in PARAMS.GEO) - ver='3.2' - level='110401' -c -c --- SETUP PHASE -- read control file information - call SETUP -c -c --- COMPUTATIONAL PHASE -- process data files - call COMP -c -c --- TERMINATION PHASE -- program termination functions - call FIN -c - stop - end -c---------------------------------------------------------------------- - BLOCK DATA -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 BLOCK DATA -c D. Strimaitis -c -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.geo' -c -c --- Include common blocks - include 'filnam.geo' - include 'control.geo' - include 'grid.geo' - include 'lucat.geo' - include 'snow.geo' - -c --- FILNAM common block - data runinp/'makegeo.inp'/,runlst/'makegeo.lst'/, - 1 terrdat/'terr.dat'/,ludat/'lu.dat'/,lu2dat/'lu2.dat'/, - 2 geodat/'geo.dat'/,lugrd/'qaluse.grd'/,tegrd/'qaterr.grd'/, - 3 snowdat/'snow.dat'/ - -c --- FILLOG common block - data lcfiles/.true./ - -c --- CONTROL common block -c --- Primary variables - data lterr/.true./, lqacell/.false./,lsnow/.false./ - data iflip/1/,nlx/0/,nly/0/,ifmtgeo/1/ - data htfac/1.0/ - data image/0/ - data flumin/0.96/ - -c --- Derived variables - data lutm/.false./, llcc/.false./, lps/.false./ - data lem/.false./, llaza/.false./, lttm/.false./ - -c --- GRID common block - data pmap/'UTM '/ - data utmhem/'N '/, datum/'WGS-84'/ - data reflat/-999./,reflon/-999./,xlat1/-999./,xlat2/-999./ - data feast/0.0/, fnorth/0.0/ - -c --- LUCAT common block - data noutcat/14/, iwat1/50/, iwat2/55/ - data nincat/38/, numwat/5/, nsplit/0/, imiss/55/ - data cfract/0.5/ - -C --- Snow data common bloc - data flonorg,flatorg,nxt,nyt,dlon,dlat/-124.729584, 52.8704185 - & ,6935, 3351, 8.33333377E-03, -8.33333377E-03/ - data cmaps,datums,timezones,datens,unitss,datetimes/ - & 'LL ','WGS-84 ','02-21-2003','DEG ' - & ,'UTC+0000','GREGORIAN_YMDHS '/ - data ifmt/1/ - data HSCL,SDPMIN/10.,0.01/ - data MSRL,MSAL/1,1/ - - end - -c---------------------------------------------------------------------- -c --- BRING IN CALPUFF SYSTEM UTILITY SUBROUTINES - include 'calutils.for' -c---------------------------------------------------------------------- - -c----------------------------------------------------------------------- - subroutine setup -c----------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 100301 SETUP -c D. Strimaitis -c -c PURPOSE: SETUP calls routines to read and check the control data -c provided, to set logicals, and it reports the control -c data, and opens the data files if inputs are valid. -c -c --- Updates -c Ver 3.11, Level 100301 from Ver 3.0, Level 090526 DGS -c - Edit list-file output -c Ver 3.0, Level 090526 from Ver 2.27, Level 060309 ZWU -c - Add snow data processing variables -c Ver 2.27 Level 060309 from Ver 2.26 Level 041230 DGS -c Filenames from c*70 to c*132 for CALUTILS V2.3 and later -c Ver 2.26 Level 041230 from Ver 2.2 Level 030402 DGS -c Add list file report of FLUMIN value -c Report LU2.DAT file variables -c Modify IMISS documentation for list file -c Ver 2.2 Level 030402 from Ver 2.1 Level 011003 DGS -c New COORDS/DATUM, and QA landuse/terrain output files -c New header records in landuse/terrain input files -c New header records in GEO.DAT ouitput file -c IFLIP and HTFAC removed from iputs -c -c ARGUMENTS: -c PASSED: none -c -c RETURNED: none -c -c CALLING ROUTINES: MAIN -c -c EXTERNAL ROUTINES: DATETM, COMLINE, READCF, READHD, WRTHEAD -c----------------------------------------------------------------------- -c --- Include file of parameters and commons - include 'params.geo' - include 'control.geo' - include 'filnam.geo' - include 'grid.geo' - include 'lucat.geo' - include 'qa.geo' - include 'snow.geo' - -c --- Get date and time from system - call DATETM(rdate,rtime,rcpu) - -c --- Get the name of the control file from the command line - call COMLINE(runinp) - -c --- Open the control file - open(io5,file=runinp,status='old') - -c --- Report progress - write(iomesg,*)'SETUP PHASE' - -c --- Check that the version and level number in the parameter -c --- file matches those in the code itself - if(ver.ne.mver.or.level.ne.mlevel)then - write(iomesg,10) ver,level,mver,mlevel -10 format(/1x,'ERROR in SUBR. SETUP -- The MAKEGEO version ', - 1 'and level numbers do not match those in the parameter file'/ - 2 5x,' Model Code - Version: ',a12,' Level: ',a12/ - 3 5x,'Parameter File - Version: ',a12,' Level: ',a12) - stop - endif - -c --- Read control file (open list file) - call READCF - -c --- Write header lines to list-file - - write(io6,*) - write(io6,*) '--------------------------' - write(io6,*) ' SETUP Information' - write(io6,*) '--------------------------' - write(io6,*) - -c ----------------------------- -c --- Report control data -c ----------------------------- - - write(io6,*) - write(io6,*) 'Application -----' - write(io6,*) ctitle - - write(io6,*) - write(io6,*) 'Control File Used -----' - write(io6,*) runinp - - write(io6,*) - write(io6,*) 'Processing Options -----' - write(io6,*) 'Terrain Data File Used? : ',lterr - write(io6,*) 'Snow Data File Used? : ',lsnow - if(LSNOW) then - write(io6,*) 'Snow Processing Dates : ', - & idatebeg,idateend - endif - if(nlx.EQ.0 .OR. nly.EQ.0) then - write(io6,*) 'QA output for 1 cell is NOT requested' - else - write(io6,*) 'QA Cell located at : ',nlx,nly - endif - - write(io6,*) - write(io6,*) 'Input Land Use File -----' - write(io6,'(a10,a)') 'ludat : ',trim(ludat) - if(LLU2) then - write(io6,'(a10,a)') 'lu2dat : ',trim(lu2dat) - endif - if(LTERR) then - write(io6,*) 'Input Terrain File -----' - write(io6,'(a10,a)') 'terrdat : ',trim(terrdat) - endif - if(LSNOW) then - write(io6,*) 'Input SNOW File -----' - write(io6,'(a10,a)') 'snowdat : ',trim(snowdat) - endif - - write(io6,*) - write(io6,*) 'Output GEO.DAT File -----' - write(io6,'(a10,a)') 'geodat : ',trim(geodat) - if(LSNOW .AND. ifmtgeo.EQ.1) then - write(io6,*) '(Daily files created with date added)' - endif - - write(io6,*) 'Output List File -----' - write(io6,'(a10,a)') 'runlst : ',trim(runlst) - write(io6,*) 'Output Plot Files -----' - write(io6,'(a10,a)') 'lugrd : ',trim(lugrd) - write(io6,'(a10,a)') 'tegrd : ',trim(tegrd) - write(io6,'(a18)') 'luclr : LUSE.CLR' - - write(io6,*) - write(io6,*) 'Grid data (for output) ---------------------' - write(io6,*) 'datum : ' ,datum - write(io6,*) 'pmap : ' ,pmap - if(LUTM) then - write(io6,*) 'Hemisphere : ',utmhem - write(io6,*) 'UTM zone : ',izone - endif - write(io6,*) 'xorgn : ' ,xorg - write(io6,*) 'yorgn : ' ,yorg - write(io6,*) 'izone : ' ,izone - write(io6,*) 'delx : ' ,delx - write(io6,*) 'nx : ' ,nx - write(io6,*) 'ny : ' ,ny - if(LLCC.or.LPS.or.LEM.or.LLAZA.or.LTTM) then - write(io6,*) 'rlat(N): ' ,reflat - write(io6,*) 'rlon(E): ' ,reflon - if(LLCC.or.LPS)write(io6,*) 'xlat1 : ' ,xlat1 - if(LLCC)write(io6,*) 'xlat2 : ' ,xlat2 - endif - - write(io6,*) - write(io6,*) 'Land Use Processing Data -----' - write(io6,*) - write(io6,*)' Supplemental fractional land use file provided ', - & 'for missing data?: ',llu2 - if(LLU2) write(io6,*)' (Read from LU2.DAT file) ' - write(io6,*) - write(io6,*)' Land use category used for missing data: ',imiss - write(io6,*)' (Must be listed in input categories for valid run)' - write(io6,*)' (May be set to invalid LU to produce only QA files)' - write(io6,*) - write(io6,*)' Total fractional land use for cell may be greater', - & ' than or equal to ',flumin - write(io6,*)' or less than or equal to .001 (missing)' - write(io6,*) - write(io6,*)' Water coverage threshold fraction (CFRACT) = ', - 1 cfract - write(io6,*)' Number of input water categories: ',numwat - write(io6,*)' Water categories: ',(iwat(i),i=1,numwat) - - if(LSNOW) then - write(io6,*) - write(io6,*)' Snow processing configuration:' - if(msrl.EQ.1) then - write(io6,*)' Surface roughness with snow computed' - write(io6,*)' Height Scale(m): ',hscl - else - write(io6,*)' Surface roughness with snow from User Table' - endif - write(io6,*)' Min. snow depth(m) for roughness: ',sdpmin - if(msal.EQ.1) then - write(io6,*)' Surface albedo computed with snow age' - else - write(io6,*)' Surface albedo with snow from User Table' - endif - endif - - write(io6,*) - write(io6,105) -105 format(/1x,'Number',2x,'Input Category',2x,'Redefined?'/ - 1 25x,'(0=No,0 cfract*100% of the cell -c - watsum = 0. - if (numwat .gt. 0) then - do k = 1,numwat - do kk = 1,nincat - if (iwat(k) .eq. incat(kk)) then - watsum = watsum + pland(i,j,kk) - goto 65 - end if - end do - 65 continue - end do - end if - water = 0 -c*** if (watsum .gt. 0.5) then -c if (watsum .gt. cfract) then - if (watsum .gt. cfract+0.0001) then - water = 1 - end if - - percal(i,j)=-99.9 - do 32 k=1,nincat -c -c --- Water is only eligible for dominant category if it makes up -c --- more than cfract*100 percent of the cell (water = 1) -c - - water2 = 0 - do kk = 1,numwat -c -c --- Is this a water category? -c - if (iwat(kk) .eq. incat(k)) then - water2 = 1 - goto 67 - end if - end do - 67 continue - - if (water2 .eq. 0 .and. water .eq. 1) goto 32 - if (water2 .eq. 1 .and. water .eq. 0) goto 32 - if(pland(i,j,k) .gt. percal(i,j))then - percal(i,j)=pland(i,j,k) - ipercal(i,j)= incat(k) - endif - -32 continue - -c --- Special treatment if invalid IMISS was assigned for QA - if(pland(i,j,nincat+1) .LT. freplace .AND. LQAMISS) then - percal(i,j)=0.0 - ipercal(i,j)= imiss - endif - -3 continue - write(io6,*) - write(io6,*) -c -c --- Print the percentage of each primary land use type within each -c --- cell - messag='Fraction of primary LU ' - -c --- Use the percal(i,j) array already filled above ... - call out(percal,idum,1,5,ldate,messag,1,1,nx,ny) - -c do 42 i=1,nx -c do 42 j=1,ny -c do k = 1,nincat -c if (ipercal(i,j) .eq. incat(k)) then -c kk = k -c goto 69 -c end if -c end do -c 69 continue -c dum2d(i,j)=pland(i,j,kk) -c42 continue -c call out(dum2d,idum,1,5,ldate,messag,1,1,nx,ny) - -c --- Print the dominant land use types - messag='Dominant land use type in each cell before mapping' - call out(orgx,ipercal,2,3,ldate,messag,1,1,nx,ny) -c -c --- Perform mapping of land use types from input to output -c - do i = 1, nx - do j = 1, ny - do k = 1,nincat - if (ipercal(i,j) .eq. incat(k)) then - ipercal(i,j) = mapcat(k) - goto 68 - end if - end do - 68 continue - end do - end do -c -c --- Print the dominant land use types - messag='Dominant land use type in each cell after mapping' - call out(orgx,ipercal,2,3,ldate,messag,1,1,nx,ny) -c -c --- Print the total percentage of each cell with LU data - messag='Fraction of each cell with LU data in the data base' - do 34 i=1,nx - do 34 j=1,ny - dum2d(i,j)=pland(i,j,nincat+1) -34 continue - call out(dum2d,idum,1,5,ldate,messag,1,1,nx,ny) - -c --- Write messages about incomplete cell coverage - - if(nfill2.GT.0) then - write(io6,'(/,a,i10)') - & 'Total number of cells replaced using LU2.DAT file: ',nfill2 - write(*,'(2x,a,i10)') - & 'Total number of cells replaced using LU2.DAT file: ',nfill2 - endif - - if(nadj.GT.0) then - write(io6,'(/,a,f6.3,a,i10,a)') - 1 'Warning -- LU coverage is less than ',freplace,' in ', - 2 nadj,' cell(s)' - write(io6,'(a,i4)') - & 'Missing LU fraction filled with LU =',imiss - write(*,'(2x,a,f6.3,a,i10,a)') - 1 'Warning -- LU coverage is less than ',freplace, - 2 ' in ',nadj,' cell(s)' - write(*,'(2x,a,i4)') - & 'Missing LU fraction filled with LU =',imiss - endif - - if(nmiss.GT.0) then - write(io6,'(/,a,f6.3,a,i10,a)') - 1 'Warning -- LU coverage is less than ',freplace,' in ', - 2 nmiss,' cell(s)' - write(io6,'(a,i4)') - & 'LU for cell set to ',imiss - write(*,*) - write(*,'(2x,a,f6.3,a,i10,a)') - 1 'Warning -- LU coverage is less than ',freplace, - 2 ' in ',nmiss,' cell(s)' - write(*,'(2x,a,i4)') - & 'LU for cell set to ',imiss - write(*,*) - endif - - if(nbad.GT.0) then - write(io6,'(/,a,f6.3,a,f6.3,a,i10,a)') - 1 'FATAL -- LU coverage is between ',freplace,' and ', - 2 flumin,' in ',nbad,' cell(s)' - write(io6,'(a)')'Check for problems in LU processing' - write(io6,'(a)')'No GEO.DAT file is created' - write(io6,'(a)')'HALTED in COMP' - - write(*,'(2x,a,f6.3,a,f6.3,a,i10,a)') - 1 'FATAL -- LU coverage is between ',freplace,' and ', - 2 flumin,' in ',nbad,' cell(s)' - write(*,'(2x,a)')'Check for problems in LU processing' - write(*,'(2x,a)')'No GEO.DAT file is created' - write(*,'(2x,a)')'HALTED in COMP' - -c --- Remove output file and terminate - close(io7,status='delete') - stop - - endif -c -c ------------------------------------------------------- -c --- Write LU and ELEV fields to the GRD files (for map) -c ------------------------------------------------------- -c -c --- Coordinates of upper-right corner of domain - xur=xorg+nx*delx - yur=yorg+ny*delx -c --- Coordinates of cell centers of the corners - dxby2=0.5*delx - x1=xorg+dxby2 - y1=yorg+dxby2 - xnx=xur-dxby2 - yny=yur-dxby2 - -c --- Process landuse [GRD format] -c -------------------------------- - if(image.EQ.0) then -c --- Place data points at cell centers (SURFER 8 Image) - xlo=x1 - xhi=xnx - ylo=y1 - yhi=yny - elseif(image.EQ.1) then -c --- Identify data with entire cell (SURFER 7 Image) - xlo=xorg - xhi=xur - ylo=yorg - yhi=yur - else - write(*,*)'HALTED in COMP: Image format = 0,1' - write(*,*)'Found Image = ',image - stop - endif - -c --- Set min/max landuse to 10 - 100 range - lmin=10 - lmax=100 -c --- Header records - write(io8,'(a4)') 'DSAA' - write(io8,'(2i12)') nx,ny - write(io8,'(2f12.4)') xlo,xhi - write(io8,'(2f12.4)') ylo,yhi - write(io8,'(2i12)') lmin,lmax -c --- Data, in rows of constant Y - do j=1,ny - write(io8,'(10000(i3,2x))')(IABS(ipercal(i,j)),i=1,nx) - enddo - close(io8) -c -c --- Process terrain elevations [GRD format] -c ------------------------------------------- -c --- Obtain min/max elevations - emin=elev(1,1) - emax=elev(1,1) - do j=1,ny - do i=1,nx - if(elev(i,j).GT.emax) emax=elev(i,j) - if(elev(i,j).LT.emin) emin=elev(i,j) - enddo - enddo - if(emax.EQ.emin) then - close(io9, status='DELETE') - else -c --- Header records -c --- Place data points at cell centers for contouring - write(io9,'(a4)') 'DSAA' - write(io9,'(2i12)') nx,ny - write(io9,'(2f12.4)') x1,xnx - write(io9,'(2f12.4)') y1,yny - write(io9,'(2e12.4)') emin,emax -c --- Data, in rows of constant Y - do j=1,ny - write(io9,'(10000(1pe11.4,1x))') (elev(i,j),i=1,nx) - enddo - close(io9) - endif -c -c --- Write the default colors to the CLR file (for map) -c - write(io53,'(a)') 'ColorMap 1 1' - write(io53,'(a)') ' 0.000000 255 255 0' - write(io53,'(a)') ' 11.000000 255 255 0' - write(io53,'(a)') ' 11.000000 204 255 102' - write(io53,'(a)') ' 22.100000 204 255 102' - write(io53,'(a)') ' 22.100000 160 255 160' - write(io53,'(a)') ' 33.100000 160 255 160' - write(io53,'(a)') ' 33.100000 80 255 80' - write(io53,'(a)') ' 44.200000 80 255 80' - write(io53,'(a)') ' 44.200000 153 255 255' - write(io53,'(a)') ' 50.000000 153 255 255' - write(io53,'(a)') ' 50.000000 60 204 255' - write(io53,'(a)') ' 55.400000 60 204 255' - write(io53,'(a)') ' 55.400000 204 153 204' - write(io53,'(a)') ' 66.500000 204 153 204' - write(io53,'(a)') ' 66.500000 255 204 153' - write(io53,'(a)') ' 77.600000 255 204 153' - write(io53,'(a)') ' 77.600000 255 255 204' - write(io53,'(a)') ' 88.700000 255 255 204' - write(io53,'(a)') ' 88.700000 255 255 255' - write(io53,'(a)') ' 99.029557 255 255 255' - write(io53,'(a)') ' 99.029557 255 0 0' - write(io53,'(a)') ' 100.000000 255 0 0' - close(io53) - - if(LQAMISS) then -c --- Completed QA processing - write(io6,*) - write(io6,*)' NOTE --- IMISS is not an input LU category ' - write(io6,*)' NO GEO.DAT file is created' - write(io6,*)' Existing GEO.DAT file is deleted' - write(io6,*)' Review list file and QALUSE.GRD file' -c --- Remove output file and return - close(io7,status='delete') - return - endif - -c --------------------------------------------- -c --- Compute the GEO.DAT parameters for CALMET -c --------------------------------------------- -c -c --- Print the percentage of those land use types needed for -c --- calculation of GEO.DAT parameters -c -c --- Compute area-weighted values of each GEO.DAT parameter -c print *, ' call z0' - call wt(pland,z0lu, xwork,1,nx,ny,nincat,z0) -c print *, ' call alb' - call wt(pland,alblu, xwork,0,nx,ny,nincat,albedo) -c print *, ' call bow' - call wt(pland,bowlu, xwork,0,nx,ny,nincat,bowen) -c print *, ' call sil' - call wt(pland,soillu,xwork,0,nx,ny,nincat,soilcg) -c print *, ' call qf' - call wt(pland,qflu, xwork,0,nx,ny,nincat,qf) -c print *, ' call la' - call wt(pland,xlailu,xwork,0,nx,ny,nincat,xlai) -c print *, ' call vflu' - call wt(pland,vflu,xwork,0,nx,ny,nincat,vf) -c print *,'Finish weighting calculation!' -c - if(cuamter.EQ.'Y' .OR. cuamter.EQ.'y') then -c... Write UAM terrain file - write(io52)ifile,note,1,25,idate,begtim,jdate,endtim - write(io52)orgx,orgy,iizone,xxorg,yyorg,ddelx,dely,nnx,nny, - * nz,nzlow,nzup,zhtsfc,zminlw,zminup - write(io52)ix,iy,nxcll,nycll - write(io52)1,tname1,((z0(ii,jj),ii=1,nx),jj=1,ny) - write(io52)1,tname2,((vf(ii,jj),ii=1,nx),jj=1,ny) - endif - -c --- Write the QA check at the user-specified grid cell - if(LQACELL)then - write(io6,989) nlx,nly -989 format(//,'Contents of QA check cell - (I,J) = (',i3,',',i3,')') - write(io6,1900)ipercal(nlx,nly),' - dominant land use class ' - write(io6,1902) elev(nlx,nly),' - terrain height (m) ' - write(io6,1901) z0(nlx,nly),' - roughness length (m) ' - write(io6,1901) vf(nlx,nly),' - UAM vegfactor ' - write(io6,1901) albedo(nlx,nly),' - albedo (fraction) ' - write(io6,1901) bowen(nlx,nly),' - bowen ratio ' - write(io6,1901) soilcg(nlx,nly),' - soil heat flux ' - write(io6,1901) qf(nlx,nly),' - anthropogenic heat flux ' - write(io6,1901) xlai(nlx,nly),' - leaf area index ' -1900 format(1x,i6,a30) -1901 format(1x,f6.3,a30) -1902 format(1x,f6.1,a30) - endif - - if(LSNOW) goto 2000 - -c --- Part I: Without Snow Processing ---------------- - -c --- Write the gridded GEO.DAT fields -c --- Write the land use data - write(io7,1222) -1222 format(1x,'1 - LAND USE DATA - (1=new categories)') - write(io7,1224)noutcat,iwat1,iwat2 -1224 format(1x,3i4,' - NLU, IWAT1, IWAT2') - write(io7,1226)(outcat(n),n=1,noutcat) -1226 format(1x,100(1x,i3),' - new LU categories') - nxm1=nx-1 - do 1230 j=ny,1,-1 - write(io7,1228)(ipercal(i,j),ccomma,i=1,nxm1),ipercal(nx,j) -c1228 format(100(5x,i3,a1)) -1228 format(10(4x,i3,a1)) -1230 continue - - messag='TERRAIN heights - HTFAC (Conversion to meters)' - -c --- If gridded terrain data is not read in, default conversion is 1.0 - if(.not.LTERR) htfac = 1.0 - call wredat(elev,nx,ny,1,htfac,messag) -c - messag='gridded z0 field' - call wrrdat(z0,nx,ny,2,messag) -c - messag='gridded albedo field' - call wrrdat(albedo,nx,ny,1,messag) -c - messag='gridded Bowen ratio field' - call wrrdat(bowen,nx,ny,1,messag) -c - messag='gridded soil heat flux parameters' - call wrrdat(soilcg,nx,ny,1,messag) -c - messag='gridded anthropogenic heat flux field' - call wrrdat(qf,nx,ny,1,messag) -c - messag='gridded leaf area index field' - call wrrdat(xlai,nx,ny,1,messag) -c -C --- Complete no-snow processing - return - - 2000 continue -c --- Part II: With Snow Processing ---------------- - if( .NOT. LSNOW) then - print *,' Error: Snow processing only:',LSNOW - stop - endif - -C --- Read snow file header - open(isnw,file=snowdat,status='old',action='read') - call rdsnhd - - allocate(xsnow(nxp,nyp,nwdt)) - allocate(xsnowc(nxp,nyp),ndsnow(nxp,nyp)) - -C --- Setup time stamp - idateb=idatebeg*100 - idatee=idateend*100 - - call gethours(idateb,idatee,nhrtot) - ndtot=nhrtot/24 - if(mod(nhrtot,24).ne.0) ndtot=ndtot+1 - print *,' Total days: ',ndtot - - call getdate(idateb,iy,im,id,ih) - call chgtim(iy,im,id,ih,24) - call timestmp(iy,im,id,ih,idatenext) - - xsnow=fmiss - ndsnow=ndsnowb - -C --- Loop over all datas - idatgeo=idateb - nt=index(geodat,'.',back=.TRUE.)-1 - nl=len_trim(geodat) - - iloop=1 - - 3000 continue - - nn=idatgeo/100 - write(fsgeo,310)geodat(1:nt),nn,geodat(nt+1:nl) - 310 format(a,i8.8,a) - - print *,' Create GEODAT file: ',trim(fsgeo) - - open(io7,file=fsgeo, status='unknown') - call WRTHEAD - -C --- Read snow data record - call rdsn(xsnow,ndsnow,xsnowc) - -C --- Process GEO.DAT for one day ------ - -c --- Compute area-weighted values of each GEO.DAT parameter -c print *, ' call z0' - if(msrl.eq.1) then - call wtswz0(pland,z0lu,xwork,1,nx,ny,nincat,z0,xsnowc) - elseif(msrl.eq.2) then - call wtsw(pland,z0lu,xwork,1,nx,ny,nincat,z0,xsnowc,z0lus) - else - write(io6,*)' Error: Illegal MSRL:',msrl - write(*,*)' Error: Illegal MSRL:',msrl - stop - endif - -c print *, ' call alb' - if(msal.eq.1) then - call wtswalb(pland,alblu,xwork,0,nx,ny,nincat,albedo,ndsnow - & ,alblus,xsnowc) - elseif(msal.eq.2) then - call wtsw(pland,alblu,xwork,0,nx,ny,nincat,albedo,ndsnow - & ,alblus) - else - write(io6,*)' Error: Illegal MSAL:',msal - write(*,*)' Error: Illegal MSAL:',msal - stop - endif -c print *, ' call bow' - call wtsw(pland,bowlu,xwork,0,nx,ny,nincat,bowen,xsnowc,bowlus) -c print *, ' call sil' - call wtsw(pland,soillu,xwork,0,nx,ny,nincat,soilcg,xsnowc,soillus) -c print *, ' call qf' - call wtsw(pland,qflu,xwork,0,nx,ny,nincat,qf,xsnowc,qflus) -c print *, ' call la' - call wtsw(pland,xlailu,xwork,0,nx,ny,nincat,xlai,xsnowc,xlailus) - -c print *,'Finish weighting calculation with snow info!' - -c --- Write the gridded GEO.DAT fields -c --- Write the land use data - write(io7,1222) - write(io7,1224)noutcat,iwat1,iwat2 - write(io7,1226)(outcat(n),n=1,noutcat) - nxm1=nx-1 - do j=ny,1,-1 - write(io7,1228)(ipercal(i,j),ccomma,i=1,nxm1),ipercal(nx,j) - enddo - -c --- If gridded terrain data is not read in, default conversion is 1.0 - messag='TERRAIN heights - HTFAC (Conversion to meters)' - if(.not.LTERR) htfac = 1.0 - call wredat(elev,nx,ny,1,htfac,messag) -c - messag='gridded z0 field' - call wrrdat(z0,nx,ny,2,messag) -c - messag='gridded albedo field' - call wrrdat(albedo,nx,ny,1,messag) -c - messag='gridded Bowen ratio field' - call wrrdat(bowen,nx,ny,1,messag) -c - messag='gridded soil heat flux parameters' - call wrrdat(soilcg,nx,ny,1,messag) -c - messag='gridded anthropogenic heat flux field' - call wrrdat(qf,nx,ny,1,messag) -c - messag='gridded leaf area index field' - call wrrdat(xlai,nx,ny,1,messag) - - close(io7) - -C --- Finish geo.dat for one day -c Nextday snow date - iloop=iloop+1 - call getdate(idatc,iy,im,id,ih) - call chgtim(iy,im,id,ih,24) - call timestmp(iy,im,id,ih,idatenext) - -c Nextday geo date - call getdate(idatgeo,iy,im,id,ih) - call chgtim(iy,im,id,ih,24) - call timestmp(iy,im,id,ih,idatgeo) - - if(iloop.le.ndtot) then - call rollbk(xsnow,nxp,nyp,nwdt,fmiss) - goto 3000 - endif - - deallocate(xsnow,xsnowc,ndsnow) - - return - end -c---------------------------------------------------------------------- - subroutine wt(xlupcnt,xlutab,xref,ilog,nx,ny,nlu,xdata) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 960215 WT -c --- J. Scire, SRC -c -c --- PURPOSE: Compute area-weighted values of gridded land use -c parameters using either arithmetic or log weights -c -c --- INPUTS: -c XLUPCNT(nx,ny,nlu+1) - real array - Percentage of land use type in -c each cell -c XLUTAB(nlu) - real array - Value of parameter (e.g., z0, -c LAI, etc.) for each land use -c XREF(nlu) - real array - Work array dimensioned NLU -c ILOG - integer - Weighting type (0=arithmetic -c weighting, 1=log weighting) -c NX - integer - No. grid cells in X direction -c NY - integer - No. grid cells in Y direction -c NLU - integer - No. land use categories -c -c --- OUTPUT: -c XDATA(nx,ny) - real array - Gridded parameter values -c weighted by land use area -c within each cell -c -c Parameters: MXNX, MXNY, MXCAT, IO6 -c -c --- WT called by: MAIN -c --- WT calls: none -c---------------------------------------------------------------------- -c -c --- Set parameters - include 'params.geo' - - real xlupcnt(mxnx,mxny,mxcat+1) - real xlutab(mxcat),xref(mxcat) - real xdata(mxnx,mxny) -c -c --- Arithmetic or log weights - if(ilog.eq.0)then -c -c --- Arithmetic weighting factors - do 10 i=1,nlu - xref(i)=xlutab(i) -10 continue - else if(ilog.eq.1)then -c -c --- Logarithmic weighting factors - do 20 i=1,nlu - xref(i)=alog(xlutab(i)) -20 continue - else -c -c --- Invalid value of ILOG passed into subr. - write(io6,*)'Error in subr. WT -- Invalid value of ILOG -- ', - 1 'ILOG = ',ilog - write(*,*) ' ERROR in SUBR. WT -- See Run LIST file' - stop - endif -c -c --- Compute area-weighted gridded values - do 50 i=1,nx - do 50 j=1,ny -c - xnum=0.0 - xden=0.0 -c - do 40 k=1,nlu - xnum=xnum+xlupcnt(i,j,k)*xref(k) - xden=xden+xlupcnt(i,j,k) -40 continue -c - if(xden.eq.0.0)then - write(io6,*)'Error in subr. WT -- XDEN = 0.0 -- I = ',i, - 1 ' J = ',j - write(*,*) ' ERROR in SUBR. WT -- See Run LIST file' - stop - else - xdata(i,j)=xnum/xden - endif -c -50 continue -c -c --- Adjust back from log if using log weighting factors - if(ilog.eq.1)then - do 60 i=1,nx - do 60 j=1,ny - xdata(i,j)=exp(xdata(i,j)) -60 continue - endif -c - return - end - -c---------------------------------------------------------------------- - subroutine wtsw(xlupcnt,xlutab,xref,ilog,nx,ny,nlu,xdata - & ,xsnowc,xlutabs) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 WTSW -c --- J. Scire, SRC -c -c --- PURPOSE: Compute area-weighted values of gridded land use -c parameters using either arithmetic or log weights, -c and consider snow coverage for individul landuse -c type. -c -c --- INPUTS: -c XLUPCNT(nx,ny,nlu+1) - real array - Percentage of land use type in -c each cell -c XLUTAB(nlu) - real array - Value of parameter (e.g., z0, -c LAI, etc.) for each land use -c XREF(nlu) - real array - Work array dimensioned NLU -c ILOG - integer - Weighting type (0=arithmetic -c weighting, 1=log weighting) -c NX - integer - No. grid cells in X direction -c NY - integer - No. grid cells in Y direction -c NLU - integer - No. land use categories - -c XLUTABS(nlu) - real array - Same as XLUTAB but in snow covered -c land use -c XSNOWC(nxp,nyp) - real array - Daily snow depth -c NXP - integer - Snow No. grid cells in X direction -c NYP - integer - Snow No. grid cells in Y direction -c -c --- OUTPUT: -c XDATA(nx,ny) - real array - Gridded parameter values -c weighted by land use area -c within each cell -c -c Parameters: MXNX, MXNY, MXCAT, IO6 -c -c --- WT called by: MAIN -c --- WT calls: none -c---------------------------------------------------------------------- -c -c --- Set parameters - include 'params.geo' - include 'snow.geo' - include 'snowref.geo' - -c --- No snow data - real xlupcnt(mxnx,mxny,mxcat+1) - real xlutab(mxcat),xref(mxcat) -c --- Snow data - real xsnowc(nxp,nyp) - real xlutabs(mxcat) -C --- Output - real xdata(mxnx,mxny) -c XREF2(nlu) - real array - SNOW Work array dimensioned NLU - dimension xref2(nlu) - -c --- Arithmetic or log weights - if(ilog.eq.0)then -c -c --- Arithmetic weighting factors - do 10 i=1,nlu - xref(i)=xlutab(i) - xref2(i)=xlutabs(i) - 10 continue - else if(ilog.eq.1)then -c -c --- Logarithmic weighting factors - do 20 i=1,nlu - xref(i)=alog(xlutab(i)) - xref2(i)=alog(xlutabs(i)) - 20 continue - else -c -c --- Invalid value of ILOG passed into subr. - write(io6,*)'Error in subr. WTSW - Invalid value of ILOG -', - 1 'ILOG = ',ilog - write(*,*) ' ERROR in SUBR. WTSW - See Run LIST file' - stop - endif - -c --- Compute area-weighted gridded values - do 50 i=1,nx - do 50 j=1,ny - -c xnum=0.0 -c xden=0.0 - -c do 40 k=1,nlu -c xnum=xnum+xlupcnt(i,j,k)*xref(k) -c xden=xden+xlupcnt(i,j,k) -c40 continue - -C --- Snow count ---- - xnum=0.0 - xden=0.0 - - nn=nland(i,j) - do k=1,nn - land=ntype(k,i,j) - np=ngsnow(k,i,j) - do m=1,np - ijs=idsnow(m,k,i,j) - rr=rsnow(m,k,i,j) - dd=dd+rr - - js1=(ijs-1)/nxt+1 - is1=ijs-(js1-1)*nxt - - is=is1-isoff - js=js1-jsoff - - if(is.lt.1 .or. is.gt.nxp) then - write(io6,410)is,nxp,isoff - print 410,is,nxp,isoff - 410 format(' Error: Snow grid out-range in I:',3i6) - stop - endif - - if(js.lt.1 .or. js.gt.nyp) then - write(io6,411)js,nyp,jsoff - print 410,js,nyp,jsoff - 411 format(' Error: Snow grid out-range in J:',3i6) - stop - endif - - sdp=xsnowc(is,js) - - if(sdp.gt.0) then - xf=xref2(land) - else - xf=xref(land) - endif - - xnum=xnum+rr*xf - xden=xden+rr - - enddo ! end of m - enddo ! end of k - - if(xden.eq.0.0)then - write(io6,*)'Error in subr. WT -- XDEN = 0.0 -- I = ',i, - 1 ' J = ',j - write(*,*) ' ERROR in SUBR. WT -- See Run LIST file' - stop - else - xdata(i,j)=xnum/xden - endif - - 50 continue - -c --- Adjust back from log if using log weighting factors - if(ilog.eq.1)then - do 60 i=1,nx - do 60 j=1,ny - xdata(i,j)=exp(xdata(i,j)) -60 continue - endif - - return - end - -c---------------------------------------------------------------------- - subroutine wtswz0(xlupcnt,xlutab,xref,ilog,nx,ny,nlu,xdata - & ,xsnowc) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 WTSW -c --- J. Scire, SRC -c -c --- PURPOSE: Compute area-weighted z0 values of gridded land use -c parameters using log weights, and considering snow -c coverage for individul landuse type. - -c Note: z0 only, do not use for other property values -c -c --- INPUTS: -c XLUPCNT(nx,ny,nlu+1) - real array - Percentage of land use type in -c each cell -c XLUTAB(nlu) - real array - Value of parameter (e.g., z0, -c LAI, etc.) for each land use -c XREF(nlu) - real array - Work array dimensioned NLU -c ILOG - integer - Weighting type (0=arithmetic -c weighting, 1=log weighting) -c NX - integer - No. grid cells in X direction -c NY - integer - No. grid cells in Y direction -c NLU - integer - No. land use categories - -c XLUTABS(nlu) - real array - Same as XLUTAB but in snow covered -c land use -c XSNOWC(nxp,nyp) - real array - Daily snow depth -c NXP - integer - Snow No. grid cells in X direction -c NYP - integer - Snow No. grid cells in Y direction -c -c --- OUTPUT: -c XDATA(nx,ny) - real array - Gridded parameter values -c weighted by land use area -c within each cell -c -c Parameters: MXNX, MXNY, MXCAT, IO6 -c -c --- WT called by: MAIN -c --- WT calls: none -c---------------------------------------------------------------------- -c -c --- Set parameters - include 'params.geo' - include 'snow.geo' - include 'snowref.geo' - -c --- No snow data - real xlupcnt(mxnx,mxny,mxcat+1) - real xlutab(mxcat),xref(mxcat) -c --- Snow data - real xsnowc(nxp,nyp) -C --- Output - real xdata(mxnx,mxny) - -c --- Locals - dimension hz0(nlu) - -c --- Arithmetic or log weights - if(ilog.ne.1) then - write(io6,*)' Error: WTSWZ0 only uses log weights:',ilog - print *,' Error: WTSWZ0 only uses log weights:',ilog - stop - endif - -c --- Recove obstacle height for no-snow landuse - do i=1,nlu - zs=xlutab(i) - hz0(i)=zs*hscl - enddo - hzmin=hz0(nlu) !ice - -c -- Logarithmic weighting factors - do i=1,nlu - xref(i)=alog(xlutab(i)) - enddo - -c --- Compute area-weighted gridded values - do 50 i=1,nx - do 50 j=1,ny - -C --- Snow count ---- - xnum=0.0 - xden=0.0 - - nn=nland(i,j) - do k=1,nn - land=ntype(k,i,j) - np=ngsnow(k,i,j) - do m=1,np - ijs=idsnow(m,k,i,j) - rr=rsnow(m,k,i,j) - dd=dd+rr - - js1=(ijs-1)/nxt+1 - is1=ijs-(js1-1)*nxt - - is=is1-isoff - js=js1-jsoff - - if(is.lt.1 .or. is.gt.nxp) then - write(io6,410)is,nxp,isoff - print 410,is,nxp,isoff - 410 format(' Error: Snow grid out-range in I:',3i6) - stop - endif - - if(js.lt.1 .or. js.gt.nyp) then - write(io6,411)js,nyp,jsoff - print 410,js,nyp,jsoff - 411 format(' Error: Snow grid out-range in J:',3i6) - stop - endif - - sdp=xsnowc(is,js) - - if(sdp.lt.sdpmin) then - xf=xref(land) - else - hh=hz0(land)-sdp - hh=max(hh,hzmin) - hz=hh/hscl - xf=alog(hz) - endif - - xnum=xnum+rr*xf - xden=xden+rr - - enddo ! end of m - enddo ! end of k - - if(xden.eq.0.0)then - write(io6,*)'Error in subr. WT -- XDEN = 0.0 -- I = ',i, - 1 ' J = ',j - write(*,*) ' ERROR in SUBR. WT -- See Run LIST file' - stop - else - xdata(i,j)=xnum/xden - endif - - 50 continue - -c --- Adjust back from log if using log weighting factors - if(ilog.eq.1)then - do 60 i=1,nx - do 60 j=1,ny - xdata(i,j)=exp(xdata(i,j)) -60 continue - endif - - return - end - -c---------------------------------------------------------------------- - subroutine wtswalb(xlupcnt,xlutab,xref,ilog,nx,ny,nlu,xdata - & ,ndsnow,xlutabs,xsnowc) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090714 WTSW -c --- J. Scire, SRC -c -c --- PURPOSE: Compute area-weighted albedo values of gridded land use -c parameters using arithmetic weights, and consider snow -c ages of individul landuse type. - -c Note: Albedo only, do not use for other property values -c -c --- INPUTS: -c XLUPCNT(nx,ny,nlu+1) - real array - Percentage of land use type in -c each cell -c XLUTAB(nlu) - real array - Value of parameter (e.g., z0, -c LAI, etc.) for each land use -c XREF(nlu) - real array - Work array dimensioned NLU -c ILOG - integer - Weighting type (0=arithmetic -c weighting, 1=log weighting) -c NX - integer - No. grid cells in X direction -c NY - integer - No. grid cells in Y direction -c NLU - integer - No. land use categories - -c XLUTABS(nlu) - real array - Same as XLUTAB but in snow covered -c land use -c NDSNOW(nxp,nyp) - integer array - Snow history in days -c XSNOWC(nxp,nyp) - real array - Daily snow depth -c NXP - integer - Snow No. grid cells in X direction -c NYP - integer - Snow No. grid cells in Y direction -c -c --- OUTPUT: -c XDATA(nx,ny) - real array - Gridded parameter values -c weighted by land use area -c within each cell -c -c Parameters: MXNX, MXNY, MXCAT, IO6 -c -c --- WT called by: MAIN -c --- WT calls: none -c---------------------------------------------------------------------- -c -c --- Set parameters - include 'params.geo' - include 'snow.geo' - include 'snowref.geo' - -c --- No snow data - real xlupcnt(mxnx,mxny,mxcat+1) - real xlutab(mxcat),xref(mxcat) -c --- Snow Data: Snow history (in days), Snow depth (in meter) - integer ndsnow(nxp,nyp) - real xsnowc(nxp,nyp) - - real xlutabs(mxcat),xref2(mxcat) - -C --- Output - real xdata(mxnx,mxny) - -C --- Locals - real rdcy(mxcat) - -c --- Arithmetic or log weights - if(ilog.ne.0) then - write(io6,*)' Error: WTSWZ0 only uses log weights:',ilog - print *,' Error: WTSWZ0 only uses log weights:',ilog - stop - endif - - if(nlu.gt.mxcat) then - write(io6,*)' Error: LandUse Type mis-match:',mxcat,nlu - print *,' Error: LandUse Type mis-match:',mxcat,nlu - stop - endif - - do i=1,nlu - xref(i)=xlutab(i) ! without snow - xref2(i)=xlutabs(i) ! with snow - dd=xref2(i)-xref(i) - rdcy(i)=dd*ralb(i) - enddo - -c --- Compute area-weighted gridded values - do 50 i=1,nx - do 50 j=1,ny - -C --- Snow count ---- - xnum=0.0 - xden=0.0 - - nn=nland(i,j) - do k=1,nn - land=ntype(k,i,j) - np=ngsnow(k,i,j) - do m=1,np - ijs=idsnow(m,k,i,j) - rr=rsnow(m,k,i,j) - dd=dd+rr - - js1=(ijs-1)/nxt+1 - is1=ijs-(js1-1)*nxt - - is=is1-isoff - js=js1-jsoff - - if(is.lt.1 .or. is.gt.nxp) then - write(io6,410)is,nxp,isoff - print 410,is,nxp,isoff - 410 format(' Error: Snow grid out-range in I:',3i6) - stop - endif - - if(js.lt.1 .or. js.gt.nyp) then - write(io6,411)js,nyp,jsoff - print 410,js,nyp,jsoff - 411 format(' Error: Snow grid out-range in J:',3i6) - stop - endif - - sdp=xsnowc(is,js) - nd=ndsnow(is,js) - nds=nages(land) - rdc=rdcy(land) - - if(nd.gt.nds) nd=nds - age=float(nd)/nds - - if(sdp.lt.sdpmin) then - xf=xref(land) - else - ww=1.0-rdc*age - xf=xref2(land)*ww - endif - - xnum=xnum+rr*xf - xden=xden+rr - - enddo ! end of m - enddo ! end of k - - if(xden.eq.0.0)then - write(io6,*)'Error in subr. WT -- XDEN = 0.0 -- I = ',i, - 1 ' J = ',j - write(*,*) ' ERROR in SUBR. WT -- See Run LIST file' - stop - else - xdata(i,j)=xnum/xden - endif - - 50 continue - - return - end - -c---------------------------------------------------------------------- - subroutine xtrctx(ctxtin,ctxtout) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 060309 XTRCTX -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Extract from a character string the text starting -c with the first non-blank character up to the -c last non-blank character before next blank -c i.e., strip off leading blanks & stop at first -c blank space after the text has started. -c (" filenam.dat " is extracted as "filename.dat") -c -c --- Updates -c Ver 2.27 Level 060309 from Ver 1.1 Level 010206 DGS -c - Filenames from c*70 to c*132 for CALUTILS V2.3 and later -c -c --- INPUTS: -c CTXTIN - char*132 - Input text (with blanks) -c -c --- OUTPUT: -c CTXTOUT- char*132 - Output text (no blanks) -c -c --- XTRCTX called by: MAIN -c --- XTRCTX calls: none -c---------------------------------------------------------------------- -c - character*132 ctxtin,ctxtout -c -c --- Extract filename from 132 character string - do i=1,132 - if(ctxtin(i:i).NE.' ')then - ibeg=i - go to 11 - endif - enddo -c --- If all characters are blank, return a blank - ibeg=132 -11 continue -c - do i=ibeg,132 - if(ctxtin(i:i).EQ.' ')then - iend=i - go to 12 - endif - enddo - iend=132 -12 continue -c -c --- Transfer text between ibeg and iend to output variable - read(ctxtin(ibeg:iend),'(a)')ctxtout -c - return - end -c---------------------------------------------------------------------- - subroutine wrrdat(xdata,nx,ny,iform,messag) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 960215 WRRDAT -c --- J. Scire, SRC -c -c --- PURPOSE: Write real gridded data in the GEO.DAT format used -c by CALMET -c -c --- INPUTS: -c XDATA(nx,ny) - real array - Gridded data field -c NX - integer - No. grid cells in X direction -c NY - integer - No. grid cells in Y direction -c IFORM - integer - Output format -c (1=f7.2, 2=f7.4) -c MESSAG - char*70 - Text label for initial record -c -c --- OUTPUT: none -c -c Parameters: MXNX, MXNY, IO6, IO7 -c -c --- WRRDAT called by: MAIN -c --- WRRDAT calls: none -c---------------------------------------------------------------------- -c -c --- Set parameters - include 'params.geo' - - real xdata(mxnx,mxny) - character*1 ccomma - character*70 messag -c - data ccomma/','/ -c -c --- Write the header record for this field -c --- NOTE: 2 is the code for a gridded field - write(io7,12)messag -12 format(1x,'2',3x,' - ',a70) -c -c --- Write a gridded field in GEO.DAT format - nxm1=nx-1 - if(iform.eq.1)then - do 100 j=ny,1,-1 - write(io7,95)(xdata(n,j),ccomma,n=1,nxm1),xdata(nx,j) -95 format(100(f7.2,a1)) -100 continue - else if(iform.eq.2)then - do 200 j=ny,1,-1 - write(io7,195)(xdata(n,j),ccomma,n=1,nxm1),xdata(nx,j) -195 format(100(f7.4,a1)) -200 continue - else - write(io6,*)'Error in subr. WRRDAT -- Invalid value of IFORM ', - 1 '-- IFORM = ',iform - write(*,*) ' ERROR in SUBR. WRRDAT -- See Run LIST file' - stop - endif -c - return - end -c---------------------------------------------------------------------- - subroutine wredat(xdata,nx,ny,iform,htfac,messag) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 960622 WREDAT -c --- J. Scire, SRC -c -c --- PURPOSE: Write gridded ELEVATION data in the GEO.DAT format used -c by CALMET -c -c --- INPUTS: -c XDATA(nx,ny) - real array - Gridded elevtaion data field (m) -c NX - integer - No. grid cells in X direction -c NY - integer - No. grid cells in Y direction -c IFORM - integer - Output format -c (1=f7.2, 2=f7.4) -c HTFAC - real - Factor to convert elevations -c to meters -c MESSAG - char*70 - Text label for initial record -c -c --- OUTPUT: none -c -c Parameters: MXNX, MXNY, IO6, IO7 -c -c --- WREDAT called by: MAIN -c --- WREDAT calls: none -c---------------------------------------------------------------------- -c -c --- Set parameters - include 'params.geo' - - real xdata(mxnx,mxny) - character*1 ccomma - character*70 messag -c - data ccomma/','/ -c -c --- Write the header record for this field -c --- NOTE: htfac is the conversion factor to meters - write(io7,12) htfac,messag -12 format(1x,f6.4,1x,' - ',a70) -c -c --- Write a gridded field in GEO.DAT format - nxm1=nx-1 - if(iform.eq.1)then - do 100 j=ny,1,-1 - write(io7,95)(xdata(n,j),ccomma,n=1,nxm1),xdata(nx,j) -95 format(100(f7.2,a1)) -100 continue - else if(iform.eq.2)then - do 200 j=ny,1,-1 - write(io7,195)(xdata(n,j),ccomma,n=1,nxm1),xdata(nx,j) -195 format(100(f7.4,a1)) -200 continue - else - write(io6,*)'Error in subr. WREDAT -- Invalid value of IFORM ', - 1 '-- IFORM = ',iform - write(*,*) ' ERROR in SUBR. WREDAT -- See Run LIST file' - stop - endif -c - return - end -c---------------------------------------------------------------------- - subroutine out(rarray,iarray,ityp,nsigd,ldate,messag,nbx,nby, - 1 nex,ney) - -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 990130 OUT -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Write a gridded field of real or integer numbers -c -c --- Update -c Ver 1.0 Level 960215 to 990130 DGS -c Allow subgrid to be printed, and use (I3) cell index -c -c --- INPUTS: -c RARRAY(MXNX,MXNY) - Real array- Array of real numbers to print -c (used only if ITYP = 1) -c IARRAY(MXNX,MXNY) - Int. array- Array of integer numbers to -c print (used only if ITYP = 2) -c ITYP - Integer - Array type (1=real, 2=integer) -c NSIGD - Integer - No. digits to print (valid range -c for NSIGD is 1 to 5) -c LDATE - Logical - Control variable for printing -c of date (.true. = print date in -c common /GEN/, .false. = do not -c print date) -c MESSAG - Char.*70 - Label of table -c NBX - Integer - Starting X cell to print -c NBY - Integer - Starting Y cell to print -c NEX - Integer - Ending X cell to print -c NEY - Integer - Ending Y cell to print -c Common block /GEN/ variables: -c NYR, NMO, NDAY, NJUL, NHR - (Used only if LDATE=.true.) -c Parameters: MXNX, MXNY, IO6 -c -c --- OUTPUT: none -c -c --- OUT called by: MAIN -c --- OUT calls: WRT, WRT2 -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.geo' -c -c --- Set dummy common for "date" variables (not used here) - common/gen/nyr,nmo,nday,njul,nhr -c - real rarray(mxnx,mxny) -c - integer iarray(mxnx,mxny),icol(5) - integer iout(mxnx) -c - logical ldate -c - character*70 messag - character*1 sign(mxnx),plus,minus - character*24 form1(5) - character*21 form2(5) - character*18 form3(5) -c -c include 'gen.met' -c - data icol /40,40,30,25,20/ - data plus,minus /'+','-'/ - data form1 /'(1x,i3,1x,1hI,40(i3,1x))', - 1 '(1x,i3,1x,1hI,40(i3,1x))', - 2 '(1x,i3,1x,1hI,40(i3,1x))', - 3 '(1x,i3,1x,1hI,40(i4,1x))', - 4 '(1x,i3,1x,1hI,40(i5,1x))'/ - data form2 /'(5x,1hI,40(2x,a1,1x))', - 1 '(5x,1hI,40(2x,a1,1x))', - 2 '(5x,1hI,40(2x,a1,1x))', - 3 '(5x,1hI,40(3x,a1,1x))', - 4 '(5x,1hI,40(4x,a1,1x))'/ - data form3 /'(6x,40(i3,1x))', - 1 '(6x,40(i3,1x))', - 2 '(6x,40(i3,1x))', - 3 '(6x,40(i4,1x))', - 4 '(6x,40(i5,1x))'/ - -c --- check that valid values of array type (ityp) and print digits -c --- (nsigd) have been passed to routine - if(ityp.ne.1.and.ityp.ne.2)then - write(io6,*)'ERROR in SUBR. OUT -- invalid value of ITYP -- ', - 1 'ITYP = ',ityp - write(*,*) 'ERROR in SUBR. OUT -- See Run LIST File' - stop - endif - if(nsigd.lt.1.or.nsigd.gt.5)then - write(io6,*)'ERROR in SUBR. OUT -- invalid value of NSIGD -- ', - 1 'NSIGD = ',nsigd - write(*,*) 'ERROR in SUBR. OUT -- See Run LIST File' - stop - endif -c -c --- compute no. X cells to print - nx=nex-nbx+1 -c - icr=2 - if(nsigd.eq.1)icr=1 - if(mod(nx,icol(nsigd)).eq.0)then - npass=nx/icol(nsigd) - else - npass=nx/icol(nsigd)+1 - endif -c -c --- real array -- find min. & max. values - if(ityp.ne.1)go to 50 - xmax=-1.e-25 - xmin=1.e25 - do 10 i=nbx,nex - do 10 j=nby,ney - if(rarray(i,j).gt.xmax)xmax=rarray(i,j) - if(rarray(i,j).lt.xmin)xmin=rarray(i,j) -10 continue - if(xmin.ne.0.0.or.xmax.ne.0.0)go to 12 - if(ldate)write(io6,94)messag,nyr,nmo,nday,njul,nhr - if(.not.ldate)write(io6,95)messag - write(io6,11) -11 format(1x,'GRID NOT PRINTED -- all values zero') - return -c -12 continue - xexp=xmax - if(abs(xmin).gt.xmax)xexp=abs(xmin) - iexp=alog10(xexp) - if(xexp.lt.1.0)iexp=iexp-1 - nexp=iexp-(nsigd-icr) - xscale=10.**(-nexp) -c - ic1=nbx - ic2=ic1+icol(nsigd)-1 - if(ic2.gt.nex)ic2=nex -c - do 30 ipass=1,npass -c - if(ldate)write(io6,94)messag,nyr,nmo,nday,njul,nhr -94 format(/1x,a70,2x,'year: ',i2,2x,'month: ',i2,2x,'day: ',i2,2x, - 1 'Julian day: ',i3,2x,'hour: ',i2/) - if(.not.ldate)write(io6,95)messag -95 format(/1x,a70/) - write(io6,109)nexp -109 format(1x,'Multiply all values by 10 ** ',i3/) -c - do 20 jj=ney,nby,-1 - icnt=0 -c - do 18 i=ic1,ic2 - icnt=icnt+1 - if(rarray(i,jj).lt.0)then - iout(icnt)=-(rarray(i,jj)*xscale-0.5) - sign(icnt)=minus - else - iout(icnt)=rarray(i,jj)*xscale+0.5 - sign(icnt)=plus - endif -18 continue - call wrt(form1(nsigd),form2(nsigd),jj,iout,sign,icnt,io6) -20 continue -c --- Set underline (minimum space per cell is 4 characters) - minund=4 - nund=icnt*MAX((nsigd+1),minund) - write(io6,101)(minus,n=1,nund) -101 format(5x,160a1) - call wrt2(form3(nsigd),ic1,ic2,io6) -c - ic1=ic1+icol(nsigd) - ic2=ic2+icol(nsigd) - if(ic2.gt.nex)ic2=nex -30 continue - return -c -c --- integer array -- find min. & max. values -50 continue - kmax=-9999999 - kmin=9999999 - do 110 i=nbx,nex - do 110 j=nby,ney - if(iarray(i,j).gt.kmax)kmax=iarray(i,j) - if(iarray(i,j).lt.kmin)kmin=iarray(i,j) -110 continue - if(kmin.ne.0.or.kmax.ne.0)go to 102 - if(ldate)write(io6,94)messag,nyr,nmo,nday,njul,nhr - if(.not.ldate)write(io6,95)messag - write(io6,11) - return -c -102 continue - xexp=kmax - if(iabs(kmin).gt.kmax)xexp=iabs(kmin) - iexp=alog10(xexp) - if(xexp.lt.1.0)iexp=iexp-1 - nexp=iexp-(nsigd-icr) - xscale=10.**(-nexp) -c - ic1=nbx - ic2=ic1+icol(nsigd)-1 - if(ic2.gt.nex)ic2=nex -c - do 130 ipass=1,npass -c - if(ldate)write(io6,94)messag,nyr,nmo,nday,njul,nhr - if(.not.ldate)write(io6,95)messag - write(io6,109)nexp -c - do 120 jj=ney,nby,-1 - icnt=0 -c - do 118 i=ic1,ic2 - icnt=icnt+1 - if(iarray(i,jj).lt.0)then - iout(icnt)=-(iarray(i,jj)*xscale-0.5) - sign(icnt)=minus - else - iout(icnt)=iarray(i,jj)*xscale+0.5 - sign(icnt)=plus - endif -118 continue - call wrt(form1(nsigd),form2(nsigd),jj,iout,sign,icnt,io6) -120 continue -c --- Set underline (minimum space per cell is 4 characters) - minund=4 - nund=icnt*MAX((nsigd+1),minund) - write(io6,101)(minus,n=1,nund) - call wrt2(form3(nsigd),ic1,ic2,io6) -c - ic1=ic1+icol(nsigd) - ic2=ic2+icol(nsigd) - if(ic2.gt.nex)ic2=nex -130 continue -c - return - end -c---------------------------------------------------------------------- - subroutine wrt(form1,form2,jj,iout,sign,n,io6) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 920905 WRT -c --- J. Scire, SRC -c -c --- PURPOSE: Write one Y row of gridded data -c -c --- INPUTS: -c FORM1 - Char.*24 - Format field for Y label and data -c to be printed -c FORM2 - Char.*21 - Format field for sign of data -c JJ - Integer - Y grid cell number -c IOUT(N) - Int. array - Array of data to be printed -c (one Y row) -c SIGN(N) - Char.*1 - Array containing sign of data -c ('+' or '-') -c N - Integer - Number of cells in this row -c IO6 - Integer - Fortran unit no. of output -c -c --- OUTPUT: none -c -c --- WRT called by: OUT -c --- WRT calls: none -c---------------------------------------------------------------------- - integer iout(n) -c - character*1 sign(n) - character*24 form1 - character*21 form2 -c - write(io6,form1)jj,iout - write(io6,form2)sign -c - return - end -c---------------------------------------------------------------------- - subroutine wrt2(form,n1,n2,io6) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 920905 WRT2 -c --- J. Scire, SRC -c -c --- PURPOSE: Write a line labeling grid cell numbers -c -c --- INPUTS: -c FORM - Char.*18 - Format field of data to be printed -c N1 - Integer - Starting grid cell number -c N2 - Integer - Ending grid cell number -c IO6 - Integer - Fortran unit no. of output -c -c --- OUTPUT: none -c -c --- WRT2 called by: OUT -c --- WRT2 calls: none -c---------------------------------------------------------------------- - character*18 form -c - write(io6,form)(i,i=n1,n2) - return - end -c---------------------------------------------------------------------- - logical function lrsame(r0,r1,r2) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 991104c LRSAME -c D. Strimaitis, Earth Tech, Inc. -c --- From CALPOST V5.2, L991104c -c -c --- PURPOSE: Compare 2 real numbers (r1,r2) to determine if their -c fractional difference exceeds r0 -c -c --- INPUTS: -c r0 - real - Fractional difference allowed -c r1 - real - Real value 1 -c r2 - real - Real value 2 -c -c -c --- OUTPUT: -c lrsame - logical - Key indicating result of test -c .TRUE. -- values are 'same' -c .FALSE. -- values are NOT 'same' -c -c -c --- LRSAME called by: MAIN -c --- LRSAME calls: none -c---------------------------------------------------------------------- -c - data half/0.5/ - - lrsame=.TRUE. - -c --- Direct comparison - if(r1.EQ.r2) return - - rdif=ABS(r1-r2) - ravg=half*ABS(r1+r2) - - if(rdif.GE.ravg) then -c --- Fractional difference greater than one! - lrsame=.FALSE. - else - ftest=rdif/ravg - if(ftest.GT.r0) lrsame=.FALSE. - endif - - return - end -c----------------------------------------------------------------------- - subroutine wrthead -c----------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 WRTHEAD -c D. Strimaitis, Earth Tech, Inc. -c -c PURPOSE: WRTHEAD constructs the header records for the output -c data file GEO.DAT -c -C -C Update: -C From Version: 3.2 Level: 030402 to Veriosn: 3.0 Level: 090526 -C Change GEO.DAT Version numder to 2.1 from 2.0 to indicate -C possible snow informat processing. -C -C Zhong-Xiang Wu -C 5/26/2009 - -c ARGUMENTS: -c PASSED: /CONTROL/ logicals -c /GRID/ data -c /QA/ ver,level -c -c RETURNED: none -c -c CALLING ROUTINES: SETUP -c -c EXTERNAL ROUTINES: none -c----------------------------------------------------------------------- -c --- Include file of parameters and commons - include 'params.geo' - include 'control.geo' - include 'grid.geo' - include 'qa.geo' - -c --- Local Variables - character*16 dataset,dataver - character*64 datamod - character*80 comment1 - -c --- Configure output variables - data dataset/'GEO.DAT'/, dataver/'2.1'/ -c data dataset/'GEO.DAT'/, dataver/'2.0'/ - data datamod/'Header structure with coordinate parameters'/ - data ncomment/2/ - data comment1/'Produced by MAKEGEO Version: '/ - -c --- Construct the version-level comment string - j=30 - do i=1,12 - if(ver(i:i).NE.' ') then - comment1(j:j)=ver(i:i) - j=j+1 - endif - enddo - j=j+1 - comment1(j:j+7)=' Level: ' - j=j+8 - do i=1,12 - if(level(i:i).NE.' ') then - comment1(j:j)=level(i:i) - j=j+1 - endif - enddo - -c --- Record 1: Dataset, Version, Modifier - write(io7,'(2a16,a64)') dataset,dataver,datamod -c --- Record 2: Number of comment records - write(io7,'(i4)') ncomment -c --- Record 3: Comment (optional/repeatable) - write(io7,'(a80)') comment1 - write(io7,'(a80)') ctitle -c --- Record 5: Map projection - write(io7,'(a8)') pmap -c --- Record 6: Map projection parameters - if(LUTM) then - write(io7,'(i4,a4)') izone,utmhem - elseif(LLCC) then - write(io7,'(4a16)') clat0,clon0,clat1,clat2 - elseif(LPS) then - write(io7,'(3a16)') clat0,clon0,clat1 - elseif(LEM.or.LLAZA.or.LTTM) then - write(io7,'(2a16)') clat0,clon0 - endif -c --- Record 7: Map false Easting/Northing - if(LLCC.or.LLAZA.or.LTTM) then - write(io7,*) feast,fnorth - endif -c --- Record 8: Map DATUM - write(io7,'(a8,a12)') datum,daten -c --- Record 9: Grid - write(io7,'(2i8,4f12.3)') nx,ny,xorg,yorg,delx,delx -c --- Record 10: XYUNIT,ZUNIT - write(io7,'(2a4)') 'KM ','M ' - - return - end -c---------------------------------------------------------------------- - subroutine fin -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090511 FIN -c --- J. Scire -c -c --- PURPOSE: Run termination routine -- compute runtime -c -c --- V2.0 (011003) to V6.327 (090511) (DGS) -c - Reformat date reported at end of run -c -c --- INPUTS: -c Common block /QA/ -c rdate, rtime, rcpu -c Parameters: IO6, IOMESG -c -c --- OUTPUT: none -c -c --- FIN called by: MAIN -c --- FIN calls: DATETM, JULDAY, DELTT, FMT_DATE -c---------------------------------------------------------------------- -c -c --- include parameters - include 'params.geo' - include 'qa.geo' -c - character*8 rtime2 - character*10 rdate2 - character*12 rdate12 -c - write(iomesg,*)'TERMINATION PHASE' -c -c --- get system date & time at end of run - call datetm(rdate2,rtime2,rcpu) -c -c --- compute runtime - read(rtime(1:2),10)ihr1 - read(rtime(4:5),10)imin1 - read(rtime(7:8),10)isec1 -10 format(i2) - t1=ihr1*3600.+imin1*60.+isec1 -c - read(rtime2(1:2),10)ihr2 - read(rtime2(4:5),10)imin2 - read(rtime2(7:8),10)isec2 - t2=ihr2*3600.+imin2*60.+isec2 -c - if(rdate.eq.rdate2)then - delt=t2-t1 - else - read(rdate(1:2),10)imo1 - read(rdate(4:5),10)iday1 - read(rdate(7:10),'(i4)')iyr1 - call julday(io6,iyr1,imo1,iday1,ijul1) -c - read(rdate2(1:2),10)imo2 - read(rdate2(4:5),10)iday2 - read(rdate2(7:10),'(i4)')iyr2 - call julday(io6,iyr2,imo2,iday2,ijul2) -c -c --- compute no. hours from beg. of first hour of run to -c --- ending hour of ending day of the run - call deltt(iyr1,ijul1,ihr1,iyr2,ijul2,ihr2,idelhr) -c -c --- adjust for minutes and seconds - delt=idelhr*3600.-imin1*60.-isec1+imin2*60.+isec2 - endif - -c --- On the PC, the runtime and CPU time are the same -c --- (DATETM provides RCPU = 0.0 on the PC) - if(rcpu.EQ.0.0)rcpu=delt - -c --- Report current date - rdate12=rdate2(1:10)//' ' - call FMT_DATE(io6,'MM-DD-YYYY','DD-MMM-YYYY',rdate12) - write(io6,1402)rtime2,rdate12,NINT(delt),NINT(rcpu) -1402 format(//2x,'End of run -- Clock time: ',a8/ - 1 2x,' Date: ',a12// - 2 2x,' Elapsed Clock Time: ',i12,' (seconds)'// - 3 2x,' CPU Time: ',i12,' (seconds)') - -c - return - end - -c---------------------------------------------------------------------- - subroutine rdsnhd -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 RDSNHD -c J. Scire, D. Strimaitis Earth Tech, Inc. -c -c --- PURPOSE: -C Read the file header from a snow.dat file -C -c --- Zhong-Xiang Wu -C 5/26/2009 - - include 'params.geo' - include 'control.geo' - include 'snow.geo' - - parameter(mxcmm=100) - - character*16 dataseti,dataveri,datetimei - character*64 datamodi - character*8 cmapi,datumi,timezonei - character*10 dateni - character*4 unitsi - character*80 buff - -C --- Header Record #1, #2 - if(ifmt.eq.1) then - read(isnw,101)dataseti,dataveri,datamodi - read(isnw,102)ncomm - 101 format(2a16,a64) - 102 format(i4) - else - read(isnw)dataseti,dataveri,datamodi - read(isnw)ncomm - endif - -C --- Header Record #3 - if(ncomm.gt.mxcmm) then - write(io6,*)' Error: Comment lines out range:',ncomm,mxcmm - print *,' Error: Comment lines out range:',ncomm,mxcmm - stop - endif - - do i=1,ncomm - if(ifmt.eq.1) then - read(isnw,'(a)')comment - else - read(isnw)comment - endif - enddo - -C --- Read Standard CALXX file header (from DS) - if(ifmt.eq.1) then - read(isnw,121)cmapi - read(isnw,121)datumi,dateni - read(isnw,122)unitsi - 121 format(a8,a10) - 122 format(a4) - else - read(isnw)cmapi - read(isnw)datumi,dateni - read(isnw)unitsi - endif - - if(ifmt.eq.1) then - read(isnw,*)flonbs,flatbs,nxp,nyp,dx,dy - read(isnw,121)timezonei - read(isnw,302)datetimei - 302 format(a16) - else - read(isnw)flonbs,flatbs,nxp,nyp,dx,dy - read(isnw)timezonei - read(isnw)datetimei - endif - -C --- Raw snow data config. info - if(ifmt.eq.1) then - read(isnw,*)flon0,flat0,nx0,ny0,dx0,dy0 - read(isnw,*)nib,nie,njb,nje,npk - else - read(isnw)flon0,flat0,nx0,ny0,dx0,dy0 - read(isnw)nib,nie,njb,nje,npk - endif - - isoff=nib-1 - jsoff=njb-1 - -C --- Snow file header QA -------------- - if(nxt.ne.nx0 .or. nyt.ne.ny0) then - write(io6,201)nxt,nyt,nx0,ny0 - write(*,201)nxt,nyt,nx0,ny0 - stop - endif - 201 format(' Error: nx/ny mis-match:',4i8) - - dd1=abs(flonorg-flon0)+abs(flatorg-flat0) - dd2=abs(dlon-dx0)+abs(dlat-dy0) - if(dd1.gt.0.001) then - write(io6,202)dd1,flonorg,flon0,flatorg,flat0 - stop - endif - 202 format(' Error: Corner lon/lat mis-match:',4f12.6) - - if(dd2.gt.0.00001) then - write(io6,203)dd2,dlon,dx0,dlat,dy0 - stop - endif - 203 format(' Error: Grid size mis-match:',4f12.6) - - return - end - -c---------------------------------------------------------------------- - subroutine rdsn(xsnow,ndsnow,xsnowc) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 RDSN -c J. Scire, D. Strimaitis Earth Tech, Inc. -c -c --- PURPOSE: -C Read the file header from a snow.dat file -C -c --- Zhong-Xiang Wu -C 5/26/2009 - - include 'params.geo' - include 'control.geo' - include 'snow.geo' - - real xsnow(nxp,nyp,nwdt) - integer ndsnow(nxp,nyp) - real xsnowc(nxp,nyp) - -C --- Local - integer*2 ix(nxp*nyp),ix2(nxp*nyp) - integer*2 isml2,ibig2,irange2,ipmiss2,ia - integer*2 it0,it1,it2,it3,it4,it5,it6,it7,it8,it9 - - character*8 vns,csndp,cprec - data csndp,cprec/'SNOWDEP','PRECIPS'/ - data precmin/0.1/ - -C --- Loop over variables in snow data - call getdate(idatenext,iy,im,id,ih) - call chgtim(iy,im,id,ih,-48) - call timestmp(iy,im,id,ih,idatelmt) - - 4000 continue - ifound1=0 - ifound2=0 - - do 5000 ivar=1,npk - -C --- Data header - if(ifmt.eq.1) then - read(isnw,111,err=6000,end=6000)it1,it2,it3,it4,it0,it5,it6 - & ,it7,it8,it0,vns,isml2,ibig2,ipmiss2,scale,ins - 111 format(2(i4,3i3,1x,i4.4,1x),a8,1x,3i7,f8.1,i10) - else - read(isnw,err=6000,end=6000)it1,it2,it3,it4,it0,it5,it6 - & ,it7,it8,it0,vns,isml2,ibig2,ipmiss2,scale,ins - endif - - isml=isml2 - ibig=ibig2 - irange=ibig-isml - - if(irange.gt.nmx) then - write(io6,112)isml,ibig,irange - print 112,isml,ibig,irange - 112 format(' Error: TRANSDATA failed: data outrange :',4i10) - stop - endif - - iyr=it1 - imn=it2 - idy=it3 - ihr=it4 - -C --- Read packed Data - if(ins.lt.0) then - write(io6,201)ins - print 201,ins - 201 format(' Error: Illegal packed snow data:',2i7) - stop - endif - - if(ifmt.eq.1) then - read(isnw,301)(ix2(ij),ij=1,ins) - 301 format(10i7) - else - read(isnw)(ix2(ij),ij=1,ins) - endif - -C --- Finish reading one variable from one-day data - 2000 continue - if(vns.ne.csndp .and. vns.ne.cprec) goto 5000 - -C --- Check time stamps - ihr0=0 - - call timestmp(iyr,imn,idy,ihr0,idatc) - - if(idatc.lt.idatelmt) goto 5000 - -C --- Find selected variable - -C --- Expand to full nx*ny array - if(vns.eq.csndp) ifound1=1 - if(vns.eq.cprec) ifound2=1 - - ipos=1 - ij=0 - - 1000 ia=ix2(ipos) - if(ia.ge.0 .or. ia.eq.ipmiss2) then - ij=ij+1 - ix(ij)=ia - else - np=-ia - ipos=ipos+1 - ia=ix2(ipos) - do i=1,np - ij=ij+1 - ix(ij)=ia - enddo - endif - - ipos=ipos+1 - - if(ipos.le.ins) goto 1000 - - if(ij.ne.nxp*nyp) then - write(io6,102)ij,nxp*nyp - print 102,ij,nxp*nyp - 102 format(' Error: Expanding failed:',3i10) - stop - endif - -C --- Recover original values to 2D array - do ij=1,nxp*nyp - ia=ix(ij) - j=(ij-1)/nxp+1 - i=ij-(j-1)*nxp - - if(ia.ne.ipmiss2) then - ia=ia+isml2 - aa=ia/scale - else - aa=fmiss - endif - - if(vns.eq.csndp) then - xsnow(i,j,nwdt)=aa - elseif(vns.eq.cprec) then - if(aa.ge.precmin) then - ndsnow(i,j)=0 - else - ndsnow(i,j)=ndsnow(i,j)+1 - endif - endif - enddo - - 5000 continue - - if(idatc.lt.idatelmt) goto 4000 - - if(ifound1.eq.0) then - write(io6,311)ifound1,csndp - print 311,ifound1,csndp - 311 format(' Error: Missing Required Variable:',i6,1x,a) - stop - endif - - if(ifound2.eq.0) then - write(io6,311)ifound2,cprec - print 311,ifound2,cprec - stop - endif - -C --- Fill missing in spatial if required for snow depth - if(isfill.eq.1) then - call fills(xsnow,nxp,nyp,nwdt,nwdt,fmiss,nwds) - endif - -C --- Read 2nd day at beginning date - if(idatc.lt.idatenext) then - call rollbk(xsnow,nxp,nyp,nwdt,fmiss) - goto 4000 - endif - - if(idatc.ne.idatenext) then - write(io6,*)' Error: Snow data not found:',idatc,idatenext - print *,' Error: Snow data not found:',idatc,idatenext - stop - endif - - goto 7000 - 6000 continue - - ioff=1 - print *,' Snow Data End at ',idatc - -C --- Fill missing in spatial if required - 7000 continue - - nn=nwdt-1 - if(itfill.eq.1) then - call fillt(xsnow,xsnowc,nxp,nyp,nn,nwdt,fmiss) - else -C Pass the middle one for GEO processing use - do j=1,nyp - do i=1,nxp - xsnowc(i,j)=xsnow(i,j,nn) - enddo - enddo - endif - - return - end - -c---------------------------------------------------------------------- - subroutine fills(xdata,nx,ny,ivar,nvar,fmiss,nwds) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 FILL -c J. Scire, D. Strimaitis Earth Tech, Inc. -c -c --- PURPOSE: -C Fill missing data within a spatial window -C -c --- Zhong-Xiang Wu -C 5/26/2009 - - dimension xdata(nx,ny,nvar) - dimension xtmp(nx,ny) - - do j=1,ny - do i=1,nx - xtmp(i,j)=xdata(i,j,ivar) - enddo - enddo - - ims=0 - do j=1,ny - do i=1,nx - aa=xtmp(i,j) - if(aa.ne.fmiss) goto 1000 - - do m=1,nwds - i1=i-m - i2=i+m - j1=j-m - j2=j+m - - i1=max(i1,1) - j1=max(j1,1) - i2=min(i2,nx) - j2=min(j2,ny) - - dd=0 - ip=0 - do jj=j1,j2 - do ii=i1,i2 - aa=xtmp(ii,jj) - if(aa.ne.fmiss) then - ip=ip+1 - dd=dd+aa - endif - enddo - enddo - - if(ip.ge.1) then - dd=dd/ip - xdata(i,j,ivar)=dd - ims=ims+1 - goto 1000 - endif - enddo ! end of m - - 1000 continue - - enddo ! end of i - enddo ! end of j - - return - end - -c---------------------------------------------------------------------- - subroutine fillt(xdata,xdatac,nx,ny,ivar,nwdt,fmiss) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 FILL -c J. Scire, D. Strimaitis Earth Tech, Inc. -c -c --- PURPOSE: -C Fill missing data within a spatial window -C -c --- Zhong-Xiang Wu -C 5/26/2009 - - dimension xdata(nx,ny,nwdt),xdatac(nx,ny) - - ims=0 - - do j=1,ny - do i=1,nx - aa=xdata(i,j,ivar) - if(aa.ne.fmiss) then - xdatac(i,j)=aa - else - dd=0 - ip=0 - do m=1,nwdt - aa=xdata(i,j,m) - if(aa.ne.fmiss) then - ip=ip+1 - dd=dd+aa - endif - enddo - - if(ip.ge.1) then - dd=dd/ip - ims=ims+1 - else - dd=fmiss - endif - xdatac(i,j)=dd - endif - enddo ! end of i - enddo ! end of j - - return - end - -! ********************************************************************** - subroutine chgtim(iyr,imon,iday,ihour,idt) - -c --- RUCDECODE Version: 2.6 Level: 060823 -! --- Zhong-Xiang Wu -! -! --- PURPOSE: -! Increase or decrease hours. -! Used to convert Local Stand Time to GMT or to setup time stamp for loop - - parameter(nmonth=12) - - dimension ndays(nmonth) - - data ndays/31,28,31,30,31,30,31,31,30,31,30,31/ - - if(mod(iyr,4).eq.0) then - ndays(2)=29 - else - ndays(2)=28 - endif - - ihour=ihour+idt - - if(idt.lt.0) goto 2000 - - 1000 if(ihour.gt.23) then - ihour=ihour-24 - iday=iday+1 - - if(iday.gt.ndays(imon)) then - iday=1 - imon=imon+1 - - if(imon.gt.12) then - imon=1 - iyr=iyr+1 - if(iyr/4 .eq. iyr/4.0) then - ndays(2)=29 - else - ndays(2)=28 - endif - endif - endif - goto 1000 - else - return - endif - - 2000 continue - - 3000 if(ihour.lt.0) then - ihour=ihour+24 - iday=iday-1 - - if(iday.le.0) then - imon=imon-1 - if(imon.le.0) then - iyr=iyr-1 - imon=12 - if(iyr/4 .eq. iyr/4.0) then - ndays(2)=29 - else - ndays(2)=28 - endif - endif - - iday=ndays(imon) - endif - goto 3000 - else - return - endif - - end -! -------------------------------------------------- - Subroutine timestmp(iyr,imn,idy,ihr,idate) - -c --- RUCDECODE Version: 2.6 Level: 060823 - - idate=ihr+idy*100+imn*10000+iyr*1000000 - - return - end - -c --------------------------------------------------------------------- - subroutine getdate(ndate,iyr,imon,iday,ihour) -c --------------------------------------------------------------------- -c --- RUCDECODE Version: 2.6 Level: 050507 GETDATE - - iyr=ndate/1000000 - imon=ndate/10000-iyr*100 - iday=ndate/100-iyr*10000-imon*100 - ihour=ndate-iyr*1000000-imon*10000-iday*100 - - return - end - -c---------------------------------------------------------------------- - subroutine rollbk(xdata,nx,ny,nwdt,fmiss) -c---------------------------------------------------------------------- -c -c --- MAKEGEO Version: 3.2 Level: 090526 FILL -c J. Scire, D. Strimaitis Earth Tech, Inc. -c -c --- PURPOSE: -C Save one day snow data -C -c --- Zhong-Xiang Wu -C 5/26/2009 - - dimension xdata(nx,ny,nwdt) - - do j=1,ny - do i=1,nx - do k=1,nwdt-1 - k1=k+1 - xdata(i,j,k)=xdata(i,j,k1) - enddo - xdata(i,j,nwdt)=fmiss - enddo - enddo - - return - end - -c -------------------------------------------------------------- - subroutine gethours(ndate1,ndate2,nhrs) - -c --- RUCDECODE Version: 2.6 Level: 061228 -C Purpose: -c Get hours between two dates -C Zhong Wu -C (3/22/1999) - -C Changes -C 1. Fix an error for total hours when beginning year is -C leap year -C Zhong Wu -C 5/23/2003 - -c Get hours between to dates - - if(ndate2.lt.ndate1) then - print *,'Error in gethours: ndate2 < ndate1' - print *,ndate1,ndate2 - stop - endif - - call getdate(ndate1,iyr1,imon1,iday1,ihour1) - call julday(io6,iyr1,imon1,iday1,jday1) - - call getdate(ndate2,iyr2,imon2,iday2,ihour2) - call julday(io6,iyr2,imon2,iday2,jday2) - - call deltt(iyr1,jday1,ihour1,iyr2,jday2,ihour2,nhrs) - - nhrs=nhrs+1 ! deltt is one hour less total hours - - return - end diff --git a/CALPUFF_SRC/MAKEGEO/params.cal b/CALPUFF_SRC/MAKEGEO/params.cal deleted file mode 100644 index 6a77e6b..0000000 --- a/CALPUFF_SRC/MAKEGEO/params.cal +++ /dev/null @@ -1,12 +0,0 @@ -c---------------------------------------------------------------------- -c --- PARAMETER statements CALUTILS -c---------------------------------------------------------------------- -c --- Specify parameters - parameter(mxvar=60,mxcol=200) -c -c --- CONTROL FILE READER definitions: -c MXVAR - Maximum number of variables in each input group -c MXCOL - Maximum length (bytes) of a control file input record -c---------------------------------------------------------------------- - - \ No newline at end of file diff --git a/CALPUFF_SRC/MAKEGEO/qa.geo b/CALPUFF_SRC/MAKEGEO/qa.geo deleted file mode 100644 index 3b60b71..0000000 --- a/CALPUFF_SRC/MAKEGEO/qa.geo +++ /dev/null @@ -1,18 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /QA/ -- Model QA parameters MAKEGEO -c----------------------------------------------------------------------- - character*12 ver,level - character*8 rtime - character*10 rdate -c - common/QA/ver,level,rcpu,rtime,rdate -c -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c ver version number of MAKEGEO [c] -c level level number of MAKEGEO [c] -c rcpu computed CPU time of the run [r] -c rtime system time at start of run (HH:MM:SS) [c] -c rdate system date at start of run (MM-DD-YY) [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/MAKEGEO/snow.geo b/CALPUFF_SRC/MAKEGEO/snow.geo deleted file mode 100644 index d076ec5..0000000 --- a/CALPUFF_SRC/MAKEGEO/snow.geo +++ /dev/null @@ -1,53 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /SNOW/ CTGCOMP -c----------------------------------------------------------------------- - parameter(isfill=1,nwds=2) ! S-Fill window in grids - parameter(itfill=1,nwdt=3) ! T-Fill window in days - - parameter(nvars=8) - parameter(nmx=32767,ipmiss=32768,fmiss=-9999.) - parameter(ndsnowb=14) -c - character*120 fsngrid,fsgeo - character*16 datasets,datavers,datetimes - character*64 datamods - character*80 comment - - character*8 cmaps,datums,timezones - character*10 datens - character*4 unitss - - character*12 cactions - character*4 c4dums - - real*8 vectis(9),vectos(9) - - common/SNOW/datasets,datavers,datetimes,datamods,fsgeo - & ,fsnow,fsngrid,cmaps,datums,timezones,datens,unitss - & ,flonorg,flatorg,flonbs,flatbs,nxp,nyp - & ,nib,nie,njb,nje,npk,isoff,jsoff - & ,nxt,nyt,nxs,nys,dlon,dlat,xl,xh,yl,yh,xyoff,nijs - & ,cactions,vectis,vectos,feastis,fnortis,feasts,fnorths - & ,c4dums,ngref,ngipp,istart,ifmt - & ,iyrs,imns,idys,ihre,iyr,imn,idy,nhrtot,idatc - & ,idateold,idatenew,idatenext,idateb,idatee,ndtot - & ,sdpmin,hfact,msrl,hscl,msal - & ,nages(mxcat),ralb(mxcat) - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c fsngrid Snow grid reference file name [c] -c datasets Snow data set name [c] -c datavers Snow data version name [c] -c datetime Snow data time [c] -c cmap Snow data map projection [c] -C datumsn Snow data datum [c] -C timezones Snow data time zone [c] -C datens Snow data daten [c] -C unitss Snow data units [c] - -c idatebeg Beginning date (YYYYMMDD) of varying geo.dat [i] -c idateend Ending date (YYYYMMDD) of varying geo.dat [i] -c idate Current date (YYYYMMDD) of varying geo.dat [i] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/MAKEGEO/snowref.geo b/CALPUFF_SRC/MAKEGEO/snowref.geo deleted file mode 100644 index 43dce8a..0000000 --- a/CALPUFF_SRC/MAKEGEO/snowref.geo +++ /dev/null @@ -1,21 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /SNOWREF/ MAKEGEO -c----------------------------------------------------------------------- -c --- Snow arrays - parameter (mxsng=10,mxtype=10) - - integer nland(mxnx,mxny),ntype(mxtype,mxnx,mxny) - integer ngsnow(mxtype,mxnx,mxny) - integer idsnow(mxsng,mxtype,mxnx,mxny) - real rsnow(mxsng,mxtype,mxnx,mxny) - character*524 buffl,blankl - - common/SNOWREF/nland,ntype,ngsnow,idsnow,rsnow - -c MXSNG - maximum snow grids in one calmet grid -c MXTYPE - maximum landuse catagories in snow grids -c -c NLAND - Number of landuse type in calmet grid -c NTYPE - Landuse type for NLAND -c NGSNOW - Number of snow grids -C RSNOW - Percentage of snow grid diff --git a/CALPUFF_SRC/README.md b/CALPUFF_SRC/README.md new file mode 100644 index 0000000..499c5eb --- /dev/null +++ b/CALPUFF_SRC/README.md @@ -0,0 +1,9 @@ +# The Build Directory for CALPUFF model code + +The model code can not be hosted on GitHub. This directory will be populated by `installcalpuff.sh` + +## Downloading model code: + +This systems uses CALPUFF version 7 + +[http://www.src.com/calpuff/download/mod7_codes.htm](http://www.src.com/calpuff/download/mod7_codes.htm) diff --git a/CALPUFF_SRC/TERREL/blockdat.crd b/CALPUFF_SRC/TERREL/blockdat.crd deleted file mode 100644 index c87c405..0000000 --- a/CALPUFF_SRC/TERREL/blockdat.crd +++ /dev/null @@ -1,1374 +0,0 @@ - BLOCK DATA DATUMS -c -c************************************************************ -c -c --- BUILD manufactored BLOCK DATA routine -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - INCLUDE 'nima.crd' - data kmax,nudat /234,132/ -c -c --- Set date-stamp for this BLOCK DATA file - data dateb /'02-21-2003 '/ -c --- Set checking date stamp here - data dstamp /'02-21-2003 '/ -c - data datum / - *'WGS-84 : WGS 84 ', - *'WGS-84 : EMG 96 ', - *'WGS-84 : GRS 80 ', - *'WGS-72 : WGS 72 ', - *'NWS : 6370KM Sphere ', - *'ESRI REFERENCE : Normal Sphere (6371) ', - *'ADINDAN : Clarke 1880 ', - *'AFGOOYE : Krassovsky 1940 ', - *'ARC 1950 : Clarke 1880 ', - *'ARC 1960 : Clarke 1880 ', - *'AYABELLE LIGHTHOUSE : Clarke 1880 ', - *'BISSAU : International 1924 ', - *'CAPE : Clarke 1880 ', - *'CARTHAGE : Clarke 1880 ', - *'DABOLA : Clarke 1880 ', - *'EUROPEAN 1950 : International 1924 ', - *'LEIGON : Clarke 1880 ', - *'LIBERIA 1964 : Clarke 1880 ', - *'MASSAWA : Bessel 1841 ', - *'MERCHICH : Clarke 1880 ', - *'MINNA : Clarke 1880 ', - *'M-PORALOKO : Clarke 1880 ', - *'NORTH SAHARA 1959 : Clarke 1880 ', - *'OLD EGYPTIAN 1907 : Helmert 1906 ', - *'POINT 58 : Clarke 1880 ', - *'POINTE NOIRE 1948 : Clarke 1880 ', - *'SCHWARZECK : Bessel 1841 ', - *'SIERRA LEONE 1960 : Clarke 1880 ', - *'TANANARIVE OBSERVATORY 1925 : International 1924 ', - *'VOIROL 1874 : Clarke 1880 ', - *'VOIROL 1960 : Clarke 1880 ', - *'AIN EL ABD 1970 : International 1924 ', - *'BUKIT RIMPAH : Bessel 1841 ', - *'DJAKARTA (BATAVIA) : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'GUNUNG SEGARA : Bessel 1841 ', - *'HERAT NORTH : International 1924 ', - *'HONG KONG 1963 : International 1924 ', - *'HU-TZU-SHAN : International 1924 ', - *'INDIAN : Everest (1830) ', - *'INDIAN : Everest (1956) ', - *'INDIAN : Everest ', - *'INDIAN 1954 : Everest (1830) ', - *'INDIAN 1960 : Everest (1830) ', - *'INDIAN 1975 : Everest (1830) ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'KANDAWALA : Everest (1830) ', - *'KERTAU 1948 : Everest (1948) ', - *'KOREAN GEODETIC SYSTEM 1995 : WGS 84 ', - *'NAHRWAN : Clarke 1880 ', - *'OMAN : Clarke 1880 ', - *'PULKOVO 1942 : Krassovsky 1940 ', - *'QATAR NATIONAL : International 1924 ', - *'SOUTH ASIA : Modified Fischer 1960', - *'TIMBALAI 1948 : Everest ', - *'TOKYO : Bessel 1841 ', - *'AUSTRALIAN GEODETIC 1966 : Australian National ', - *'AUSTRALIAN GEODETIC 1984 : Australian National ', - *'COORD SYSTEM 1937 OF ESTONIA : Bessel 1841 ', - *'EUROPEAN 1950 : International 1924 ', - *'EUROPEAN 1979 : International 1924 ', - *'HERMANNSKOGEL : Bessel 1841 ', - *'IRELAND 1965 : Modified Airy ', - *'ORD SURV OF GREAT BRITAIN 36 : Airy ', - *'ROME 1940 : International 1924 ', - *'S-42 (PULKOVO 1942) : Krassovsky 1940 ', - *'S-JTSK : Bessel 1841 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'NORTH AMERICAN 1927 : Clarke 1866 ', - *'NORTH AMERICAN 1983 : GRS 80 ', - *'BOGOTA OBSERVATORY : International 1924 ', - *'CAMPO INCHAUSPE 1969 : International 1924 ', - *'CHUA ASTRO : International 1924 ', - *'CORREGO ALEGRE : International 1924 ', - *'PROVISIONAL S. AMERICAN 1956 : International 1924 ', - *'PROVISIONAL S. CHILEAN 1963 : International 1924 ', - *'SOUTH AMERICAN 1969 : South American 1969 ', - *'SIRGAS : GRS 80 ', - *'YACARE : International 1924 ', - *'ZANDERIJ : International 1924 ', - *'ANTIGUA ISLAND ASTRO 1943 : Clarke 1880 ', - *'ASCENSION ISLAND 1958 : International 1924 ', - *'ASTRO DOS 71/4 : International 1924 ', - *'BERMUDA 1957 : Clarke 1866 ', - *'CAPE CANAVERAL : Clarke 1866 ', - *'DECEPTION ISLAND : Clarke 1880 ', - *'FORT THOMAS 1955 : Clarke 1880 ', - *'GRACIOSA BASE SW 1948 : International 1924 ', - *'HJORSEY 1955 : International 1924 ', - *'ISTS 061 ASTRO 1968 : International 1924 ', - *'L. C. 5 ASTRO 1961 : Clarke 1866 ', - *'MONTSERRAT ISLAND ASTRO 1958 : Clarke 1880 ', - *'NAPARIMA, BWI : International 1924 ', - *'OBSERVAT. METEOROLOGICO 1939 : International 1924 ', - *'PICO DE LAS NIEVES : International 1924 ', - *'PORTO SANTO 1936 : International 1924 ', - *'PUERTO RICO : Clarke 1866 ', - *'QORNOQ : International 1924 ', - *'SAO BRAZ : International 1924 ', - *'SAPPER HILL 1943 : International 1924 ', - *'SELVAGEM GRANDE 1938 : International 1924 ', - *'TRISTAN ASTRO 1968 : International 1924 ', - *'ANNA 1 ASTRO 1965 : Australian National ', - *'GAN 1970 : International 1924 ', - *'ISTS 073 ASTRO 1969 : International 1924 ', - *'KERGUELEN ISLAND 1949 : International 1924 ', - *'MAHE 1971 : Clarke 1880 ', - *'REUNION : International 1924 ', - *'AMERICAN SAMOA 1962 : Clarke 1866 ', - *'ASTRO BEACON E 1945 : International 1924 ', - *'ASTRO TERN ISLAND (FRIG) 61 : International 1924 ', - *'ASTRONOMICAL STATION 1952 : International 1924 ', - *'BELLEVUE (IGN) : International 1924 ', - *'CAMP AREA ASTRO : International 1924 ', - *'CANTON ASTRO 1966 : International 1924 ', - *'CHATHAM ISLAND ASTRO 1971 : International 1924 ', - *'DOS 1968 : International 1924 ', - *'EASTER ISLAND 1967 : International 1924 ', - *'GEODETIC DATUM 1949 : International 1924 ', - *'GUAM 1963 : Clarke 1866 ', - *'GUX l ASTRO : International 1924 ', - *'INDONESIAN 1974 : Indonesian 1974 ', - *'JOHNSTON ISLAND 1961 : International 1924 ', - *'KUSAIE ASTRO 1951 : International 1924 ', - *'LUZON : Clarke 1866 ', - *'MIDWAY ASTRO 1961 : International 1924 ', - *'OLD HAWAIIAN : Clarke 1866 ', - *'PITCAIRN ASTRO 1967 : International 1924 ', - *'SANTO (DOS) 1965 : International 1924 ', - *'VITI LEVU 1916 : Clarke 1880 ', - *'WAKE-ENIWETOK 1960 : Hough ', - *'WAKE ISLAND ASTRO 1952 : International 1924 '/ - data datcod / - *'WGS-84 ','WGS-96 ','WGS-G ','WGS-72 ','NWS-84 ', - *'ESR-S ','ADI-M ','ADI-E ','ADI-F ','ADI-A ', - *'ADI-C ','ADI-D ','ADI-B ','AFG ','ARF-M ', - *'ARF-A ','ARF-H ','ARF-B ','ARF-C ','ARF-D ', - *'ARF-E ','ARF-F ','ARF-G ','ARS-M ','ARS-A ', - *'ARS-B ','PHA ','BID ','CAP ','CGE ', - *'DAL ','EUR-F ','EUR-T ','LEH ','LIB ', - *'MAS ','MER ','MIN-A ','MIN-B ','MPO ', - *'NSD ','OEG ','PTB ','PTN ','SCK ', - *'SRL ','TAN ','VOI ','VOR ','AIN-A ', - *'AIN-B ','BUR ','BAT ','EUR-H ','EUR-S ', - *'GSE ','HEN ','HKD ','HTN ','IND-B ', - *'IND-I ','IND-P ','INF-A ','ING-A ','ING-B ', - *'INH-A ','INH-A1 ','IDN ','KAN ','KEA ', - *'KGS ','NAH-A ','NAH-B ','NAH-C ','FAH ', - *'PUK ','QAT ','SOA ','TIL ','TOY-M ', - *'TOY-A ','TOY-C ','TOY-B ','TOY-B1 ','AUA ', - *'AUG ','EST ','EUR-M ','EUR-A ','EUR-E ', - *'EUR-G ','EUR-K ','EUR-B ','EUR-I ','EUR-J ', - *'EUR-L ','EUR-C ','EUR-D ','EUS ','HER ', - *'IRL ','OGB-M ','OGB-A ','OGB-B ','OGB-C ', - *'OGB-D ','MOD ','SPK-A ','SPK-B ','SPK-C ', - *'SPK-D ','SPK-E ','SPK-F ','SPK-G ','CCD ', - *'CAC ','NAS-C ','NAS-B ','NAS-A ','NAS-D ', - *'NAS-V ','NAS-W ','NAS-Q ','NAS-R ','NAS-E ', - *'NAS-F ','NAS-G ','NAS-H ','NAS-I ','NAS-J ', - *'NAS-O ','NAS-P ','NAS-N ','NAS-T ','NAS-U ', - *'NAS-L ','NAR-A ','NAR-E ','NAR-B ','NAR-C ', - *'NAR-H ','NAR-D ','BOO ','CAI ','CHU ', - *'COA ','PRP-M ','PRP-A ','PRP-B ','PRP-C ', - *'PRP-D ','PRP-E ','PRP-F ','PRP-G ','PRP-H ', - *'HIT ','SAN-M ','SAN-A ','SAN-B ','SAN-C ', - *'SAN-D ','SAN-E ','SAN-F ','SAN-J ','SAN-G ', - *'SAN-H ','SAN-I ','SAN-K ','SAN-L ','SIR ', - *'YAC ','ZAN ','AIA ','ASC ','SHB ', - *'BER ','CAC ','DID ','FOT ','GRA ', - *'HJO ','ISG ','LCF ','ASM ','NAP ', - *'FLO ','PLN ','POS ','PUR ','QUO ', - *'SAO ','SAP ','SGM ','TDC ','ANO ', - *'GAA ','IST ','KEG ','MIK ','REU ', - *'AMA ','ATF ','TRN ','ASQ ','IBE ', - *'CAZ ','CAO ','CHI ','GIZ ','EAS ', - *'GEO ','GUA ','DOB ','IDN ','JOH ', - *'KUS ','LUZ-A ','LUZ-B ','MID ','OHA-M ', - *'OHA-A ','OHA-B ','OHA-C ','OHA-D ','OHI-M ', - *'OHI-A ','OHI-B ','OHI-C ','OHI-D ','PIT ', - *'SAE ','MVS ','ENW ','WAK '/ - data atlas / - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'GLOBAL ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'AFRICA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'ASIA ', - *'AUSTRALIA ', - *'AUSTRALIA ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'EUROPE ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'NORTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'SOUTH AMERICA ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'ATLANTIC OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'INDIAN OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN ', - *'PACIFIC OCEAN '/ - data geodat1 / - *'Global coverage [WGS-84 reference ellipsoid and geoid] ', - *'Global coverage [WGS-EGM96 geoid for the Earth Gravitational', - *'Global coverage [GRS-80 ITRF reference ellipsoid] ', - *'Global coverage [WGS-72 reference ellipsoid and geoid] ', - *'Global Sphere (WGS84) ', - *'Global Reference Sphere ', - *'MEAN FOR Ethiopia, Sudan ', - *'Burkina Faso ', - *'Cameroon ', - *'Ethiopia ', - *'Mali ', - *'Senegal ', - *'Sudan ', - *'Somalia ', - *'MEAN FOR Botswana, Lesotho, Malawi, Swaziland, Zaire, Zambia', - *'Botswana ', - *'Burundi ', - *'Lesotho ', - *'Malawi ', - *'Swaziland ', - *'Zaire ', - *'Zambia ', - *'Zimbabwe ', - *'MEAN FOR Kenya, Tanzania ', - *'Kenya ', - *'Tanzania ', - *'Djibouti ', - *'Guinea-Bissau ', - *'South Africa ', - *'Tunisia ', - *'Guinea ', - *'Egypt ', - *'Tunisia ', - *'Ghana ', - *'Liberia ', - *'Eritrea ', - *'Morocco ', - *'Cameroon ', - *'Nigeria ', - *'Gabon ', - *'Algeria ', - *'Egypt ', - *'Burkina Faso, Niger ', - *'Congo ', - *'Namibia ', - *'Sierra Leone ', - *'Madagascar ', - *'Tunisia, Algeria ', - *'Algeria ', - *'Bahrain Island ', - *'Saudi Arabia ', - *'Bangka and Belitung Islands (Indonesia) ', - *'Sumatra (Indonesia) ', - *'Iran ', - *'Iraq, Israel, Jordan, Kuwait, Lebanon, Saudi Arabia, Syria ', - *'Kalimantan (Indonesia) ', - *'Afghanistan ', - *'Hong Kong ', - *'Taiwan ', - *'Bangladesh ', - *'India, Nepal ', - *'Pakistan ', - *'Thailand ', - *'Vietnam (near 16N) ', - *'Con Son Island (Vietnam) ', - *'Thailand ', - *'Thailand ', - *'Indonesia ', - *'Sri Lanka ', - *'West Malaysia, Singapore ', - *'South Korea ', - *'Masirah Island (Oman) ', - *'United Arab Emirates ', - *'Saudi Arabia ', - *'Oman ', - *'Russia ', - *'Qatar ', - *'Singapore ', - *'Brunei, East Malaysia (Sarawak and Sabah) ', - *'MEAN FOR Japan, Okinawa, South Korea ', - *'Japan ', - *'Okinawa ', - *'South Korea ', - *'South Korea ', - *'Australia, Tasmania ', - *'Australia, Tasmania ', - *'Estonia ', - *'MEAN FOR Austria, Belgium, Denmark, Finland, France, Federal', - *'MEAN FOR Austria, Denmark, France, Federal Republic of Germa', - *'Cyprus ', - *'England, Channel Islands, Scotland, Shetland Islands ', - *'England, Ireland, Scotland, Shetland Islands ', - *'Greece ', - *'Sardinia (Italy) ', - *'Sicily (Italy) ', - *'Malta ', - *'Norway, Finland ', - *'Portugal, Spain ', - *'MEAN FOR Austria, Finland, Netherlands, Norway, Spain, Swede', - *'Yugoslavia (Prior to 1990), Slovenia, Croatia, Bosnia and He', - *'Ireland ', - *'MEAN FOR England, Isle of Man, Scotland, Shetland Islands, W', - *'England ', - *'England, Isle of Man, Wales ', - *'Scotland, Shetland Islands ', - *'Wales ', - *'Sardinia ', - *'Hungary ', - *'Poland ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Latvia ', - *'Kazakhstan ', - *'Albania ', - *'Romania ', - *'Czechoslovakia (Prior to 1 January 1993) ', - *'Florida, Bahamas ', - *'MEAN FOR CONTIGUOUS US(CONUS) ', - *'MEAN FOR Arizona, Arkansas, California, Colorado, Idaho, Iow', - *'MEAN FOR Alabama, Connecticut, Delaware, District of Columbi', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands (East of 180W) ', - *'Aleutian Islands (West of 180W) ', - *'Bahamas (Excluding San Salvador Island) ', - *'San Salvador Island ', - *'MEAN FOR Canada (Including Newfoundland) ', - *'Alberta, British Columbia ', - *'MEAN FOR Newfoundland, New Brunswick, Nova Scotia, Quebec ', - *'Manitoba, Ontario ', - *'Northwest Territories, Saskatchewan ', - *'Yukon ', - *'Canal Zone ', - *'MEAN FOR Antigua Island, Barbados, Barbuda, Caicos Islands, ', - *'MEAN FOR Belize, Costa Rica, El Salvador, Guatemala, Hondura', - *'Cuba ', - *'Greenland (Hayes Peninsula) ', - *'Mexico ', - *'Alaska (Excluding Aleutian Islands) ', - *'Aleutian Islands ', - *'Canada ', - *'CONTIGUOUS US (CONUS) ', - *'Hawaii ', - *'Mexico, Central America ', - *'Colombia ', - *'Argentina ', - *'Paraguay ', - *'Brazil ', - *'MEAN FOR Bolivia, Chile, Colombia, Ecuador, Guyana, Peru, Ve', - *'Bolivia ', - *'Northern Chile (near 19S) ', - *'Southern Chile (near 43S) ', - *'Colombia ', - *'Ecuador ', - *'Guyana ', - *'Peru ', - *'Venezuela ', - *'Southern Chile (near 53S) ', - *'MEAN FOR Argentina, Bolivia, Brazil, Chile, Colombia, Ecuado', - *'Argentina ', - *'Bolivia ', - *'Brazil ', - *'Chile ', - *'Colombia ', - *'Ecuador (Excluding Galapagos Islands) ', - *'Baltra, Galapagos Islands ', - *'Guyana ', - *'Paraguay ', - *'Peru ', - *'Trinidad and Tobago ', - *'Venezuela ', - *'South America ', - *'Uruguay ', - *'Suriname ', - *'Antigua, Leeward Islands ', - *'Ascension Island ', - *'St. Helena Island ', - *'Bermuda Islands ', - *'Bahamas, Florida ', - *'Deception Island (Antarctica) ', - *'Nevis, St. Kitts, Leeward Islands ', - *'Faial, Graciosa, Pico, Sao Jorge, Terceira Islands (Azores) ', - *'Iceland ', - *'South Georgia Island ', - *'Cayman Brac Island ', - *'Montserrat, Leeward Islands ', - *'Trinidad and Tobago ', - *'Corvo and Flores Islands (Azores) ', - *'Canary Islands ', - *'Porto Santo, Madeira Islands ', - *'Puerto Rico, Virgin Islands ', - *'South Greenland ', - *'Sao Miguel, Santa Maria Islands (Azores) ', - *'East Falkland Island ', - *'Salvage Islands ', - *'Tristan da Cunha ', - *'Cocos Islands ', - *'Republic of Maldives ', - *'Diego Garcia ', - *'Kerguelen Island ', - *'Mahe Island ', - *'Mascarene Islands ', - *'American Samoa Islands ', - *'Iwo Jima ', - *'Tern Island ', - *'Marcus Island ', - *'Efate and Erromango Islands ', - *'Camp McMurdo Area (Antarctica) ', - *'Phoenix Islands ', - *'Chatham Island (New Zealand) ', - *'Gizo Island (New Georgia Islands) ', - *'Easter Island ', - *'New Zealand ', - *'Guam ', - *'Guadalcanal Island ', - *'Indonesia ', - *'Johnston Island ', - *'Caroline Islands, Federal States of Micronesia ', - *'Philippines (Excluding Mindanao Island) ', - *'Mindanao Island ', - *'Midway Islands ', - *'MEAN FOR Hawaiian Islands ', - *'Hawaii ', - *'Kauai ', - *'Maui ', - *'Oahu ', - *'Old Hawaiian (Mean) ', - *'Old Hawaiian Hawaii ', - *'Old Hawaiian Kauai ', - *'Old Hawaiian Maui ', - *'Old Hawaiian Oahu ', - *'Pitcairn Island ', - *'Espirito Santo Island ', - *'Viti Levu Island (Fiji Islands) ', - *'Marshall Islands ', - *'Wake Atoll '/ - data geodat2 / - *' ', - *' Model (EGM) vertical datum] ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *', Zimbabwe ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' Republic of Germany (Prior to 1 January 1993), Gibraltar, G', - *'ny (Prior to 1 January 1993), Netherlands, Switzerland ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'n, Switzerland ', - *'rzegovina, Serbia ', - *' ', - *'ales ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'a, Kansas, Montana, Nebraska, Nevada, New Mexico, North Dako', - *'a, Florida, Georgia, Illinois, Indiana, Kentucky, Louisiana,', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'Cuba, Dominican Republic, Grand Cayman, Jamaica, Turks Islan', - *'s, Nicaragua ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'nezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'r, Guyana, Paraguay, Peru, Trinidad and Tobago, Venezuela ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data geodat3 / - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'reece, Italy, Luxembourg, Netherlands, Norway, Portugal, Spa', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ta, Oklahoma, Oregon, South Dakota, Texas, Utah, Washington,', - *' Maine, Maryland, Massachusetts, Michigan, Minnesota, Missis', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *'ds ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' ', - *' '/ - data dattyp / - * 1, 2, 3, 4, 5, - * 6, 7, 7, 7, 7, - * 7, 7, 7, 8, 9, - * 9, 9, 9, 9, 9, - * 9, 9, 9, 10, 10, - * 10, 11, 12, 13, 14, - * 15, 16, 16, 17, 18, - * 19, 20, 21, 21, 22, - * 23, 24, 25, 26, 27, - * 28, 29, 30, 31, 32, - * 32, 33, 34, 35, 35, - * 36, 37, 38, 39, 40, - * 41, 42, 43, 44, 44, - * 45, 45, 46, 47, 48, - * 49, 50, 50, 50, 51, - * 52, 53, 54, 55, 56, - * 56, 56, 56, 56, 57, - * 58, 59, 60, 60, 60, - * 60, 60, 60, 60, 60, - * 60, 60, 60, 61, 62, - * 63, 64, 64, 64, 64, - * 64, 65, 66, 66, 66, - * 66, 66, 66, 66, 67, - * 68, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 69, 69, 69, 69, - * 69, 70, 70, 70, 70, - * 70, 70, 71, 72, 73, - * 74, 75, 75, 75, 75, - * 75, 75, 75, 75, 75, - * 76, 77, 77, 77, 77, - * 77, 77, 77, 77, 77, - * 77, 77, 77, 77, 78, - * 79, 80, 81, 82, 83, - * 84, 85, 86, 87, 88, - * 89, 90, 91, 92, 93, - * 94, 95, 96, 97, 98, - * 99, 100, 101, 102, 103, - * 104, 105, 106, 107, 108, - * 109, 110, 111, 112, 113, - * 114, 115, 116, 117, 118, - * 119, 120, 121, 122, 123, - * 124, 125, 125, 126, 127, - * 127, 127, 127, 127, 128, - * 128, 128, 128, 128, 128, - * 129, 130, 131, 132/ - data dradim / - *.6378137D+07,.6378137D+07,.6378137D+07,.6378135D+07,.6370000D+07, - *.6370997D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378245D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378249D+07, - *.6377397D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378249D+07,.6378200D+07,.6378249D+07,.6378249D+07,.6377484D+07, - *.6378249D+07,.6378388D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6377397D+07,.6377397D+07,.6378388D+07,.6378388D+07, - *.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377276D+07, - *.6377301D+07,.6377310D+07,.6377276D+07,.6377276D+07,.6377276D+07, - *.6377276D+07,.6377276D+07,.6378160D+07,.6377276D+07,.6377304D+07, - *.6378137D+07,.6378249D+07,.6378249D+07,.6378249D+07,.6378249D+07, - *.6378245D+07,.6378388D+07,.6378155D+07,.6377299D+07,.6377397D+07, - *.6377397D+07,.6377397D+07,.6377397D+07,.6377397D+07,.6378160D+07, - *.6378160D+07,.6377397D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6377397D+07, - *.6377340D+07,.6377563D+07,.6377563D+07,.6377563D+07,.6377563D+07, - *.6377563D+07,.6378388D+07,.6378245D+07,.6378245D+07,.6378245D+07, - *.6378245D+07,.6378245D+07,.6378245D+07,.6378245D+07,.6377397D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07, - *.6378206D+07,.6378137D+07,.6378137D+07,.6378137D+07,.6378137D+07, - *.6378137D+07,.6378137D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07, - *.6378160D+07,.6378160D+07,.6378160D+07,.6378160D+07,.6378137D+07, - *.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07,.6378388D+07, - *.6378206D+07,.6378206D+07,.6378249D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378206D+07,.6378249D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378160D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378249D+07,.6378388D+07, - *.6378206D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378388D+07,.6378160D+07,.6378388D+07, - *.6378388D+07,.6378206D+07,.6378206D+07,.6378388D+07,.6378206D+07, - *.6378206D+07,.6378206D+07,.6378206D+07,.6378206D+07,.6378388D+07, - *.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07,.6378388D+07, - *.6378388D+07,.6378249D+07,.6378270D+07,.6378388D+07/ - data dflat / - *.2982572D+03,.2982572D+03,.2982572D+03,.2982600D+03,.1000000D+21, - *.1000000D+21,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2983000D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2934650D+03, - *.2991528D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2934650D+03,.2983000D+03,.2934650D+03,.2934650D+03,.2991528D+03, - *.2934650D+03,.2970000D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2991528D+03,.2991528D+03,.2970000D+03,.2970000D+03, - *.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03,.3008017D+03, - *.3008017D+03,.3008017D+03,.2982470D+03,.3008017D+03,.3008017D+03, - *.2982572D+03,.2934650D+03,.2934650D+03,.2934650D+03,.2934650D+03, - *.2983000D+03,.2970000D+03,.2983000D+03,.3008017D+03,.2991528D+03, - *.2991528D+03,.2991528D+03,.2991528D+03,.2991528D+03,.2982500D+03, - *.2982500D+03,.2991528D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2991528D+03, - *.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03,.2993250D+03, - *.2993250D+03,.2970000D+03,.2983000D+03,.2983000D+03,.2983000D+03, - *.2983000D+03,.2983000D+03,.2983000D+03,.2983000D+03,.2991528D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03, - *.2949787D+03,.2982572D+03,.2982572D+03,.2982572D+03,.2982572D+03, - *.2982572D+03,.2982572D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03, - *.2982500D+03,.2982500D+03,.2982500D+03,.2982500D+03,.2982572D+03, - *.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03, - *.2949787D+03,.2949787D+03,.2934650D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2949787D+03,.2934650D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2982500D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2934650D+03,.2970000D+03, - *.2949787D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2970000D+03,.2982470D+03,.2970000D+03, - *.2970000D+03,.2949787D+03,.2949787D+03,.2970000D+03,.2949787D+03, - *.2949787D+03,.2949787D+03,.2949787D+03,.2949787D+03,.2970000D+03, - *.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03,.2970000D+03, - *.2970000D+03,.2934650D+03,.2970000D+03,.2970000D+03/ - data dec2 / - *.6694380D-02,.6694380D-02,.6694380D-02,.6694318D-02,.0000000D+00, - *.0000000D+00,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6693422D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6803511D-02, - *.6674372D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6803511D-02,.6693422D-02,.6803511D-02,.6803511D-02,.6674372D-02, - *.6803511D-02,.6722670D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6674372D-02,.6674372D-02,.6722670D-02,.6722670D-02, - *.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02,.6637847D-02, - *.6637847D-02,.6637847D-02,.6694609D-02,.6637847D-02,.6637847D-02, - *.6694380D-02,.6803511D-02,.6803511D-02,.6803511D-02,.6803511D-02, - *.6693422D-02,.6722670D-02,.6693422D-02,.6637847D-02,.6674372D-02, - *.6674372D-02,.6674372D-02,.6674372D-02,.6674372D-02,.6694542D-02, - *.6694542D-02,.6674372D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6674372D-02, - *.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02,.6670540D-02, - *.6670540D-02,.6722670D-02,.6693422D-02,.6693422D-02,.6693422D-02, - *.6693422D-02,.6693422D-02,.6693422D-02,.6693422D-02,.6674372D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02, - *.6768658D-02,.6694380D-02,.6694380D-02,.6694380D-02,.6694380D-02, - *.6694380D-02,.6694380D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02, - *.6694542D-02,.6694542D-02,.6694542D-02,.6694542D-02,.6694380D-02, - *.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02, - *.6768658D-02,.6768658D-02,.6803511D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6768658D-02,.6803511D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6694542D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6803511D-02,.6722670D-02, - *.6768658D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6722670D-02,.6694609D-02,.6722670D-02, - *.6722670D-02,.6768658D-02,.6768658D-02,.6722670D-02,.6768658D-02, - *.6768658D-02,.6768658D-02,.6768658D-02,.6768658D-02,.6722670D-02, - *.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02,.6722670D-02, - *.6722670D-02,.6803511D-02,.6722670D-02,.6722670D-02/ - data dxmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -166.000, -118.000, -134.000, -165.000, - * -123.000, -128.000, -161.000, -43.000, -143.000, - * -138.000, -153.000, -125.000, -161.000, -134.000, - * -169.000, -147.000, -142.000, -160.000, -157.000, - * -175.000, -79.000, -173.000, -136.000, -263.000, - * -83.000, -130.000, -112.000, -130.000, -90.000, - * 639.000, 31.000, -81.000, -92.000, -74.000, - * -186.000, -130.000, -106.000, -148.000, 616.000, - * -88.000, -189.000, -73.000, -123.000, -150.000, - * -143.000, -384.000, -377.000, -117.000, -103.000, - * -403.000, -333.000, -156.000, -637.000, 282.000, - * 295.000, 283.000, 217.000, 198.000, 182.000, - * 209.000, 210.000, -24.000, -97.000, -11.000, - * 0.000, -247.000, -249.000, -243.000, -346.000, - * 28.000, -128.000, 7.000, -679.000, -148.000, - * -148.000, -158.000, -146.000, -147.000, -133.000, - * -134.000, 374.000, -87.000, -87.000, -104.000, - * -86.000, -86.000, -84.000, -97.000, -97.000, - * -107.000, -87.000, -84.000, -86.000, 682.000, - * 506.000, 375.000, 371.000, 371.000, 384.000, - * 370.000, -225.000, 28.000, 23.000, 26.000, - * 24.000, 15.000, 24.000, 28.000, 589.000, - * -2.000, -8.000, -8.000, -9.000, -5.000, - * -2.000, 2.000, -4.000, 1.000, -10.000, - * -7.000, -22.000, -9.000, 4.000, -7.000, - * 0.000, -3.000, 0.000, -9.000, 11.000, - * -12.000, 0.000, -2.000, 0.000, 0.000, - * 1.000, 0.000, 307.000, -148.000, -134.000, - * -206.000, -288.000, -270.000, -270.000, -305.000, - * -282.000, -278.000, -298.000, -279.000, -295.000, - * 16.000, -57.000, -62.000, -61.000, -60.000, - * -75.000, -44.000, -48.000, -47.000, -53.000, - * -61.000, -58.000, -45.000, -45.000, 0.000, - * -155.000, -265.000, -270.000, -205.000, -320.000, - * -73.000, -2.000, 260.000, -7.000, -104.000, - * -73.000, -794.000, 42.000, 174.000, -10.000, - * -425.000, -307.000, -499.000, 11.000, 164.000, - * -203.000, -355.000, -289.000, -632.000, -491.000, - * -133.000, 208.000, 145.000, 41.000, 94.000, - * -115.000, 145.000, 114.000, 124.000, -127.000, - * -104.000, 298.000, 175.000, 230.000, 211.000, - * 84.000, -100.000, 252.000, -24.000, 189.000, - * 647.000, -133.000, -133.000, 912.000, 61.000, - * 89.000, 45.000, 65.000, 58.000, 201.000, - * 229.000, 185.000, 205.000, 198.000, 185.000, - * 170.000, 51.000, 102.000, 276.000/ - data dymod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, -15.000, -14.000, -2.000, -11.000, - * -20.000, -18.000, -14.000, -163.000, -90.000, - * -105.000, -5.000, -108.000, -73.000, -105.000, - * -19.000, -74.000, -96.000, -6.000, -2.000, - * -23.000, -129.000, 253.000, -108.000, 6.000, - * 37.000, -117.000, -77.000, 29.000, 40.000, - * 405.000, 146.000, -84.000, -93.000, -130.000, - * -93.000, 110.000, -129.000, 51.000, 97.000, - * 4.000, -242.000, -247.000, -206.000, -250.000, - * -236.000, 664.000, 681.000, -132.000, -106.000, - * 684.000, -222.000, -271.000, -549.000, 726.000, - * 736.000, 682.000, 823.000, 881.000, 915.000, - * 818.000, 814.000, -15.000, 787.000, 851.000, - * 0.000, -148.000, -156.000, -192.000, -1.000, - * -130.000, -283.000, -10.000, 669.000, 507.000, - * 507.000, 507.000, 507.000, 506.000, -48.000, - * -48.000, 150.000, -98.000, -96.000, -101.000, - * -96.000, -96.000, -95.000, -103.000, -88.000, - * -88.000, -95.000, -107.000, -98.000, -203.000, - * -122.000, -111.000, -112.000, -111.000, -111.000, - * -108.000, -65.000, -121.000, -124.000, -121.000, - * -124.000, -130.000, -130.000, -121.000, 76.000, - * 151.000, 160.000, 159.000, 161.000, 135.000, - * 152.000, 204.000, 154.000, 140.000, 158.000, - * 162.000, 160.000, 157.000, 159.000, 139.000, - * 125.000, 142.000, 125.000, 152.000, 114.000, - * 130.000, 0.000, 0.000, 0.000, 0.000, - * 1.000, 0.000, 304.000, 136.000, 229.000, - * 172.000, 175.000, 188.000, 183.000, 243.000, - * 169.000, 171.000, 159.000, 175.000, 173.000, - * 196.000, 1.000, -1.000, 2.000, -2.000, - * -1.000, 6.000, 3.000, 26.000, 3.000, - * 2.000, 0.000, 12.000, 8.000, 0.000, - * 171.000, 120.000, 13.000, 107.000, 550.000, - * 213.000, 151.000, 12.000, 215.000, 167.000, - * 46.000, 119.000, 124.000, 359.000, 375.000, - * -169.000, -92.000, -249.000, 72.000, 138.000, - * 141.000, 21.000, -124.000, 438.000, -22.000, - * -321.000, -435.000, -187.000, -220.000, -948.000, - * 118.000, 75.000, -116.000, -234.000, -769.000, - * -129.000, -304.000, -38.000, -199.000, 147.000, - * -22.000, -248.000, -209.000, -15.000, -79.000, - * 1777.000, -77.000, -79.000, -58.000, -285.000, - * -279.000, -290.000, -290.000, -283.000, -228.000, - * -222.000, -233.000, -233.000, -226.000, 165.000, - * 42.000, 391.000, 52.000, -57.000/ - data dzmod / - * 0.000, 0.000, 0.000, 0.000, 0.000, - * 0.000, 204.000, 218.000, 210.000, 206.000, - * 220.000, 224.000, 205.000, 45.000, -294.000, - * -289.000, -292.000, -295.000, -317.000, -295.000, - * -278.000, -283.000, -293.000, -302.000, -299.000, - * -303.000, 145.000, 27.000, -292.000, 431.000, - * 124.000, -151.000, -145.000, 364.000, 88.000, - * 60.000, 47.000, 115.000, 122.000, 42.000, - * 310.000, -13.000, 165.000, -291.000, -251.000, - * 101.000, -91.000, 227.000, 219.000, -1.000, - * 7.000, -48.000, -50.000, -164.000, -141.000, - * 41.000, 114.000, -189.000, -203.000, 254.000, - * 257.000, 231.000, 299.000, 317.000, 344.000, - * 290.000, 289.000, 5.000, 86.000, 5.000, - * 0.000, 369.000, 381.000, 477.000, 224.000, - * -95.000, 22.000, -26.000, -48.000, 685.000, - * 685.000, 676.000, 687.000, 687.000, 148.000, - * 149.000, 588.000, -121.000, -120.000, -140.000, - * -120.000, -120.000, -130.000, -120.000, -135.000, - * -149.000, -120.000, -120.000, -119.000, 480.000, - * 611.000, 431.000, 434.000, 434.000, 425.000, - * 434.000, 9.000, -77.000, -82.000, -78.000, - * -82.000, -84.000, -92.000, -77.000, 480.000, - * 181.000, 176.000, 175.000, 179.000, 172.000, - * 149.000, 105.000, 178.000, 165.000, 187.000, - * 188.000, 190.000, 184.000, 188.000, 181.000, - * 201.000, 183.000, 194.000, 178.000, 195.000, - * 190.000, 0.000, 4.000, 0.000, 0.000, - * -1.000, 0.000, -318.000, 90.000, -29.000, - * -6.000, -376.000, -388.000, -390.000, -442.000, - * -371.000, -367.000, -369.000, -379.000, -371.000, - * 93.000, -41.000, -37.000, -48.000, -41.000, - * -44.000, -36.000, -44.000, -42.000, -47.000, - * -33.000, -44.000, -33.000, -33.000, 0.000, - * 37.000, -358.000, 62.000, 53.000, -494.000, - * 296.000, 181.000, -147.000, 225.000, -38.000, - * -86.000, -298.000, 147.000, 365.000, 165.000, - * 81.000, 127.000, 314.000, -101.000, -189.000, - * 53.000, 72.000, 60.000, -609.000, 435.000, - * 50.000, -229.000, 103.000, -134.000, -1262.000, - * 426.000, -272.000, -333.000, -25.000, 472.000, - * 239.000, -375.000, 113.000, -752.000, 111.000, - * 209.000, 259.000, -751.000, 5.000, -202.000, - * -1124.000, -51.000, -72.000, 1227.000, -181.000, - * -183.000, -172.000, -190.000, -182.000, -346.000, - * -348.000, -337.000, -355.000, -347.000, 42.000, - * 84.000, -36.000, -38.000, 149.000/ - END diff --git a/CALPUFF_SRC/TERREL/calutils.for b/CALPUFF_SRC/TERREL/calutils.for deleted file mode 100644 index 20bcf13..0000000 --- a/CALPUFF_SRC/TERREL/calutils.for +++ /dev/null @@ -1,2953 +0,0 @@ -c------------------------------------------------------------------------------ -c --- CALUTILS -- CALPUFF SYSTEM UTILITIES -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 141010 -c -c Copyright (c) 2014 by Exponent, Inc. -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c --- Coordinates -c subroutine xtractll -c --- Year 2000 -c subroutine yr4 -c subroutine yr4c -c subroutine qayr4 -c --- Date/Time -c subroutine julday -c subroutine grday -c subroutine dedat -c subroutine deltt -c subroutine incr -c subroutine indecr -c subroutine incrs -c subroutine deltsec -c subroutine midnite -c subroutine basrutc -c subroutine utcbasr -c --- Control file -c subroutine filcase -c subroutine readin -c subroutine altonu -c subroutine deblnk -c subroutine deplus -c subroutine tright -c subroutine tleft -c subroutine setvar -c subroutine allcap -c --- System -c subroutine datetm -c subroutine fmt_date -c subroutine etime -c subroutine undrflw -c subroutine comline -c --- Error -c subroutine open_err -c ----------------------------- -c -c --- UPDATE -c --- V2.6.0-V2.7.0 141010 :Add error-report for file-open -c New : OPEN_ERR -c --- V2.58-V2.6.0 140318(MBN):Use F95 intrinsic procedures for date and time. -c Modified: DATETM -c Removed obsolete Compaq, Microsoft, and HP -c compiler codes, and removed getcl -c Modified: COMLINE -c --- V2.571-V2.58 110225(DGS):Add variable type 5 to control file processor -c to allow character array variables -c Modified: READIN, ALTONU, SETVAR -c --- V2.57-V2.571 090511(DGS):Add routine to reformat a date string -c New : FMT_DATE -c --- V2.56-V2.57 090202(DGS): Increase control file line length to 200 -c characters -c Modified: PARAMS.CAL, READIN -c Activate CPU clock using F95 system routine -c Modified: DATETM -c --- V2.55-V2.56 080407(DGS): Exponential notation processing in ALTONU did -c not properly interpret an entry without a -c decimal point. -c --- V2.54-V2.55 070327(DGS): Format for output time zone stringin BASRUTC -c wrote zone zero as 'UTC+0 0' instead of -c 'UTC+0000' -c Add RETURN statement to BASRUTC and UTCBASR -c --- V2.53-V2.54 061020(DGS): Allow negative increments in INCRS -c --- V2.52-V2.53 060626(DGS): Remove routine GLOBE1 (move to COORDLIB) -c --- V2.51-V2.52 060519(DGS): Modify search for '=' in READIN to allow -c for blanks between c*12 variable name and -c the '=' sign (internal blanks are not removed -c after V2.2) -c --- V2.5-V2.51 051019 (KAM): Add Albers Conical Equal Area projection -c in GLOBE1 -c --- V2.4-V2.5 041123 (FRR): add subroutine BASRUTC to convert real -c base time zone to character UTC time zone -c and UTCBASR for the backward conversion -c --- V2.3-V2.4 041029 (DGS): Add routine INCRS to change time by a -c number of seconds -c Add routine MIDNITE - converts timestamp -c from day N, time 0000 -c to day N-1, time 2400 -c --- V2.2-V2.3 040330 (DGS): Replace filename strings c*70 with c*132 -c (FILCASE, COMLINE) -c Allow for spaces within pathnames by adding -c new TLEFT and TRIGHT trim subroutines -c --- V2.1-V2.2 030528 (DGS): Screen for valid UTM zone using -c absolute value (S. Hem. zones are -c negative) in GLOBE1 -c --- V2.0-V2.1 030402 (DGS): Remove routine GLOBE -c Split DEBLNK action (removes ' ', '+') -c into DEBLNK and DEPLUS -c Add routine UNDRFLW -c Add false Easting and Northing (GLOBE1) -c Add TYPE argument to XTRACTLL -c Change format XTRACTLL (f16) to (f16.0) -c --- V1.1-V2.0 021018 (DGS): Add routines for new COORDS -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input (YR4C) -c -c -c---------------------------------------------------------------------- - subroutine xtractll(io,type,clatlon,rlatlon) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 XTRACTLL -c D. Strimaitis EarthTech -c -c --- PURPOSE: Extract the real latitude or longitude from a character -c string that contains the N/S or E/W convention -c character, and express result as either North Latitude -c or East Longitude -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (010713) (DGS) -c - Add TYPE argument for QA -c - Change format (f16) to (f16.0) to satisfy different -c compilers -c -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c TYPE - char*4 - LAT or LON -c CLATLON - char*16 - Latitude or longitude (degrees), with -c 1 character that denotes convention -c (e.g. 'N 45.222' or '-35.999s') -c -c --- OUTPUT: -c RLATLON - real - North Latitude or East Longitude -c (degrees) -c -c --- XTRACTLL called by: (utility) -c --- XTRACTLL calls: DEBLNK, ALLCAP -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' - - character*1 cstor1(mxcol),cstor2(mxcol) - character*16 clatlon, clatlon2 - character*4 type - logical ltype - - ltype=.FALSE. - -c --- Initialize character variables for output - clatlon2=' ' - do i=1,20 - cstor2(i)=' ' - enddo - -c --- Was valid type provided? - if(type.NE.'LAT ' .AND. type.NE.'LON ') then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'Invalid type: ',type - write(io,*) 'Expected LAT or LON' - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Pass c*16 string into storage array 1 - do i=1,16 - cstor1(i)=clatlon(i:i) - enddo -c --- Pad out to position 20 - do i=17,20 - cstor1(i)=' ' - enddo - -c --- Remove blank characters from string, place in storage array 2 -c --- (Use a 20-character field here for a margin at end of string) - call DEBLNK(cstor1,1,20,cstor2,nlim) -c -c --- Convert lower case letters to upper case - call ALLCAP(cstor2,nlim) - -c --- Interpret valid convention character (N,S,E,W) - nchar=0 - ichar=0 - ilat=0 - ilon=0 - - do i=1,nlim - if(cstor2(i).EQ.'N') then - ilat=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'S') then - ilat=2 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'W') then - ilon=1 - ichar=i - nchar=nchar+1 - elseif(cstor2(i).EQ.'E') then - ilon=2 - ichar=i - nchar=nchar+1 - endif - enddo - -c --- Was 1 valid character found? - if(nchar.NE.1) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character is missing or repeated' - write(io,*) 'Lat/Lon = ',clatlon - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Was valid character the right type? - if(type.EQ.'LAT ' .AND. ilat.EQ.0) ltype=.TRUE. - if(type.EQ.'LON ' .AND. ilon.EQ.0) ltype=.TRUE. - if(LTYPE) then - write(io,*) 'XTRACTLL: FATAL ERROR reported when ', - & 'extracting Latitude/Longitude' - write(io,*) 'N,S,E,W character does not match type' - write(io,*) 'Lat/Lon = ',clatlon - write(io,*) 'type = ',type - write(*,*) - stop 'Halted in XTRACTLL -- see list file' - endif - -c --- Remove character from string - do i=ichar,nlim - cstor2(i)=cstor2(i+1) - enddo - -c --- Search for position of decimal point - ipt=0 - do i=1,nlim - if(cstor2(i).EQ.'.') ipt=i - enddo - -c --- Add a decimal point if needed - if(ipt.EQ.0) then - cstor2(nlim)='.' - endif - -c --- Pass resulting "number" back into c*16 variable - do i=1,nlim - clatlon2(i:i)=cstor2(i) - enddo - -c --- Get real part - read(clatlon2,'(f16.0)') rlatlon - -c --- Convert to either N. Lat. or E. Lon., if needed - if(ilat.EQ.2) then - rlatlon=-rlatlon - elseif(ilon.EQ.1) then - rlatlon=-rlatlon - endif - -c --- Condition longitude to be -180 to +180 - if(ilon.GT.0) then - if(rlatlon.GT.180.) then - rlatlon=rlatlon-360. - elseif(rlatlon.LT.-180.) then - rlatlon=rlatlon+360. - endif - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4(io,iyr,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 991104 YR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year (YYYY or YY) -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c --- YR4 called by: Input routines reading 'year' data -c --- YR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - - ierr=0 - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.iyylo) then - iyr=(icclo+1)*100+iyr - else - iyr=icclo*100+iyr - endif - else -c --- Year not recognized - ierr=1 - write(io,*)'ERROR in YR4 --- Year not recognized: ',iyr - write(*,*)'ERROR in YR4 --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine yr4c(iyr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 020828 YR4C -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Checks/converts 2-digit year to 4-digit year (CURRENT) -c -c --- UPDATE -c --- V1.0-V1.1 020828 (DGS): Add check for YYYY on input -c -c --- INPUTS: -c IYR - integer - Year (YYYY or YY) -c -c --- OUTPUT: -c IYR - integer - Year (YYYY) -c -c --- YR4C called by: host subroutines -c --- YR4C calls: none -c---------------------------------------------------------------------- -c --- Set parameters for converting a current year (1999 - 2098) -c --- Use KCCLO as century digits for years GE KYYLO - data kyylo/99/, kcclo/19/ - -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) - return - elseif(iyr.LT.100 .AND. iyr.GE.0) then -c --- 2-digit year -c --- Construct 4-digit year - if(iyr.LT.kyylo) then - iyr=(kcclo+1)*100+iyr - else - iyr=kcclo*100+iyr - endif - else -c --- Year not recognized - write(*,*)'ERROR in YR4C --- Year not recognized: ',iyr - endif - - return - end -c---------------------------------------------------------------------- - subroutine qayr4(io,iyr,metrun,ierr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 991104 QAYR4 -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Defines century and year markers to use in converting -c --- 2-digit year to 4-digit year -c --- The IBYR (YYYY) must be provided in the control file -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year provided for start of run -c METRUN - integer - Flag to run period in met file -c 0 = do not run period -c 1 = run period -c -c --- OUTPUT: -c IERR - integer - Error code: 0=OK, 1=FATAL -c -c Common block /Y2K/: -c IYYLO - integer - Smallest 2-digit year for which -c 'old' century marker is used -c ICCLO - integer - 2-digit ('old') century -c -c --- QAYR4 called by: host subroutines -c --- QAYR4 calls: none -c---------------------------------------------------------------------- -c - common/y2k/iyylo,icclo - -c --- Sets parameters for the starting century marker (CC) and the -c --- 2-digit year (YY) used as the marker between the starting century -c --- and the next century. For example, if CC=19 and YY=30, then a -c --- year less than 30 (say 15) is assumed to be 2015. Any year -c --- greater than or equal to 30 (say 56) is assumed to be 1956. - -c --- Set number of years prior to start of simulation that must not -c --- be placed in the next century - data ibackyr/50/ - - ierr=0 - -c --- Expect explicit starting year (YYYY) -c --- Test for 4-digit year (must exceed 1000) - if(iyr.GT.1000) then -c --- Passes 11th Century test (large year not trapped) -c --- Back up IBACKYR years to set IYYLO - kyr=iyr-ibackyr -c --- Extract starting 2-digit century and 2-digit year - icclo=kyr/100 - iyylo=kyr-icclo*100 - -c --- Warn user that control file input is used to convert to YYYY - iyr1=icclo*100+iyylo - iyr2=(icclo+1)*100+iyylo-1 - write(io,*) - write(io,*)'-------------------------------------------------' - write(io,*)'NOTICE: Starting year in control file sets the' - write(io,*)' expected century for the simulation. All' - write(io,*)' YY years are converted to YYYY years in' - write(io,*)' the range: ',iyr1,iyr2 - write(io,*)'-------------------------------------------------' - write(io,*) - else - ierr=1 - write(*,*) - write(*,*)'--------------------------------------------' - write(*,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(*,*)' and must always be provided' - endif - write(*,*)'--------------------------------------------' - write(*,*) - write(io,*) - write(io,*)'-------------------------------------------' - write(io,*)'QAYR4 -- Start year must be 4-digits!: ',iyr - if(metrun.EQ.1) then - write(io,*)' and must always be provided' - endif - write(io,*)'-------------------------------------------' - write(io,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine julday(io,iyr,imo,iday,ijuldy) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 000602 JULDAY -c --- J. Scire, SRC -c -c --- PURPOSE: Compute the Julian day number from the Gregorian -c date (month, day) -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c -c --- OUTPUT: -c IJUL - integer - Julian day -c -c --- JULDAY called by: host subroutines -c --- JULDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12) - data kday/0,31,59,90,120,151,181,212,243,273,304,334/ -c -c --- Check for valid input data - ierr=0 -c --- Check for valid month - if(imo.lt.1.or.imo.gt.12)ierr=1 -c --- Check for valid day in 30-day months - if(imo.eq.4.or.imo.eq.6.or.imo.eq.9.or.imo.eq.11)then - if(iday.gt.30)ierr=1 - else if(imo.eq.2)then - if(mod(iyr,4).eq.0)then -c --- February in a leap year - if(iday.gt.29)ierr=1 - else -c --- February in a non-leap year - if(iday.gt.28)ierr=1 - endif - else -c --- Check for valid day in 31-day months - if(iday.gt.31)ierr=1 - endif -c - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. JULDAY' - write(io,*)'Invalid date - IYR = ',iyr,' IMO = ', - 1 imo,' IDAY = ',iday - write(*,*) - stop 'Halted in JULDAY -- see list file.' - endif -c -c --- Compute the Julian day - ijuldy=kday(imo)+iday - if(imo.le.2)return - if(mod(iyr,4).EQ.0)ijuldy=ijuldy+1 -c - return - end -c---------------------------------------------------------------------- - subroutine grday(io,iyr,ijul,imo,iday) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 000602 GRDAY -c J. Scire, SRC -c -c --- PURPOSE: Compute the Gregorian date (month, day) from the -c Julian day -c -c --- UPDATE -c --- 000602 (DGS): YYYY format for year -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Year -c IJUL - integer - Julian day -c -c --- OUTPUT: -c IMO - integer - Month -c IDAY - integer - Day -c -c --- GRDAY called by: host subroutines -c --- GRDAY calls: none -c---------------------------------------------------------------------- -c - integer kday(12,2) - data kday/31,59,90,120,151,181,212,243,273,304,334,365, - 1 31,60,91,121,152,182,213,244,274,305,335,366/ -c -c - ileap=1 - if(mod(iyr,4).eq.0)ileap=2 - if(ijul.lt.1.or.ijul.gt.kday(12,ileap))go to 11 -c - do 10 i=1,12 - if(ijul.gt.kday(i,ileap))go to 10 - imo=i - iday=ijul - if(imo.ne.1)iday=ijul-kday(imo-1,ileap) - return -10 continue -c -11 continue - write(io,12)iyr,ijul -12 format(//2x,'ERROR in SUBR. GRDAY -- invalid Julian day '//2x, - 1 'iyr = ',i5,3x,'ijul = ',i5) - write(*,*) - stop 'Halted in GRDAY -- see list file.' - end -c------------------------------------------------------------------------------ - subroutine dedat(idathr,iyr,ijul,ihr) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 941215 DEDAT -c --- J. Scire, SRC -c -c --- Decode a date-time variable -c -c --- INPUTS: -c IDATHR - integer - Date-time variable (YYYYJJJHH) -c -c --- OUTPUT: -c IYR - integer - Year of precip. data (4 digits) -c IJUL - integer - Julian day number of precip. data -c IHR - integer - Ending hour (1-24) of precip. data -c -c --- DEDAT called by: host subroutines -c --- DEDAT calls: none -c------------------------------------------------------------------------------ -c -c --- decode date and time - iyr=idathr/100000 - ijul=idathr/100-iyr*1000 - ihr=idathr-iyr*100000-ijul*100 -c - return - end -c------------------------------------------------------------------------------ - subroutine deltt(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jleng) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 941215 DELTT -c --- J. Scire, SRC -c -c --- Compute the difference (in hours) between two dates & times -c --- (time #2 - time #1) -c -c --- INPUTS: -c J1YR - integer - Year of date/time #1 -c J1JUL - integer - Julian day of date/time #1 -c J1HR - integer - Hour of date/time #1 -c J2YR - integer - Year of date/time #2 -c J2JUL - integer - Julian day of date/time #2 -c J2HR - integer - Hour of date/time #2 -c -c --- OUTPUT: -c JLENG - integer - Difference (#2 - #1) in hours -c -c --- DELTT called by: host subroutines -c --- DELTT calls: none -c------------------------------------------------------------------------------ -c - jmin=min0(j1yr,j2yr) -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the first date/hour - if(j1yr.eq.jmin)then - j1=0 - else - j1=0 - j1yrm1=j1yr-1 - do 10 i=jmin,j1yrm1 - if(mod(i,4).eq.0)then - j1=j1+8784 - else - j1=j1+8760 - endif -10 continue - endif - j1=j1+(j1jul-1)*24+j1hr -c -c --- find the number of hours between Jan. 1 of the "base" year and -c --- the second date/hour - if(j2yr.eq.jmin)then - j2=0 - else - j2=0 - j2yrm1=j2yr-1 - do 20 i=jmin,j2yrm1 - if(mod(i,4).eq.0)then - j2=j2+8784 - else - j2=j2+8760 - endif -20 continue - endif - j2=j2+(j2jul-1)*24+j2hr -c -c --- compute the time difference (in hours) - jleng=j2-j1 -c - return - end -c---------------------------------------------------------------------- - subroutine incr(io,iyr,ijul,ihr,nhrinc) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 000602 INCR -c J. Scire, SRC -c -c --- PURPOSE: Increment the time and date by "NHRINC" hours -c -c --- UPDATE -c --- 000602 (DGS): add message to "stop" -c --- 980304 (DGS): Allow for a negative "increment" of -c up to 24 hours -c --- 980304 (DGS): Allow for arbitrarily large nhrinc -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year -c IJUL - integer - Current Julian day -c IHR - integer - Current hour (00-23) -c NHRINC - integer - Time increment (hours) -c -c NOTE: "NHRINC" must >= -24 -c Hour is between 00-23 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c -c --- INCR called by: host subroutines -c --- INCR calls: none -c---------------------------------------------------------------------- -c -c --- Check nhrinc - if(nhrinc.lt.-24) then - write(io,*)'ERROR IN SUBR. INCR -- Invalid value of NHRINC ', - 1 '-- NHRINC = ',nhrinc - write(*,*) - stop 'Halted in INCR -- see list file.' - endif - -c --- Save increment remaining (needed if nhrinc > 8760) - nleft=nhrinc -c -c --- Process change in hour - if(nhrinc.gt.0)then -c -10 ninc=MIN0(nleft,8760) - nleft=nleft-ninc -c -c --- Increment time - ihr=ihr+ninc - if(ihr.le.23)return -c -c --- Increment day - ijul=ijul+ihr/24 - ihr=mod(ihr,24) -c -c --- ILEAP = 0 (non-leap year) or 1 (leap year) - if(mod(iyr,4).eq.0)then - ileap=1 - else - ileap=0 - endif -c - if(ijul.gt.365+ileap) then -c --- Update year - iyr=iyr+1 - ijul=ijul-(365+ileap) - endif -c -c --- Repeat if more hours need to be added - if(nleft.GT.0) goto 10 -c - elseif(nhrinc.lt.0)then -c --- Decrement time - ihr=ihr+nhrinc - if(ihr.lt.0)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - endif -c - return - end -c------------------------------------------------------------------------------ - subroutine indecr(io,iyr,ijul,ihr,idelt,ihrmin,ihrmax) -c------------------------------------------------------------------------------ -c -c --- CALUTILS Version: 2.7.0 Level: 961014 INDECR -c --- J. Scire, SRC -c -c --- Increment or decrement a date/time by "IDELT" hours -c --- (-24 <= IDELT <= 24) -c --- Allows specification of 0-23 or 1-24 hour clock -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Input Year -c IJUL - integer - Input Julian day -c IHR - integer - Input hour (ihrmin <= IHR <= ihrmax) -c IDELT - integer - Change in time (hours) -- must be -c between -24 to +24, inclusive -c IHRMIN - integer - Minimum hour (i.e., either 0 or 1) -c IHRMAX - integer - Maximum hour (i.e., either 23 or 24) -c -c --- OUTPUT: -c IYR - integer - Year after change of "IDELT" hours -c IJUL - integer - Julian day after change of "IDELT" hours -c IHR - integer - Hour after change of "IDELT" hours -c -c --- INDECR called by: host subroutines -c --- INDECR calls: none -c------------------------------------------------------------------------------ -c - if(iabs(idelt).gt.24)then - write(io,10)'IDELT',iyr,ijul,ihr,idelt,ihrmin,ihrmax -10 format(/1x,'ERROR in subr. INDECR -- invalid "',a,'" -- ', - 1 ' iyr,ijul,ihr,idelt,ihrmin,ihrmax = ',6i10) - write(*,987) -987 format(1x,'ERROR in run - see the .LST file') - stop - endif - if(ihr.lt.ihrmin.or.ihr.gt.ihrmax)then - write(io,10)'IHR',iyr,ijul,ihr,idelt,ihrmin,ihrmax - write(*,987) - stop - endif -c - if(idelt.lt.0)then -c --- idelt is negative - ihr=ihr+idelt - if(ihr.lt.ihrmin)then - ihr=ihr+24 - ijul=ijul-1 - if(ijul.lt.1)then - iyr=iyr-1 - if(mod(iyr,4).eq.0)then - ijul=366 - else - ijul=365 - endif - endif - endif - else -c --- idelt is positive or zero - ihr=ihr+idelt - if(ihr.gt.ihrmax)then - ihr=ihr-24 - ijul=ijul+1 - if(mod(iyr,4).eq.0)then - ndays=366 - else - ndays=365 - endif - if(ijul.gt.ndays)then - ijul=1 - iyr=iyr+1 - endif - endif - endif -c - return - end -c---------------------------------------------------------------------- - subroutine incrs(io,iyr,ijul,ihr,isec,nsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 061020 INCRS -c D. Strimaitis, EARTH TECH -c -c --- PURPOSE: Increment the time and date by "NSEC" seconds -c -c --- UPDATE -c --- V2.54 (061020) from V2.4 (041029) (DGS) -c - Allow negative increment -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c IYR - integer - Current year (YYYY) -c IJUL - integer - Current Julian day (JJJ) -c IHR - integer - Current hour (00-23) -c ISEC - integer - Current second (0000-3599) -c NSEC - integer - Time increment (seconds) -c Parameters: IO6 -c -c --- OUTPUT: -c IYR - integer - Updated year -c IJUL - integer - Updated Julian day -c IHR - integer - Updated hour (00-23) -c ISEC - integer - Updated seconds (0000-3599) -c -c --- INCRS called by: host subroutines -c --- INCRS calls: INCR -c---------------------------------------------------------------------- - - if(nsec.GE.0) then -c --- Increment seconds - isec=isec+nsec - if(isec.GE.3600) then - nhrinc=isec/3600 - isec=MOD(isec,3600) - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - - else -c --- Decrement seconds - isec=isec+nsec - if(isec.LT.0) then -c --- Earlier hour - ksec=-isec - if(ksec.GE.3600) then -c --- Back up at least 1 hour - nhrinc=ksec/3600 - ksec=MOD(ksec,3600) - nhrinc=-nhrinc - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - isec=-ksec - if(isec.LT.0) then -c --- Back up 1 more hour - nhrinc=-1 - isec=3600+isec - call INCR(io,iyr,ijul,ihr,nhrinc) - endif - endif - - endif - - return - end -c---------------------------------------------------------------------- - subroutine deltsec(ndhrb,nsecb,ndhre,nsece,ndelsec) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 041029 DELTSEC -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Compute the difference (in seconds) between two dates & -c times (timeE - timeB) -c -c --- INPUTS: -c NDHRB - integer - Beginning year & hour (YYYYJJJHH) -c NSECB - integer - Beginning second (SSSS) -c NDHRE - integer - Ending year & hour (YYYYJJJHH) -c NSECE - integer - Ending second (SSSS) -c -c --- OUTPUT: -c NDELSEC - integer - Length of interval (seconds) -c -c --- DELTSEC called by: host subroutines -c --- DELTSEC calls: DELTT -c---------------------------------------------------------------------- -c -c --- Extract year, Julian day, and hour from date-time variables -c --- Beginning - j1yr=ndhrb/100000 - iyyjjj=ndhrb/100 - j1jul=iyyjjj-j1yr*1000 - j1hr=ndhrb-iyyjjj*100 -c --- Ending - j2yr=ndhre/100000 - iyyjjj=ndhre/100 - j2jul=iyyjjj-j2yr*1000 - j2hr=ndhre-iyyjjj*100 - -c --- Find difference between hours (in seconds) - call DELTT(j1yr,j1jul,j1hr,j2yr,j2jul,j2hr,jdelhr) - ndelsec=jdelhr*3600 - -c --- Add difference between seconds - ndelsec=ndelsec+(nsece-nsecb) - - return - end -c---------------------------------------------------------------------- - subroutine midnite(io,ctrans,iyr,imo,iday,ijul, - & kyr,kmo,kday,kjul) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 041029 MIDNITE -c --- D. Strimaitis, Earth Tech -c -c --- PURPOSE: Converts date/time at midnight between day N, 0000 -c and day N-1, 2400. Direction is determined by the -c CTRANS instruction. -c -c --- INPUTS: -c IO - integer - Unit number for list file output -c CTRANS - character - Instruction 'TO 24h' or 'TO 00h' -c IYR - integer - Year -c IMO - integer - Month -c IDAY - integer - Day -c IJUL - integer - Julian day -c -c --- OUTPUT: -c KYR - integer - Year -c KMO - integer - Month -c KDAY - integer - Day -c KJUL - integer - Julian day -c -c --- MIDNITE called by: host subroutines -c --- MIDNITE calls: JULDAY, INCR, GRDAY -c---------------------------------------------------------------------- - character*6 ctrans - - ierr =0 - -c --- Get Julian day from month/day if needed - if(ijul.LE.0) call JULDAY(io,iyr,imo,iday,ijul) - - kyr=iyr - kmo=imo - kday=iday - kjul=ijul - - if(ctrans.EQ.'TO 24h') then -c --- Convert from 0000 on ijul to 2400 on kjul - ihr=0 - nhr=-1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - elseif(ctrans.EQ.'TO 00h') then -c --- Convert from 2400 on ijul to 0000 on kjul - ihr=23 - nhr=1 - call INCR(io,kyr,kjul,ihr,nhr) - call GRDAY(io,kyr,kjul,kmo,kday) - else - ierr=1 - endif - - if(ierr.eq.1)then - write(io,*) - write(io,*)'ERROR in SUBR. MIDNITE' - write(io,*)'Invalid instruction: ',ctrans - write(io,*)' Expected: TO 24h' - write(io,*)' OR : TO 00h' - write(*,*) - stop 'Halted in MIDNITE -- see list file.' - endif - - return - end -c---------------------------------------------------------------------- - subroutine utcbasr(axtz,xbtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 070327 UTCBASR -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts character string UTC time zone -c to real base time zone -c -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Add RETURN statement -c -c --- INPUT: -c AXTZ - char*8 - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c --- OUTPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) -c -c --- UTCBASR called by: host subroutines -c --- UTCBASR calls: none -c---------------------------------------------------------------------- - character*8 axtz - - read(axtz(4:6),'(i3)')ihr - read(axtz(7:8),'(i2)')imin - if(ihr.lt.0)imin=-imin - - xbtz=ihr+imin/60. - -c --- Flip sign as base time convention is opposite UTC/GMT - xbtz=-xbtz - - return - end -c---------------------------------------------------------------------- - subroutine basrutc(xbtz,axtz) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 070327 BASRUTC -c --- F.Robe, Earth Tech -c -c --- PURPOSE: Converts real base time zone to character string -c UTC time zone -c -c --- UPDATE -c --- V2.55 (070327) from V2.5 (041123) (DGS) -c - Fix output format of time zone string for zone=0 -c - Add RETURN statement -c -c --- INPUT: -c XBTZ - real - base time zone (old convention: positive -c in North America i.e. opposite to UTC) - -c --- OUTPUT: -c AXTZ - real - time zone (international convention: -c relative to UTC/GMT)UTC-HHMM -c -c --- BASRUTC called by: host subroutines -c --- BASRUTC calls: none -c---------------------------------------------------------------------- - character*8 axtz - - ixbtz=int(xbtz) -c convert fractional real to minutes - imin=(xbtz-ixbtz)*60 - ixbtz=ixbtz*100+imin - -c --- Define time as "UTC-HHMM" (hours/minutes) - axtz(1:3)="UTC" - -c --- Flip sign as base time zone is minus UTC zone - if (xbtz.gt.0.) then - axtz(4:4)="-" - else - axtz(4:4)="+" - endif -c --- Make sure time zone is written as 4 digits - write(axtz(5:8),'(i4.4)')abs(ixbtz) - - return - end -c---------------------------------------------------------------------- - subroutine filcase(lcfiles,cfile) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 FILCASE -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all characters within a file name to lower -c case (if LCFILES=T) or UPPER CASE (if LCFILES=F). -c -c --- UPDATE -c --- V2.2 (950610) to V2.3 (040330) DGS -c - Replace filename strings c*70 with c*132 -c -c --- INPUTS: -c -c LCFILES - logical - Switch indicating if all characters in the -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c CASE letters (LCFILES=F). -c CFILE - char*132- Input character string -c -c --- OUTPUT: -c -c CFILE - char*132- Output character string with -c letters converted -c -c --- FILCASE called by: READFN -c --- FILCASE calls: none -c---------------------------------------------------------------------- -c - character*132 cfile - character*1 cchar,clc(29),cuc(29) - logical lcfiles -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - if(lcfiles)then -c -c --- Convert file name to lower case letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.cuc(j))then - cfile(i:i)=clc(j) - go to 52 - endif - enddo -52 continue - enddo - else -c -c --- Convert file name to UPPER CASE letters - do i=1,132 - cchar=cfile(i:i) -c - do j=1,29 - if(cchar.eq.clc(j))then - cfile(i:i)=cuc(j) - go to 62 - endif - enddo -62 continue - enddo - endif -c - return - end -c---------------------------------------------------------------------- - subroutine readin(cvdic,ivleng,ivtype,ioin,ioout,lecho, - 1 i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15,i16,i17,i18, - 2 i19,i20,i21,i22,i23,i24,i25,i26,i27,i28,i29,i30,i31,i32,i33,i34, - 3 i35,i36,i37,i38,i39,i40,i41,i42,i43,i44,i45,i46,i47,i48,i49,i50, - 4 i51,i52,i53,i54,i55,i56,i57,i58,i59,i60) -c---------------------------------------------------------------------- -c *** Change number of characters in line from 150 to 200 *** -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 110225 READIN -c J. Scire -c -c --- PURPOSE: Read one input group of the free formatted control -c file -- allows comments within the input file -- -c ignores all text except that within delimiters -c -c --- NOTE: All variables (real, integer, logical, -c or character) must be 4 bytes -c --- NOTE: Character*4 array uses only one character -c per word -- it must be dimensioned large -c enough to accommodate the number of characters -c in the variable field -c -c --- UPDATE -c --- V2.58 (110225) from V2.57 (090202) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.57 (090202) from V2.52 (060519) (DGS) -c - Increase max line length from 150 to 200 -c (requires MXCOL=200) -c --- V2.52 (060519) from V2.3 (040330) (DGS) -c - Search for '=' beyond position 14 because blanks are -c not automatically removed within string -c --- V2.3 (040330) from V2.1 (030402) (DGS) -c - Preserve spaces within character variables -c --- V2.1 (030402) from V2.0 (000602) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c -c --- INPUTS: -c -c CVDIC(mxvar) - character*12 array - Variable dictionary -c containing up to "MXVAR" -c variable names -c IVLENG(mxvar) - integer array - Dimension of each variable -c (dim. of scalars = 1) -c IVTYPE(mxvar) - integer array - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c IOIN - integer - Fortran unit of control file -c input -c IOOUT - integer - Fortran unit of list file -c output -c LECHO - logical - Control variable determining -c if input data are echoed to -c list file (IOOUT) -c Parameters: MXVAR, MXCOL -c -c --- OUTPUT: -c -c I1, I2, ... - integer arrays - Variables being read -c (integer array locally, but can be a real, -c integer, logical, or character*4 array in -c the calling routine) -c -c --- READIN called by: host subroutines -c --- READIN calls: DEBLNK, ALTONU, SETVAR, ALLCAP, DEPLUS, -c TRIGHT, TLEFT -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - integer*4 i1(*),i2(*),i3(*),i4(*),i5(*),i6(*),i7(*),i8(*),i9(*), - 1 i10(*),i11(*),i12(*),i13(*),i14(*),i15(*),i16(*),i17(*),i18(*), - 2 i19(*),i20(*),i21(*),i22(*),i23(*),i24(*),i25(*),i26(*),i27(*), - 3 i28(*),i29(*),i30(*),i31(*),i32(*),i33(*),i34(*),i35(*),i36(*), - 4 i37(*),i38(*),i39(*),i40(*),i41(*),i42(*),i43(*),i44(*),i45(*), - 5 i46(*),i47(*),i48(*),i49(*),i50(*),i51(*),i52(*),i53(*),i54(*), - 6 i55(*),i56(*),i57(*),i58(*),i59(*),i60(*) - integer*4 ivleng(mxvar),jdex(mxvar),ivtype(mxvar) -c - logical*4 lv - logical lecho -c - character*12 cvdic(mxvar),cvar,cblank - character*4 cv(mxcol) - character*1 cstor1(mxcol),cstor2(mxcol) -c --- Intermediate scratch arrays - character*1 cstor3(mxcol),cstor4(mxcol) - character*1 cdelim,ceqls,ce,cn,cd,comma,cblnk -c - data cblank/' '/ - data cdelim/'!'/,ceqls/'='/,ce/'E'/,cn/'N'/,cd/'D'/,comma/','/ - data cblnk/' '/ -c - ilim2=99 - do 2 i=1,mxvar - jdex(i)=1 -2 continue -c -c --- begin loop over lines -c -c --- read a line of input -5 continue - read(ioin,10)cstor1 -10 format(200a1) - if(lecho)write(ioout,7)cstor1 -7 format(1x,200a1) -c -c --- check if this is a continuation line - if(ilim2.gt.0)go to 16 -c -c --- continuation line -- find the second delimiter - do 12 i=1,mxcol - if(cstor1(i).eq.cdelim)then - ilim2=i - go to 14 - endif -12 continue -14 continue - il2=ilim2 - if(il2.eq.0)il2=mxcol -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blank characters from string within delimiters -c call deblnk(cstor1,1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- -c --- Remove blank characters on right side - call TRIGHT(cstor1,1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- - icom=0 -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) - go to 55 -c -16 continue - ibs=1 -c -c --- begin loop over delimiter pairs -17 continue - if(ibs.ge.mxcol)go to 5 -c -c --- find location of delimiters - do 20 i=ibs,mxcol - if(cstor1(i).eq.cdelim)then - ilim1=i - if(ilim1.eq.mxcol)go to 22 - ip1=ilim1+1 - do 18 j=ip1,mxcol - if(cstor1(j).eq.cdelim)then - ilim2=j - go to 22 - endif -18 continue -c -c --- second delimiter not on this line - ilim2=0 - go to 22 - endif -20 continue -c -c --- no delimiters found -- skip line and read next line of text - go to 5 -22 continue - ibs=ilim2+1 - if(ilim2.eq.0)ibs=mxcol+1 -c -c --- Trim blanks from left and right sides of string within delimiters -c ----------------------- -cc --- remove blanks from string within delimiters -c il2=ilim2 -c if(il2.eq.0)il2=mxcol -c call deblnk(cstor1,ilim1,il2,cstor2,nlim) -cc --- Remove '+' characters as well (is this needed?) -c if(nlim.gt.0) then -c do k=1,mxcol -c cstor3(k)=cstor2(k) -c enddo -c il3=nlim -c call deplus(cstor3,1,il3,cstor2,nlim) -c endif -c ----------------------- - il2=ilim2 - if(il2.eq.0)il2=mxcol -c --- Remove blank characters on right side - call TRIGHT(cstor1,ilim1,il2,cstor2,nlim) -c --- Remove blank characters on left side - if(nlim.gt.0) then - do k=1,mxcol - cstor3(k)=cstor2(k) - enddo - il3=nlim - call TLEFT(cstor3,1,il3,cstor2,nlim) - endif -c ----------------------- -c -c --- convert lower case letters to upper case - call allcap(cstor2,nlim) -c -c --- search for equals sign (cstor2(1) is delimiter; cstor2(2) is -c --- first letter of variable; cstor2(3) is earliest '=' can occur) -c --- (060519) Search entire string as now there may be blanks before '=' -c do 30 i=3,14 - do 30 i=3,nlim - if(cstor2(i).eq.ceqls)then - ieq=i - go to 32 - endif -30 continue -c -c --- "END" within delimiters signifies the end of the read for -c --- this input group - if(cstor2(2).eq.ce.and.cstor2(3).eq.cn.and.cstor2(4).eq.cd)return - write(ioout,31)(cstor2(n),n=1,nlim) -31 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable too long (Equals sign not found in string) -- ', - 2 'CSTOR2 = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- CVAR is character*12 variable name -32 continue - cvar=cblank - ieqm1=ieq-1 -c --- Grab string to left of '=', and remove blanks - call deblnk(cstor2,1,ieqm1,cstor3,keqm1) -c --- Pass string to variable name - do 40 i=2,keqm1 - il=i-1 - cvar(il:il)=cstor3(i) -40 continue -c -c --- find the variable name in the variable dictionary - do 50 i=1,mxvar - if(cvar.eq.cvdic(i))then - nvar=i - go to 52 - endif -50 continue - write(ioout,51)cvar,(cvdic(n),n=1,mxvar) -51 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Variable not found in variable dictionary'/ - 2 1x,'Variable: ',a12/ - 3 1x,'Variable Dictionary: ',9(a12,1x)/ - 4 10(22x,9(a12,1x)/)) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -52 continue -c --- Assign current variable type - itype=ivtype(nvar) -c -c --- Check for invalid value of variable type - if(itype.le.0.or.itype.ge.6)then - write(ioout,53)itype,nvar,ivtype(nvar),cvdic(nvar) -53 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'Invalid value of variable type -- ITYPE must be 1, 2, 3, ', - 2 '4, or 5'/1x,'ITYPE = ',i10/1x,'NVAR = ',i10/1x, - 3 'IVTYPE(nvar) = ',i10/1x,'CVDIC(nvar) = ',a12) - write(*,*) - stop 'Halted in READIN -- see list file.' - endif -c -c --- search for comma - icom=ieq -c -c --- beginning of loop over values within delimiters -55 continue - ivb=icom+1 -c -c --- if reaches end of line, read next line - if(ivb.gt.nlim)go to 5 - do 60 i=ivb,nlim - if(cstor2(i).eq.comma)then - icom=i - go to 64 - endif -60 continue -c -c --- no comma found - icom=0 - ive=nlim-1 -c -c --- comma between last value and delimiter is allowed - if(cstor2(ivb).eq.cdelim.and.cstor2(ive).eq.comma)go to 17 -c -c --- if no comma & last non-blank character is not a delimiter, -c --- then the input is in error - if(cstor2(nlim).eq.cdelim)go to 66 - write(ioout,63)cstor1 -63 format(/1x,'ERROR IN SUBR. READIN -- Error in input data -- '/ - 1 1x,'If a string within delimiters covers more than one line, ', - 2 'the last character in the line must be a comma'/ - 3 1x,'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -64 continue -c -c --- value of variable is contained in elements IVB to IVE of -c --- CSTOR2 array -c --- Include comma for variable type 5 (character array) so that it -c --- can be used outside of READIN to parse the array values from the -c --- single string that is returned - if(itype.EQ.5) then - ive=icom - else - ive=icom-1 - endif -66 continue -c ncar=ive-ivb+1 - index=jdex(nvar) -c -c --- Convert character string to numeric or logical value -c (if ITYPE = 1,2, or 3) -- If 4 or 5 transfer characters to the -c work array CV) - -c --- Remove all blanks from variable string if type is numeric or -c --- logical; otherwise, trim left and right side of string - if(itype.LT.4) then - call deblnk(cstor2,ivb,ive,cstor4,nv) -c --- Remove '+' characters as well (is this needed?) - if(nv.gt.0) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call deplus(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - else -c --- Pass variable string into cstor4 - nv=ive-ivb+1 - do k=1,nv - cstor4(k)=cstor2(ivb+k-1) - enddo - do k=nv+1,mxcol - cstor4(k)=cblnk - enddo -c --- Remove blank characters on right side of character variable -c --- if last character is either a blank or comma - if(cstor4(nv).EQ.cblnk .OR. - & cstor4(nv).EQ.comma) call TRIGHT(cstor2,ivb,ive,cstor4,nv) -c --- Remove blank characters on left side of character variable - if(nv.GT.0 .AND. cstor4(1).EQ.cblnk) then - do k=1,mxcol - cstor3(k)=cstor4(k) - enddo - il3=nv - call TLEFT(cstor3,1,il3,cstor4,nv) - endif - call altonu(ioout,cstor4(1),nv,itype,irep,rlno,ino,lv,cv) - endif -c -c --- check that array bounds are not exceeded - if(index+irep-1.gt.ivleng(nvar))go to 201 -c - go to (101,102,103,104,105,106,107,108,109,110,111,112,113,114, - 1 115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130, - 2 131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146, - 3 147,148,149,150,151,152,153,154,155,156,157,158,159,160),nvar -c -c --- code currently set up to handle up to 60 variables/source group - write(ioout,71)nvar,(cstor2(n),n=1,nlim) -71 format(/1x,'ERROR IN SUBR. READIN -- Current code ', - 1 'configuration allows up to 60 variables per source group'/ - 2 1x,'No. variables (NVAR) = ',i10/ - 3 1x,'Input data (CSTOR2) = ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' -c -c --- transfer value into output variable -101 continue - call setvar(itype,irep,rlno,ino,lv,cv,i1(index),i1(index), - 1 i1(index),i1(index)) - go to 161 -102 continue - call setvar(itype,irep,rlno,ino,lv,cv,i2(index),i2(index), - 1 i2(index),i2(index)) - go to 161 -103 continue - call setvar(itype,irep,rlno,ino,lv,cv,i3(index),i3(index), - 1 i3(index),i3(index)) - go to 161 -104 continue - call setvar(itype,irep,rlno,ino,lv,cv,i4(index),i4(index), - 1 i4(index),i4(index)) - go to 161 -105 continue - call setvar(itype,irep,rlno,ino,lv,cv,i5(index),i5(index), - 1 i5(index),i5(index)) - go to 161 -106 continue - call setvar(itype,irep,rlno,ino,lv,cv,i6(index),i6(index), - 1 i6(index),i6(index)) - go to 161 -107 continue - call setvar(itype,irep,rlno,ino,lv,cv,i7(index),i7(index), - 1 i7(index),i7(index)) - go to 161 -108 continue - call setvar(itype,irep,rlno,ino,lv,cv,i8(index),i8(index), - 1 i8(index),i8(index)) - go to 161 -109 continue - call setvar(itype,irep,rlno,ino,lv,cv,i9(index),i9(index), - 1 i9(index),i9(index)) - go to 161 -110 continue - call setvar(itype,irep,rlno,ino,lv,cv,i10(index),i10(index), - 1 i10(index),i10(index)) - go to 161 -111 continue - call setvar(itype,irep,rlno,ino,lv,cv,i11(index),i11(index), - 1 i11(index),i11(index)) - go to 161 -112 continue - call setvar(itype,irep,rlno,ino,lv,cv,i12(index),i12(index), - 1 i12(index),i12(index)) - go to 161 -113 continue - call setvar(itype,irep,rlno,ino,lv,cv,i13(index),i13(index), - 1 i13(index),i13(index)) - go to 161 -114 continue - call setvar(itype,irep,rlno,ino,lv,cv,i14(index),i14(index), - 1 i14(index),i14(index)) - go to 161 -115 continue - call setvar(itype,irep,rlno,ino,lv,cv,i15(index),i15(index), - 1 i15(index),i15(index)) - go to 161 -116 continue - call setvar(itype,irep,rlno,ino,lv,cv,i16(index),i16(index), - 1 i16(index),i16(index)) - go to 161 -117 continue - call setvar(itype,irep,rlno,ino,lv,cv,i17(index),i17(index), - 1 i17(index),i17(index)) - go to 161 -118 continue - call setvar(itype,irep,rlno,ino,lv,cv,i18(index),i18(index), - 1 i18(index),i18(index)) - go to 161 -119 continue - call setvar(itype,irep,rlno,ino,lv,cv,i19(index),i19(index), - 1 i19(index),i19(index)) - go to 161 -120 continue - call setvar(itype,irep,rlno,ino,lv,cv,i20(index),i20(index), - 1 i20(index),i20(index)) - go to 161 -121 continue - call setvar(itype,irep,rlno,ino,lv,cv,i21(index),i21(index), - 1 i21(index),i21(index)) - go to 161 -122 continue - call setvar(itype,irep,rlno,ino,lv,cv,i22(index),i22(index), - 1 i22(index),i22(index)) - go to 161 -123 continue - call setvar(itype,irep,rlno,ino,lv,cv,i23(index),i23(index), - 1 i23(index),i23(index)) - go to 161 -124 continue - call setvar(itype,irep,rlno,ino,lv,cv,i24(index),i24(index), - 1 i24(index),i24(index)) - go to 161 -125 continue - call setvar(itype,irep,rlno,ino,lv,cv,i25(index),i25(index), - 1 i25(index),i25(index)) - go to 161 -126 continue - call setvar(itype,irep,rlno,ino,lv,cv,i26(index),i26(index), - 1 i26(index),i26(index)) - go to 161 -127 continue - call setvar(itype,irep,rlno,ino,lv,cv,i27(index),i27(index), - 1 i27(index),i27(index)) - go to 161 -128 continue - call setvar(itype,irep,rlno,ino,lv,cv,i28(index),i28(index), - 1 i28(index),i28(index)) - go to 161 -129 continue - call setvar(itype,irep,rlno,ino,lv,cv,i29(index),i29(index), - 1 i29(index),i29(index)) - go to 161 -130 continue - call setvar(itype,irep,rlno,ino,lv,cv,i30(index),i30(index), - 1 i30(index),i30(index)) - go to 161 -131 continue - call setvar(itype,irep,rlno,ino,lv,cv,i31(index),i31(index), - 1 i31(index),i31(index)) - go to 161 -132 continue - call setvar(itype,irep,rlno,ino,lv,cv,i32(index),i32(index), - 1 i32(index),i32(index)) - go to 161 -133 continue - call setvar(itype,irep,rlno,ino,lv,cv,i33(index),i33(index), - 1 i33(index),i33(index)) - go to 161 -134 continue - call setvar(itype,irep,rlno,ino,lv,cv,i34(index),i34(index), - 1 i34(index),i34(index)) - go to 161 -135 continue - call setvar(itype,irep,rlno,ino,lv,cv,i35(index),i35(index), - 1 i35(index),i35(index)) - go to 161 -136 continue - call setvar(itype,irep,rlno,ino,lv,cv,i36(index),i36(index), - 1 i36(index),i36(index)) - go to 161 -137 continue - call setvar(itype,irep,rlno,ino,lv,cv,i37(index),i37(index), - 1 i37(index),i37(index)) - go to 161 -138 continue - call setvar(itype,irep,rlno,ino,lv,cv,i38(index),i38(index), - 1 i38(index),i38(index)) - go to 161 -139 continue - call setvar(itype,irep,rlno,ino,lv,cv,i39(index),i39(index), - 1 i39(index),i39(index)) - go to 161 -140 continue - call setvar(itype,irep,rlno,ino,lv,cv,i40(index),i40(index), - 1 i40(index),i40(index)) - go to 161 -141 continue - call setvar(itype,irep,rlno,ino,lv,cv,i41(index),i41(index), - 1 i41(index),i41(index)) - go to 161 -142 continue - call setvar(itype,irep,rlno,ino,lv,cv,i42(index),i42(index), - 1 i42(index),i42(index)) - go to 161 -143 continue - call setvar(itype,irep,rlno,ino,lv,cv,i43(index),i43(index), - 1 i43(index),i43(index)) - go to 161 -144 continue - call setvar(itype,irep,rlno,ino,lv,cv,i44(index),i44(index), - 1 i44(index),i44(index)) - go to 161 -145 continue - call setvar(itype,irep,rlno,ino,lv,cv,i45(index),i45(index), - 1 i45(index),i45(index)) - go to 161 -146 continue - call setvar(itype,irep,rlno,ino,lv,cv,i46(index),i46(index), - 1 i46(index),i46(index)) - go to 161 -147 continue - call setvar(itype,irep,rlno,ino,lv,cv,i47(index),i47(index), - 1 i47(index),i47(index)) - go to 161 -148 continue - call setvar(itype,irep,rlno,ino,lv,cv,i48(index),i48(index), - 1 i48(index),i48(index)) - go to 161 -149 continue - call setvar(itype,irep,rlno,ino,lv,cv,i49(index),i49(index), - 1 i49(index),i49(index)) - go to 161 -150 continue - call setvar(itype,irep,rlno,ino,lv,cv,i50(index),i50(index), - 1 i50(index),i50(index)) - go to 161 -151 continue - call setvar(itype,irep,rlno,ino,lv,cv,i51(index),i51(index), - 1 i51(index),i51(index)) - go to 161 -152 continue - call setvar(itype,irep,rlno,ino,lv,cv,i52(index),i52(index), - 1 i52(index),i52(index)) - go to 161 -153 continue - call setvar(itype,irep,rlno,ino,lv,cv,i53(index),i53(index), - 1 i53(index),i53(index)) - go to 161 -154 continue - call setvar(itype,irep,rlno,ino,lv,cv,i54(index),i54(index), - 1 i54(index),i54(index)) - go to 161 -155 continue - call setvar(itype,irep,rlno,ino,lv,cv,i55(index),i55(index), - 1 i55(index),i55(index)) - go to 161 -156 continue - call setvar(itype,irep,rlno,ino,lv,cv,i56(index),i56(index), - 1 i56(index),i56(index)) - go to 161 -157 continue - call setvar(itype,irep,rlno,ino,lv,cv,i57(index),i57(index), - 1 i57(index),i57(index)) - go to 161 -158 continue - call setvar(itype,irep,rlno,ino,lv,cv,i58(index),i58(index), - 1 i58(index),i58(index)) - go to 161 -159 continue - call setvar(itype,irep,rlno,ino,lv,cv,i59(index),i59(index), - 1 i59(index),i59(index)) - go to 161 -160 continue - call setvar(itype,irep,rlno,ino,lv,cv,i60(index),i60(index), - 1 i60(index),i60(index)) -c -161 continue - jdex(nvar)=jdex(nvar)+irep -c -c --- continue reading values for this array until array is filled -c --- or delimiter is reached - if(icom.ne.0.and.jdex(nvar).le.ivleng(nvar))go to 55 - go to 17 -201 continue - iatt=index+irep-1 - write(ioout,202)cvdic(nvar),ivleng(nvar),iatt,cstor1 -202 format(/1x,'ERROR IN SUBR. READIN -- Error in input data', - 1 1x,'Array bounds exceeded -- Variable: ',a12,3x,' Declared ', - 2 'dimension = ',i8/1x,'Input attempted to element ',i8/1x, - 3 'Input line: ',200a1) - write(*,*) - stop 'Halted in READIN -- see list file.' - end -c---------------------------------------------------------------------- - subroutine altonu(ioout,alp,ncar,itype,irep,rlno,ino,lv,cv) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 110225 ALTONU -c --- J. Scire -c -c --- PURPOSE: Convert a character string into a real, integer or -c logical variable -- also compute the repetition factor -c for the variable -c -c --- UPDATES -c --- V2.58 (110225) from V2.56 (080407) (DGS) -c - Add ITYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c --- V2.56 (080407) from V1.0 (000602) (DGS) -c - Treat case in which exponential notation is used -c without a decimal point. Pointer had been left at -c 'zero' which placed the decimal location in front of -c a number so that 2e02 became 0.2e02 instead of 2.0e02 -c - Trap case where no number appears in front the E or D -c in exponential notation -c -c --- 000602 (DGS): add message to "stop" -c -c --- INPUTS: -c IOOUT - integer - Fortran unit of list file -c output -c ALP(ncar) - character*1 array - Characters to be converted -c NCAR - integer - Number of characters -c ITYPE - integer - Type of each variable -c 1 = real, -c 2 = integer, -c 3 = logical, -c 4 = character*4 -c 5 = character*4 with commas -c -c Parameter: MXCOL -c -c --- OUTPUT: -c IREP - integer - Repetition factor for value -c RLNO - real - Real variable produced from -c character string -c INO - integer - Integer variable produced from -c character string -c LV - logical*4 - Logical variable produced from -c character string -c CV(mxcol) - character*4 - Character*4 variable produced -c from character string -c (NOTE: Only 1 (NOT 4) -c character(s) per word) -c -c --- ALTONU called by: READIN -c --- ALTONU calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real*8 rno,xmult,ten - integer num2(mxcol) - logical*4 lv - character*4 cv(mxcol) - character*1 alp(ncar),alpsv,ad(17),astar,adec -c - data ad/'0','1','2','3','4','5','6','7','8','9','-', -c --- num2 = 0 1 2 3 4 5 6 7 8 9 11 - 1 '*','.','E','D','T','F'/ -c --- num2 = 12 13 14 15 16 17 - data astar/'*'/,adec/'.'/,ten/10.0d0/ -c -c --- If dealing with a character*4 variable, transfer characters -c into the work array CV (ONE character per 4-byte word) - if(itype.eq.4 .OR. itype.eq.5)then - do 5 i=1,ncar - cv(i)(1:1)=alp(i) -5 continue -c -c --- NOTE: Repetition factor refers to the number of -c characters in the field, if ITYPE = 4, 5 - irep=ncar - return - endif -c -c --- Convert character array elements into numeric codes - do 30 i=1,ncar - alpsv=alp(i) - do 20 j=1,17 - if(alpsv.eq.ad(j))then - num2(i)=j - if(j.lt.11)num2(i)=j-1 - go to 30 - endif -20 continue - write(ioout,21)(alp(n),n=1,ncar) -21 format(/1x,'ERROR IN SUBR. ALTONU -- Unrecognizable character ', - 1 'in input -- Character string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -30 continue -c -c --- Locally classify variable type (1=real, 2=integer, 3=logical) - do 40 i=1,ncar - if(num2(i).le.12)go to 40 - if(num2(i).ge.16)then -c -c --- logical variable ("T", "F") - jtype=3 - go to 41 - else -c -c --- real variable (".", "E", "D") - jtype=1 - go to 41 - endif -40 continue -c -c --- integer variable - jtype=2 -41 continue -c -c --- determine if repetition factor "*" is used - do 50 i=1,ncar - if(alp(i).eq.astar)then - istar=i - go to 51 - endif -50 continue - istar=0 -51 continue - if(istar.ne.0)go to 400 - irep=1 - go to (101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) -55 format(/1x,'ERROR IN SUBR. ALTONU -- JTYPE must be 1, 2, or 3 ', - 1 '-- JTYPE = ',i3/3x,'Text string (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- REAL number w/o "*" -c -------------------------------------------------------------------- -c --- Determine sign -- ISTAR is position of array containing "*" -c (ISTAR = 0 if no repetition factor) -101 continue - if(num2(1+istar).eq.11)then - isgn=-1 - istart=istar+2 - else - isgn=1 - istart=istar+1 - endif -c -c --- Locate decimal point - idec=0 - do 109 i=istart,ncar - if(alp(i).eq.adec)then - if(idec.eq.0)then - idec=i - go to 109 - endif -c -c --- More than one decimal point found - write(ioout,120)(alp(n),n=1,ncar) -120 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid real variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif -109 continue -c -c --- Search for E or D - do 110 i=istart,ncar - if(num2(i).eq.14.or.num2(i).eq.15)then - istop=i-1 - go to 111 - endif -110 continue - istop=ncar -111 continue - -c --- 080407 Update: -c --- Correct for missing decimal point before decoding - if(idec.EQ.0) idec=istop+1 -c --- Trap missing number in front of E,D - if(istop.LT.1 .OR. istart.GT.istop) then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - write(*,*)'Missing number!' - stop 'Halted in ALTONU -- see list file.' - endif -c -c --- Convert integer numerics to real number - rno=0.0 - do 130 i=istart,istop - if(i.eq.idec)go to 130 - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=idec-i - if(iexp.gt.0)iexp=iexp-1 - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rno=rno+xmult*num2(i) - -130 continue -c -c --- Account for minus sign (if present) - rno=isgn*rno - rlno=rno -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - if(istop.eq.ncar)return -c -c --- Find exponent (istop+1 is position in array containing E or D) - isgn=1 - istart=istop+2 - if(num2(istart).ne.11)go to 135 - isgn=-1 - istart=istart+1 -135 continue - if(istart.gt.ncar)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - rexp=0.0 - do 140 i=istart,ncar - if(num2(i).ge.10)then - write(ioout,120)(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - endif - iexp=ncar-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - rexp=rexp+xmult*num2(i) -140 continue - xmult=1.0 - if(rexp.ne.0.0)xmult=ten**(isgn*rexp) - rno=rno*xmult - rlno=rno -c -c --- Also set integer variable in case of improper input - if(rlno.lt.0.0)then - ino=rlno-0.0001 - else - ino=rlno+0.0001 - endif - return -c -c -------------------------------------------------------------------- -c --- INTEGER variables -c -------------------------------------------------------------------- -201 continue - if(num2(1+istar).ne.11)go to 228 - isgn=-1 - istart=istar+2 - go to 229 -228 continue - isgn=1 - istart=istar+1 -229 continue - ino=0 - do 230 i=istart,ncar - if(num2(i).ge.10)go to 208 - iexp=ncar-i - xmult=1.0 - if(iexp.ne.10)xmult=ten**iexp - ino=ino+xmult*num2(i)+0.5 -230 continue - ino=isgn*ino -c -c --- Also set real variable in case of improper input - rlno=ino - return -208 continue - write(ioout,220)(alp(n),n=1,ncar) -220 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid integer variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c -------------------------------------------------------------------- -c --- LOGICAL variables -c -------------------------------------------------------------------- -301 continue - if(ncar-istar.ne.1)go to 308 - if(num2(istar+1).eq.16)then -c -c --- Variable = T - lv=.true. - return - else if(num2(istar+1).eq.17)then -c -c --- Variable = F - lv=.false. - return - endif -308 continue - write(ioout,320)(alp(n),n=1,ncar) -320 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid logical variable ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -c -c --- Determine repetition factor -400 continue - irep=0 -c -c --- ISTAR is the position of array containing "*" - istrm1=istar-1 - do 430 i=1,istrm1 - if(num2(i).ge.10)go to 408 - iexp=istrm1-i - xmult=1.0 - if(iexp.ne.0)xmult=ten**iexp - irep=irep+xmult*num2(i)+0.5 -430 continue - go to(101,201,301),jtype - write(ioout,55)jtype,(alp(n),n=1,ncar) - write(*,*) - stop 'Halted in ALTONU -- see list file.' -408 continue - write(ioout,420)(alp(n),n=1,ncar) -420 format(/1x,'ERROR IN SUBR. ALTONU -- Invalid repetition factor ', - 1 'entry'/5x,'Input text (ALP) = ',15a1) - write(*,*) - stop 'Halted in ALTONU -- see list file.' - end -c---------------------------------------------------------------------- - subroutine deblnk(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 DEBLNK -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank or "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- UPDATE -c --- V2.1 (030402) from V2.0 (980918) (DGS) -c - Split DEBLNK action (removes ' ', '+') into -c DEBLNK and DEPLUS(new) -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without blanks within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEBLNK called by: (utility) -c --- DEBLNK calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cblnk)go to 10 -c -c --- transfer non-blank character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine deplus(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 DEPLUS -c --- J. Scire, Earth Tech, Inc. -c -c --- PURPOSE: Remove all "+" characters from the character -c string within delimiters -c Only characters in the range ilim1 to il2 may be -c written to output array -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for plus begins -c IL2 - integer - Array element at which search -c for plus ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (without plus within text) -c NLIM - integer - Length of output string -c (characters) -c -c --- DEPLUS called by: (utility) -c --- DEPLUS calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk,cplus - data cblnk/' '/,cplus/'+'/ -c - ind=0 - do 10 i=ilim1,il2 - if(cstor1(i).eq.cplus)go to 10 -c -c --- transfer non-plus character into output array - ind=ind+1 - cstor2(ind)=cstor1(i) -10 continue - nlim=ind - if(ind.eq.mxcol)return -c -c --- pad rest of output array - indp1=ind+1 - do 20 i=indp1,mxcol - cstor2(i)=cblnk -20 continue - return - end -c---------------------------------------------------------------------- - subroutine tright(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 TRIGHT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the RIGHT of the last non-blank character -c in the string before il2. Also remove the character -c at il2 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=3, il2=21 -c CSTOR1 : 2 for this run ! -c Position : 000000000111111111122 -c 123456789012345678901 -c CSTOR2 : for this run! -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with right-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TRIGHT called by: (utility) -c --- TRIGHT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of last non-blank character - klast=0 - il2m1=il2-1 - do k=ilim1,il2m1 - if(cstor1(k).NE.cblnk) klast=k - enddo - -c --- Transfer all characters in range up to klast - ind=0 - if(klast.GT.0) then - do k=ilim1,klast - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif -c --- Add last character in range if non-blank - if(cstor1(il2).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(il2) - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine tleft(cstor1,ilim1,il2,cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 TLEFT -c --- D. Strimaitis, Earth Tech, Inc. -c -c --- PURPOSE: Remove all blank characters in the range ilim1 to il2 -c that lie to the LEFT of the first non-blank character -c in the string after ilim1. Also remove the character -c at ilim1 if it is blank. -c Only characters in the range ilim1 to il2 may be -c written to the output array. -c -c Example -- -c Range : ilim1=2, il2=19 -c CSTOR1 : 2 for this run ! -c Position : 123456789111111111122 -c 012345678901 -c CSTOR2 : 2for this run -c -c --- INPUTS: -c -c CSTOR1(mxcol) - character*1 array - Input character string -c ILIM1 - integer - Array element at which search -c for blanks begins -c IL2 - integer - Array element at which search -c for blanks ends -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string -c (with left-blanks removed) -c NLIM - integer - Length of output string -c (characters) -c -c --- TLEFT called by: (utility) -c --- TLEFT calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor1(mxcol),cstor2(mxcol),cblnk - data cblnk/' '/ - -c --- Position of first non-blank character - kfrst=0 - ilim1p1=ilim1+1 - do k=il2,ilim1p1,-1 - if(cstor1(k).NE.cblnk) kfrst=k - enddo - - ind=0 -c --- Pass first character in range if non-blank - if(cstor1(ilim1).NE.cblnk) then - ind=ind+1 - cstor2(ind)=cstor1(ilim1) - endif - -c --- Transfer all characters in range from kfrst - if(kfrst.GT.0) then - do k=kfrst,il2 - ind=ind+1 - cstor2(ind)=cstor1(k) - enddo - endif - nlim=ind - if(ind.EQ.mxcol) return - -c --- Pad rest of output array - indp1=ind+1 - do i=indp1,mxcol - cstor2(i)=cblnk - enddo - - return - end -c---------------------------------------------------------------------- - subroutine setvar(itype,irep,xx,jj,ll,cv,xarr,jarr,larr,carr) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 110225 SETVAR -c --- J. Scire -c -c --- PURPOSE: Fill the output variable or array with the value read -c from the input file -c -c --- UPDATE -c --- V2.58 (110225) from V1.0 (950122) (DGS) -c - Add IVTYPE=5 (char*4 array with commas retained -c as delimiters for parsing) -c -c --- INPUTS: -c -c ITYPE - integer - Variable type (1=real, 2=integer, -c 3=logical, 4=character*4, -c 5=character*4 includes commas) -c IREP - integer - Repetition factor -c If ITYPE = 4, IREP refers to the -c number of characters in the field) -c XX - real - Real value read from input -c file (Used only if ITYPE=1) -c JJ - integer - Integer value read from input -c file (Used only if ITYPE=2) -c LL - logical*4 - Logical value read from input -c file (Used only if ITYPE=3) -c CV(mxcol) - character*4 - Character*4 values read from input -c file (Used only if ITYPE=4) -c -c PARAMETER: MXCOL -c -c --- OUTPUT: -c -c XARR(*) - real array - Output real array (or scalar if -c IREP=1) -- Used only if ITYPE=1 -c JARR(*) - integer array - Output integer array (or scalar if -c IREP=1) -- Used only if ITYPE=2 -c LARR(*) - logical array - Output logical array (or scalar if -c IREP=1) -- Used only if ITYPE=3 -c CARR(*) - character*4 - Output character*4 array (or -c scalar if IREP=1) -- Used only if -c ITYPE=4 -c -c --- SETVAR called by: READIN -c --- SETVAR calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - real xarr(*) - integer jarr(*) - logical*4 larr(*),ll - character*4 carr(*),cv(mxcol) -c - go to(10,20,30,40,50),itype -c -c --- real variable -10 continue - do 15 i=1,irep - xarr(i)=xx -15 continue - return -c -c --- integer variable -20 continue - do 25 i=1,irep - jarr(i)=jj -25 continue - return -c -c --- logical variable -30 continue - do 35 i=1,irep - larr(i)=ll -35 continue - return -c -c --- character*4 variable string -40 continue - do 45 i=1,irep - carr(i)=cv(i) -45 continue - return -c -c --- character*4 variable string -50 continue - do 55 i=1,irep - carr(i)=cv(i) -55 continue - return - - end -c---------------------------------------------------------------------- - subroutine allcap(cstor2,nlim) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 950122 ALLCAP -c --- J. Scire, SRC -c -c --- PURPOSE: Convert all lower case letters within a character -c string to upper case -c -c --- INPUTS: -c -c CSTOR2(mxcol) - character*1 array - Input character string -c NLIM - integer - Length of string (characters) -c Parameters: MXCOL -c -c --- OUTPUT: -c -c CSTOR2(mxcol) - character*1 array - Output character string with -c lower case letters converted -c to upper case -c -c --- ALLCAP called by: READIN -c --- ALLCAP calls: none -c---------------------------------------------------------------------- -c -c --- Include parameter statements - include 'params.cal' -c - character*1 cstor2(mxcol),cchar,clc(29),cuc(29) -c - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - 1 'j','k','l','m','p','q','r','s','t','v','w','y','z','-','.', - 2 '*'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - 1 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z','-','.', - 2 '*'/ -c - do 100 i=1,nlim - cchar=cstor2(i) -c - do 50 j=1,29 - if(cchar.eq.clc(j))then - cstor2(i)=cuc(j) - go to 52 - endif -50 continue -52 continue -100 continue -c - return - end -c---------------------------------------------------------------------- - subroutine datetm(rdate,rtime,rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 140318 DATETM -c --- J. Scire -c -c --- PURPOSE: Get system date and time from system clock, and -c elapsed CPU time -c --- UPDATES -c --- V2.57-V2.6.0 140318(MBN):Remove obsolete Lahey F77L code, -c and etime calls. -c --- V1.0-V2.57 090202 (DGS): Activate CPU time (F95 call) -c -c --- INPUTS: none -c -c --- OUTPUT: rdate - C*10 - Current system date (MM-DD-YYYY) -c rtime - C*8 - Current system time (HH:MM:SS) -c rcpu - real - CPU time (sec) from system utility -c -c --- DATETM called by: SETUP, FIN -c --- DATETM calls: DATE_AND_TIME (F95) -c CPU_TIME (F95) -c YR4C -c---------------------------------------------------------------------- - character*8 rtime - character*10 rdate - -c --- Local store - character*11 stime - character*8 sdate - -c --- Set initial base CPU time to -1. - data rcpu0/-1./ - SAVE rcpu0 - -c --- System date in CCYYMMDD -c --- System clock in HHMMSS.sss, where sss = thousandths of seconds - call DATE_AND_TIME(sdate,stime) -c --- Pass to output formats (MM-DD-YYYY) and (HH:MM:SS) - rdate=' - - ' - rdate(1:2)=sdate(5:6) - rdate(4:5)=sdate(7:8) - rdate(7:10)=sdate(1:4) - rtime=' : : ' - rtime(1:2)=stime(1:2) - rtime(4:5)=stime(3:4) - rtime(7:8)=stime(5:6) -c --- Get CPU time from F95 intrinsic procedure - call CPU_TIME(rcpu1) - -c --- Construct 4-digit year from current 2-digit year (if found) - read(rdate(7:10),'(i4)') iyr - call YR4C(iyr) - write(rdate(7:10),'(i4)') iyr - -c --- Update base CPU time on first call - if(rcpu0.LT.0.0) rcpu0=rcpu1 - -c --- Return CPU time difference from base - rcpu=rcpu1-rcpu0 - -cc --- DEBUG -c write(*,*)'DATETM: stime,rcpu0,rcpu1,rcpu = ', -c & stime,rcpu0,rcpu1,rcpu - - return - end -c---------------------------------------------------------------------- - subroutine fmt_date(io,fmt1,fmt2,sdate) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 090511 FMT_DATE -c D. Strimaitis -c -c --- PURPOSE: Change the format of a date string -c -c --- INPUTS: -c io - integer - Listfile output unit number -c fmt1 - character*12 - Input date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c sdate - character*12 - Date string to convert -c fmt2 - character*12 - Output date format -c MM-DD-YYYY -c DD-MM-YYYY -c YYYY-MM-DD -c YYYY-DD-MM -c DD-MMM-YYYY -c MMM-DD-YYYY -c -c --- OUTPUT: -c sdate - character*12 - Converted date string -c -c --- FMT_DATE called by: (any) -c --- FMT_DATE calls: ALLCAP -c---------------------------------------------------------------------- - character*12 fmt1,fmt2,sdate - character*3 month3(12),month3uc(12),amon3 - character*1 amon(3) - integer io - -c --- Set abbreviation names for months - data month3/'Jan','Feb','Mar','Apr','May','Jun', - & 'Jul','Aug','Sep','Oct','Nov','Dec'/ - data month3uc/'JAN','FEB','MAR','APR','MAY','JUN', - & 'JUL','AUG','SEP','OCT','NOV','DEC'/ - -c --- Extract input month, day and year - if(fmt1(1:10).EQ.'MM-DD-YYYY') then - read(sdate(1:2),'(i2)') imon - read(sdate(4:5),'(i2)') iday - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'DD-MM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:5),'(i2)') imon - read(sdate(7:10),'(i4)') iyear - elseif(fmt1(1:10).EQ.'YYYY-MM-DD') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') imon - read(sdate(9:10),'(i4)') iday - elseif(fmt1(1:10).EQ.'YYYY-DD-MM') then - read(sdate(1:4),'(i4)') iyear - read(sdate(6:7),'(i2)') iday - read(sdate(9:10),'(i4)') imon - elseif(fmt1(1:11).EQ.'DD-MMM-YYYY') then - read(sdate(1:2),'(i2)') iday - read(sdate(4:6),'(3a1)') amon - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - elseif(fmt1(1:11).EQ.'MMM-DD-YYYY') then - read(sdate(1:3),'(3a1)') amon - read(sdate(5:6),'(i2)') iday - read(sdate(8:11),'(i4)') iyear - call ALLCAP(amon,3) - amon3=amon(1)//amon(2)//amon(3) - imon=0 - do k=1,12 - if(amon3.EQ.month3uc(k)) imon=k - enddo - else - write(io,*)'FMT_DATE: Invalid input format = ',fmt1 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Check for valid month index - if(imon.LT.1 .OR. imon.GT.12) then - write(io,*)'FMT_DATE: Invalid month in date = ',sdate - write(io,*)' for input format = ',fmt1 - stop 'Halted in FMT_DATE --- see list file' - endif - -c --- Create output date string - if(fmt2(1:10).EQ.'MM-DD-YYYY') then - sdate='MM-DD-YYYY ' - write(sdate(1:2),'(i2.2)') imon - write(sdate(4:5),'(i2.2)') iday - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'DD-MM-YYYY') then - sdate='DD-MM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - write(sdate(4:5),'(i2.2)') imon - write(sdate(7:10),'(i4.4)') iyear - elseif(fmt2(1:10).EQ.'YYYY-MM-DD') then - sdate='YYYY-MM-DD ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') imon - write(sdate(9:10),'(i2.2)') iday - elseif(fmt2(1:10).EQ.'YYYY-DD-MM') then - sdate='YYYY-DD-MM ' - write(sdate(1:4),'(i4.4)') iyear - write(sdate(6:7),'(i2.2)') iday - write(sdate(9:10),'(i2.2)') imon - elseif(fmt2(1:11).EQ.'DD-MMM-YYYY') then - sdate='DD-MMM-YYYY ' - write(sdate(1:2),'(i2.2)') iday - sdate(4:6)=month3(imon) - write(sdate(8:11),'(i4.4)') iyear - elseif(fmt2(1:11).EQ.'MMM-DD-YYYY') then - sdate='MMM-DD-YYYY ' - sdate(1:3)=month3(imon) - write(sdate(5:6),'(i2.2)') iday - write(sdate(8:11),'(i4.4)') iyear - else - write(io,*)'FMT_DATE: Invalid output format = ',fmt2 - write(io,*)'Expected: MM-DD-YYYY, DD-MM-YYYY, YYYY-MM-DD' - write(io,*)' YYYY-DD-MM, DD-MMM-YYYY, MMM-DD-YYYY' - stop 'Halted in FMT_DATE --- see list file' - endif - - return - end -c---------------------------------------------------------------------- - subroutine etime(rcpu) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 941215 ETIME -c --- J. Scire, SRC -c -c --- PURPOSE: Dummy system CPU time routine for PC -c DO NOT USE THIS ROUTINE ON SUNs -c -c --- INPUTS: none -c -c --- OUTPUT: RCPU - real - CPU time (sec) -- set to zero for PC -c -c --- ETIME called by: DATETM -c --- ETIME calls: none -c---------------------------------------------------------------------- - rcpu=0.0 -c - return - end -c---------------------------------------------------------------------- - subroutine undrflw(lflag) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 030402 UNDRFLW -c D. Strimaitis, Earth Tech Inc. -c -c --- PURPOSE: This routine takes advantage of the Lahey F77L routine -c UNDER0 to set underflows to zero. When other compilers -c are used, there may be a similar routine. If none -c exists, place a dummy statement here and use compiler -c switches to configure the NDP response to an underflow. -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c---------------------------------------------------------------------- - logical lflag - -cc --- Lahey F77L Compiler (begin) -cc ------------------------------- -cc --- Lahey F77 compiler -- set underflows ( < 10**-38 ) to zero -c call UNDER0(lflag) -cc --- Lahey F77L Compiler (end) - -c --- Dummy (no action on underflows) -c ----------------------------------- - lflag=.TRUE. -c --- Dummy (end) - - return - end -c---------------------------------------------------------------------- - subroutine comline(ctext) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 040330 COMLINE -c J. Scire, SRC -c -c --- PURPOSE: Call the compiler-specific system routine that will -c pass back the command line argument after the text -c that executed the program -c -c This routine contains calls for several different -c compilers, but only one should be active at any one -c time. -c -c --- UPDATE -c --- V2.3 (040330) to V2.6.0 (040330) MBN -c - Removed obsolete Compaq, Microsoft, and HP compiler codes -c - Removed getcl (Lahey-only function not needed) -c --- V2.2 (960521) to V2.3 (040330) DGS -c - Replace strings c*70 with c*132 -c -c --- INPUTS: -c -c CTEXT - character*132 - Default command line argument #1 -c -c --- OUTPUT: -c -c CTEXT - character*132 - Command line argument #1 -c If command line argument is -c missing, CTEXT is not changed -c -c --- COMLINE called by: SETUP -c --- COMLINE calls: IARGC, GETARG - compiler routines -c -c---------------------------------------------------------------------- -c - character*132 ctext,cdeflt -c -c --- The following is for any system without a command line routine -c --- and is also used as a default - cdeflt=ctext -c -c ---------------- -c --- Intel ifort, Lahey lf95, and GNU gfortran compilers: -c ---------------- - numargs=IARGC() - if(numargs.ge.1)then - call GETARG(1,ctext) - endif -c -c --- If no command line arguments, use default - if(ctext(1:1).eq.' ')ctext=cdeflt - - return - end - -c---------------------------------------------------------------------- - subroutine open_err(iolst,cfrom,cftype,cfname,iunit) -c---------------------------------------------------------------------- -c -c --- CALUTILS Version: 2.7.0 Level: 141010 OPEN_ERR -c D. Strimaitis, Exponent Inc. -c -c --- PURPOSE: Report error in opening a file -c -c --- INPUTS: -c IOLST - integer - Unit number of output list file -c (<0 if not available) -c CFROM - char* - Called-From string to report error -c CFTYPE - char* - File-type string -c CFNAME - char* - File-name string -c IUNIT - integer - File unit number -c -c --- OUTPUT: -c -c --- OPEN_ERR called by: () -c --- OPEN_ERR calls: -c---------------------------------------------------------------------- - implicit none - -c --- Declare arguments - character(len=*) :: cfrom,cftype,cfname - integer :: iolst, iunit - - if(iolst.GT.0) then - write(iolst,*) - write(iolst,*)'ERROR opening '//TRIM(cftype) - write(iolst,*)' File Name: '//TRIM(cfname) - write(iolst,*)' File Unit: ',iunit - write(iolst,*)'Problem reported from '//TRIM(cfrom) - write(iolst,*) - write(iolst,*)'The file may not exist in this location' - write(iolst,*)'Check the spelling of the name and the location' - write(*,*) - stop 'ERROR: File not found -- see list file' - else - write(*,*) - write(*,*)'ERROR opening '//TRIM(cftype) - write(*,*)' File Name: '//TRIM(cfname) - write(*,*)' File Unit: ',iunit - write(*,*)'Problem reported from '//TRIM(cfrom) - write(*,*) - write(*,*)'The file may not exist in this location' - write(*,*)'Check the spelling of the name, and the location' - stop - endif - - end - diff --git a/CALPUFF_SRC/TERREL/cell.trl b/CALPUFF_SRC/TERREL/cell.trl deleted file mode 100644 index 04007e3..0000000 --- a/CALPUFF_SRC/TERREL/cell.trl +++ /dev/null @@ -1,39 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /CELL/ -- Data for each cell in output grid TERREL -c----------------------------------------------------------------------- -c --- Full implementation includes max/min/sum/sum^2, but drop extras -c --- to conserve memory - - common /CELL/ ithres,sum(mxnxy),knt(mxnxy),htmax(mxnxy), - & znoise(5),inoiserep(5), - & terdef(5),iterrep(5),cellradkm - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c ithres threshold (%) of average number of points in cell [i] -c sum(mxnxy) sum of elevations within a cell in output grid [r] -c always in meters -c knt(mxnxy) number of elevations within a cell in output grid [i] -c htmax(mxnxy) maximum elevation (m) within a cell in output grid [r] -c ithres threshold % for QA of # of hits per cell compared [i] -c to the average # of hits in a cell -c The following 4 arrays have 5 elements by type, -c 1st-ocean, 2nd-land, 3rd-lakes, 4th-inland islands, -c 5th-ponds on islands -c znoise(5) minimum acceptable elevations for noise detection [ra] -c inoiserep(5) integer switch for replacement of noisy data [ia] -c 0 - Do not check for noise -c 1 - Set values lower than minimum to missing -c (minimum set in ZNOISE below) -c 2 - Replace values lower than minimum with minimum value -c 3 - Replace values lower than minimum with default value -c (set in TERDEF below) -c terdef(5) default values to fill void cells and receptors [ra] -c iterrep(5) integer switch for replacement with terdef [ia] -c 0 - never replace -c 1 - replace voids upon output only -c 2 - relace void values during extraction and output -c 3 - always replace (valid for oceans and lakes only) -c cellradkm maximum radius for cell height interpolation [r] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/control.trl b/CALPUFF_SRC/TERREL/control.trl deleted file mode 100644 index 82c3059..0000000 --- a/CALPUFF_SRC/TERREL/control.trl +++ /dev/null @@ -1,144 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /CONTROL/ -- Program control data TERREL -c----------------------------------------------------------------------- - logical lprev,lxy,lintxy,lcoast,lblnread,lvoidfil,lrawecho - logical l30sec,l3sec,l7_5min,l100met,l3cd,lgtopo30 - logical lnzgnr,lgnr,l3sec2,lusgsglb,lsrtm1,lsrtm3,lcded - logical lgeotiff - logical lnuat,lcmet,lmeso,liscc,liscp,lgenr - logical lutm,llcc,lps,lem,llaza,lttm - logical lfeet,lpeak,lpolr,lcent,lpush - - character*8 pmap,dusgs90,dusgs30,darm3,d3cd,ddmdf,dgtopo30 - character*8 dcded,dgeotiff - character*8 dusgsla,dnzgen,dgen,dsrtm1,dsrtm3,dwvs,dwdbii - - common /CONTROL/ imodel,igrid,iproc,msheet, - & lprev,lxy,lintxy,lcoast,lblnread,lvoidfil, - & lrawecho, - & l30sec,l3sec,l7_5min,l100met,l3cd,lgtopo30, - & lnzgnr,lgnr,l3sec2,lusgsglb,lsrtm1,lsrtm3, - & lcded,lgeotiff, - & lnuat,lcmet,lmeso,liscc,liscp,lgenr, - & lutm,llcc,lps,lem,llaza,lttm, - & lfeet,lpeak,lpolr,lcent,lpush, - & pmap,dusgs90,dusgs30,darm3, - & d3cd,ddmdf,dgtopo30,dusgsla,dnzgen,dgen, - & dsrtm1,dsrtm3,dcded,dgeotiff,dwvs,dwdbii - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c imodel index for structure of output [i] -c 1 = CALMET (grid-cell-average elevations) -c 2 = MESOPAC (grid-cell-average elevations) -c 3 = ISC POLAR (grid-cell-peak elevations) -c 4 = ISC CARTESIAN (grid-cell-peak elevations) -c 5 = NUATMOS (grid-cell-average elevations) -c 6 = Generic (grid-cell-average elevations) -c igrid index for type of output grid [i] -c 1 = Cartesian, with reference point at Lower Left -c CORNER of cell (1,1) --- CALMET Convention --- -c 2 = Cartesian, with reference point at CENTER of -c cell (1,1) -c 3 = Polar, with reference point at center of rings -c ---------- -c Note: cell (1,1) is at the SW corner of the grid -c iproc index for polar grid elevation processing [i] -c 1 = NORMAL: terrain data for point at the intersection -c of ring and ray is extracted from the region -c bounded by rings and radials halfway to the -c adjacent rings and radials -c 2 = SCREEN: terrain data for point at the intersection -c of ring and ray is extracted from the region -c bounded by the current ring and the next larger -c ring, and radials halfway to the adjacent radials -c msheet index for method used to transform coordinates as [i] -c data are read from 1-deg sheet of lat-long data -c 0 = Transform 4 corners of data sheet and interpolate -c --- Use this to match results prior to TERREL v3.69 -c 1 = Transform each data point in sheet from -c (latitude,longitude) to (x,y) -c --- Preferred method -c lprev flag indicating a continuation run using previous [l] -c save file -c lxy flag indicating discrete-point processing [l] -c lintxy flag indicating if discrete points are interpolated [l] -c instead of simple peak search -c lcoast flag indicating if coastline processing is done [l] -c lblnread flag indicating if pre-processed BLN coastline [l] -c is read instead of processing raw data -c lvoidfil flag indicating if void cells are filled by [l] -c inetrpolation -c lrawecho flag indicating if raw data are to be echoed to [l] -c raw data output file -c l30sec flag indicating 30-sec terrain input data (lat,lon) [l] -c l3sec flag indicating 3-sec USGS terrain input data -c (lat,lon) [l] -c l3sec2 flag indicating USGS DEM-2 terrain input data -c (lat,lon) [l] -c lusgsglb flag indicating Lambert Azimuthal global terrain -c input data (x,y) [l] -c l7_5min flag indicating USGS 7.5 minute Quadrangle terrain [l] -c input data (UTM) -c l100met flag indicating 100-meter terrain input data (UTM) [l] -c l3cd flag indicating 3-sec binary terrain input data -c (lat,lon) [l] -c lgtopo30 flag indicating 30-sec binary global terrain input -c data (lat,lon) [l] -c lnzgnr flag indicating New Zealand generic terrain -c input data (lat,lon) [l] -c lgnr flag indicating generic terrain input data [l] -c (lat,lon OR x,y) [l] -c lsrtm1 flag indicating 1-sec SRTM terrain input data -c (lat,lon) [l] -c lsrtm3 flag indicating 3-sec SRTM terrain input data -c (lat,lon) [l] -c lcded flag indicating Canadian terrain input data [l] -c (lat,lon) -c lgeotiff flag indicating GeoTIFF terrain input data [l] -c (defined in file) -c lnuat flag indicating NUATMOS format output [l] -c lcmet flag indicating CALMET format output [l] -c lmeso flag indicating MESOPAC format output [l] -c liscc flag indicating ISC2 Discrete Cartesian Receptors [l] -c liscp flag indicating ISC2 Polar Grid Receptors [l] -c lgenr flag indicating GENERIC format output [l] -c --- Output Projection Logicals --- -c lutm flag indicating Universal Transverse Mercator [l] -c llcc flag indicating Lambert Conformal Conic [l] -c lps flag indicating Polar Stereographic [l] -c lem flag indicating Equatorial Mercator [l] -c llaza flag indicating Lambert Azimuthal Equal Area [l] -c lttm flag indicating Tangential Transverse Mercator [l] -c -c lfeet flag indicating elevation data are in FEET [l] -c lpeak flag indicating peak, not average, elevations [l] -c lpolr flag indicating use of polar grid cells [l] -c lcent flag indicating use of cell-centered reference [l] -c lpush flag indicating use of polar grid screening method [l] -c -c pmap character code for output map projection [c] -c UTM : Universal Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c TTM : Tangential Transverse Mercator -c dusgs90 default code for Datum-Region of USGS90 DB files [c] -c dusgs30 default code for Datum-Region of USGS30 DB files [c] -c darm3 default code for Datum-Region of ARM3 DB files [c] -c d3cd default code for Datum-Region of 3CD DB files [c] -c ddmdf default code for Datum-Region of DMDF DB files [c] -c dgtopo30 default code for Datum-Region of GTOPO30 DB files [c] -c dusgsla default code for Datum-Region of USGSLA DB files [c] -c dnzgen default code for Datum-Region of NZGEN DB files [c] -c dgen default code for Datum-Region of GEN DB files [c] -c dusgs30 default code for Datum-Region of USGS30 DB files [c] -c dsrtm1 default code for Datum-Region of SRTM 1sec DB files [c] -c dsrtm3 default code for Datum-Region of SRTM 3sec DB files [c] -c dcded default code for Datum-Region of CDED DB files [c] -c dgeotiff default code for Datum-Region of GeoTIFF DB files [c] -c dwvs default code for Datum-Region of WVS shore data [c] -c dwdbii default code for Datum-Region of WDBII shore data [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/coordlib.for b/CALPUFF_SRC/TERREL/coordlib.for deleted file mode 100644 index 14aa842..0000000 --- a/CALPUFF_SRC/TERREL/coordlib.for +++ /dev/null @@ -1,8190 +0,0 @@ -c---------------------------------------------------------------------- -c --- COORDLIB -- COORDINATE SYSTEM UTILITIES -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 070921 -c -c Copyright (c) 2003-2007 by TRC Environmental Corporation -c -c ----------------------------- -c --- CONTENT: -c ----------------------------- -c -c --- Interface routines -c subroutine GLOBE1 -c subroutine GLOBE -c subroutine NIMADATE -c subroutine COORDSVER -c -c --- Coordinate transformation engine -c subroutine COORDS -c (and subroutines) -c ----------------------------- -c -c --- UPDATE -c -c --- V1.98-V1.99 070921 (DGS): Modify UTM section of PJINIT in -c COORDS to fix erroneous non-zero -c false Northing when converting S. -c hemisphere locations to UTM-N -c coordinates -c Initialize full work arrays DWRK, -c DWRK2, TDUM to zero -c Initialize UTMOUT to zero -c -c --- V1.97-V1.98 060911 (DGS): Changes in COORDS that allow a higher -c level of FORTRAN error checking. -c -c --- V1.96-V1.97 060626 (DGS): Add subroutine GLOBE1 (from CALUTILS) -c after removing link to CALUTILS -c components -c -c --- V1.95-V1.96 051010 (KAM): ADD ALBERS CONICAL EQUAL AREA (ACEA) -c PROJECTION AS ONE OF THE SUPPORTED -c PROJECTIONS IN SUBROUTINE COORDS. -c -c --- V1.94-V1.95 050126 (GEM): FORBID UTM CONVERSION TO BE DONE -c FOR A NON-USGS SPHEROID. ADDED AN ERROR -c STRING TO THE COORDS CALL BETWEEN IRET -c AND DSTAMPIN. ADDED THE IRET CODE 99 -c FOR THE CASE WHEN THE FORBIDDEN UTM -c CONVERSION IS ENCOUNTERED. ALSO FIXED -c THE UTM TO UTM CASE WHEN THE OUTPUT UTM -c ZONE IS NOT SPECIFIED. USES THE INPUT -c (OR NATURAL) ZONE TO AVOID ZEROES. -C (GEM): Added IRET=98 error code for a LAZA -c projection with a datum that is not a -c sphere (e.g. not NWS-84 or ESR-S). -c (GEM): LAZA Projection: removed assignment -c of 6370 km earth radius (NWS-84 datum) -c when a value less than 6000 km is -c found. This assignment can override -c a requested radius of 6371 (ESR-S -c datum) if the NWS-84 datum is used -c with any valid projection prior to the -c request for ESR-S. LAZA(NWS-84) -c coordinate distances from the -c projection origin are about 0.016% -c smaller than LAZA(ESR-S). -c (DGS): Introduce subroutine COORDSVER -c --- V1.93-V1.94 041007 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY WHEN -c MOVING FROM ONE DATUM TO ANOTHER - A -c CONTINUATION OF THE FIX IN THE -c PREVIOUS VERSION. -c --- V1.92-V1.93 040713 (GEM): CORRECTED CASE WHERE UTM EQUATOR -c CROSSOVER WAS DONE INCORRECTLY AND -c FIXED THE CASE WHERE NWS-84 UNDER -c UTM USE DID NOT HAVE A VALID ELLIPSE -c MODEL INPUT -c --- V1.91-V1.92 031201 (GEM): CORRECTED CASE WHERE ONLY A CHANGE -C IN THE SAME PROJECTION IS DESIRED -c --- V1.9-V1.91 031017 (GEM): CORRECTED WGS 72 AND FIXED ELLIPSOID -c INITIALIZATION -c --- V1.15-V1.9 030905 (GEM): MAPLIB VERSION 1.9 030905 -c Rename MAPLIB system to COORDLIB -c --- V1.14-V1.15 030528 (DGS): MAPLIB VERSION 1.85 030528 -c --- V1.13-V1.14 030402 (DGS): MAPLIB VERSION 1.84 030402 -c --- V1.12-V1.13 030307 (DGS): MAPLIB VERSION 1.83 030307 -c NIMA Date now C*12 (MM-DD-YYYY ) -c --- V1.11-V1.12 030221 (DGS): Add routine to pass NIMA date -c --- V1.1-V1.11 030217 (DGS): Revise COORDS error message -c --- V1.0-V1.1 030117 (DGS): Add date stamp to COORDS call -c MAPLIB VERSION 1.8A 011403 -c -c---------------------------------------------------------------------- - subroutine globe1(cmapi,iutmzni,tmsfi,xlat1i,xlat2i,rlati,rloni, - & feasti,fnorti, - & cmapo,iutmzno,tmsfo,xlat1o,xlat2o,rlato,rlono, - & feasto,fnorto, - & caction,vecti,vecto) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 060626 GLOBE1 -c D. Strimaitis -c -c --- PURPOSE: Setup for coordinate transformation routine COORDS -c -c --- UPDATE -c --- V1.97(060626) (DGS) -c - Transferred from CALUTILS -c - Remove calls to DEBLNK and ALLCAP to isolate -c --- ...CALUTILS... -c --- V2.3 (051019) from V2.2 (030528) (KAM) -c - Add Albers Conical Equal Area projection -c --- V2.2 (030528) from V2.1 (030402) (DGS) -c - Screen for valid UTM zone using absolute value -c (S. Hem. zones are negative) -c --- V2.1 (030402) from V2.0 (021018) (DGS) -c - Add False Easting & Northing inputs -c -c --- INPUTS: -c CMAPI - char*8 - Map projection of input coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNI - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFI - real - Scale Factor for TM projection -c XLAT1I - real - Matching Equator-ward N.Latitude -c XLAT2I - real - Matching Pole-ward N.Latitude -c RLATI - real - Map origin N.Latitude -c RLONI - real - Map origin E.Longitude -c FEASTI - real - False Easting (km) at proj. origin -c FNORTI - real - False Northing (km) at proj. origin -c CMAPO - char*8 - Map projection of output coordinates -c LL : N.Lat., E.Long. -c UTM : Universal Transverse Mercator -c TM : Transverse Mercator -c LCC : Lambert Conformal Conic -c PS : Polar Stereographic -c EM : Equatorial Mercator -c LAZA: Lambert Azimuthal Equal Area -c ACEA: Albers Conical Equal Area -c IUTMZNO - integer - UTM zone of input coords. -c (S. hemisphere is NEGATIVE) -c TMSFO - real - Scale Factor for TM projection -c XLAT1O - real - Matching Equator-ward N.Latitude -c XLAT2O - real - Matching Pole-ward N.Latitude -c RLATO - real - Map origin N.Latitude -c RLONO - real - Map origin E.Longitude -c FEASTO - real - False Easting (km) at proj. origin -c FNORTO - real - False Northing (km) at proj. origin -c -c -c --- OUTPUT: -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c -c -c --- GLOBE1 called by: (utility) -c --- GLOBE1 calls: none -c---------------------------------------------------------------------- - - character*1 cstor1(20),cstor2(20),clc(26),cuc(26) - - real*8 vecti(9),vecto(9) - character*12 caction - character*8 cmapi,cmapo - - data clc/'i','n','x','a','e','o','u','b','c','d','f','g','h', - & 'j','k','l','m','p','q','r','s','t','v','w','y','z'/ - data cuc/'I','N','X','A','E','O','U','B','C','D','F','G','H', - & 'J','K','L','M','P','Q','R','S','T','V','W','Y','Z'/ - -c --- Set action string for conversion -c ------------------------------------ -c --- Initialize character variables for output - do i=1,20 - cstor1(i)=' ' - cstor2(i)=' ' - enddo - do i=1,8 - j=i+9 - cstor1(i)=cmapi(i:i) - cstor1(j)=cmapo(i:i) - enddo - cstor1(9)='2' -c --- Remove blank characters from string, place in storage array 2 - nlim=0 - do i=1,17 - if(cstor1(i).NE.' ') then -c --- Transfer non-blank character into array 2 - nlim=nlim+1 - cstor2(nlim)=cstor1(i) - endif - enddo -c --- Convert lower case letters to upper case - do i=1,nlim - do j=1,26 - if(cstor2(i).EQ.clc(j)) then - cstor2(i)=cuc(j) - go to 52 - endif - enddo -52 continue - enddo -c --- Transfer characters to action string - do i=1,12 - caction(i:i)=cstor2(i) - enddo - -c --- Set transformation vectors -c ------------------------------ -c --- Initialize transformation vectors - vecti(1)=999.0D0 - vecto(1)=999.0D0 - do i=2,9 - vecti(i)=0.0D0 - vecto(i)=0.0D0 - enddo - -c --- Input coords - if(cmapi.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzni).GT.0 .AND. - & IABS(iutmzni).LT.61) vecti(1)=DBLE(iutmzni) - else -c --- Matching points / origin - vecti(4)=DBLE(xlat1i) - vecti(5)=DBLE(xlat2i) - vecti(6)=DBLE(rloni) - vecti(7)=DBLE(rlati) - endif - if(cmapi.EQ.'TM') then -c --- TM Scale Factor - vecti(1)=DBLE(tmsfi) - endif - if(cmapi.EQ.'TM'.or.cmapi.EQ.'LCC'.or.cmapi.EQ.'LAZA'.or. - & cmapi.EQ.'ACEA') then - vecti(8)=DBLE(feasti) - vecti(9)=DBLE(fnorti) - endif - -c --- Output coords - if(cmapo.EQ.'UTM') then -c --- UTM zone - if(IABS(iutmzno).GT.0 .AND. - & IABS(iutmzno).LT.61) vecto(1)=DBLE(iutmzno) - else -c --- Matching points / origin - vecto(4)=DBLE(xlat1o) - vecto(5)=DBLE(xlat2o) - vecto(6)=DBLE(rlono) - vecto(7)=DBLE(rlato) - endif - if(cmapo.EQ.'TM') then -c --- TM Scale Factor - vecto(1)=DBLE(tmsfo) - endif - if(cmapo.EQ.'TM'.or.cmapo.EQ.'LCC'.or.cmapo.EQ.'LAZA'.or. - & cmapo.EQ.'ACEA') then - vecto(8)=DBLE(feasto) - vecto(9)=DBLE(fnorto) - endif - - return - end -c---------------------------------------------------------------------- - subroutine globe(iolst,caction,cdatumi,vecti,cdatumo,vecto, - & xinp4,yinp4,xout4,yout4,izone,utmhem) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 050126 GLOBE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Driver for coordinate transformation routine COORDS -c translates CALPUFF system information and provides -c fixed inputs -c -c --- UPDATE -c -c --- V1.13 (030307) to V1.95 (050126) -c - Added ESTRNG string to COORDS call for error message -c text. (GEM) -c - Added VERDOC string to COORDS call for identification -c text (DGS) -c --- V1.12 (030217) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c --- V1.1 (030117) to V1.11 (030217) (DGS) -c - Revise return error message -c --- V1.0 () to V1.1 (030117) (DGS) -c - Add date stamp to COORDS calls -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c CACTION - char*12 - Map conversion string (e.g., UTM2LCC) -c CDATUMI - char*8 - Datum-region code for input coords -c VECTI(9) - real*8 arr - Input Coordinate description vector: -c UTM zone or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.Latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c CDATUMO - char*8 - Datum-region code for output coords -c VECTO(9) - real*8 arr - Output Coordinate description vector: -c UTM zone override (ignore if 999.0D0) -c or TM Scale Factor -c Reserved -c Reserved -c Matching Equator-ward N.Latitude -c Matching Pole-ward N.latitude -c Map origin E.Longitude -c Map origin N.Latitude -c False Easting -c False Northing -c XINP4 - real*4 - Input Easting(km) (or E.Longitude deg) -c YINP4 - real*4 - Input Northing(km) (or N.Latitude deg) -c -c -c --- OUTPUT: -c XOUT4 - real*4 - Output Easting(km) (or E.Longitude deg) -c YOUT4 - real*4 - Output Northing(km) (or N.Latitude deg) -c IZONE - integer - UTM zone of output -c UTMHEM - char*4 - Hemisphere for UTM projection (N or S) -c -c --- GLOBE called by: (utility) -c --- GLOBE calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - logical ldb - - character*4 utmhem - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set debug output logical - ldb=.FALSE. - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - -c --- Convert output coordinates to single precision - xout4=SNGL(xyzio(1)) - yout4=SNGL(xyzio(2)) - utmzn=SNGL(utmout) - izone=NINT(utmzn) - -c --- Format UTM zone to CALPUFF convention - utmhem='N' - if(izone.LT.0) then - utmhem='S' - izone=-izone - endif - - if(LDB) then - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - endif - - return - end -c---------------------------------------------------------------------- - subroutine nimadate(date) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 030905 NIMADATE -c D. Strimaitis EarthTech -c -c --- PURPOSE: Passes the NIMA date from common to calling program -c -c --- UPDATE -c --- V1.13 (030307) to V1.9 (030905) (GEM) -c - Change to NIMA.CRD for MAPLIB VERSION 1.9 -c --- V1.12 (030221) to V1.13 (030307) (DGS) -c - Change NIMA date from C*10 to C*12 -c -c --- INPUTS: -c none -c -c --- OUTPUT: -c DATE - char*12 - NIMA database date -c -c --- NIMADATE called by: (utility) -c --- NIMADATE calls: none -c---------------------------------------------------------------------- - include 'nima.crd' - character*12 date - - date=daten - - return - end -c---------------------------------------------------------------------- - subroutine coordsver(iolst,verdoc) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 050126 COORDSVER -c D. Strimaitis EarthTech -c -c --- PURPOSE: Accesses the COORDS version information by making one -c generic call to COORDS (like GLOBE) -c -c --- INPUTS: -c IOLST - integer - Unit number for list file output -c -c --- OUTPUT: -c VERDOC - char*50 - COORDS version information -c -c --- COORDSVER called by: (utility) -c --- COORDSVER calls: COORDS -c---------------------------------------------------------------------- - parameter (nc = 3, ndat = 6) - - real*8 vecti(9),vecto(9),xyzin(nc),xyzio(nc),utmout - real*8 xdatum(ndat) - - character*10 iunit - character*8 cdatumi,cdatumo - character*12 caction - character*12 dstamp - character*50 estrng, verdoc - - data iunit/'KILOMETERS'/ - data imode/0/, iprec/1/, nvec/9/ - data xdatum/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecti/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - data vecto/0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/ - -c --- Set dstamp to blank string to invoke default in COORDS - dstamp=' ' - -c --- Set up converter for a null translation of lat/lon - xinp4= -90.0 - yinp4=45.0 - caction='LL2LL ' - cdatumi='WGS-84 ' - cdatumo='WGS-84 ' - -c --- Convert input coordinates to double precision - xyzin(1)=DBLE(xinp4) - xyzin(2)=DBLE(yinp4) - - mcp=nc - mdat=ndat - xyzin(3) = 1.0D0 - xyzio(3) = 1.0D0 - - call COORDS(iolst,iunit,imode,caction,cdatumi,cdatumo,iprec, - & vecti,vecto,nvec,xyzin,mcp,xdatum,mdat, - & xyzio,utmout,iret,estrng,dstamp,verdoc) - - IF(IRET.NE.0)THEN - write(iolst,*)'GLOBE: COORDS FAILED - ',estrng - write(iolst,*) - write(iolst,*)'COORDS arguments -----------' - write(iolst,*)'iunit = ',iunit - write(iolst,*)'imode = ',imode - write(iolst,*)'caction = ',caction - write(iolst,*)'cdatumi = ',cdatumi - write(iolst,*)'cdatumo = ',cdatumo - write(iolst,*)'iprec = ',iprec - write(iolst,*)'vecti = ',(vecti(j),j=1,nvec) - write(iolst,*)'vecto = ',(vecto(j),j=1,nvec) - write(iolst,*)'xyzin = ',(xyzin(j),j=1,mcp) - write(iolst,*)'xyzio = ',(xyzio(j),j=1,mcp) - write(iolst,*)'xdatum = ',(xdatum(j),j=1,mdat) - write(iolst,*)'utmout = ',utmout - write(iolst,*)'iret = ',iret - write(iolst,*)'dstamp = ',dstamp - write(iolst,*)'verdoc = ',verdoc - write(iolst,*) - write(*,*) - write(*,*)'GLOBE: COORDS FAILED - ',estrng - stop 'Halted in GLOBE - see list file.' - endif - - return - end -C---------------------------------------------------------------------- - SUBROUTINE COORDS(IO,IUNIT,IMODE,IPROJ,IDATMI,IDATMO,IPREC, - 1 CVECTI,CVECTO,NVEC,XYZIN,NC,XDATUM,NDAT,XYZIO,UTMOUT,IRET, - 2 ESTRNG,DSTAMPIN,VERDOC) -C---------------------------------------------------------------------- -C -C --- COORDLIB Version: 1.99 Level: 070921 COORDS -C -C --- Program was written by Gary Moore -C -C --- PROGRAM NOTES FOLLOW: -C -C --- Version 1.1 argument change -C -C --- IDATMI(O) - FULL CHARACTER STRING FOR GUI SUPPLIED (IRANK REMOVED) -C --- XDATUM,NDAT - PASS FULL ARRAY OF USER DEFINED DATUM INFO (DP) -C -C --- (1) - MAJOR RADIUS -C --- (2) - INVERSE FLATTENING -C --- (3) - ECCENTRICITY SQUARED -C --- (4) - DX -C --- (5) - DY -C --- (6) - DZ -C -C --- Version 1.2 argument change -C -C --- UTMOUT a double precision output UTM zone is used in the convert -C --- program as output to tell what UTM each point has been translated -C --- TO. -C -C --- Version 1.3 changes -C -C --- Addition of LL2ZONE subroutine for extracting the natural UTM zone -C --- when going FROM LCC TO UTMS - otherwise there is no way of knowing -C --- added extra projection calls in places to retrieve the geodetic -C --- coordinates. -C -C --- Version 1.4 changes -C -C --- Fixed the use of the FROM ellipsoid model for the final projection -C --- and changed to it to the TO ellipsoid model. Fixed the DAT2DAT and -C --- DATSHFT routines so that the proper reverse transformation proceedure -C --- is done (note - changed presentation figures) -C -C --- Version 1.5 changes -C -C --- Added more options for transformation - PS = Polar Stereographic -C --- and EM = Equatorial Mercator. Note - both of these will generally -C --- be used on a spherical earth represented by Datum 220, but can -C --- be projected to an ellipical surface - unlike the azimuthal -C --- projections that can only be done on a sphere. The LAZA was hardwired -C --- to do only a sphere with a radius of 6370 km (before it could float -C --- incorrectly). -C -C --- The block data variables were modified to accomodate the new NIMA -C --- data base. Block data call was moved to the INIT subroutine which -C --- sets up variables for COORDS and outputs several arrays for use with -C --- GUI's -C -C --- The NIMA data base use resulted in a considerable set of code -C --- revisions including (1) 8 Character Datum ID use for selecting the -C --- Datum (2) use of a 21 character ellipsoid string check (3) use of -C --- a revised 118 character region string. -C -C --- An INCLUDE file 'NIMA.CRD' was used to insert the NIMA common -C --- blocks into routines. -C -C --- version 1.6 changes -C -C --- Made several upgrades including: -C -C --- (1) adds a date check to make sure the block data is the right -C --- version. This requires adding an extra argument to COORDS -C -C --- (2) adds the Tranverse Mercator projection (TM) -C -C --- (3) add error codes for projections -C -C --- (4) allows the user input 'to' (output) utm zone to work -c -c --- Changed the ordering of CVECTI/CVECTO elements 4-7 to be consistent -c --- across all transformations, rather than following the USGS element -c --- definitions. Lat/Lon of origin of EM and PS projections is accepted -c --- and the corresponding false Easting/Northing values are computed -c --- and applied. The elements of the transformation vector are: -c (1) UTM Zone (for UTM), or Scale Factor (for TM) -c (2) radius of major axis of earth - (used for Azimuthal projections) -c (3) not currently used -c (4) True N. Latitude #1 (where applicable) -c (5) True N. Latitude #2 (where applicable) -c (6) E. Longitude of projection origin (where applicable) -c (7) N. Latitude of projection origin (where applicable) -c (8) False Easting (where applicable) -c (9) False Northing (where applicable) -C -C --- Version 1.7 changes -C -C --- Moved false northing determination of TO projections to a point -C --- where they occur AFTER a datum shift -C -C --- Added dummy arrays to keep longitude/latitudes from being written -C --- over. -C -C --- Removed writes to standard output so DLL's can be directly made -C -C --- Removed external date check changes to an internal one -C -C --- Further revisions to PS and EM cases the user cannot input a -C --- false northing and easting - and error is returned if they do -C -C --- Fixed PS2PS and EM2EM cases -C -C --- Version 1.8 changes -C -C --- Dealt with a major issue of projection initialization that is done -C --- with INZONE. Initialization is done when the UTM zone changes. Software -C --- was added to make sure this happens. -C -C --- The PS/EM projections had consistency problems when the offset is -C --- calculated with a 0.0 rather than a true longitude - the true longitude -C --- was used. -C -C --- An error in the PS/EM projection was corrected when the input -C --- parameter vector was found to be using an incorrect latitude of -C --- true scale. -C -C --- Error warnings were included to make sure that no false eastings -C --- or northings are input by the user of the PS and EM projections. -C -C --- Version 1.81 changes -C -C --- Modified USGS routines to force initialization every time by -C --- setting the switch array to zero for all projections on each call -C -C --- Added DGS approach to checking date stamp using DATEN and DATEB -C -C --- Added include for the block data (blockdat.crd) -C -C --- Version 1.82 changes -C -C --- Fixed the TM insertion of scaling factor - moved it from the USGS -C --- Element # 3 (CVECT element #4) to the CVECT element #1 normally -C --- (UTM ZONE) - the UTM zone is now set to 999. There is a mapping -C --- of the UTM ZONE to the USGS element 3 and a resetting of the -C --- UTM zone to 999 before entering the USGS subroutines. -C -C --- Scale false Easting/Northing to METERS -C --- Correct false Easting/Northing assignments after processing -C -C --- Convert main program to the CALPUFF Version/Level designation -C --- where Level is YYMMDD -C -C --- Added date-stamp argument DSTAMPIN to re-assign DSTAMP if the -C --- argument is non-blank -C -C --- Version 1.83 changes -C -C --- NIMA date variables changed from C*10 to C*12 -C --- DAT2DAT does not transform to/from WGS84 if input/output datum -C is for a sphere -C -C --- Version 1.84 changes -C -C --- Recast UTM-to-UTM conversions to properly handle zone overrides -C by adding IOVUTM: -C 0) finds native output UTM zone for output UTMs -C 1) no change to input coordinates when inzone=iozone -C 2) uses zone override for output UTMs -C -C --- Version 1.85 Level: 030528 changes -C -C --- Fix Polar Stereographic (PS) dummy array initialization which -C did not include the Earth Radius for spherical datum, and clarify -C code (remove unneeded dummy arrays) -c -c --- Take absolute value of UTM zone when testing for valid values -c (UTM is negative in S. Hemisphere) -c -C -C --- Version 1.9 Level: 030905 changes -C -C --- NEW BLOCK DATA!!!! The new block data was created by version 1.3 -C of BUILD.FOR which utilizes new data sources for DATUMs. These new -C files include: -C -C --- (1) New HEADER.TXT which defines two new global datum and removes -C one spherical earth datum (based on NAD 27). The two new datums -C are functionally equivalent and they serve as a placeholder to -C assure users they have the proper DATUM -C -C --- (2) New Datum data files GEOTRANS_02-21-2003.dat and ellips.dat -C These new data files are required since the DATUM listing text -C file produced by NIMA is not available for the latest changes -C in datum definitions. Instead the user is referred to the data -C files used by the NIMA GEOTRANS geocalculator. The ellips.dat -C file contains the parameters defining 23 ellipsoid models used -C to define the datums. These are matched by two character codes -C to the differences in geocentric coordinates of each datum -C relative to WGS-84 found in GEOTRANS_02-21-2003. The -C GEOTRANS_02-21-2003.dat file contains five new local datums - -C all which are Hawaian Island local variants. -C -C --- (3) NEWDATUM.TXT is a new file that has been added to allow insertion -C of new datums into the proper place in the master list of local -C datums. This file also allows one to add descriptive text (3 lines) -C describing the valid region or conditions of the datum. -C -C --- (4) Introduced the WGS72 global data and added formulas -C to deal with the coordinate transformations between WGS84. -C -C --- Version 1.91 Level: 031017 changes -C -C --- Made a change to TPARIN and TPARIO - Placed ellipsoid -C --- parameters in locations 14 (major radius) and 15 (eccentricity -C --- squared). Also forces the first pass initialization of GZTP0 -C --- to use the parameters rather than default to a CLARKE 1866. -C --- Also fixed a typo so that the USGS WGS 72 ellipsoid model in -C --- the USGS programs is used. -C -C --- Version 1.93 Level: 041307 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere). Also fixed a problem with NWS-84 and -C --- UTM combination where there is no difference in the results when -C --- going to and from this DATUM from other DATUMS. For UTM the 6371 km -C --- spherical ellipse model must be used when the 6370Km sphere is used -C --- because of USGS program input array conflicts. -C -C --- Version 1.94 Level: 041007 changes -C -C --- Made a change to UTM to fix the equator problem (going from southern -C --- to northern hemisphere) when going from one DATUM to another. This -C --- is a continuation of the change made in version 1.93. -C -C --- Version 1.95 Level: 050126 changes -C -C --- Made it impossible to use a non-USGS earth spheroid when using UTM's -C --- Essentially reversed an attempted fix under version 1.93. -C --- EMG-96 is aliased to GRS 80 ellipsoid model. -C -C--------------- -C *** ALERT *** -C--------------- -C - COORDS versions prior to 1.93 used the Clark 1866 spheroid for -C - UTM conversions when a datum with a non-USGS earth spheroid is -C - specified. An example of this is the NWS-84 datum. -C - The UTM/NWS-84 fix implemented in version 1.93 and present in -C - version 1.94 whould have used a mixture of ESRI and Clarke 1866 -C - owing to the fix being applied only to one side of the -C - transformation. One should never mix versions 1.93 and 1.94 -C - with prior versions. ONE SHOULD NOT USE VERSIONS 1.93 and 1.94 -C - owing to the inconsistent nature of the transformation!!!! -C -C --- Added another IRET error code (IRET = 99) for this case. Added an -C --- error string (50 characters) between IRET and DSTAMPIN to the call -C --- to COORDS to return the error message text. -C -C --- Added yet another IRET error code (IRET = 98) for the case when -C --- one tries to use LAZA with a datum that is not a sphere (e.g. not -C --- (NWS-84 or ESR-S). -c -c --- Added VERDOC string to argument list for COORDS identification -c --- text. -c -c --- LAZA Projection: removed assignment of 6370 km earth radius -c --- (NWS-84 datum) when a value less than 6000 km is found. This -c --- assignment can override a requested radius of 6371 (ESR-S datum) -c --- if the NWS-84 datum is used with any valid projection prior to the -c --- request for ESR-S. LAZA(NWS-84) coordinate distances from the -c --- projection origin are about 0.016% smaller than LAZA(ESR-S). -c --- This undoes a change made in version 1.5. -C -C --- Fixed the case for a UTM to UTM transformation when the output UTM -C --- zone is not specified by the user. The UTM zone is set to the -C --- input UTM zone (or the natural UTM if it estimated) in order that -C --- the proper UTM zone is presented in the output rather than zero. -C --- This fix addresses a situation that arises in the coordinate -C --- conversion GUI. -C -C --- Version 1.96 Level: 051010 changes -C -C --- Add Albers Conical Equal Area projection as one of the supported -C --- projections. -C -C --- Version 1.98 Level: 060911 changes -C -c --- Changes that allow a higher level of FORTRAN error checking: -c --- Replace the constant 4 with an I*4 variable (IUNIT4) in -c calls to GTPZ0 from COORDS (to/from lat-lon). -c --- Set GTPZ0 argument LENGTH=100 (for direct access files that -c are not used). -c --- Replace constant 0 with I*4 variable (INSPHZERO) in argument 1 -c of SPHDZ0 call in GTPZ0 -c --- Change FUNCTION ADJLZ0 argument name and reassign to LON within -c (sub is called with a computed argument that should not be -c changed within subroutine) -c --- SAVE9 is undefined first time in PJINIT; set to zero in DATA - -C -C --- Version 1.99 Level: 070921 changes -C -c --- Modify UTM section of PJINIT to fix erroneous non-zero false -c --- Northing when converting S. hemisphere locations to UTM-N -c --- coordinates. Main subroutine also changed to remove patches -c --- that had corrected this problem when converting from lat/lon to -c --- UTM-N. The bug only affected conversions to N. hemisphere UTM -c --- coordinates when the location was in the S. hemisphere. The -c --- coordinates returned were actually in UTM-S. -c -c --- Initialize full real*8 work arrays DWRK, DWRK2, TDUM to zero. -c -c --- Initialize UTMOUT to zero. -C -C---------------------------------------------------------------------- -C -C --- PROGRAM FUNCTION: -C -C --- THIS IS THE MAIN DRIVER PROGRAM FOR THE MOLODENSKY DATUM -C --- CONVERSION AND THE USGS GCTP PROJECTION CONVERSION SOFTWARE. -C -C --- INPUT VARIABLES -C -C --- IO = LOGICAL FORTRAN UNIT FOR OUTPUT -C --- IUNIT = 10 CHARACTER UNITS STRING - 'METERS ' OR 'KILOMETERS' -C --- IMODE = 0 - USES DATA IN BLOCK DATA -C --- 1 - USER DEFINED DATUM INFORMATION (FROM) -C --- 2 - USER DEFINED DATUM INFORMATION (TO) -C --- 3 - USER DEFINED DATUM INFORMATION (FROM-TO) -C --- IPROJ = 12 CHARACTER PROJECTION ACTION STRING EG 'LL2UTM ' -C --- IDATMI = 8 CHARACTER INPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IDATMO = 8 CHARACTER OUTPUT DATUM ID STRING -C --- PPP-GGXX WHERE PPP IS THE PRIMARY ID, GG IS THE -C --- GEOGRAPHIC REGION INDICATOR AND XX ARE PRESENLTY BLANK -C --- IPREC = 0 - SINGLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- 1 - DOUBLE PRECISION COORDINATES FOR XYZIN(O),CVECTI(O) -C --- CVECTI = 1-D VECTOR OF INPUT PROJECTION PARAMETERS (DP) -C --- CVECTO = 1-D VECTOR OF OUTPUT PROJECTION PARAMETERS (DP) -C --- NVEC = NUMBER OF PARAMETERS IN THE CVECT ARRAYS -C --- XYZIN = 1-D ARRAY OF INPUT COORDINATES (X,Y,Z) (DP) -C --- NC = NUMBER OF VALID ELEMENTS IN XYZIN(O) (2 OR 3) (X,Y) OR (X,Y,Z) -C --- XDATUM = 1-D VECTOR OF DATUM DEFINITION PARAMETERS -C --- NDAT = NUMBER OF DATUM DEFINITION PARAMETERS (NORMALLY = 6) -C --- DSTAMPIN = 12 CHARACTER DATE STRING (MM-DD-YYYY ) FOR CHECKING -C --- NIMA PARAMS AND BLOCKDATA (Leave blank for default) - -C -C --- OUTPUT VARIABLES -C -C --- XYZIO = 1-D ARRAY OF OUTPUT COORDINATES (X,Y,Z) (DP) -C --- UTMOUT = UTM ZONE OF THE OUTPUT TO TRANSFORMATION (DP) -C --- IRET = RETURN FLAG (0) - SUCCESSFUL -C --- ESTRNG = 50 CHARACTER STRNG CONTAINING ERROR MESSAGE -C --- VERDOC = 50 character string containing COORDS version and level -C -C --- THIS PROGRAM CALLS: -C -C --- GTPZ0 - USGS GCTP MAIN SUBROUTINE -C --- ERRFLG - ERROR PRINTS FOR GTPZ0 -C --- DAT2DAT - MOLODENSKY DATUM SHIFT -C -C --- All NIMA BASED COMMON BLOCKS AND SUPPORTIVE DECLARATIVE -C --- STATEMENTS HAVE BEEN LUMPED INTO A SINGLE INCLUDE FILE -C --- CALLED 'NIMA.CRD' -C -c---------------------------------------------------------------------- -C - PARAMETER (MP = 64) -C - CHARACTER*128 FN27,FN83 - CHARACTER*50 IERR(12) - CHARACTER*50 ESTRNG, VERDOC - CHARACTER*12 JPROJ(MP),IPROJ - CHARACTER*8 IDATMI,IDATMO - CHARACTER*7 IPATH1,IPATH2 - CHARACTER*10 IUNIT - CHARACTER*21 ELIPSI,ELIPSO - CHARACTER*52 IDSTRNG - CHARACTER*12 DSTAMPIN -C - INTEGER*4 INSYS,INZONE,INUNIT,INSPH,IPR,JPR,LEMSG,LPARM,LN27, - 1 LN83,LENGTH,IOSYS,IOZONE,IOUNIT,IFLG - -c --- V1.98 (060911) - INTEGER*4 IUNIT4 - - INTEGER*4 SYSFLG(2,MP) - Integer*4 irnkin,irnkio - Integer*4 io,lpr, iret -C - Real*4 xdum,dxshft,dyshft,dzshft -C - REAL*8 CRDIN(2),TPARIN(15),CRDIO(2),TPARIO(15),DWRK(15), - 1 DWRK2(15) - REAL*8 XYZIN(NC), XYZIO(NC), CVECTI(NVEC), CVECTO(NVEC) - REAL*8 TDUM(15),XDATUM(NDAT) - Real*8 xlonin,xlatin,xlonio,xlatio - Real*8 flonin,flatin,flonio,flatio - Real*8 dd,dms,drad,dflt - Real*8 utmout - Real*8 TCRDIN(2),TCRDIO(2) -C -C --- Include the NIMA database - INCLUDE 'nima.crd' -C - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -C -C --- DEFAULT CONTROL SETTINGS AND ALLOWED PROJECTIONS - DATA IPATH1,IPATH2 /'NAD27SP','NAD83SP'/ - DATA LEMSG,LPARM,LN27,LN83 /16,17,18,19/ -c DATA IPR,JPR /0,0/ - DATA IPR,JPR /1,1/ - DATA JPROJ/ - * 'LL2LL ','LL2UTM ','LL2LCC ','LL2LAZA ', - * 'LL2PS ','LL2EM ','LL2TM ','LL2ACEA ', - * 'UTM2LL ','UTM2UTM ','UTM2LCC ','UTM2LAZA ', - * 'UTM2PS ','UTM2EM ','UTM2TM ','UTM2ACEA ', - * 'LCC2LL ','LCC2UTM ','LCC2LCC ','LCC2LAZA ', - * 'LCC2PS ','LCC2EM ','LCC2TM ','LCC2ACEA ', - * 'LAZA2LL ','LAZA2UTM ','LAZA2LCC ','LAZA2LAZA ', - * 'LAZA2PS ','LAZA2EM ','LAZA2TM ','LAZA2ACEA ', - * 'PS2LL ','PS2UTM ','PS2LCC ','PS2LAZA ', - * 'PS2PS ','PS2EM ','PS2TM ','PS2ACEA ', - * 'EM2LL ','EM2UTM ','EM2LCC ','EM2LAZA ', - * 'EM2PS ','EM2EM ','EM2TM ','EM2ACEA ', - * 'TM2LL ','TM2UTM ','TM2LCC ','TM2LAZA ', - * 'TM2PS ','TM2EM ','TM2TM ','TM2ACEA ', - * 'ACEA2LL ','ACEA2UTM ','ACEA2LCC ','ACEA2LAZA ', - * 'ACEA2PS ','ACEA2EM ','ACEA2TM ','ACEA2ACEA '/ - DATA SYSFLG/0,0,0,1,0,4,0,11,0,6,0,5,0,9,0,3, - * 1,0,1,1,1,4,1,11,1,6,1,5,1,9,1,3, - * 4,0,4,1,4,4,4,11,4,6,4,5,4,9,4,3, - * 11,0,11,1,11,4,11,11,11,6,11,5,11,9,11,3, - * 6,0,6,1,6,4,6,11,6,6,6,5,6,9,6,3, - * 5,0,5,1,5,4,5,11,5,6,5,5,5,9,5,3, - * 9,0,9,1,9,4,9,11,9,6,9,5,9,9,9,3, - * 3,0,3,1,3,4,3,11,3,6,3,5,3,9,3,3/ - DATA TDUM /15*1.0D0/ -C - FN27(1:7) = IPATH1 - FN83(1:7) = IPATH2 - LPR = IO - -c --- V1.98 (060911) -c --- Set units variable for steps with conversion to/from lat-lon - iunit4=4 -c --- Define record-length argument for GTPZ0 - length=100 - -c---------------------------------------------------------------------- -c --- Set the COORDS version and level string - - verdoc=' --- COORDLIB Version: 1.99 Level: 070921 ' - -c---------------------------------------------------------------------- - -C -C --- SET IRET TO ZERO - IRET = 0 -C -C --- PROPERLY INITIALIZE ESTRNG to BLANKS (NOT NULLS) - DO K = 1,50 - ESTRNG(K:K) = ' ' - ENDDO -C -C --- SPECIAL CHECK FOR NWS-84 SPHERE JUST IN CASE A LAZA PROJECTION -C --- IS DESIRED. A SPHERE FLAG IS INITIALIZED HERE (TO ZERO). IT IS -C --- SET TO 1 IF THE ELLIPSOID MODEL IS A SPHERE. - IBALLI = 0 - IBALLO = 0 - IF(IDATMI.EQ.'NWS-84')IBALLI = 1 - IF(IDATMO.EQ.'NWS-84')IBALLO = 1 -C -C --- Establish the date-stamp value - if(dstampin(1:1).NE.' ') dstamp=dstampin -C -C --- NOW FINDS OUT IF THE USER EXPECTED DATE STRING MATCHES THE -C --- ONE FOUND IN THE NIMA TEXT FILE - IF(DSTAMP.NE.DATEN)THEN - IRET = 10 - IERR(1)='DATE STAMP FAILURE FOR NIMA.CRD! ' - ESTRNG = IERR(1) - RETURN - ENDIF -C -C --- NOW FINDS OUT IF WE HAVE THE RIGHT BLOCK DATA FILE - IF(DSTAMP.NE.DATEB)THEN - IRET = 20 - IERR(2)='DATE STAMP FAILURE FOR BLOCKDATA! ' - ESTRNG = IERR(2) - RETURN - ENDIF -C -C --- IMMEDIATELY FINDS THE PROPER DATUM FROM THE PRESTORED SET - IRNKIN = 0 - IRNKIO = 0 - IF(IMODE.EQ.0)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 222 - ENDIF - ENDDO -222 CONTINUE - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 232 - ENDIF - ENDDO -232 CONTINUE - ENDIF - IF(IMODE.EQ.1)THEN - DO K = 1,ND - IF(IDATMO.EQ.DATCOD(K))THEN - IRNKIO = K - GO TO 332 - ENDIF - ENDDO -332 CONTINUE - ENDIF - IF(IMODE.EQ.2)THEN - DO K = 1,ND - IF(IDATMI.EQ.DATCOD(K))THEN - IRNKIN = K - GO TO 322 - ENDIF - ENDDO -322 CONTINUE - ENDIF -C -C --- IMMEDIATE CHECK FOR ILLEGAL DATUM POINTER - IF(IMODE.EQ.0)THEN - IF(IRNKIN.LT.1.OR.IRNKIN.GT.ND)THEN - IRET = 60 - IERR(6)='INPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(6) - RETURN - ENDIF - IF(IRNKIO.LT.1.OR.IRNKIO.GT.ND)THEN - IRET = 70 - IERR(7)='OUTPUT DATUM POINTER IS ILLEGAL! ' - ESTRNG = IERR(7) - RETURN - ENDIF - ENDIF -C -C --- CHECKS OPERATION MODE - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C --- NOW ESTABLISHES THE TRANSFORMATION TYPE - DO K = 1,MP - IF(JPROJ(K).EQ.IPROJ)THEN - INSYS = SYSFLG(1,K) - IOSYS = SYSFLG(2,K) - GOTO 101 - ENDIF - ENDDO - IRET = 40 - IERR(4) = 'THE PROJECTION PAIR IS UNDEFINED OR NOT ALLOWED! ' - ESTRNG = IERR(4) - RETURN - 101 CONTINUE -C -C --- NOW CHECKS FOR IMPROPER EASTING AND NORTHING OFFSETS FOR PS AND EM -C --- PROJECTIONS - IF((INSYS.EQ.5.OR.INSYS.EQ.6).AND.CVECTI(9).NE.0.0D+00)THEN - IRET = 80 - IERR(8) = 'ILLEGAL INPUT OF (FROM) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(8) - ENDIF - IF((IOSYS.EQ.5.OR.IOSYS.EQ.6).AND.CVECTO(9).NE.0.0D+00)THEN - IRET = 90 - IERR(9) = 'ILLEGAL INPUT OF (TO) EASTING/NORTHING OFFSET ' - ESTRNG = IERR(9) - ENDIF -C -C --- NOW ESTABLISHES THE PROPER UNITS -C --- LL = DECIMAL DEGREES -C --- UTM,LCC,LAZA,PS,MC,ACEA = METERS OR KILOMETERS - XMULTI = 1.0 - IF(INSYS.EQ.0)THEN - INUNIT = 4 - ELSE - INUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTI = 1000.0 - ELSE - XMULTI = 1.0 - ENDIF - ENDIF - XMULTO = 1.0 - IF(IOSYS.EQ.0)THEN - IOUNIT = 4 - ELSE - IOUNIT = 2 - IF(IUNIT.EQ.'KILOMETERS ')THEN - XMULTO = 0.001 - ELSE - XMULTO = 1.0 - ENDIF - ENDIF -C -C --- SINGLE PRECISION CHECK - SINGLE PRECISION IS NOT YET SUPPORTED - IF(IPREC.EQ.0)THEN - IRET = 50 - IERR(5) = 'NICE TRY - SINGLE PRECISION COORDS ARE ILLEGAL! ' - ESTRNG = IERR(5) - RETURN - ENDIF -c -c --- Store the ELon and NLat of the projection origin (DD) - FLONIN=CVECTI(6) - FLONIO=CVECTO(6) - FLATIN=CVECTI(7) - FLATIO=CVECTO(7) -C -C --- FILLS THE INPUT COORDINATES ARRAY CRDIN AND THE TPARIN ARRAY - CRDIN(1) = XYZIN(1)*DBLE(XMULTI) - CRDIN(2) = XYZIN(2)*DBLE(XMULTI) - IF(NVEC.GT.16)THEN - IRET = 60 - IERR(6) = 'TRUNCATED PROJECTION PARAMETER VECTOR! ' - ESTRNG = IERR(6) - NVEC = 16 - ENDIF - DO K = 1,15 - TPARIN(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTI(1)) - INZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIN(K-1) = CVECTI(K)*DBLE(XMULTI) - ELSE -C --- ASSIGN DIRECTLY FROM INPUT VECTOR - TPARIN(K-1) = CVECTI(K) - ENDIF - ENDDO -C -C --- FILLS THE TPARIO ARRAY (ALSO NEEDED) - DO K = 1,15 - TPARIO(K) = 0.0D+00 - ENDDO - XDUM = SNGL(CVECTO(1)) - IOZONE = NINT(XDUM) - DO K = 2,NVEC - IF(K.EQ.8 .OR. K.EQ.9) THEN -C --- SCALE FALSE EASTING/NORTHING TO METERS - TPARIO(K-1) = CVECTO(K)/DBLE(XMULTO) - ELSE -C --- ASSIGN DIRECTLY FROM OUTPUT VECTOR - TPARIO(K-1) = CVECTO(K) - ENDIF - ENDDO - -c --- Initialize full work arrays - do k = 1,15 - dwrk(k) = 0.0D+00 - dwrk2(k) = 0.0D+00 - tdum(k) = 0.0D+00 - enddo - -c --- Initialize output variable UTMOUT - utmout = 0.0D+00 -C -C --- Now converts the TPARIN, TPARIO FROM DD to DDDMMMSSS.SS -C --- UTM's - IF(INSYS.EQ.1)THEN - DD = TPARIN(1) - CALL DD2DMS(DD,DMS) - TPARIN(1) = DMS - DD = TPARIN(2) - CALL DD2DMS(DD,DMS) - TPARIN(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(INSYS.EQ.4.OR.INSYS.EQ.3)THEN - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(3) = DMS - DD = TPARIN(4) - CALL DD2DMS(DD,DMS) - TPARIN(4) = DMS - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- EM & PS's (Note shift of arguments) - IF(INSYS.EQ.5.OR.INSYS.EQ.6)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(3) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - TPARIN(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(INSYS.EQ.9)THEN - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS -C --- NOW SWAP FROM CVECTI ELEMENT 1 TO USGS ELEMENT 3 - TPARIN(3) = CVECTI(1) - INZONE = 999 - ENDIF -C --- LAZA's - IF(INSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIN(1).LT.6000000.0D+00)THEN -C TPARIN(1) = 6370000.0D+00 -C ENDIF - DD = TPARIN(5) - CALL DD2DMS(DD,DMS) - TPARIN(5) = DMS - DD = TPARIN(6) - CALL DD2DMS(DD,DMS) - TPARIN(6) = DMS - ENDIF -C --- UTM's - IF(IOSYS.EQ.1)THEN - DD = TPARIO(1) - CALL DD2DMS(DD,DMS) - TPARIO(1) = DMS - DD = TPARIO(2) - CALL DD2DMS(DD,DMS) - TPARIO(2) = DMS - ENDIF -C --- LCC's and ACEA's - IF(IOSYS.EQ.4.OR.IOSYS.EQ.3)THEN - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(3) = DMS - DD = TPARIO(4) - CALL DD2DMS(DD,DMS) - TPARIO(4) = DMS - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C --- EM AND PS's (Note shift of arguments) - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(3) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - TPARIO(3) = 0.0D0 - ENDIF -C --- TRANSVERSE MERCATOR (TM) - IF(IOSYS.EQ.9)THEN - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS -C --- NOW SWAP FROM CVECTO ELEMENT 1 TO USGS ELEMENT 3 - TPARIO(3) = CVECTO(1) - IOZONE = 999 - ENDIF -C --- LAZA's - IF(IOSYS.EQ.11)THEN -C --- MAKES SURE A LEGAL SPHERE RADIUS IS PRESENT -C IF(TPARIO(1).LT.6000000.0D+00)THEN -C TPARIO(1) = 6370000.0D+00 -C ENDIF - DD = TPARIO(5) - CALL DD2DMS(DD,DMS) - TPARIO(5) = DMS - DD = TPARIO(6) - CALL DD2DMS(DD,DMS) - TPARIO(6) = DMS - ENDIF -C -C --- NOW ESTABLISHES THE PROPER ELLIPSOID MODEL PARAMETERS - IF(IMODE.EQ.0.OR.IMODE.EQ.2)THEN - IDSTRNG = DATUM(DATTYP(IRNKIN)) - ELIPSI = IDSTRNG(32:52) - INSPH = -1 -c -c --- Special alias for EMG 96 - if(elipsi.eq.'EMG 96 ')INSPH = 8 - IF(ELIPSI.EQ.'Clarke 1866 ')INSPH = 0 - IF(ELIPSI.EQ.'Clarke 1880 ')INSPH = 1 - IF(ELIPSI.EQ.'Bessel 1841 ')INSPH = 2 - IF(ELIPSI.EQ.'International 1967 ')INSPH = 3 - IF(ELIPSI.EQ.'International 1909 ')INSPH = 4 - IF(ELIPSI.EQ.'WGS 72 ')INSPH = 5 - IF(ELIPSI.EQ.'Everest (1830) ')INSPH = 6 - IF(ELIPSI.EQ.'WGS 66 ')INSPH = 7 - IF(ELIPSI.EQ.'GRS 80 ')INSPH = 8 - IF(ELIPSI.EQ.'Airy ')INSPH = 9 - IF(ELIPSI.EQ.'Everest (1956) ')INSPH = 10 - IF(ELIPSI.EQ.'Modified Airy ')INSPH = 11 - IF(ELIPSI.EQ.'WGS 84 ')INSPH = 12 - IF(ELIPSI.EQ.'Modified Fischer 1960')INSPH = 13 - IF(ELIPSI.EQ.'Australian National ')INSPH = 14 - IF(ELIPSI.EQ.'Krassovsky 1940 ')INSPH = 15 - IF(ELIPSI.EQ.'Hough ')INSPH = 16 - IF(ELIPSI.EQ.'Mercury 1960 ')INSPH = 17 - IF(ELIPSI.EQ.'Modified Mercury 1968')INSPH = 18 - IF(ELIPSI.EQ.'Normal Sphere (6371) ')INSPH = 19 - IF(ELIPSI.EQ.'International 1924 ')INSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(INSPH.LT.0.AND.INSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmi -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(INSPH.EQ.19)IBALLI = 1 - IF(INSYS.EQ.11.AND.IBALLI.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmi -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF - IF(IMODE.EQ.0.OR.IMODE.EQ.1)THEN - IDSTRNG = DATUM(DATTYP(IRNKIO)) - ELIPSO = IDSTRNG(32:52) - IOSPH = -1 -c -c --- Special alias for EMG 96 - if(elipso.eq.'EMG 96 ')IOSPH = 8 - IF(ELIPSO.EQ.'Clarke 1866 ')IOSPH = 0 - IF(ELIPSO.EQ.'Clarke 1880 ')IOSPH = 1 - IF(ELIPSO.EQ.'Bessel 1841 ')IOSPH = 2 - IF(ELIPSO.EQ.'International 1967 ')IOSPH = 3 - IF(ELIPSO.EQ.'International 1909 ')IOSPH = 4 - IF(ELIPSO.EQ.'WGS 72 ')IOSPH = 5 - IF(ELIPSO.EQ.'Everest (1830) ')IOSPH = 6 - IF(ELIPSO.EQ.'WGS 66 ')IOSPH = 7 - IF(ELIPSO.EQ.'GRS 80 ')IOSPH = 8 - IF(ELIPSO.EQ.'Airy ')IOSPH = 9 - IF(ELIPSO.EQ.'Everest (1956) ')IOSPH = 10 - IF(ELIPSO.EQ.'Modified Airy ')IOSPH = 11 - IF(ELIPSO.EQ.'WGS 84 ')IOSPH = 12 - IF(ELIPSO.EQ.'Modified Fischer 1960')IOSPH = 13 - IF(ELIPSO.EQ.'Australian National ')IOSPH = 14 - IF(ELIPSO.EQ.'Krassovsky 1940 ')IOSPH = 15 - IF(ELIPSO.EQ.'Hough ')IOSPH = 16 - IF(ELIPSO.EQ.'Mercury 1960 ')IOSPH = 17 - IF(ELIPSO.EQ.'Modified Mercury 1968')IOSPH = 18 - IF(ELIPSO.EQ.'Normal Sphere (6371) ')IOSPH = 19 - IF(ELIPSO.EQ.'International 1924 ')IOSPH = 20 - ENDIF -C -C --- DOES NOT ALLOW UTM WITHOUT USGS SPHEROID MODEL TO -C --- BE USED (IRET ERROR CODE OF 99 IS GIVEN). PRESENTLY -C --- NWS-84 DATUM FITS THIS CONDITION AS DOES A NUMBER OF -C --- OTHER EXOTICS. -C IJSYS = 0 -C IF(INSYS.EQ.1.OR.IOSYS.EQ.1)IJSYS = 1 - IF(IOSPH.LT.0.AND.IOSYS.EQ.1)THEN - IRET = 99 - write(IERR(11),'(a26,a8)')'CANNOT USE UTM WITH DATUM ', - & idatmo -c IERR(11) = 'CANNOT USE UTM WITH NON-USGS SPHERE' - ESTRNG = IERR(11) - RETURN - ENDIF -C -C --- DOES NOT ALLOW LAZA TO BE USED WITH A NON-SPHERE SPHEROID -C --- (IRET ERROR CODE OF 98 IS GIVEN) - IF(IOSPH.EQ.19)IBALLO = 1 - IF(IOSYS.EQ.11.AND.IBALLO.NE.1)THEN - IRET = 98 - write(IERR(12),'(a27,a8)')'CANNOT USE LAZA WITH DATUM ', - & idatmo -c IERR(12) = 'CANNOT USE LAZA WITH NON-SPHERE' - ESTRNG = IERR(12) - RETURN - ENDIF -C -C --- STICKS THE ELLIPSOID PARAMETERS INTO ELEMENTS 1,2 OF -C --- TPARIN, TPARIO - IF(INSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIN(1) = DRADIM(IRNKIN) - TPARIN(2) = DEC2(IRNKIN) - ENDIF - IF(IOSPH.LT.0.AND.IMODE.EQ.0)THEN -C IF(IMODE.EQ.0)THEN - TPARIO(1) = DRADIM(IRNKIO) - TPARIO(2) = DEC2(IRNKIO) - ENDIF -C -C --- SPECIAL SET FOR ELLIPSOID PARAMETERS IN TPARIN AND TPARIO ELEMENTS 14,15 - TPARIN(14) = DRADIM(IRNKIN) - TPARIN(15) = DEC2(IRNKIN) - TPARIO(14) = DRADIM(IRNKIO) - TPARIO(15) = DEC2(IRNKIO) -C -C-------------------------------------------------------------------- -C --- CRDIN = COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C --- INSYS = CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C --- INZONE = CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C --- TPARIN = PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C --- INUNIT = CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I* -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C -C --- INSPH = INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C --- 0 = CLARKE 1866 1 = CLARKE 1880 -C --- 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C --- 4 = INTERNATIONAL 1909 5 = WGS 72 -C --- 6 = EVEREST 7 = WGS 66 -C --- 8 = GRS 1980 9 = AIRY -C --- 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C --- 12 = WGS 84 13 = SOUTHEAST ASIA -C --- 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C --- 16 = HOUGH 17 = MERCURY 1960 -C --- 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C --- 20 = INTERNATIONAL 1924 -C -C --- IPR = PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C --- JPR = PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C --- LEMSG = LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C --- LPARM = LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C --- LN27 = LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C --- FN27 = FILE NAME OF NAD 1927 SPCS PARAMETERS -C --- LN83 = LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C --- FN83 = FILE NAME OF NAD 1983 SPCS PARAMETERS -C --- LENGTH = RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C -C--------------------------------------------------------------------- -C -C --- SETS IN NEW DATUM PARAMETERS AND CHECK FOR BAD MODE FLAG - IF(IMODE.EQ.1)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.2)THEN - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.EQ.3)THEN - INSPH = -1 - TPARIN(1) = XDATUM(1) - TPARIN(2) = XDATUM(3) - IRNKIN = 9999 - IOSPH = -1 - TPARIO(1) = XDATUM(1) - TPARIO(2) = XDATUM(3) - IRNKIO = 9999 - DRAD = XDATUM(1) - DFLT = XDATUM(2) - DXSHFT = SNGL(XDATUM(4)) - DYSHFT = SNGL(XDATUM(5)) - DZSHFT = SNGL(XDATUM(6)) - ENDIF - IF(IMODE.LT.0.OR.IMODE.GT.3)THEN - IRET = 30 - IERR(3) = 'THE INPUT OPERATION MODE IS ILLEGAL! ' - ESTRNG = IERR(3) - ENDIF -C -C********************************************************************** -C -C --- Now converts TLAT1 for EM,PS to LATITUDE OF TRUE SCALE -C --- and takes the Latitude of origin of projection and changes -C --- it to a false northing -C -C********************************************************************** -C -C --- (FROM) INPUT DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(INSYS.EQ.6.OR.INSYS.EQ.5)THEN -C -C --- SET COORDINATE ORIGIN AS THE PS POINT DESIRED - TCRDIN(1) = FLONIN - TCRDIN(2) = FLATIN -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIN(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE ADDED TO THE -C --- PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,INSYS,INZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) -C -C --- ERROR PROCESSING - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF -C -C --- NOW SHIFTS THE INPUT COORDS FROM DOMAIN CENTER TO THE POLE -C --- ASSUMES SINCE ONE IS NOT PUTTING IN OFFSETS THAT THE DATA -C --- COMING IN IS ALREADY OFFSET AND MUST BE SET TO THE POLE - CRDIN(1) = CRDIN(1) + TCRDIO(1) - CRDIN(2) = CRDIN(2) + TCRDIO(2) - ENDIF -C********************************************************************** -C -C --- OUTPUT (TO) DATUM SIDE - POLAR STEREOGRAPHIC + EQUATORIAL MERCATOR - IF(IOSYS.EQ.6.OR.IOSYS.EQ.5)THEN -C -C --- SET DOMAIN CENTER AS THE PS POINT DESIRED - TCRDIN(1) = FLONIO - TCRDIN(2) = FLATIO -C -C --- CREATE A DUMMY WORKING PROJECTION VECTOR (DWRK2) FOR -C --- CONVERTING TO PS/EM - DO KK = 1,NVEC - DWRK2(KK) = TPARIO(KK) - ENDDO -C -C --- CLEAN TEMPORARY OUTPUT ARRAY FOR FALSE EASTING, NORTHING AND -C --- SET PROPER UNITS FOR A LL2PS/EM TRANSFORMATION - TCRDIO(1) = 0.0D0 - TCRDIO(2) = 0.0D0 - JNUNIT = 4 - JOUNIT = 2 -C -C --- DOES CALL FOR THE FALSE EASTING AND NORTHING TO BE SUBTRACTED -C --- FROM THE PROJECTION - CALL GTPZ0(TCRDIN,0,0,TDUM,JNUNIT,IOSPH,IPR, - . JPR,LEMSG,LPARM,TCRDIO,IOSYS,IOZONE,DWRK2,JOUNIT, - . LN27,LN83,FN27,FN83,LENGTH,IFLG) -C -C --- ERROR PROCESSING - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - ENDIF -C********************************************************************** -C -C --- DOES A COMPLETE CYCLE PROJ/DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,0,TDUM,4,IOSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,0,TDUM,IUNIT4,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES ONLY A DATUM SHIFT - IF(INSYS.EQ.0.AND.IOSYS.EQ.0)THEN - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - UTMOUT = DBLE(INZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - FROM PROJ/DATUM TO LL (GEODETIC) - IF(IRNKIN.NE.IRNKIO.AND.INSYS.NE.0.AND.IOSYS.EQ.0)THEN -C -C --- STEP 1 PROJECTION TO LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, -c . LEMSG,LPARM,CRDIO,0,0,TDUM,4,LN27,LN83, -c . FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,0,0,TDUM,IUNIT4,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 DATUM TRANSFORMATION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIO(1) = XLONIO - CRDIO(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE FROM LL (GEODETIC) TO DATUM/PROJ - IF(IRNKIN.NE.IRNKIO.AND.INSYS.EQ.0.AND.IOSYS.NE.0)THEN -C -C --- STEP 1 DATUM TRANSFORMATION - XLONIN = CRDIN(1) - XLATIN = CRDIN(2) - ZLEVIN = SNGL(XYZIN(3)) - CALL DAT2DAT(LPR,IPR,XLONIN,XLATIN,ZLEVIN,IRNKIN, - 1 IRNKIO,XLONIO,XLATIO,ZLEVIO) - CRDIN(1) = XLONIO - CRDIN(2) = XLATIO - XYZIO(3) = DBLE(ZLEVIO) -C -C --- GETS THE TO UTM ZONE - IF(IOSYS.EQ.1.AND.IABS(IOZONE).GT.60)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -C -C --- STEP 2 PROJECTION FROM LAT-LON - CALL GTPZ0(CRDIN,0,INZONE,TPARIN,INUNIT,IOSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (070921) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - IF(IFLG.NE.0)RETURN - UTMOUT = DBLE(IOZONE) - ENDIF -C********************************************************************** -C -C --- DOES A PARTIAL CYCLE - PROJ ONLY - NO DATUM CHANGE - IF(IRNKIN.EQ.IRNKIO)THEN -C -C --- GOES TO LL (GEODETIC IF IOSYS = 1) TO GET UTM ZONE FOR OUTPUT - IF(IOSYS.EQ.1)THEN - IF(INSYS.NE.0)THEN - DO KK = 1,NVEC - DWRK(KK) = 0.0D0 - DWRK2(KK) = TPARIN(KK) - ENDDO - CRDIO(1) = 0.0D0 - CRDIO(2) = 0.0D0 - IDUM = INZONE - JDUM = IOZONE - JOUNIT = 4 - JOSYS = 0 - CALL GTPZ0(CRDIN,INSYS,IDUM,DWRK2,INUNIT,INSPH,IPR, - . JPR,LEMSG,LPARM,CRDIO,JOSYS,JDUM,DWRK,JOUNIT,LN27, - . LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XLONIO = CRDIO(1) - XLATIO = CRDIO(2) - ELSE - XLONIO = CRDIN(1) - XLATIO = CRDIN(2) - ENDIF -C -C --- DETERMINE IF A VALID OUTPUT ZONE IS GIVEN - IOVUTM = 0 - IF(IABS(IOZONE).GT.0.AND.IABS(IOZONE).LT.61)IOVUTM = 1 - IF(IOZONE.NE.INZONE.AND.IOVUTM.EQ.1)IOVUTM = 2 -C -C --- MAKE SURE WE GET A DECENT ZONE IF WE ENTERED A BOGUS ONE INITIALLY - IF(IOVUTM.EQ.0)THEN - CALL LL2ZON(XLONIO,XLATIO,IOZONE,IRET) - ENDIF -c PRINT *,'HEY - LATITUDE - UTM OUT: ',XLATIO,IOZONE - ENDIF -C -C --- SPECIAL CASE UTM2UTM WHERE OVERRIDE IS DESIRED - IF(INSYS.EQ.1.AND.IOSYS.EQ.1)THEN - CRDIN(1) = CRDIO(1) - CRDIN(2) = CRDIO(2) - JNUNIT = 4 - JNSYS = 0 - IF(IOVUTM.EQ.0)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE - IF(IOVUTM.EQ.2)THEN - CALL GTPZ0(CRDIN,JNSYS,IDUM,DWRK,JNUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT, - 2 LN27,LN83,FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - ELSE -C -C --- DO NOTHING EXCEPT UNITS CHANGE - XYZIO(1) = XYZIN(1) - XYZIO(2) = XYZIN(2) - RETURN - ENDIF - ENDIF - -C -C --- SPECIAL CASE WHERE INZONE IS PROVIDED BUT IOZONE IS NOT - IF(IABS(INZONE).GT.0.AND.IABS(INZONE).LT.61)THEN - IOZONE = INZONE - ENDIF - UTMOUT = DBLE(IOZONE) - ELSE -C -C --- REGULAR CASES - IF(INSYS.NE.IOSYS)THEN - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - -c --- Fix moved into PJINIT (070921) -cC --- SPECIAL FIX FOR NH CROSS OVER OF ZONE [IOZONE > 0 crdin(2) <0.0] -c IF(INSYS.EQ.0.AND.IOSYS.EQ.1.AND.IOZONE.GT.0.AND.CRDIN(2). -c 1 LT.0.0)THEN -c CRDIO(2) = CRDIO(2)-10000000.0 -c ENDIF - - ELSE ! CASE FROM ONE PROJECTION SETTING TO ANOTHER -C -C --- STEP 1 PROJECTION TO LAT-LON -C -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, -c 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,4,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR, - 1 JPR,LEMSG,LPARM,CRDIO,0,IOZONE,TDUM,IUNIT4,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)RETURN -C -C --- STEP 2 FEED CHANGE BACK TO PROJECTION - XLONIN = CRDIO(1) - XLATIN = CRDIO(2) - CRDIN(1) = XLONIN - CRDIN(2) = XLATIN -C -C --- STEP 3 PROJECTION FROM LAT-LON -c --- V1.98 (060911) -c CALL GTPZ0(CRDIN,0,IOZONE,TDUM,4,IOSPH,IPR,JPR, -c 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, -c 2 FN27,FN83,LENGTH,IFLG) - CALL GTPZ0(CRDIN,0,IOZONE,TDUM,IUNIT4,IOSPH,IPR,JPR, - 1 LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - 2 FN27,FN83,LENGTH,IFLG) - CALL ERRPRT(IFLG,LPR,2) - IF(IFLG.NE.0)RETURN - ENDIF - CALL ERRPRT(IFLG,LPR,1) - IF(IFLG.NE.0)THEN - IRET = IRET + IFLG - RETURN - ENDIF - XYZIO(3) = XYZIN(3) - UTMOUT = DBLE(IOZONE) - ENDIF - ENDIF -C -C--------------------------------------------------------------------- -C -C --- IOSYS = CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C --- IOZONE = CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C --- TPARIO = PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY) -C --- IOUNIT = CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I -C --- CRDIO = COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY) -C --- IFLG = RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C -C---------------------------------------------------------------------- -C -C --- PUTS THE OUTPUT INFORMATION INTO XYZIO AND SCALES -C --- NOTE THAT TCRDIO ARRAY HAS BEEN FILLED APPROPRIATELY WHEN AN -C --- OFFSET IS COMPUTED FOR PS AND EM - IF(IOSYS.EQ.5.OR.IOSYS.EQ.6)THEN - XYZIO(1) = (CRDIO(1) - TCRDIO(1))*DBLE(XMULTO) - XYZIO(2) = (CRDIO(2) - TCRDIO(2))*DBLE(XMULTO) - ELSE - XYZIO(1) = CRDIO(1)*DBLE(XMULTO) - XYZIO(2) = CRDIO(2)*DBLE(XMULTO) - ENDIF -C -C --- NOW DOES A 'TO' (OUTPUT) PROJECTION CHECK - JFLG = 1 -C IF(FLONIO.NE.0.0.AND.FLATIO.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIO,FLATIO,JFLG,IRET) -C ELSE -C IF(FLONIN.NE.0.0.AND.FLATIN.NE.0.0)THEN -C CALL PRJCHK(LPR,IOSYS,FLONIN,FLATIN,JFLG,IRET) -C ENDIF -C ENDIF -C - 999 CONTINUE -C 999 PRINT *,'FINISHED NORMALLY' - RETURN - END -c -c----------------------------------------------------------------------- -c --- Bring in BLOCK DATA as an include file -c----------------------------------------------------------------------- - include 'blockdat.crd' -c -c---------------------------------------------------------------------- - SUBROUTINE PRJCHK(IO,INSYS,XLON,XLAT,IFLG,IRET) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 021024 PRJCHK -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the mapping -c --- to various projections when the longitude and latitude are set to -c --- some values that are outside the bounds of the various projections. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- insys = projection type -c --- xlon = double precision longitude -c --- xlat = double precision latitude -c --- iflg = error print flag -c -c --- Program outputs are: -c -c --- iret = error number -c -c---------------------------------------------------------------------- -c - Real*8 xlon, xlat -c - Real*4 xlono,xlato -c - Integer*4 iflg,io,iret,ichk -c - ichk = 0 - xlato = sngl(xlat) - xlono = sngl(xlon) -c -c --- Test for polar stereographic mapping - if(insys.eq.6.and.abs(xlato).le.45.0)iret = iret + 100 -c -c --- Test for mercator mapping - if(insys.eq.5.and.abs(xlato).ge.45.0)iret = iret + 200 -c -c --- Test for utm mapping - if(insys.eq.1.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret - 1 + 300 -c -c --- Test for transverse mercator mapping - if(insys.eq.9.and.(xlato.ge.84.0.or.xlato.le.-80.0))iret=iret+ - 1 400 -c -c --- Print out - IF(ICHK.GT.0)THEN -c PRINT *,' WARNING INAPPROPIATE LATITUDE ' - WRITE(IO,'(A29)')'WARNING INAPPROPIATE LATITUDE' - ENDIF - Return - End -c---------------------------------------------------------------------- - SUBROUTINE ERRPRT(IFLG,IO,IAPP) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020623 ERRPRT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program writes out the errors associated with the USGS GCTP -c --- software. -c -c --- Program inputs are: -c -c --- io = FORTRAN logical unit for output -c --- iflg = error flag -c --- iapp = application number -c---------------------------------------------------------------------- -C -C --- PRINT ERROR MESSAGES - IF(IFLG.NE.0)THEN -c PRINT *,' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - WRITE(IO,'(A35,I5)')' PROBLEMS WITH APPLICATION NUMBER: ',IAPP - IF(IFLG.EQ.1)THEN -c PRINT *,' ILLEGAL INPUT SYSTEM CODE.' - WRITE(IO,'(A25)')'ILLEGAL INPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.2)THEN -c PRINT *,' ILLEGAL OUTPUT SYSTEM CODE.' - WRITE(IO,'(A26)')'ILLEGAL OUTPUT SYSTEM CODE' - ENDIF - IF(IFLG.EQ.3)THEN -c PRINT *,' ILLEGAL INPUT UNIT CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.4)THEN -c PRINT *,' ILLEGAL OUTPUT UNIT CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT UNIT CODE' - ENDIF - IF(IFLG.EQ.5)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR INPUT.' - WRITE(IO,'(A40)')'INCONSISTENT UNIT/SYSTEM CODES FOR INPUT' - ENDIF - IF(IFLG.EQ.6)THEN -c PRINT *,' INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT.' - WRITE(IO,'(A41)')'INCONSISTENT UNIT/SYSTEM CODES FOR OUTPUT' - ENDIF - IF(IFLG.EQ.7)THEN -c PRINT *,' ILLEGAL INPUT ZONE CODE.' - WRITE(IO,'(A23)')'ILLEGAL INPUT ZONE CODE' - ENDIF - IF(IFLG.EQ.8)THEN -c PRINT *,' ILLEGAL OUTPUT ZONE CODE.' - WRITE(IO,'(A24)')'ILLEGAL OUTPUT ZONE CODE' - ENDIF - IF(IFLG.GT.8)THEN -c PRINT *,' REALLY BAD UNDETERMINED ERROR! ' - WRITE(IO,'(A30)')'REALLY BAD UNDETERMINED ERROR!' - STOP - ENDIF -c PRINT *,' WILL TRY NEXT COORDINATE SET: ' - ENDIF - RETURN - END -c---------------------------------------------------------------------- - Subroutine ll2zon(dxlon,dxlat,izone,iret) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020710 LL2ZON -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in to UTM zone for use -c --- in estimating the UTM zone of any given latitude and longitude. -c -c --- Program inputs are: -c -c --- dxlon = longitude in decimal degrees (DP) -c --- dxlat = latitude in decimal degrees (DP) -c -c --- Program outputs are: -c -c --- izone = utm zone in the range -60 < -1 and 1 < 60 -c --- iret = a return code = 100 if the longitude is funky -c -c---------------------------------------------------------------------- -c - Real*8 dxlon,dxlat -c - iret = 0 - if(dabs(dxlon).gt.180.0D0)then - iret = 100 -c Print *,'magnitude of longitude is > 180 degrees!!!!' - Return - Endif -c -c --- NH E Quad - If(dxlon.ge.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 30 + izone - endif -c -c --- NH W Quad - If(dxlon.le.0.0D0.and.dxlat.ge.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = 31 - izone - endif -c -c --- SH E Quad - If(dxlon.ge.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(30 + izone) - endif -c -c --- SH W Quad - If(dxlon.le.0.0D0.and.dxlat.le.0.0D0)then - izone = dint(dabs(dxlon)/6.0D0) + 1 - izone = -(31 - izone) - endif - if(izone.gt.60)izone = 60 - if(izone.lt.-60)izone = -60 - Return - End -c---------------------------------------------------------------------- - Subroutine dd2dms(dd,dms) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 020624 DD2DMS -c -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- PROGRAM NOTES FOLLOW: -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- Convert decimal degrees to packed degrees,mintues,econds format -c -c --- dd.ddddd to dddmmmsss.ss -c -c --- Program Inputs -c -c --- dd = decimal degrees (dp) -c -c --- Program Outputs -c -c --- dms = packed degrees minutes seconds format (dp) -c -c---------------------------------------------------------------------- -c - real*8 dd,dms - real*4 sdd -c - sdd = sngl(dd) - ideg = int(sdd) - xminit = (sdd - ideg)*60.0 - iminit = int(xminit) - xsec = (xminit - iminit)*60.0 - dms = 1000000.D0*ideg + 1000.D0*iminit + 1.0D0*xsec - return - end - -c---------------------------------------------------------------------- - Subroutine dat2dat(lpr,ipr,xlonin,xlatin,zlevin,irnkin, - 1 irnkio,xlonio,xlatio,zlevio) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 030905 DAT2DAT -c -c --- Program was written by Gary Moore -c Earth Tech @2002 all rights -c Atmospheric Studies Group (ASG) -c Concord,MA 01742 -c -c --- Program notes follow: -c -c --- Added a 9999 datum designamtion to do a manual datum trasformation -c --- using user input information in the common block XDATM (version 1.1 -c --- 062002) -c -c --- Version 1.2 (071102) -c -c --- Changed calls to DATSHFT by adding IFLG so that a proper paired -c --- set of FROM-TO transformations could be made. -c -c --- Added the NIMA.CRD include. Use the new strings and pointers for -c --- handling the NIMA dataset. -c -c --- Version 1.3 102802 -c -c --- Corrected the ao,fo - ai,fi used (switched order) on from ref to -c --- output datum -c -c --- Version 1.4 030703 -c -c --- Blocked datum conversion to/from WGS84 lat-lon for sphere datums -c -c --- Version 1.9 Level: 030905 -c -c --- Add iflg values 2 and 3 to datshft calls to go to and from WGS-72 -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts longitude,latitude in one datum to the -c --- longitude,latitude in another. The program also does a shift in -c --- elevation due to a change in the geoid. -c -c --- Program inputs are: -c -c --- lpr = FORTRAN logical unit for output -c --- ipr = print flag => 0 to avoid printing -c --- xlonin = input longitude in decimal degrees (dp) -c --- xlatin = input latitude in decimal degrees (dp) -c --- zlevin = elevation of the input point of interest in meters -c --- irnkin = input datum pointer -c --- irnkio = output datum pointer -c -c --- Program outputs are: -c -c --- xlonio = output longitude in decimal degrees (dp) -c --- xlatio = output latitude in decimal degrees (dp) -c --- zlevio = revised elevation output of the input point in meters -c -c --- subroutine calls: -c -c --- DATSHFT -c -c---------------------------------------------------------------------- -c - Real*8 ai, ao, fi, fo, dx, dy, dz, xlonin, xlatin, zhti, - 1 xlonio, xlatio, zhto - Real*8 xlato,xlono,drad,dflt -c - Integer*4 iposi,iposo -c - common /xdatm/ drad,dflt,dxshft,dyshft,dzshft -c -c --- NIMA data base include - Include 'nima.crd' -c -c --- reference definition - the convention will be it is always 1! - iref = 1 -c -c --- asigns the positions - if(irnkin.ne.9999)then - iposi = irnkin - else - iposi = 0 - endif - if(irnkio.ne.9999)then - iposo = irnkio - else - iposo = 0 - endif -c -c --- Print out information - if(ipr.ne.1.and.iposi.ne.0)then - Write(lpr,'(a12,a8,1x,a50,1x,a60)')'From datum: ', - 1 datcod(iposi),datum(dattyp(iposi)),geodat1(iposi) - endif - if(ipr.ne.1.and.iposo.ne.0)then - Write(lpr,'(a10,a8,1x,a50,1x,a60)')'To datum: ', - 1 datcod(iposo),datum(dattyp(iposo)),geodat1(iposo) - endif -c -c --- datum to reference shift (i= input o = output) - if(iposi.ne.0)then - ai = dradim(iposi) - fi = 1.0/dflat(iposi) - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxmod(iposi)) - dy = dble(dymod(iposi)) - dz = dble(dzmod(iposi)) - zhti = dble(zlevin) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - zhti = dble(zlevin) - endif -c --- Transform to WGS84 only if input datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposi).eq.'WGS-72 ')then - iiflag = 2 - else - iiflag = 0 - endif - Call datshft(xlonin,xlatin,zhti,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlono,xlato,zhto) - else - xlono=xlonin - xlato=xlatin - zhto=zhti - endif -c -c --- reference to datum shift (i = input o = output) note same diffierence -c --- but a negative sign is used - this insures we get back to where -c --- we started!!!! - if(iposo.ne.0)then - ao = dradim(iref) - fo = 1.0/dflat(iref) - ai = dradim(iposo) - fi = 1.0/dflat(iposo) - dx = dble(dxmod(iposo)) - dy = dble(dymod(iposo)) - dz = dble(dzmod(iposo)) - else - ai = drad - fi = 1.0/dflt - ao = dradim(iref) - fo = 1.0/dflat(iref) - dx = dble(dxshft) - dy = dble(dyshft) - dz = dble(dzshft) - endif -c --- Transform from WGS84 only if output datum is NOT a sphere - if(fi.GT.1.0D-19) then - if(datcod(iposo).eq.'WGS-72 ')then - iiflag = 3 - else - iiflag = 1 - endif - Call datshft(xlono,xlato,zhto,ai,fi,fo,ao,dx,dy,dz,iiflag, - 1 xlonio,xlatio,zhti) - else - xlonio=xlono - xlatio=xlato - zhti=zhto - endif - zlevio = sngl(zhti) -c - Return - End -c--------------------------------------------------------------------- - subroutine datshft(xloni,xlati,zhti,ai,fi,fo,ao,dx,dy,dz,iflg, - 1 xlono,xlato,zhto) -c---------------------------------------------------------------------- -c -C --- COORDLIB Version: 1.99 Level: 030905 DATSHFT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Standard Modolensky Datum Transformation -c -c -c---------------------------------------------------------------------- -c -c --- Program notes -c --- Added the IFLG argument for proper FROM - TO conversions -c -c -c --- Version 1.1 -c --- Modified code constants to insure everything is DP -c --- Modified calculation of the reverse transformation. The reverse -c --- is done by subtracting the geodetics rather than inputing negative -c --- delta X,Y,Z. -c -c --- Version 1.9 Level: 030905 -c -c --- Add equations and special option to go to and from WGS-72 -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program converts the lat/lon/height of one datum to another -c --- assuming an earth center shift of dx,dy,dz (geoid specific) and the -c --- ellipsoid major axis and flattening of each datum. -c -c --- Input arguments - double precision -c -c --- xlati = input latitude in decimal dgrees -c --- xloni = input longitude in decimal degrees -c --- zhti = input elevation in meters -c --- ai = input major radius in meters -c --- fi = input flattening factor -c --- fo = output flattening factor -c --- ao = output major radius -c --- dx = datum to reference earth center shift in meters -c --- dy = datum to reference earth center shift in meters -c --- dz = datum to reference earth center shift in meters -c --- iflg = 0 FROM datum A TO WGS84 = 1 TO datum B FROM WGS84 -c --- iflg = 2 FROM datum A to WGS72 = 3 TO datum B FROM WGS72 -c -c --- Output arguments - double precision -c -c --- xlato = output longitude in decimal degrees -c --- xlono = output longitude in decimal degrees -c --- zhto = output elevation in meters -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - real*8 xlati,xloni,zhti,ai,fi,fo,ao,dx,dy,dz,xlato,xlono,zhto - real*8 deg2rad,rad2deg,da,df,sithet,siphi,cithet,ciphi,siphi2 - real*8 rn,rm,dlat,dlon,dh,one,two,dlat72,dh72 - real*8 es,bda,c1,c2,c3,c4,d1,d2,e1,e2,e3,e4,e5 -c -c --- compute some double precision constants - deg2rad = 0.01745329252D0 - rad2deg = 57.295779513D0 - one = 1.0D0 - two = 2.0D0 -c -c --- compute delta radius/flattening - double precision - da = ao - ai - df = fo - fi - es = two*fi - fi*fi ! eccentricity squared - bda = one - fi !pole/equator radius ratio -c -c --- compute sin,cos of theta and phi - double precision - siphi = dsin(xlati*deg2rad) - siphi2 = dsin(xlati*2.0*deg2rad) - ciphi = dcos(xlati*deg2rad) - sithet = dsin(xloni*deg2rad) - cithet = dcos(xloni*deg2rad) -c -c --- radius of curvature - prime vertical - rn = ai/dsqrt(one - es*siphi**2) -c -c --- radius of curvature - prime meridian - rm = ai*(one - es)/(one - es*siphi**2)**1.5 -c -c --- shift in latitude - c1 = -dx*siphi*cithet - dy*siphi*sithet + dz*ciphi - c2 = da*(rn*es*siphi*ciphi)/ai - c3 = df*(rm/bda + rn*bda)*siphi*ciphi - c4 = rm + zhti - dlat = (c1 + c2 + c3)/c4 - dlat72 = 4.5D0*ciphi/(ai*sin(1.0*deg2rad/3600.0)) + - 1 df*siphi2/(sin(1.0*deg2rad/3600.0)) -c -c --- shift in longitude - d1 = -dx*sithet + dy*cithet - d2 = (rn + zhti)*ciphi - dlon = d1/d2 -c -c --- shift in height - e1 = dx*ciphi*cithet - e2 = dy*ciphi*sithet - e3 = dz*siphi - e4 = da*ai/rn - e5 = df*bda*rn*siphi*siphi - dh = e1 + e2 + e3 - e4 + e5 - dh72 = 4.5D0*siphi + ai*df*siphi*siphi - da + 1.4D0 -c -c --- estimate the output arguments - if(iflg.eq.0)then - xlato = xlati + dlat*rad2deg - xlono = xloni + dlon*rad2deg - zhto = zhti + dh - endif - if(iflg.eq.1)then - xlato = xlati - dlat*rad2deg - xlono = xloni - dlon*rad2deg - zhto = zhti - dh - endif -c -c --- Special WGS-72 change 030905 - if(iflg.eq.2)then - xlato = xlati + dlat72/3600.0D0 - xlono = xloni + 0.554D0/3600.0D0 - zhto = zhti + dh72 - endif - if(iflg.eq.3)then - xlato = xlati - dlat72/3600.0D0 - xlono = xloni - 0.554D0/3600.0D0 - zhto = zhti - dh72 - endif -c - return - end -c---------------------------------------------------------------------- - Subroutine init(datloc,datnam,datid,datreg1,datreg2,datreg3, - 1 max,maxd) -c---------------------------------------------------------------------- -c -c --- COORDLIB Version: 1.99 Level: 021016 INIT -c -c --- Program was written by Gary Moore at Earth Tech - Concord MA -c -c --- Initializes the NIMA data label arrays -c -c---------------------------------------------------------------------- -c -c --- Program notes -c -c---------------------------------------------------------------------- -c -c --- Program function: -c -c --- This program does some string housekeeping and outputs the strings -c --- for use by a GUI or some other management routines. It starts -c --- with the NIMA common blocks that are input via the NIMA.CRD include -c --- block. -c -c --- Input arguments: -c -c --- MAX = maximum number of datums in the data base -c -c --- Output arguments - double precision -c -c --- DATID = 8 character ID code array for each datum -c --- DATLOC = 20 character Atlas location string array -c --- DATNAM = 50 character Datum name string array -c --- DATREG1 = 60 character Region descriptor string array - line 1 -c --- DATREG2 = 60 character Region descriptor string array - line 2 -c --- DATREG3 = 60 character Region descriptor string array - line 3 -c -c --- Subroutine calls: -c -c --- None -c -c---------------------------------------------------------------------- -c - CHARACTER*8 DATID(MAX) - CHARACTER*20 DATLOC(MAX) - CHARACTER*50 ISTRNG, DATNAM(MAX) - CHARACTER*60 DATREG1(MAX), DATREG2(MAX), DATREG3(MAX) -c -c --- Calls the include - Include 'nima.crd' -c -c --- First maps the DATLOC and DATNAM arrays - maxd = kmax - Do i = 1,kmax - DATLOC(i) = Atlas(dattyp(i)) - DATNAM(i) = Datum(dattyp(i)) - DATID(i) = Datcod(i) - DATREG1(i) = Geodat1(i) - DATREG2(i) = Geodat2(i) - DATREG3(i) = Geodat3(i) - Enddo -c -c --- Now compresses the Datum name string - Do k = 1,kmax - istrng = datnam(k) - Do j = 1,29 - jj = 29 - j + 1 - if(istrng(jj:jj).ne.' ')then - jbeg = jj + 2 - go to 444 - endif - Enddo -444 continue - jend = jbeg + 20 - if(jend.gt.50)jend = 50 - istrng(jbeg:jend) = istrng(30:50) - if(jend.lt.50)then - Do j = jend+1,50 - istrng(j:j) = ' ' - Enddo - endif - datnam(k) = istrng - Enddo - Return - End -C----------------------------------------------------------------------- -C GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE - VERSION 2.0.2 -C FORTRAN 77 LANGUAGE FOR IBM, AMDAHL, ENCORE, VAX, CONCURRENT, AND -C DATA GENERAL COMPUTERS -C ADJLZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ADJLZ0 (LONIN) - -c --- V1.98 (060911) -c --- Change argument name and reassign (sub is called with a computed -c --- argument that should not be changed within subroutine) - -C -C FUNCTION TO ADJUST LONGITUDE ANGLE TO MODULO 180 DEGREES. -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,PI /2.0D0,3.14159265358979323846D0/ - -c --- V1.98 (060911) - LON=LONIN -C - 020 ADJLZ0 = LON - IF (DABS(LON) .LE. PI) RETURN - TWOPI = TWO * PI - LON = LON - DSIGN (TWOPI,LON) - GO TO 020 -C - END -C ASINZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION ASINZ0 (CON) -C -C THIS FUNCTION ADJUSTS FOR ROUND-OFF ERRORS IN COMPUTING ARCSINE -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - IF (DABS(CON) .GT. ONE) THEN - CON = DSIGN (ONE,CON) - ENDIF - ASINZ0 = DASIN (CON) - RETURN -C - END -C DMSPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION DMSPZ0 (SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT UNPACKED DMS TO PACKED DMS ANGLE -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,NEG - DATA CON1,CON2 /1000000.0D0,1000.0D0/ - DATA NEG /'-'/ -C - CON = DBLE (DEGS) * CON1 + DBLE (MINS) * CON2 + DBLE (SECS) - IF (SGNA .EQ. NEG) CON = - CON - DMSPZ0 = CON - RETURN -C - END -C E0FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E0FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E0). -C - IMPLICIT REAL*8 (A-Z) - DATA QUART,ONE,ONEQ,THREE,SIXT /0.25D0,1.0D0,1.25D0,3.0D0,16.0D0/ -C - E0FNZ0 = ONE - QUART * ECCNTS * (ONE + ECCNTS / SIXT * - . (THREE + ONEQ * ECCNTS)) -C - RETURN - END -C E1FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E1FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E1). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2,CON3 /0.375D0,0.25D0,0.46875D0/ - DATA ONE /1.0D0/ -C - E1FNZ0 = CON1 * ECCNTS * (ONE + CON2 * ECCNTS * - . (ONE + CON3 * ECCNTS)) -C - RETURN - END -C E2FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E2FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E2). -C - IMPLICIT REAL*8 (A-Z) - DATA CON1,CON2 /0.05859375D0,0.75D0/ - DATA ONE /1.0D0/ -C - E2FNZ0 = CON1 * ECCNTS * ECCNTS * (ONE + CON2 * ECCNTS) -C - RETURN - END -C E3FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E3FNZ0 (ECCNTS) -C -C FUNCTION TO COMPUTE CONSTANT (E3). -C - IMPLICIT REAL*8 (A-Z) -C - E3FNZ0 = ECCNTS*ECCNTS*ECCNTS*(35.D0/3072.D0) -C - RETURN - END -C E4FNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION E4FNZ0 (ECCENT) -C -C FUNCTION TO COMPUTE CONSTANT (E4). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ONE + ECCENT - COM = ONE - ECCENT - E4FNZ0 = DSQRT ((CON ** CON) * (COM ** COM)) -C - RETURN - END -C GTPZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE GTPZ0(CRDIN,INSYS,INZONE,TPARIN,INUNIT,INSPH,IPR,JPR, - . LEMSG,LPARM,CRDIO,IOSYS,IOZONE,TPARIO,IOUNIT,LN27,LN83, - . FN27,FN83,LENGTH,IFLG) -C -C ********************************************************************** -C -C INPUT **************************************************************** -C CRDIN : COORDINATES IN INPUT SYSTEM (2 DP WORDS ARRAY). -C INSYS : CODE NUMBER OF INPUT COORDINATE SYSTEM (INTEGER). -C = 0 , GEOGRAPHIC -C = 1 , U T M -C = 2 , STATE PLANE -C = 3 , ALBERS CONICAL EQUAL-AREA -C = 4 , LAMBERT CONFORMAL CONIC -C = 5 , MERCATOR -C = 6 , POLAR STEREOGRAPHIC -C = 7 , POLYCONIC -C = 8 , EQUIDISTANT CONIC -C = 9 , TRANSVERSE MERCATOR -C = 10 , STEREOGRAPHIC -C = 11 , LAMBERT AZIMUTHAL EQUAL-AREA -C = 12 , AZIMUTHAL EQUIDISTANT -C = 13 , GNOMONIC -C = 14 , ORTHOGRAPHIC -C = 15 , GENERAL VERTICAL NEAR-SIDE PERSPECTIVE -C = 16 , SINUSOIDAL -C = 17 , EQUIRECTANGULAR (PLATE CARREE) -C = 18 , MILLER CYLINDRICAL -C = 19 , VAN DER GRINTEN I -C = 20 , OBLIQUE MERCATOR (HOTINE) -C = 21 , ROBINSON -C = 22 , SPACE OBLIQUE MERCATOR -C = 23 , MODIFIED-STEREOGRAPHIC CONFORMAL (ALASKA) -C INZONE : CODE NUMBER OF INPUT COORDINATE ZONE (INTEGER). -C TPARIN : PARAMETERS OF INPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C INUNIT : CODE NUMBER OF UNITS OF MEASURE FOR INPUT COORDINATES (I*4) -C = 0 , RADIANS. -C = 1 , U.S. FEET. -C = 2 , METERS. -C = 3 , SECONDS OF ARC. -C = 4 , DEGREES OF ARC. -C = 5 , INTERNATIONAL FEET. -C = 6 , USE LEGISLATED DISTANCE UNITS FROM NADUT TABLE -C INSPH : INPUT SPHEROID CODE. SEE SPHDZ0 FOR PROPER CODES. -C IPR : PRINTOUT FLAG FOR ERROR MESSAGES. 0=YES, 1=NO -C JPR : PRINTOUT FLAG FOR PROJECTION PARAMETERS 0=YES, 1=NO -C LEMSG : LOGICAL UNIT FOR LISTING ERROR MESSAGES IF IPR = 0 -C LPARM : LOGICAL UNIT FOR LISTING PROJECTION PARAMETERS IF JPR = 0 -C LN27 : LOGICAL UNIT FOR NAD 1927 SPCS PARAMETER FILE -C FN27 : FILE NAME OF NAD 1927 SPCS PARAMETERS -C LN83 : LOGICAL UNIT FOR NAD 1983 SPCS PARAMETER FILE -C FN83 : FILE NAME OF NAD 1983 SPCS PARAMETERS -C LENGTH : RECORD LENGTH OF NAD1927 AND NAD1983 PARAMETER FILES -C OUTPUT *** ***** -C IOSYS : CODE NUMBER OF OUTPUT COORDINATE SYSTEM (INTEGER). -C IOZONE : CODE NUMBER OF OUTPUT COORDINATE ZONE (INTEGER). -C TPARIO : PARAMETERS OF OUTPUT REFERENCE SYSTEM (15 DP WORDS ARRAY). -C IOUNIT : CODE NUMBER OF UNITS OF MEASURE FOR OUTPUT COORDINATES (I*4) -C CRDIO : COORDINATES IN OUTPUT REFERENCE SYSTEM (2 DP WORDS ARRAY). -C IFLG : RETURN FLAG (INTEGER). -C = 0 , SUCCESSFUL TRANSFORMATION. -C = 1 , ILLEGAL INPUT SYSTEM CODE. -C = 2 , ILLEGAL OUTPUT SYSTEM CODE. -C = 3 , ILLEGAL INPUT UNIT CODE. -C = 4 , ILLEGAL OUTPUT UNIT CODE. -C = 5 , INCONSISTENT UNIT AND SYSTEM CODES FOR INPUT. -C = 6 , INCONSISTENT UNIT AND SYSTEM CODES FOR OUTPUT. -C = 7 , ILLEGAL INPUT ZONE CODE. -C = 8 , ILLEGAL OUTPUT ZONE CODE. -C OTHERWISE , ERROR CODE FROM PROJECTION COMPUTATIONAL MODULE. -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 NAD27(134), NAD83(134), NADUT(54), SPTYPE(134) - INTEGER*4 SYSUNT(24), SWITCH(23), ITER - -c --- V1.98 (060911) - INTEGER*4 INSPHZERO - - INTEGER*2 INMOD, IOMOD, FWD, INV - CHARACTER*128 FN27, FN83, FILE27, FILE83 - DIMENSION CRDIN(2),CRDIO(2),TPARIN(15),TPARIO(15),COORD(2) - DIMENSION DUMMY(15), PDIN(15), PDIO(15) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /PROJZ0/ IPROJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /TOGGLE/ SWITCH -C - PARAMETER (MAXUNT=6, MAXSYS=23) - PARAMETER (FWD=0, INV=1) - DATA SYSUNT / 0 , 23*2 / - DATA PDIN/15*0.0D0/, PDIO/15*0.0D0/ - DATA INSP/999/, INPJ/999/, INZN/99999/ - DATA IOSP/999/, IOPJ/999/, IOZN/99999/ - DATA ITER /0/ - DATA JFLAG/0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C -C TABLE OF UNIT CODES AS SPECIFIED BY STATE LAWS AS OF 2/1/92 -C FOR NAD 1983 SPCS - 1 = U.S. SURVEY FEET, 2 = METERS, -C 5 = INTERNATIONAL FEET -C -C NADUT - UNIT CODES FOR THE STATES ARRANGED IN STATE NUMBER ORDER -C (FIRST TWO DIGITS OF ZONE NUMBER) -C - DATA NADUT /1, 5, 1, 1, 5, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 2, - . 1, 1, 5, 2, 1, 2, 5, 1, 2, 2, 2, 1, 1, 1, 5, 2, 1, 5, - . 2, 2, 5, 2, 1, 1, 5, 2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 2/ -C -C TABLE OF STATE PLANE ZONE TYPES: 4 = LAMBERT, 7 = POLYCONIC, -C 9 = TRANSVERSE MERCATOR, AND 20 = OBLIQUE MERCATOR -C - DATA SPTYPE / 9, 9, 4, 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - . 9, 9, 9, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 9, 4, 4, - . 4, 9, 9, 9, 4, 4, 4, 4, 4, 4, 9, 9, 9, 9, 9, 4, 4, - . 4, 4, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, - . 4, 4, 4, 4, 4, 4, 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, - . 9, 9, 9,20, 9, 9, 9, 9, 9, 9, 9, 9, 4, 4, 7/ -C -C SETUP -C - IOSPH = INSPH - IPEMSG = IPR - IPPARM = JPR - IPELUN = LEMSG - IPPLUN = LPARM - IPROJ = INSYS - LU27 = LN27 - FILE27 = FN27 - LU83 = LN83 - FILE83 = FN83 - LEN = LENGTH -C -C INITIALIZE SWITCH FOR EACH PROJECTION TO ZERO -C - ITER = ITER + 1 - IF (ITER .LE. 1) THEN - DO 5 I=1,15 - DUMMY(I) = 0.0D0 - 5 CONTINUE - MSYS = 2 - END IF - INSPCS = 2 - IOSPCS = 2 - IF (JFLAG.NE.0) GO TO 10 - EZ = 0.0D0 - ESZ = 0.0D0 - -c --- V1.98 (060911) -c CALL SPHDZ0(0,DUMMY) -c --- Set sphere as a variable instead of a constant - insphzero=0 - CALL SPHDZ0(insphzero,DUMMY) -C -C --- SPECIAL TREATMENT FOR STARTUP - IF(TPARIO(14).NE.0D0.AND.TPARIO(15).NE.0D0)THEN - DUMMY(1) = TPARIO(14) - DUMMY(2) = TPARIO(15) - ENDIF - JFLAG = 1 -C -C CHECK VALIDITY OF CODES FOR REFERENCE SYSTEMS. -C - 10 IF (INSYS.LT.0 .OR. INSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INSYS - 2000 FORMAT (' ILLEGAL SOURCE REFERENCE SYSTEM CODE = ',I6) - IFLG = 1 - RETURN - END IF -C - IF (IOSYS.LT.0 .OR. IOSYS.GT.MAXSYS) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOSYS - 2010 FORMAT (' ILLEGAL TARGET REFERENCE SYSTEM CODE = ',I6) - IFLG = 2 - RETURN - END IF -C -C FORCE INITIALIZATION OF PROJECTIONS IF SPHEROID OR PROJECTION -C HAS CHANGED FROM PREVIOUS INPUT - OUTPUT SET -C -C -C---------------------------------------------------------------------- -C -C --- THIS SECTION IS TO BE PLACED IN ALL VERSIONS OF USGS CODE TO FORCE -C --- REINITIALIZATION EACH TIME. -C -C---------------------------------------------------------------------- - DO I = 1,MAXSYS - SWITCH(I) = 0 - ENDDO -C---------------------------------------------------------------------- -C - IF (INSPH .NE. INSP) THEN - DO 11 I = 1,MAXSYS - SWITCH(I) = 0 - 11 CONTINUE - END IF -C - IF (INSYS .GT. 0) THEN - IF (INSYS .NE. INPJ .AND. INSYS .NE. IOPJ) SWITCH(INSYS) = 0 - IF (SWITCH(INSYS) .NE. INZONE .AND. SWITCH(INSYS) .NE. IOZONE) - . SWITCH(INSYS) = 0 - END IF -C - IF (IOSYS .GT. 0) THEN - IF (IOSYS .NE. INPJ .AND. IOSYS .NE. IOPJ) SWITCH(IOSYS) = 0 - IF (SWITCH(IOSYS) .NE. INZONE .AND. SWITCH(IOSYS) .NE. IOZONE) - . SWITCH(IOSYS) = 0 - END IF -C -C CHECK FOR REPEAT OF INPUT SYSTEM -C - INMOD = 1 - IF (INSYS .EQ. 2) THEN - IF (INZONE .GT. 0) THEN - ID = 0 - IF (INSPH .EQ. 0) THEN - DO 12 I = 1,134 - IF (INZONE .EQ. NAD27(I)) ID = I - 12 CONTINUE - END IF - IF (INSPH .EQ. 8) THEN - DO 13 I = 1,134 - IF (INZONE .EQ. NAD83(I)) ID = I - 13 CONTINUE - END IF - IF (ID .NE. 0) INSPCS = SPTYPE(ID) - IF (INZONE .NE. SWITCH(INSPCS)) GO TO 15 - END IF - END IF - IF (INSP .NE. INSPH) GO TO 15 - IF (INPJ .NE. INSYS) GO TO 15 - IF (INZN .NE. INZONE) GO TO 15 - IF (INSYS .GE. 3) THEN - DO 14 I=1,15 - IF (TPARIN(I) .NE. PDIN(I)) GO TO 15 - 14 CONTINUE - END IF - INMOD = 0 - GO TO 30 -C -C SAVE INPUT SYSTEM PARAMETERS -C - 15 INSP = INSPH - INPJ = INSYS - INZN = INZONE - DO 16 I=1,15 - 16 PDIN(I) = TPARIN(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (INUNIT.LT.0 .OR. INUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2020) INUNIT - 2020 FORMAT (' ILLEGAL SOURCE UNIT CODE = ',I6) - IFLG = 3 - RETURN - END IF -C -C CHECK FOR REPEAT OF OUTPUT SYSTEM -C - 30 IOMOD = 1 - IF (IOSYS .EQ. 2) THEN - IF (IOZONE .GT. 0) THEN - ID = 0 - IF (IOSPH .EQ. 0) THEN - DO 32 I = 1,134 - IF (IOZONE .EQ. NAD27(I)) ID = I - 32 CONTINUE - END IF - IF (IOSPH .EQ. 8) THEN - DO 33 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) ID = I - 33 CONTINUE - END IF - IF (ID .NE. 0) IOSPCS = SPTYPE(ID) - IF (IOZONE .NE. SWITCH(INSPCS)) GO TO 35 - END IF - END IF - IF (IOSP .NE. INSPH) GO TO 35 - IF (IOSP .NE. IOSPH) GO TO 35 - IF (IOPJ .NE. IOSYS) GO TO 35 - IF (IOZN .NE. IOZONE) GO TO 35 - IF (IOSYS .GE. 3) THEN - DO 34 I=1,15 - IF (TPARIO(I) .NE. PDIO(I)) GO TO 35 - 34 CONTINUE - END IF - IOMOD = 0 - GO TO 80 -C -C SAVE OUTPUT SYSTEM PARAMETERS -C - 35 IOSP = INSPH - IOPJ = IOSYS - IOZN = IOZONE - DO 36 I=1,15 - 36 PDIO(I) = TPARIO(I) -C -C CHECK CONSISTENCY BETWEEN UNITS OF MEASURE -C - IF (IOUNIT.LT.0 .OR. IOUNIT.GT.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2030) IOUNIT - 2030 FORMAT (' ILLEGAL TARGET UNIT CODE = ',I6) - IFLG = 4 - RETURN - END IF -C - 80 IUNIT = SYSUNT(INSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) INUNIT=1 - IF (INSPH .EQ. 8 .AND. INSYS .EQ. 2 .AND. INUNIT .EQ. 6) THEN - IND = 0 - DO 90 I = 1,134 - IF (INZONE .EQ. NAD83(I)) IND = I - 90 CONTINUE - IF (IND .NE. 0) INUNIT = NADUT( INT(INZONE/100)) - END IF - CALL UNTFZ0 (INUNIT,IUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 100 - IFLG = 5 - RETURN - 100 COORD(1) = FACTOR * CRDIN(1) - COORD(2) = FACTOR * CRDIN(2) - IUNIT = SYSUNT(IOSYS + 1) -C -C CHANGE UNITS TO LEGISLATED UNITS USING TABLE -C - IF (INSPH .EQ. 0 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) IOUNIT=1 - IF (INSPH .EQ. 8 .AND. IOSYS .EQ. 2 .AND. IOUNIT .EQ. 6) THEN - IND = 0 - DO 110 I = 1,134 - IF (IOZONE .EQ. NAD83(I)) IND = I - 110 CONTINUE - IF (IND .NE. 0) IOUNIT = NADUT( INT(IOZONE/100)) - END IF - CALL UNTFZ0 (IUNIT,IOUNIT,FACTOR,IFLG) - IF (IFLG .EQ. 0) GO TO 120 - IFLG = 6 - RETURN - 120 IF (INSYS.NE.IOSYS.OR.INZONE.NE.IOZONE.OR.INZONE.LE.0) GO TO 140 - CRDIO(1) = FACTOR * COORD(1) - CRDIO(2) = FACTOR * COORD(2) - RETURN -C -C COMPUTE TRANSFORMED COORDINATES AND ADJUST THEIR UNITS. -C - 140 IF (INSYS .EQ. 0) GO TO 520 - IF (INZONE.GT.60 .OR. INSYS.EQ.1) GO TO 200 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2040) INZONE - 2040 FORMAT (' ILLEGAL SOURCE ZONE NUMBER = ',I6) - IFLG = 7 - RETURN -C -C INVERSE TRANSFORMATION. -C - 200 IPROJ=INSYS - ISPHER = INSPH - IF (INSYS.GE.3) CALL SPHDZ0(INSPH,TPARIN) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE INPUT PROJECTION -C - IF (INSYS .EQ. 1 .AND. INZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - INMOD = 1 - END IF - IF (INSYS .EQ. 2 .AND. INZONE .NE. SWITCH(INSPCS)) THEN - SWITCH(2) = 0 - INMOD = 1 - END IF - IF (INZONE .NE. SWITCH(INSYS)) THEN - SWITCH(INSYS) = 0 - INMOD = 1 - END IF -C - IF (INSYS .EQ. 1) THEN - IF (INZONE.EQ.0.AND.TPARIN(1).NE.0.0D0) GO TO 211 - TPARIN(1) = 1.0D6*DBLE(6*INZONE-183) - TPARIN(2) = DSIGN(4.0D7,DBLE(INZONE)) - 211 CALL SPHDZ0(INSPH,DUMMY) - TPARIN(14) = DUMMY(1) - TPARIN(15) = DUMMY(2) - IF (INMOD .NE. 0) THEN - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - CALL PJ01Z0 (COORD,CRDIO,INV) - END IF -C - IF (INSYS .GT. 1) THEN - IF (INMOD .NE. 0) THEN - MSYS = INSPCS - CALL PJINIT (INSYS,INZONE,TPARIN) - IF (IERROR .NE. 0) INZN = 99999 - IF (IERROR .NE. 0) GO TO 500 - END IF - IF (INSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,INV) - IF (INSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,INV) - END IF -C - 500 IFLG = IERROR - DO 510 I = 1,15 - 510 TPARIN(I) = PDIN(I) - IF (IFLG .NE. 0) RETURN - CRDIO(1) = ADJLZ0(CRDIO(1)) - IF (IOSYS .EQ. 0) GO TO 920 - COORD(1) = CRDIO(1) - COORD(2) = CRDIO(2) - 520 IF (INSYS .EQ. 0 .AND. IOSYS .EQ. 0) THEN - CRDIO(1) = COORD(1) - CRDIO(2) = COORD(2) - GO TO 920 - END IF - IF (IOZONE.GT.60 .OR. IOSYS.EQ.1) GO TO 540 - IF (IPEMSG .NE. 0) WRITE (IPELUN,2050) IOSYS - 2050 FORMAT (' ILLEGAL TARGET ZONE NUMBER = ',I6) - IFLG = 8 - RETURN -C -C FORWARD TRANSFORMATION. -C - 540 IPROJ=IOSYS - ISPHER = INSPH - IF (IOSYS.GE.3) CALL SPHDZ0(INSPH,TPARIO) -C -C CHECK FOR CHANGE IN ZONE FROM LAST USE OF THE OUTPUT PROJECTION -C - IF (IOSYS .EQ. 1 .AND. IOZONE .NE. SWITCH(9)) THEN - SWITCH(1) = 0 - IOMOD = 1 - END IF - IF (IOSYS .EQ. 2 .AND. IOZONE .NE. SWITCH(IOSPCS)) THEN - SWITCH(2) = 0 - IOMOD = 1 - END IF - IF (IOZONE .NE. SWITCH(IOSYS)) THEN - SWITCH(IOSYS) = 0 - IOMOD = 1 - END IF -C - IF (IOSYS .EQ. 1) THEN - TPARIO(1) = COORD(1) - TPARIO(2) = COORD(2) - CALL SPHDZ0(INSPH,DUMMY) - TPARIO(14) = DUMMY(1) - TPARIO(15) = DUMMY(2) - IF (IOMOD .NE. 0) THEN - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - CALL PJ01Z0 (COORD,CRDIO,FWD) - END IF -C - IF (IOSYS .GT. 1) THEN - IF (IOMOD .NE. 0) THEN - MSYS = IOSPCS - CALL PJINIT (IOSYS,IOZONE,TPARIO) - IF (IERROR .NE. 0) IOZN = 99999 - IF (IERROR .NE. 0) GO TO 900 - END IF - IF (IOSYS .EQ. 2) CALL PJ02Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 3) CALL PJ03Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 4) CALL PJ04Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 5) CALL PJ05Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 6) CALL PJ06Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 7) CALL PJ07Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 8) CALL PJ08Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 9) CALL PJ09Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 10) CALL PJ10Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 11) CALL PJ11Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 12) CALL PJ12Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 13) CALL PJ13Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 14) CALL PJ14Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 15) CALL PJ15Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 16) CALL PJ16Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 17) CALL PJ17Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 18) CALL PJ18Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 19) CALL PJ19Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 20) CALL PJ20Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 21) CALL PJ21Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 22) CALL PJ22Z0 (COORD,CRDIO,FWD) - IF (IOSYS .EQ. 23) CALL PJ23Z0 (COORD,CRDIO,FWD) - END IF -C - 900 IFLG = IERROR - DO 910 I = 1,15 - 910 TPARIO(I) = PDIO(I) - 920 CRDIO(1) = FACTOR * CRDIO(1) - CRDIO(2) = FACTOR * CRDIO(2) - RETURN -C - END -C MLFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MLFNZ0 (E0,E1,E2,E3,PHI) -C -C FUNCTION TO COMPUTE CONSTANT (M). -C - IMPLICIT REAL*8 (A-Z) - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ -C - MLFNZ0 = E0 * PHI - E1 * DSIN (TWO * PHI) + E2 * DSIN (FOUR * PHI) - * - E3 * DSIN (SIX * PHI) -C - RETURN - END -C MSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION MSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL M). -C - IMPLICIT REAL*8 (A-Z) - DATA ONE /1.0D0/ -C - CON = ECCENT * SINPHI - MSFNZ0 = COSPHI / DSQRT (ONE - CON * CON) -C - RETURN - END -C PAKCZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKCZ0 (PAK) -C -C SUBROUTINE TO CONVERT 2 DIGIT PACKED DMS TO 3 DIGIT PACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,10000.0D0,100.0D0/ - DATA CON3,CON4 /1000000.0D0,1000.0D0/ - DATA TOL /1.0D-3/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = DMOD (CON , CON2) -C - CON = DBLE (DEGS) * CON3 + DBLE (MINS) * CON4 + SECS - IF (SGNA .EQ. NEG) CON = - CON - PAKCZ0 = CON - RETURN -C - END -C PAKDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PAKDZ0 (PAK,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT PACKED DMS TO UNPACKED DMS ANGLE. -C -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - IMPLICIT REAL*8 (A-H,O-Z) - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,IBLANK,NEG - DATA ZERO,CON1,CON2 /0.0D0,1000000.0D0,1000.0D0/ - DATA TOL /1.0D-4/ - DATA IBLANK,NEG /' ','-'/ -C - SGNA = IBLANK - IF (PAK .LT. ZERO) SGNA = NEG - CON = DABS (PAK) - DEGS = IDINT ((CON / CON1) + TOL) - CON = DMOD ( CON , CON1) - MINS = IDINT ((CON / CON2) + TOL) - SECS = SNGL ( DMOD (CON , CON2)) - RETURN -C - END -C PAKRZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKRZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO RADIANS. -C - IMPLICIT REAL*8 (A-H,O-Z) - DATA SECRAD /0.4848136811095359D-5/ -C -C CONVERT ANGLE TO SECONDS OF ARC -C - SEC = PAKSZ0 (ANG) -C -C CONVERT ANGLE TO RADIANS. -C - PAKRZ0 = SEC * SECRAD -C - RETURN - END -C PAKSZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PAKSZ0 (ANG) -C -C FUNCTION TO CONVERT DMS PACKED ANGLE INTO SECONDS OF ARC. -C - IMPLICIT REAL*8 (A-H,M-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - DIMENSION CODE(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA CODE /1000000.0D0,1000.0D0/ - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA C1,C2 /3600.0D0,60.0D0/ - DATA TOL /1.0D-4/ -C -C SEPARATE DEGREE FIELD. -C - FACTOR = ONE - IF (ANG .LT. ZERO) FACTOR = - ONE - SEC = DABS(ANG) - TMP = CODE(1) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 360) GO TO 020 - DEG = DBLE (I) -C -C SEPARATE MINUTES FIELD. -C - SEC = SEC - DEG * TMP - TMP = CODE(2) - I = IDINT ((SEC / TMP) + TOL) - IF (I .GT. 60) GO TO 020 - MIN = DBLE (I) -C -C SEPARATE SECONDS FIELD. -C - SEC = SEC - MIN * TMP - IF (SEC .GT. C2) GO TO 020 - SEC = FACTOR * (DEG * C1 + MIN * C2 + SEC) - GO TO 040 -C -C ERROR DETECTED IN DMS FORM. -C - 020 WRITE (IPELUN,2000) ANG - 2000 FORMAT ('0ERROR PAKSZ0'/ - . ' ILLEGAL DMS FIELD =',F15.3) - STOP 16 -C - 040 PAKSZ0 = SEC -C - RETURN - END -C PHI1Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI1Z0 (ECCENT,QS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-1). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE /0.5D0,1.0D0/ - DATA EPSLN,TOL,NIT /1.0D-7,1.0D-10,15/ -C - PHI1Z0 = ASINZ0 (HALF * QS) - IF (ECCENT .LT. EPSLN) RETURN -C - ECCNTS = ECCENT * ECCENT - PHI = PHI1Z0 - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - COSPI = DCOS (PHI) - CON = ECCENT * SINPI - COM = ONE - CON * CON - DPHI = HALF * COM * COM / COSPI * (QS / (ONE - ECCNTS) - - . SINPI / COM + HALF / ECCENT * DLOG ((ONE - CON) / - . (ONE + CON))) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI1Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,QS - 2000 FORMAT ('0ERROR PHI1Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' QS =',D25.16) - IERROR = 001 - RETURN -C - END -C PHI2Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI2Z0 (ECCENT,TS) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-2). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA TOL,NIT /1.0D-10,15/ - DATA HALFPI /1.5707963267948966D0/ -C - ECCNTH = HALF * ECCENT - PHI = HALFPI - TWO * DATAN (TS) - DO 020 II = 1,NIT - SINPI = DSIN (PHI) - CON = ECCENT * SINPI - DPHI = HALFPI - TWO * DATAN (TS * ((ONE - CON) / - . (ONE + CON)) ** ECCNTH) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI2Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ECCENT,TS - 2000 FORMAT ('0ERROR PHI2Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ECCENTRICITY =',D25.16,' TS =',D25.16) - IERROR = 002 - RETURN -C - END -C PHI3Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION PHI3Z0 (ML,E0,E1,E2,E3) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-3). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA TWO,FOUR,SIX /2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = ML - DO 020 II = 1,NIT - DPHI = (ML + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0 - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - PHI3Z0 = PHI - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,ML,E0,E1,E2,E3 - 2000 FORMAT ('0ERROR PHI3Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' ML =',D25.16,' E0 =',D25.16/ - . ' E1 =',D25.16,' E2 =',D25.16,' E3=',D25.16) - IERROR = 003 - RETURN -C - END -C PHI4Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PHI4Z0 (ECCNTS,E0,E1,E2,E3,A,B,C,PHI) -C -C FUNCTION TO COMPUTE LATITUDE ANGLE (PHI-4). -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 II,NIT - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - DATA ONE,TWO,FOUR,SIX /1.0D0,2.0D0,4.0D0,6.0D0/ - DATA TOL,NIT /1.0D-10,15/ -C - PHI = A - DO 020 II = 1,NIT - SINPHI = DSIN (PHI) - TANPHI = DTAN (PHI) - C = TANPHI * DSQRT (ONE - ECCNTS * SINPHI * SINPHI) - SIN2PH = DSIN (TWO * PHI) - ML = E0 * PHI - E1 * SIN2PH + E2 * DSIN (FOUR * PHI) - . - E3 * DSIN (SIX * PHI) - MLP = E0 - TWO * E1 * DCOS (TWO * PHI) + FOUR * E2 * - . DCOS (FOUR * PHI) - SIX * E3 * DCOS (SIX * PHI) - CON1 = TWO * ML + C * (ML * ML + B) - TWO * A * - . (C * ML + ONE) - CON2 = ECCNTS * SIN2PH * (ML * ML + B - TWO * A * ML) / (TWO * C) - CON3 = TWO * (A - ML) * (C * MLP - TWO / SIN2PH) - TWO * MLP - DPHI = CON1 / (CON2 + CON3) - PHI = PHI + DPHI - IF (DABS(DPHI) .GT. TOL) GO TO 020 - RETURN - 020 CONTINUE -C - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2000) NIT,E0,E1,E2,E3,A,B,C, - . ECCNTS - 2000 FORMAT ('0ERROR PHI4Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS'/ - . ' E0 =',D25.16,' E1 =',D25.16/ - . ' E2 =',D25.16,' E3 =',D25.16/ - . ' A =',D25.16,' B =',D25.16/ - . ' C =',D25.16/ - . ' ECCENTRICITY SQUARE =',D25.16) - IERROR = 004 - RETURN -C - END -C PJINIT -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE PJINIT (ISYS,ZONE,DATA) -cc ---------------------------------------------------------------------- -c --- UPDATE (for use in COORDS) -c -c --- V1.98-V1.99 070921 (DGS) -c Modify UTM section of PJINIT in to fix erroneous non-zero -c false Northing when converting S. hemisphere locations to UTM-N -c coordinates. Calls from COORDS to GTPZ0 manage the UTM zone -c (negative for S. hemisphere) so the zone alone should be used to -c set the false Northing for UTM in the S. hemisphere. Calls made -c with a positive zone MUST result in UTM-N coordinates, which are -c negative in the S. hemisphere. -c ---------------------------------------------------------------------- -C - IMPLICIT REAL*8 (A-Z) - REAL*4 SECS(5) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,ITEMP - INTEGER*4 LAND, PATH, LIMIT, IND02, IND06, IND09, ISYS, KEEPZN - INTEGER*4 SWITCH(23),I,ZONE,DEGS(5),MINS(5) - INTEGER*4 ID, IND, ITEM, ITYPE, MODE, N, MSYS - INTEGER*4 ISPHER, LUNIT, LU27, LU83, LEN, NAD27(134), NAD83(134) - CHARACTER*128 DATUM, FILE27, FILE83 - CHARACTER*32 PNAME - CHARACTER*1 SGNA(5) -C - DIMENSION DATA(15),BUFFL(15) - DIMENSION TABLE(9) - DIMENSION PR(20),XLR(20) - DIMENSION ACOEF(6),BCOEF(6) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /NORM/ Q,T,U,W,ES22,P22,SA,CA,XJ - COMMON /SPCS/ ISPHER,LU27,LU83,LEN,MSYS,FILE27,FILE83 - COMMON /PJ02/ ITYPE - COMMON /PJ03/ A03,LON003,X003,Y003,C,E03,ES03,NS03,RH003 - COMMON /PJ04/ A04,LON004,X004,Y004,E04,F04,NS04,RH004 - COMMON /PJ05/ A05,LON005,X005,Y005,E05,M1 - COMMON /PJ06/ A06,LON006,X006,Y006,E06,E4,FAC,MCS,TCS,IND06 - COMMON /PJ07/ A07,LON007,X007,Y007,E07,E007,E107,E207,E307,ES07, - . ML007 - COMMON /PJ08/ A08,LON008,X008,Y008,E008,E108,E208,E308,GL,NS08, - . RH008 - COMMON /PJ09/ A09,LON009,X009,Y009,ES09,ESP,E009,E109,E209,E309, - . KS009,LAT009,ML009,IND09 - COMMON /PJ10/ A10,LON010,X010,Y010,COSP10,LAT010,SINP10 - COMMON /PJ11/ A11,LON011,X011,Y011,COSP11,LAT011,SINP11 - COMMON /PJ12/ A12,LON012,X012,Y012,COSP12,LAT012,SINP12 - COMMON /PJ13/ A13,LON013,X013,Y013,COSP13,LAT013,SINP13 - COMMON /PJ14/ A14,LON014,X014,Y014,COSP14,LAT014,SINP14 - COMMON /PJ15/ A15,LON015,X015,Y015,COSP15,LAT015,P,SINP15 - COMMON /PJ16/ A16,LON016,X016,Y016 - COMMON /PJ17/ A17,LON017,X017,Y017,LAT1 - COMMON /PJ18/ A18,LON018,X018,Y018 - COMMON /PJ19/ A19,LON019,X019,Y019 - COMMON /PJ20/ LON020,X020,Y020,AL,BL,COSALF,COSGAM,E20,EL,SINALF, - . SINGAM,U0 - COMMON /PJ21/ A21,LON021,X021,Y021,PR,XLR - COMMON /PJ22/ A22,X022,Y022,A2,A4,B,C1,C3,LAND,PATH - COMMON /PJ23/ A23,LON023,X023,Y023,ACOEF,BCOEF,EC,LAT023, - . CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH -C - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE,TWO /0.0D0,0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-10/ - DATA TOL /1.0D-7/ - DATA TOL09 /1.0D-5/ - DATA NINTYD /90000000.0D0/ - DATA DG1 /0.01745329252D0/ - -c --- V1.98 (060911) -c --- Set initial value of SAVE9 - data SAVE9/0.0D0/ -C - DATA NAD27/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0407,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2501,2502,2503,2601,2602,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3901,3902,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5201, - . 5202,5400/ -C - DATA NAD83/0101,0102,5010,5300,0201,0202,0203,0301,0302,0401,0402, - . 0403,0404,0405,0406,0000,0501,0502,0503,0600,0700,0901, - . 0902,0903,1001,1002,5101,5102,5103,5104,5105,1101,1102, - . 1103,1201,1202,1301,1302,1401,1402,1501,1502,1601,1602, - . 1701,1702,1703,1801,1802,1900,2001,2002,2101,2102,2103, - . 2111,2112,2113,2201,2202,2203,2301,2302,2401,2402,2403, - . 2500,0000,0000,2600,0000,2701,2702,2703,2800,2900,3001, - . 3002,3003,3101,3102,3103,3104,3200,3301,3302,3401,3402, - . 3501,3502,3601,3602,3701,3702,3800,3900,0000,4001,4002, - . 4100,4201,4202,4203,4204,4205,4301,4302,4303,4400,4501, - . 4502,4601,4602,4701,4702,4801,4802,4803,4901,4902,4903, - . 4904,5001,5002,5003,5004,5005,5006,5007,5008,5009,5200, - . 0000,5400/ -C .................................................................... -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . U T M . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 1) THEN -C - IERROR = 0 - IF (SWITCH(1).NE.0 .AND. SWITCH(1).EQ.ZONE) RETURN - SWITCH(1) = ZONE - IF (SWITCH(9).NE.0.AND.SWITCH(9).EQ.ZONE.AND.DATA(14).EQ.SAVE) - . RETURN - KEEPZN = ZONE - ZONE = IABS(ZONE) - SAVE = DATA(1) - IF (ZONE .EQ. 0) THEN - ZONE = IDINT( ( (DATA(1) * 180.0D0 / PI) - . + (TOL09 / 3600.D0) ) / 6.D0 ) - IND = 1 - IF (DATA(1) .LT. ZERO) IND = 0 - ZONE = MOD ((ZONE + 30), 60) + IND - KEEPZN = ZONE - IF (DATA(2) .LT. ZERO) KEEPZN = -ZONE - ENDIF - IF (ZONE.LT.1 .OR. ZONE.GT.60) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,140) KEEPZN - 140 FORMAT ('0ERROR PJ01Z0'/ - . ' ILLEGAL ZONE NO. : ',I10) - IERROR = 011 - RETURN - ENDIF - BUFFL(1) = DATA(14) - BUFFL(2) = DATA(15) - BUFFL(3) = 0.9996D0 - BUFFL(4) = ZERO - BUFFL(5) = DBLE (6 * ZONE - 183) * 1.0D6 - BUFFL(6) = ZERO - BUFFL(7) = 500000.0D0 - BUFFL(8) = ZERO - -c --- COORDS -c --- Use just the ZONE provided when setting the false Northing -c IF (DATA(2) .LT. ZERO) BUFFL(8) = 10000000.0D0 - - IF (KEEPZN .LT. 0) BUFFL(8) = 10000000.0D0 - IF (BUFFL(1).NE.0.0D0.AND.BUFFL(1).NE.SAVE9) SWITCH(9) = 0 - SAVE9 = BUFFL(1) - ITEMP = IPPARM - IPPARM = 1 - DO 145 I=1,8 - DATA(I) = BUFFL(I) - 145 CONTINUE - AZ = DATA(14) - EZ = DATA(15) - SWITCH(9) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STATE PLANE . -C ...................................................................... -C - KSYS = 0 - IF (ISYS .EQ. 2) THEN -C - IERROR = 0 - IF (SWITCH(2).NE.0 .AND. SWITCH(2).EQ.ZONE) RETURN - IF (ISPHER .NE. 0 .AND. ISPHER .NE. 8) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,205) ISPHER - 205 FORMAT('0ERROR PJ02Z0'/ - . ' SPHEROID NO. ',I4,' IS INVALID FOR STATE PLANE', - . ' TRANSFORMATIONS') - IERROR = 020 - RETURN - ENDIF - IF (ZONE .GT. 0) THEN - IND02 = 0 - IF (ISPHER .EQ. 0) THEN - DO 210 I = 1,134 - IF (ZONE .EQ. NAD27(I)) IND02 = I - 210 CONTINUE - ENDIF - IF (ISPHER .EQ. 8) THEN - DO 220 I = 1,134 - IF (ZONE .EQ. NAD83(I)) IND02 = I - 220 CONTINUE - ENDIF - IF (IND02 .EQ. 0) THEN - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - ELSE - IF (IPEMSG .EQ. 0)WRITE (IPELUN,240) ZONE, ISPHER - IERROR = 021 - RETURN - ENDIF - IF (ISPHER .EQ. 0) THEN - LUNIT = LU27 - DATUM = FILE27 - ENDIF - IF (ISPHER .EQ. 8) THEN - LUNIT = LU83 - DATUM = FILE83 - ENDIF - OPEN (UNIT=LUNIT,FILE=DATUM,STATUS='OLD',ACCESS='DIRECT', - . RECL=LEN) - READ (UNIT=LUNIT,REC=IND02) PNAME,ID,TABLE - CLOSE (UNIT=LUNIT,STATUS='KEEP') - IF (ID .LE. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,240) ZONE, ISPHER - 240 FORMAT('0ERROR PJ02Z0'/ - . ' ILLEGAL ZONE NO. : ',I8,' FOR SPHEROID NO. : ',I4) - IERROR = 021 - RETURN - ENDIF - ITYPE = ID - AZ = TABLE(1) - ES = TABLE(2) - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - ITEMP = IPPARM - IPPARM = 1 -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - DATA(3) = TABLE(4) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 9 - SWITCH(MSYS) = 0 - KSYS = 9 - GO TO 900 - ENDIF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - DATA(3) = PAKCZ0(TABLE(6)) - DATA(4) = PAKCZ0(TABLE(5)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - MSYS = 4 - SWITCH(MSYS) = 0 - KSYS = 4 - GO TO 400 - ENDIF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(4)) - DATA(7) = TABLE(5) - DATA(8) = TABLE(6) - MSYS = 7 - SWITCH(MSYS) = 0 - KSYS = 7 - GO TO 700 - ENDIF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - DATA(3) = TABLE(4) - DATA(4) = PAKCZ0(TABLE(6)) - DATA(5) = PAKCZ0(TABLE(3)) - DATA(6) = PAKCZ0(TABLE(7)) - DATA(7) = TABLE(8) - DATA(8) = TABLE(9) - DATA(13) = ONE - MSYS = 20 - SWITCH(MSYS) = 0 - KSYS = 20 - GO TO 2000 - ENDIF -C - ENDIF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ALBERS CONICAL EQUAL AREA . -C ...................................................................... -C - IF (ISYS .EQ. 3) THEN -C - IERROR = 0 - IF (SWITCH(3).NE.0 .AND. SWITCH(3).EQ.ZONE) RETURN - SWITCH(3) = 0 - A03 = AZ - E03 = EZ - ES03 = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,340) - 340 FORMAT ('0ERROR PJ03Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 031 - RETURN - END IF - LON003 = PAKRZ0 (DATA(5)) - LAT003 = PAKRZ0 (DATA(6)) - X003 = DATA(7) - Y003 = DATA(8) - SINP03 = DSIN (LAT1) - CON = SINP03 - COSP03 = DCOS (LAT1) - MS1 = MSFNZ0 (E03,SINP03,COSP03) - QS1 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT2) - COSP03 = DCOS (LAT2) - MS2 = MSFNZ0 (E03,SINP03,COSP03) - QS2 = QSFNZ0 (E03,SINP03,COSP03) - SINP03 = DSIN (LAT003) - COSP03 = DCOS (LAT003) - QS0 = QSFNZ0 (E03,SINP03,COSP03) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS03 = (MS1 * MS1 - MS2 * MS2) / (QS2 - QS1) - ELSE - NS03 = CON - END IF - C = MS1 * MS1 + NS03 * QS1 - RH003 = A03 * DSQRT (C - NS03 * QS0) / NS03 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON003,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT003,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,350) A03,ES03, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X003,Y003 - 350 FORMAT ('0INITIALIZATION PARAMETERS (ALBERS CONICAL EQUAL-AREA', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A03 - DATA(2) = ES03 - SWITCH(3) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT CONFORMAL CONIC . -C ...................................................................... -C -400 CONTINUE - IF (KSYS.EQ.4.OR.ISYS .EQ. 4) THEN -C - IERROR = 0 - IF (SWITCH(4).NE.0 .AND. SWITCH(4).EQ.ZONE) RETURN - SWITCH(4) = 0 - A04 = AZ - E04 = EZ - ES = ESZ - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,440) - 440 FORMAT ('0ERROR PJ04Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 041 - RETURN - END IF - LON004 = PAKRZ0 (DATA(5)) - LAT004 = PAKRZ0 (DATA(6)) - X004 = DATA(7) - Y004 = DATA(8) - SINP04 = DSIN (LAT1) - CON = SINP04 - COSP04 = DCOS (LAT1) - MS1 = MSFNZ0 (E04,SINP04,COSP04) - TS1 = TSFNZ0 (E04,LAT1,SINP04) - SINP04 = DSIN (LAT2) - COSP04 = DCOS (LAT2) - MS2 = MSFNZ0 (E04,SINP04,COSP04) - TS2 = TSFNZ0 (E04,LAT2,SINP04) - SINP04 = DSIN (LAT004) - TS0 = TSFNZ0 (E04,LAT004,SINP04) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS04 = DLOG (MS1 / MS2) / DLOG (TS1 / TS2) - ELSE - NS04 = CON - END IF - F04 = MS1 / (NS04 * TS1 ** NS04) - RH004 = A04 * F04 * TS0 ** NS04 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON004,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT004,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,450) A04,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X004,Y004 - 450 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT CONFORMAL CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A04 - DATA(2) = ES - SWITCH(4) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - 470 FORMAT (' INITIALIZATION PARAMETERS (STATE PLANE PROJECTION)'/ - . ' ZONE NUMBER = ',I4,5X,' ZONE NAME = ',A32) - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 5) THEN -C - IERROR = 0 - IF (SWITCH(5).NE.0 .AND. SWITCH(5).EQ.ZONE) RETURN - SWITCH(5) = 0 - A05 = AZ - E05 = EZ - ES = ESZ - LON005 = PAKRZ0 (DATA(5)) - LAT1 = PAKRZ0 (DATA(6)) - M1 = DCOS(LAT1) / (DSQRT( ONE - ES * DSIN(LAT1) **2)) - X005 = DATA(7) - Y005 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON005,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,550) A05,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X005,Y005 - 550 FORMAT ('0INITIALIZATION PARAMETERS (MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' CENTRAL LONGITUDE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A05 - DATA(2) = ES - SWITCH(5) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLAR STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 6) THEN -C - IERROR = 0 - IF (SWITCH(6).NE.0 .AND. SWITCH(6).EQ.ZONE) RETURN - SWITCH(6) = 0 - A06 = AZ - E06 = EZ - ES = ESZ - E4 = E4Z - LON006 = PAKRZ0 (DATA(5)) - SAVE = DATA(6) - LATC = PAKRZ0 (SAVE) - X006 = DATA(7) - Y006 = DATA(8) - FAC = ONE - IF (SAVE .LT. ZERO) FAC =-ONE - IND06 = 0 - IF (DABS(SAVE) .NE. NINTYD) THEN - IND06 = 1 - CON1 = FAC * LATC - SINPHI = DSIN (CON1) - COSPHI = DCOS (CON1) - MCS = MSFNZ0 (E06,SINPHI,COSPHI) - TCS = TSFNZ0 (E06,CON1,SINPHI) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON006,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LATC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,650) A06,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X006,Y006 - 650 FORMAT ('0INITIALIZATION PARAMETERS (POLAR STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF Y-AXIS = ',A1,2I3,F7.3/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A06 - DATA(2) = ES - SWITCH(6) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . POLYCONIC . -C ...................................................................... -C - 700 CONTINUE - IF (KSYS.EQ.7.OR.ISYS .EQ. 7) THEN -C - IERROR = 0 - IF (SWITCH(7).NE.0 .AND. SWITCH(7).EQ.ZONE) RETURN - SWITCH(7) = 0 - A07 = AZ - E07 = EZ - ES07 = ESZ - E007 = E0Z - E107 = E1Z - E207 = E2Z - E307 = E3Z - LON007 = PAKRZ0 (DATA(5)) - LAT007 = PAKRZ0 (DATA(6)) - X007 = DATA(7) - Y007 = DATA(8) - ML007 = MLFNZ0 (E007,E107,E207,E307,LAT007) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON007,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT007,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,750) A07,ES07, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X007,Y007 - 750 FORMAT ('0INITIALIZATION PARAMETERS (POLYCONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A07 - DATA(2) = ES07 - SWITCH(7) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIDISTANT CONIC . -C ...................................................................... -C - IF (ISYS .EQ. 8) THEN -C - IERROR = 0 - IF (SWITCH(8).NE.0 .AND. SWITCH(8).EQ.ZONE) RETURN - SWITCH(8) = 0 - A08 = AZ - E = EZ - ES = ESZ - E008 = E0Z - E108 = E1Z - E208 = E2Z - E308 = E3Z - LAT1 = PAKRZ0 (DATA(3)) - LAT2 = PAKRZ0 (DATA(4)) - IF (DABS(LAT1+LAT2) .LT. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,840) - 840 FORMAT ('0ERROR PJ08Z0'/ - . ' EQUAL LATITUDES FOR ST. PARALLELS ON OPPOSITE', - . ' SIDES OF EQUATOR') - IERROR = 081 - RETURN - END IF - LON008 = PAKRZ0 (DATA(5)) - LAT0 = PAKRZ0 (DATA(6)) - X008 = DATA(7) - Y008 = DATA(8) - SINPHI = DSIN (LAT1) - COSPHI = DCOS (LAT1) - MS1 = MSFNZ0 (E,SINPHI,COSPHI) - ML1 = MLFNZ0 (E008,E108,E208,E308,LAT1) - IND = 0 - IF (DATA(9) .NE. ZERO) THEN - IND = 1 - SINPHI = DSIN (LAT2) - COSPHI = DCOS (LAT2) - MS2 = MSFNZ0 (E,SINPHI,COSPHI) - ML2 = MLFNZ0 (E008,E108,E208,E308,LAT2) - IF (DABS(LAT1-LAT2) .GE. EPSLN) THEN - NS08 = (MS1 - MS2) / (ML2 - ML1) - ELSE - NS08 = SINPHI - END IF - ELSE - NS08 = SINPHI - END IF - GL = ML1 + MS1 / NS08 - ML0 = MLFNZ0 (E008,E108,E208,E308,LAT0) - RH008 = A08 * (GL - ML0) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT2,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LON008,SGNA(3),DEGS(3),MINS(3),SECS(3)) - CALL RADDZ0 (LAT0,SGNA(4),DEGS(4),MINS(4),SECS(4)) - IF (IND .NE. 0) THEN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,850) A08,ES, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,4), - . X008,Y008 - 850 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF 1ST ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - ELSE - IF (IPPARM .EQ. 0) WRITE (IPPLUN,860) A08,ES, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=3,4), - . X008,Y008 - 860 FORMAT ('0INITIALIZATION PARAMETERS (EQUIDISTANT CONIC', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LATITUDE OF ST. PARALLEL = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - END IF - DATA(1) = A08 - DATA(2) = ES - SWITCH(8) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . TRANSVERSE MERCATOR . -C ...................................................................... -C - 900 CONTINUE - IF (KSYS.EQ.9.OR.ISYS .EQ. 9) THEN -C - IERROR = 0 - IF (DATA(1).NE.0.0D0.AND.DATA(1).NE.SAVE) SWITCH(9) = 0 - IF (SWITCH(9).NE.0 .AND. SWITCH(9).EQ.ZONE) RETURN - SWITCH(9) = 0 - SAVE = DATA(1) - A09 = AZ - E09 = EZ - ES09 = ESZ - E009 = E0Z - E109 = E1Z - E209 = E2Z - E309 = E3Z - KS009 = DATA(3) - LON009 = PAKRZ0 (DATA(5)) - LAT009 = PAKRZ0 (DATA(6)) - X009 = DATA(7) - Y009 = DATA(8) - ML009 = A09 * MLFNZ0 (E009,E109,E209,E309,LAT009) - IND09 = 1 - ESP = ES09 - IF (E09 .GE. TOL09) THEN - IND09 = 0 - ESP = ES09 / (ONE - ES09) - END IF -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON009,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT009,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,950) A09,ES09,KS009, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X009,Y009 - 950 FORMAT ('0INITIALIZATION PARAMETERS (TRANSVERSE MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE FACTOR AT C. MERIDIAN =',F9.6/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A09 - DATA(2) = ES09 - SWITCH(9) = ZONE -C -C LIST UTM PROJECTION INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 1) THEN - IPPARM = ITEMP - BUFFL(1) = A09 - BUFFL(2) = ES09 - ZONE = KEEPZN - SWITCH(9) = ZONE - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,960) ZONE,BUFFL(1), - . BUFFL(2),BUFFL(3), - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . BUFFL(7),BUFFL(8) - 960 FORMAT ('0INITIALIZATION PARAMETERS (U T M PROJECTION)'/ - . ' ZONE = ',I3/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID = ',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED = ',F18.15/ - . ' SCALE FACTOR AT C. MERIDIAN = ',F9.6/ - . ' LONGITUDE OF CENTRAL MERIDIAN= ',A1,2I3,F7.3/ - . ' FALSE EASTING = ',F12.2,' METERS'/ - . ' FALSE NORTHING = ',F12.2,' METERS') - SWITCH(1) = ZONE - RETURN - END IF -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . STEREOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 10) THEN -C - IERROR = 0 - IF (SWITCH(10).NE.0 .AND. SWITCH(10).EQ.ZONE) RETURN - SWITCH(10) = 0 - A10 = AZZ - LON010 = PAKRZ0 (DATA(5)) - LAT010 = PAKRZ0 (DATA(6)) - X010 = DATA(7) - Y010 = DATA(8) - SINP10 = DSIN (LAT010) - COSP10 = DCOS (LAT010) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON010,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT010,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1050) A10, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X010,Y010 - 1050 FORMAT ('0INITIALIZATION PARAMETERS (STEREOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A10 - SWITCH(10) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . LAMBERT AZIMUTHAL EQUAL-AREA . -C ...................................................................... -C - IF (ISYS .EQ. 11) THEN -C - IERROR = 0 - IF (SWITCH(11).NE.0 .AND. SWITCH(11).EQ.ZONE) RETURN - SWITCH(11) = 0 - A11 = AZZ - LON011 = PAKRZ0 (DATA(5)) - LAT011 = PAKRZ0 (DATA(6)) - X011 = DATA(7) - Y011 = DATA(8) - SINP11 = DSIN (LAT011) - COSP11 = DCOS (LAT011) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON011,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT011,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1150) A11, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X011,Y011 - 1150 FORMAT ('0INITIALIZATION PARAMETERS (LAMBERT AZIMUTHAL EQUAL-AREA' - . ,' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A11 - SWITCH(11) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . AZIMUTHAL EQUIDISTANT . -C ...................................................................... -C - IF (ISYS .EQ. 12) THEN -C - IERROR = 0 - IF (SWITCH(12).NE.0 .AND. SWITCH(12).EQ.ZONE) RETURN - SWITCH(12) = 0 - A12 = AZZ - LON012 = PAKRZ0 (DATA(5)) - LAT012 = PAKRZ0 (DATA(6)) - X012 = DATA(7) - Y012 = DATA(8) - SINP12 = DSIN (LAT012) - COSP12 = DCOS (LAT012) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON012,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT012,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1250) A12, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X012,Y012 - 1250 FORMAT ('0INITIALIZATION PARAMETERS (AZIMUTHAL EQUIDISTANT', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A12 - SWITCH(12) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GNOMONIC . -C ...................................................................... -C - IF (ISYS .EQ. 13) THEN -C - IERROR = 0 - IF (SWITCH(13).NE.0 .AND. SWITCH(13).EQ.ZONE) RETURN - SWITCH(13) = 0 - A13 = AZZ - LON013 = PAKRZ0 (DATA(5)) - LAT013 = PAKRZ0 (DATA(6)) - X013 = DATA(7) - Y013 = DATA(8) - SINP13 = DSIN (LAT013) - COSP13 = DCOS (LAT013) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON013,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT013,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1350) A13, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X013,Y013 - 1350 FORMAT ('0INITIALIZATION PARAMETERS (GNOMONIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A13 - SWITCH(13) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ORTHOGRAPHIC . -C ...................................................................... -C - IF (ISYS .EQ. 14) THEN -C - IERROR = 0 - IF (SWITCH(14).NE.0 .AND. SWITCH(14).EQ.ZONE) RETURN - SWITCH(14) = 0 - A14 = AZZ - LON014 = PAKRZ0 (DATA(5)) - LAT014 = PAKRZ0 (DATA(6)) - X014 = DATA(7) - Y014 = DATA(8) - SINP14 = DSIN (LAT014) - COSP14 = DCOS (LAT014) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON014,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT014,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1450) A14, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X014,Y014 - 1450 FORMAT ('0INITIALIZATION PARAMETERS (ORTHOGRAPHIC', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A14 - SWITCH(14) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . GENERAL VERTICAL NEAR-SIDE PERSPECTIVE . -C ...................................................................... -C - IF (ISYS .EQ. 15) THEN -C - IERROR = 0 - IF (SWITCH(15).NE.0 .AND. SWITCH(15).EQ.ZONE) RETURN - SWITCH(15) = 0 - A15 = AZZ - P = ONE + DATA(3) / A15 - LON015 = PAKRZ0 (DATA(5)) - LAT015 = PAKRZ0 (DATA(6)) - X015 = DATA(7) - Y015 = DATA(8) - SINP15 = DSIN (LAT015) - COSP15 = DCOS (LAT015) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON015,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT015,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1550) A15,DATA(3), - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X015,Y015 - 1550 FORMAT ('0INITIALIZATION PARAMETERS (GENERAL VERTICAL NEAR-SIDE', - . ' PERSPECTIVE PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' HEIGHT OF PERSPECTIVE POINT'/ - . ' ABOVE SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A15 - SWITCH(15) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SINUSOIDAL . -C ...................................................................... -C - IF (ISYS .EQ. 16) THEN -C - IERROR = 0 - IF (SWITCH(16).NE.0 .AND. SWITCH(16).EQ.ZONE) RETURN - SWITCH(16) = 0 - A16 = AZZ - LON016 = PAKRZ0 (DATA(5)) - X016 = DATA(7) - Y016 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON016,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1650) A16, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X016,Y016 - 1650 FORMAT ('0INITIALIZATION PARAMETERS (SINUSOIDAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A16 - SWITCH(16) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . EQUIRECTANGULAR . -C ...................................................................... -C - IF (ISYS .EQ. 17) THEN -C - IERROR = 0 - IF (SWITCH(17).NE.0 .AND. SWITCH(17).EQ.ZONE) RETURN - SWITCH(17) = 0 - A17 = AZZ - LAT1 = PAKRZ0 (DATA(6)) - LON017 = PAKRZ0 (DATA(5)) - X017 = DATA(7) - Y017 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LAT1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LON017,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1750) A17, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X017,Y017 - 1750 FORMAT ('0INITIALIZATION PARAMETERS (EQUIRECTANGULAR PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LATITUDE OF TRUE SCALE = ',A1,2I2,F7.3/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A17 - SWITCH(17) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MILLER CYLINDRICAL . -C ...................................................................... -C - IF (ISYS .EQ. 18) THEN -C - IERROR = 0 - IF (SWITCH(18).NE.0 .AND. SWITCH(18).EQ.ZONE) RETURN - SWITCH(18) = 0 - A18 = AZZ - LON018 = PAKRZ0 (DATA(5)) - X018 = DATA(7) - Y018 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON018,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1850) A18, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X018,Y018 - 1850 FORMAT ('0INITIALIZATION PARAMETERS (MILLER CYLINDRICAL', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A18 - SWITCH(18) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . VAN DER GRINTEN I . -C ...................................................................... -C - IF (ISYS .EQ. 19) THEN -C - IERROR = 0 - IF (SWITCH(19).NE.0 .AND. SWITCH(19).EQ.ZONE) RETURN - SWITCH(19) = 0 - A19 = AZZ - LON019 = PAKRZ0 (DATA(5)) - X019 = DATA(7) - Y019 = DATA(8) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON019,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,1950) A19, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X019,Y019 - 1950 FORMAT ('0INITIALIZATION PARAMETERS (VAN DER GRINTEN I', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A19 - SWITCH(19) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . OBLIQUE MERCATOR (HOTINE) . -C ...................................................................... -C - 2000 CONTINUE - IF (KSYS.EQ.20.OR.ISYS .EQ. 20) THEN -C - IERROR = 0 - IF (SWITCH(20).NE.0 .AND. SWITCH(20).EQ.ZONE) RETURN - SWITCH(20) = 0 - MODE = 0 - IF (DATA(13) .NE. ZERO) MODE = 1 - A = AZ - E20 = EZ - ES = ESZ - KS0 = DATA(3) - LAT0 = PAKRZ0 (DATA(6)) - X020 = DATA(7) - Y020 = DATA(8) - SINPH0 = DSIN (LAT0) - COSPH0 = DCOS (LAT0) - CON = ONE - ES * SINPH0 * SINPH0 - COM = DSQRT (ONE - ES) - BL = DSQRT (ONE + ES * COSPH0 ** 4 / (ONE - ES)) - AL = A * BL * KS0 * COM / CON - IF (DABS(LAT0).LT.EPSLN) TS0 = 1.0D0 - IF (DABS(LAT0).LT.EPSLN) D=1.0D0 - IF (DABS(LAT0).LT.EPSLN) EL=1.0D0 - IF (DABS(LAT0).GE.EPSLN) THEN - TS0 = TSFNZ0 (E20,LAT0,SINPH0) - CON = DSQRT (CON) - D = BL * COM / (COSPH0 * CON) - F = D + DSIGN (DSQRT (DMAX1 ((D * D - ONE), 0.0D0)) , LAT0) - EL = F * TS0 ** BL - END IF - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2050) A,ES,KS0 - 2050 FORMAT ('0INITIALIZATION PARAMETERS (OBLIQUE MERCATOR ''HOTINE''', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' SCALE AT CENTER =',F12.9) - IF (MODE .NE. 0) THEN - ALPHA = PAKRZ0 (DATA(4)) - LONC = PAKRZ0 (DATA(5)) - G = HALF * (F - ONE / F) - GAMMA = ASINZ0 (DSIN (ALPHA) / D) - LON020 = LONC - ASINZ0 (G * DTAN (GAMMA)) / BL -C -C LIST INITIALIZATION PARAMETERS (CASE B). -C - CALL RADDZ0 (ALPHA,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LONC,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT0,SGNA(3),DEGS(3),MINS(3),SECS(3)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2060) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,3) - 2060 FORMAT (' AZIMUTH OF CENTRAL LINE = ',A1,2I3,F7.3/ - . ' LONGITUDE OF ORIGIN = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - CON = DABS (LAT0) - IF (CON.GT.EPSLN .AND. DABS(CON - HALFPI).GT.EPSLN) THEN - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE -C -C LIST STATE PLANE INITIALIZATION PARAMETERS IF NECESSARY -C - IF (ISYS .EQ. 2) THEN - IPPARM = ITEMP - IF (IERROR .NE. 0) RETURN - IF (IPPARM .EQ. 0) WRITE (IPPLUN,470) ZONE, PNAME - SWITCH(2) = ZONE - RETURN - END IF -C - RETURN - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - 2040 FORMAT ('0ERROR PJ20Z0'/ - . ' INPUT DATA ERROR') - IERROR = 201 - RETURN - END IF - END IF - LON1 = PAKRZ0 (DATA(9)) - LAT1 = PAKRZ0 (DATA(10)) - LON2 = PAKRZ0 (DATA(11)) - LAT2 = PAKRZ0 (DATA(12)) - SINPHI = DSIN (LAT1) - TS1 = TSFNZ0 (E20,LAT1,SINPHI) - SINPHI = DSIN (LAT2) - TS2 = TSFNZ0 (E20,LAT2,SINPHI) - H = TS1 ** BL - L = TS2 ** BL - F = EL / H - G = HALF * (F - ONE / F) - J = (EL * EL - L * H) / (EL * EL + L * H) - P = (L - H) / (L + H) - CALL RADDZ0 (LON2,SGNA(3),DEGS(3),MINS(3),SECS(3)) - DLON = LON1 - LON2 - IF (DLON .LT. -PI) LON2 = LON2 - 2.D0 * PI - IF (DLON .GT. PI) LON2 = LON2 + 2.D0 * PI - DLON = LON1 - LON2 - LON020 = HALF * (LON1 + LON2) - DATAN (J * DTAN (HALF * BL * - . DLON) / P) / BL - DLON = ADJLZ0 (LON1 - LON020) - GAMMA = DATAN (DSIN (BL * DLON) / G) - ALPHA = ASINZ0 (D * DSIN (GAMMA)) - CALL RADDZ0 (LON1,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT1,SGNA(2),DEGS(2),MINS(2),SECS(2)) - CALL RADDZ0 (LAT2,SGNA(4),DEGS(4),MINS(4),SECS(4)) - CALL RADDZ0 (LAT0,SGNA(5),DEGS(5),MINS(5),SECS(5)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2070) - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,5) - 2070 FORMAT (' LONGITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 1ST POINT = ',A1,2I3,F7.3/ - . ' LONGITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF 2ND POINT = ',A1,2I3,F7.3/ - . ' LATITUDE OF ORIGIN = ',A1,2I3,F7.3) - IF (DABS(LAT1 - LAT2) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - CON = DABS (LAT1) - END IF - IF (CON.LE.EPSLN .OR. DABS(CON - HALFPI).LE.EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - ELSE - IF (DABS(DABS(LAT0) - HALFPI) .LE. EPSLN) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2040) - IERROR = 202 - RETURN - END IF - END IF - SINGAM = DSIN (GAMMA) - COSGAM = DCOS (GAMMA) - SINALF = DSIN (ALPHA) - COSALF = DCOS (ALPHA) - U0 = DSIGN((AL/BL)*DATAN(DSQRT(D*D-ONE)/COSALF),LAT0) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2080) X020,Y020 - 2080 FORMAT (' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A - DATA(2) = ES - SWITCH(20) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . ROBINSON . -C ...................................................................... -C - IF (ISYS .EQ. 21) THEN -C - IERROR = 0 - IF (SWITCH(21).NE.0 .AND. SWITCH(21).EQ.ZONE) RETURN - SWITCH(21) = 0 - A21 = AZZ - LON021 = PAKRZ0 (DATA(5)) - X021 = DATA(7) - Y021 = DATA(8) - PR(1)=-0.062D0 - XLR(1)=0.9986D0 - PR(2)=0.D0 - XLR(2)=1.D0 - PR(3)=0.062D0 - XLR(3)=0.9986D0 - PR(4)=0.124D0 - XLR(4)=0.9954D0 - PR(5)=0.186D0 - XLR(5)=0.99D0 - PR(6)=0.248D0 - XLR(6)=0.9822D0 - PR(7)=0.31D0 - XLR(7)=0.973D0 - PR(8)=0.372D0 - XLR(8)=0.96D0 - PR(9)=0.434D0 - XLR(9)=0.9427D0 - PR(10)=0.4958D0 - XLR(10)=0.9216D0 - PR(11)=0.5571D0 - XLR(11)=0.8962D0 - PR(12)=0.6176D0 - XLR(12)=0.8679D0 - PR(13)=0.6769D0 - XLR(13)=0.835D0 - PR(14)=0.7346D0 - XLR(14)=0.7986D0 - PR(15)=0.7903D0 - XLR(15)=0.7597D0 - PR(16)=0.8435D0 - XLR(16)=0.7186D0 - PR(17)=0.8936D0 - XLR(17)=0.6732D0 - PR(18)=0.9394D0 - XLR(18)=0.6213D0 - PR(19)=0.9761D0 - XLR(19)=0.5722D0 - PR(20)=1.0D0 - XLR(20)=0.5322D0 - DO 2110 I=1,20 - 2110 XLR(I)=XLR(I) * 0.9858D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON021,SGNA(1),DEGS(1),MINS(1),SECS(1)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2150) A21, - . SGNA(1),DEGS(1),MINS(1),SECS(1), - . X021,Y021 - 2150 FORMAT ('0INITIALIZATION PARAMETERS (ROBINSON', - . ' PROJECTION)'/ - . ' RADIUS OF SPHERE =',F12.2,' METERS'/ - . ' LONGITUDE OF C. MERIDIAN = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A21 - SWITCH(21) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . SPACE OBLIQUE MERCATOR . -C ...................................................................... -C - IF (ISYS .EQ. 22) THEN -C - IERROR = 0 - IF (SWITCH(22).NE.0 .AND. SWITCH(22).EQ.ZONE) RETURN - SWITCH(22) = 0 - A22 = AZ - E = EZ - ES22 = ESZ - X022 = DATA(7) - Y022 = DATA(8) - LAND = IDINT(DATA(3)+TOL) - PATH = IDINT(DATA(4)+TOL) -C -C CHECK IF LANDSAT NUMBER IS WITHIN RANGE 1 - 5 -C - IF (LAND .GT. 0 .AND. LAND .LE. 5) THEN - IF (LAND .LE. 3) LIMIT = 251 - IF (LAND .GE. 4) LIMIT = 233 - ELSE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - IERROR = 221 - RETURN - END IF -C -C CHECK IF PATH NUMBER IS WITHIN RANGE 1 - 251 FOR LANDSATS 1 - 3 -C OR RANGE 1 - 233 FOR LANDSATS 4 - 5 -C - IF (PATH .LE. 0 .OR. PATH .GT. LIMIT) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2240) LAND, PATH - 2240 FORMAT ('0ERROR PJ22Z0'/ - . ' LANDSAT NUMBER ',I2,' AND / OR PATH NUMBER ',I4, - . ' ARE OUT OF RANGE') - IERROR = 221 - RETURN - END IF - P1=1440.0D0 - IF (LAND.LE.3) THEN - P2=103.2669323D0 - ALF=99.092D0*DG1 - ELSE - P2=98.8841202D0 - ALF=98.20D0*DG1 - END IF - SA=DSIN(ALF) - CA=DCOS(ALF) - IF (DABS(CA).LT.1.D-9) CA=1.D-9 - ESC=ES22*CA*CA - ESS=ES22*SA*SA - W=((ONE-ESC)/(ONE-ES22))**TWO-ONE - Q=ESS/(ONE-ES22) - T=(ESS*(TWO-ES22))/(ONE-ES22)**TWO - U=ESC/(ONE-ES22) - XJ=(ONE-ES22)**3 - P22=P2/P1 -C -C COMPUTE FOURIER COEFFICIENTS. LAM IS CURRENT VALUE OF -C LAMBDA DOUBLE-PRIME. -C - LAM=0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=FA2 - SUMA4=FA4 - SUMB=FB - SUMC1=FC1 - SUMC3=FC3 - DO 2210 I=9,81,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+4.0D0*FA2 - SUMA4=SUMA4+4.0D0*FA4 - SUMB=SUMB+4.0D0*FB - SUMC1=SUMC1+4.0D0*FC1 - SUMC3=SUMC3+4.0D0*FC3 - 2210 CONTINUE - DO 2220 I=18,72,18 - LAM=DBLE(I) - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+TWO*FA2 - SUMA4=SUMA4+TWO*FA4 - SUMB=SUMB+TWO*FB - SUMC1=SUMC1+TWO*FC1 - SUMC3=SUMC3+TWO*FC3 - 2220 CONTINUE - LAM=90.0D0 - CALL SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) - SUMA2=SUMA2+FA2 - SUMA4=SUMA4+FA4 - SUMB=SUMB+FB - SUMC1=SUMC1+FC1 - SUMC3=SUMC3+FC3 -C -C THESE ARE THE VALUES OF FOURIER CONSTANTS. -C - A2=SUMA2/30.D0 - A4=SUMA4/60.D0 - B=SUMB/30.D0 - C1=SUMC1/15.D0 - C3=SUMC3/45.D0 -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2250) A22,ES22,LAND,PATH, - . X022,Y022 - 2250 FORMAT ('0INITIALIZATION PARAMETERS (SPACE OBL. MERCATOR', - . ' PROJECTION)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LANDSAT NO. = ',I3/ - . ' PATH = ',I5/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS'/) - DATA(1) = A22 - DATA(2) = ES22 - SWITCH(22) = ZONE - RETURN - END IF -C -C ...................................................................... -C . INITIALIZATION OF PROJECTION PARAMETERS . -C -C . MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) . -C ...................................................................... -C - IF (ISYS .EQ. 23) THEN -C - IERROR = 0 - IF (SWITCH(23).NE.0 .AND. SWITCH(23).EQ.ZONE) RETURN - SWITCH(23) = 0 - A23 = AZ - EC2 = 0.6768657997291094D-02 - EC = DSQRT (EC2) - N=6 - LON023 = -152.0D0*DG1 - LAT023 = 64.0D0*DG1 - X023 = DATA(7) - Y023 = DATA(8) - ACOEF(1)=0.9945303D0 - ACOEF(2)=0.0052083D0 - ACOEF(3)=0.0072721D0 - ACOEF(4)=-0.0151089D0 - ACOEF(5)=0.0642675D0 - ACOEF(6)=0.3582802D0 - BCOEF(1)=0.0D0 - BCOEF(2)=-.0027404D0 - BCOEF(3)=0.0048181D0 - BCOEF(4)=-0.1932526D0 - BCOEF(5)=-0.1381226D0 - BCOEF(6)=-0.2884586D0 - ESPHI=EC*DSIN(LAT023) - CHIO=TWO*DATAN(DTAN((HALFPI+LAT023)/TWO)*((ONE-ESPHI)/ - . (ONE+ESPHI))**(EC/TWO)) - HALFPI - SCHIO=DSIN(CHIO) - CCHIO=DCOS(CHIO) -C -C LIST RESULTS OF PARAMETER INITIALIZATION. -C - CALL RADDZ0 (LON023,SGNA(1),DEGS(1),MINS(1),SECS(1)) - CALL RADDZ0 (LAT023,SGNA(2),DEGS(2),MINS(2),SECS(2)) - IF (IPPARM .EQ. 0) WRITE (IPPLUN,2350) A23,EC2, - . (SGNA(I),DEGS(I),MINS(I),SECS(I),I=1,2), - . X023,Y023 - 2350 FORMAT ('0INITIALIZATION PARAMETERS (MOD. STEREOGRAPHIC', - . ' CONFORMAL PROJECTION, ALASKA)'/ - . ' SEMI-MAJOR AXIS OF ELLIPSOID =',F12.2,' METERS'/ - . ' ECCENTRICITY SQUARED =',F12.9/ - . ' LONGITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' LATITUDE OF CENTER = ',A1,2I3,F7.3/ - . ' FALSE EASTING =',F12.2,' METERS'/ - . ' FALSE NORTHING =',F12.2,' METERS') - DATA(1) = A23 - SWITCH(23) = ZONE - RETURN - END IF -C -C INITIALIZATION OF PROJECTION COMPLETED -C - END -C PJ01Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * U T M * -C ********************************************************************** -C - SUBROUTINE PJ01Z0 (COORD,CRDIO,INDIC) -C -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /TOGGLE/ SWITCH - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ01Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 013 - RETURN - 140 CALL PJ09Z0 (GEOG,PROJ,FWD) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(1) .NE. 0) GO TO 160 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 014 - RETURN - 160 CALL PJ09Z0 (PROJ,GEOG,INV) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ02Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C * STATE PLANE * -C ********************************************************************** -C - SUBROUTINE PJ02Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23), ITYPE - INTEGER*2 INDIC, FWD, INV - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ02/ ITYPE - COMMON /TOGGLE/ SWITCH -C - PARAMETER (FWD=0, INV=1) -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - 250 FORMAT ('0ERROR PJ02Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 023 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (GEOG,PROJ,FWD) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (GEOG,PROJ,FWD) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (GEOG,PROJ,FWD) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (GEOG,PROJ,FWD) - END IF -C - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(2) .EQ. 0) THEN - IF (IPEMSG .EQ. 0) WRITE (IPELUN,250) - IERROR = 025 - RETURN - END IF -C -C TRANSVERSE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 1) THEN - CALL PJ09Z0 (PROJ,GEOG,INV) - END IF -C -C LAMBERT CONFORMAL PROJECTION -C - IF (ITYPE .EQ. 2) THEN - CALL PJ04Z0 (PROJ,GEOG,INV) - END IF -C -C POLYCONIC PROJECTION -C - IF (ITYPE .EQ. 3) THEN - CALL PJ07Z0 (PROJ,GEOG,INV) - END IF -C -C OBLIQUE MERCATOR PROJECTION -C - IF (ITYPE .EQ. 4) THEN - CALL PJ20Z0 (PROJ,GEOG,INV) - END IF -C - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ03Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ALBERS CONICAL EQUAL AREA * -C ********************************************************************** -C - SUBROUTINE PJ03Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,C,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ03/ A,LON0,X0,Y0,C,E,ES,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA HALFPI /1.5707963267948966D0/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ03Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 033 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - QS = QSFNZ0 (E,SINPHI,COSPHI) - RH = A * DSQRT (C - NS * QS) / NS - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(3) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 034 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - CON = RH * NS / A - QS = (C - CON * CON) / NS - IF (E .LT. TOL) GO TO 260 - CON = ONE - HALF * (ONE - ES) * DLOG ((ONE - E) / - . (ONE + E)) / E - IF ((DABS(CON) - DABS(QS)) .GT. TOL) GO TO 260 - GEOG(2) = DSIGN (HALFPI , QS) - GO TO 280 - 260 GEOG(2) = PHI1Z0 (E,QS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 035 - RETURN - 280 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ04Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT CONFORMAL CONIC * -C ********************************************************************** -C - SUBROUTINE PJ04Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,NS,F,RH0 ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ04/ A,LON0,X0,Y0,E,F,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 200 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ04Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 043 - RETURN - 200 CON = DABS (DABS (GEOG(2)) - HALFPI) - IF (CON .GT. EPSLN) GO TO 220 - CON = GEOG(2) * NS - IF (CON .GT. ZERO) GO TO 210 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ04Z0'/ - . ' POINT CANNOT BE PROJECTED') - IERROR = 044 - RETURN - 210 RH = ZERO - GO TO 230 - 220 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - RH = A * F * TS ** NS - 230 THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(4) .NE. 0) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - IERROR = 045 - RETURN - 240 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X*X + Y*Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - IF (RH.NE.ZERO .OR. NS.GT.ZERO) GO TO 250 - GEOG(2) = - HALFPI - GO TO 260 - 250 CON = ONE / NS - TS = (RH / (A * F)) ** CON - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 260 - IERROR = 046 - RETURN - 260 GEOG(1) = ADJLZ0 (THETA / NS + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ05Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ05Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,X0,Y0,NS,F,RH0,LAT1,M1 ************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ05/ A,LON0,X0,Y0,E,M1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ05Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 052 - RETURN - 220 IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ05Z0'/ - . ' TRANSFORMATION CANNOT BE COMPUTED AT THE POLES') - IERROR = 053 - RETURN - 240 SINPHI = DSIN (GEOG(2)) - TS = TSFNZ0 (E,GEOG(2),SINPHI) - PROJ(1) = X0 + A * M1 * ADJLZ0 (GEOG(1) - LON0) - PROJ(2) = Y0 - A * M1 * DLOG (TS) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(5) .NE. 0) GO TO 260 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 054 - RETURN - 260 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - TS = DEXP (- Y / (A * M1)) - GEOG(2) = PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 280 - IERROR = 055 - RETURN - 280 GEOG(1) = ADJLZ0 (LON0 + X / (A * M1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ06Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLAR STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ06Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),IND - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,E4,MCS,TCS,FAC,IND ******* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ06/ A,LON0,X0,Y0,E,E4,FAC,MCS,TCS,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ06Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 062 - RETURN - 220 CON1 = FAC * ADJLZ0 (GEOG(1) - LON0) - CON2 = FAC * GEOG(2) - SINPHI = DSIN (CON2) - TS = TSFNZ0 (E,CON2,SINPHI) - IF (IND .EQ. 0) GO TO 240 - RH = A * MCS * TS / TCS - GO TO 260 - 240 RH = TWO * A * TS / E4 - 260 PROJ(1) = X0 + FAC * RH * DSIN (CON1) - PROJ(2) = Y0 - FAC * RH * DCOS (CON1) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(6) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 063 - RETURN - 320 X = FAC * (PROJ(1) - X0) - Y = FAC * (PROJ(2) - Y0) - RH = DSQRT (X * X + Y * Y) - IF (IND .EQ. 0) GO TO 340 - TS = RH * TCS / (A * MCS) - GO TO 360 - 340 TS = RH * E4 / (TWO * A) - 360 GEOG(2) = FAC * PHI2Z0 (E,TS) - IF (IERROR .EQ. 0) GO TO 380 - IERROR = 064 - RETURN - 380 IF (RH .NE. ZERO) GO TO 400 - GEOG(1) = FAC * LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 GEOG(1) = ADJLZ0 (FAC * DATAN2 (X , -Y) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ07Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * POLYCONIC * -C ********************************************************************** -C - SUBROUTINE PJ07Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,E0,E1,E2,ML0 ************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ07/ A,LON0,X0,Y0,E,E0,E1,E2,E3,ES,ML0 - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ07Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 072 - RETURN - 220 CON = ADJLZ0 (GEOG(1) - LON0) - IF (DABS(GEOG(2)) .GT. TOL) GO TO 240 - PROJ(1) = X0 + A * CON - PROJ(2) = Y0 - A * ML0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 240 SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - MS = MSFNZ0 (E,SINPHI,COSPHI) - CON = CON * SINPHI - PROJ(1) = X0 + A * MS * DSIN (CON) / SINPHI - PROJ(2) = Y0 + A * (ML - ML0 + MS * (ONE - DCOS(CON)) / SINPHI) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(7) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 073 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - AL = ML0 + Y / A - IF (DABS (AL) .GT. TOL) GO TO 340 - GEOG(1) = X / A + LON0 - GEOG(2) = ZERO - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 340 B = AL * AL + (X / A) ** 2 - CALL PHI4Z0 (ES,E0,E1,E2,E3,AL,B,C,GEOG(2)) - IF (IERROR .EQ. 0) GO TO 360 - IERROR = 074 - RETURN - 360 GEOG(1) = ADJLZ0 (ASINZ0 (X * C / A) / DSIN (GEOG(2)) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ08Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIDISTANT CONIC * -C ********************************************************************** -C - SUBROUTINE PJ08Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C ** PARAMETERS * A,E,ES,LAT1,LAT2,LON0,LAT0,X0,Y0,E0,E1,E2,E3,NS,GL,RH0 - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ08/ A,LON0,X0,Y0,E0,E1,E2,E3,GL,NS,RH0 - COMMON /TOGGLE/ SWITCH - DATA ZERO,ONE /0.0D0,1.0D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 300 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ08Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 083 - RETURN - 300 ML = MLFNZ0 (E0,E1,E2,E3,GEOG(2)) - RH = A * (GL - ML) - THETA = NS * ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + RH * DSIN (THETA) - PROJ(2) = Y0 + RH0 - RH * DCOS (THETA) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(8) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - IERROR = 084 - RETURN - 320 X = PROJ(1) - X0 - Y = RH0 - PROJ(2) + Y0 - RH = DSIGN (DSQRT (X * X + Y * Y) , NS) - THETA = ZERO - CON = DSIGN (ONE , NS) - IF (RH .NE. ZERO) THETA = DATAN2 (CON * X , CON * Y) - ML = GL - RH / A - GEOG(2) = PHI3Z0 (ML,E0,E1,E2,E3) - IF (IERROR .EQ. 0) GO TO 340 - IERROR = 085 - RETURN - 340 GEOG(1) = ADJLZ0 (LON0 + THETA / NS) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ09Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * TRANSVERSE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ09Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23),I,IND,NIT - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS ** A,E,ES,KS0,LON0,LAT0,X0,Y0,E0,E1,E2,E3,ESP,ML0,IND - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ09/ A,LON0,X0,Y0,ES,ESP,E0,E1,E2,E3,KS0,LAT0,ML0,IND - COMMON /TOGGLE/ SWITCH - DATA ZERO,HALF,ONE,TWO,THREE /0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ - DATA FOUR,FIVE,SIX,EIGHT,NINE /4.0D0,5.0D0,6.0D0,8.0D0,9.0D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TEN /10.0D0/ - DATA EPSLN,NIT /1.0D-10,6/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ09Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 092 - RETURN - 220 DLON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (IND .EQ. 0) GO TO 240 - COSPHI = DCOS (LAT) - B = COSPHI * DSIN (DLON) - IF (DABS(DABS(B) - ONE) .GT. EPSLN) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ09Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 093 - RETURN - 230 PROJ(1) = HALF * A * KS0 * DLOG ((ONE + B) / (ONE - B)) + X0 - CON = DACOS (COSPHI * DCOS (DLON) / DSQRT (ONE - B * B)) - IF (LAT .LT. ZERO) CON =-CON - PROJ(2) = A * KS0 * (CON - LAT0) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN -C - 240 SINPHI = DSIN (LAT) - COSPHI = DCOS (LAT) - AL = COSPHI * DLON - ALS = AL * AL - C = ESP * COSPHI * COSPHI - TQ = DTAN (LAT) - T = TQ * TQ - N = A / DSQRT (ONE - ES * SINPHI * SINPHI) - ML = A * MLFNZ0 (E0,E1,E2,E3,LAT) - PROJ(1) = KS0 * N * AL * (ONE + ALS / SIX * (ONE - T + C + - . ALS / 20.0D0 * (FIVE - 18.0D0 * T + T * T + 72.0D0 * - . C - 58.0D0 * ESP))) + X0 - PROJ(2) = KS0 *(ML - ML0 + N * TQ *(ALS *(HALF + ALS / 24.0D0 * - . (FIVE - T + NINE * C + FOUR * C * C + ALS / 30.0D0 * - . (61.0D0 - 58.0D0 * T + T * T + 600.0D0 * C - - . 330.0D0 * ESP))))) + Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(9) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 094 - RETURN - 320 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - IF (IND .EQ. 0) GO TO 340 - F = DEXP (X / (A * KS0)) - G = HALF * (F - ONE / F) - TEMP = LAT0 + Y / (A * KS0) - H = DCOS (TEMP) - CON = DSQRT ((ONE - H * H) / (ONE + G * G)) - GEOG(2) = ASINZ0 (CON) - IF (TEMP .LT. ZERO) GEOG(2) =-GEOG(2) - IF (G.NE.ZERO .OR. H.NE.ZERO) GO TO 330 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 330 GEOG(1) = ADJLZ0 (DATAN2 (G,H) + LON0) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN -C - 340 CON = (ML0 + Y / KS0) / A - PHI = CON - DO 360 I = 1,NIT - DPHI = ((CON + E1 * DSIN (TWO * PHI) - E2 * DSIN (FOUR * PHI) - . + E3 * DSIN (SIX * PHI)) / E0) - PHI - PHI = PHI + DPHI - IF (DABS(DPHI) .LE. EPSLN) GO TO 380 - 360 CONTINUE - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) NIT - 2030 FORMAT ('0ERROR PI09Z0' / - . ' LATITUDE FAILED TO CONVERGE AFTER',I3,' ITERATIONS') - IERROR = 095 - RETURN - 380 IF (DABS(PHI) .LT. HALFPI) GO TO 400 - GEOG(2) = DSIGN (HALFPI , Y) - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 400 SINPHI = DSIN (PHI) - COSPHI = DCOS (PHI) - TANPHI = DTAN (PHI) - C = ESP * COSPHI * COSPHI - CS = C * C - T = TANPHI * TANPHI - TS = T * T - CON = ONE - ES * SINPHI * SINPHI - N = A / DSQRT (CON) - R = N * (ONE - ES) / CON - D = X / (N * KS0) - DS = D * D - GEOG(2) = PHI - (N * TANPHI * DS / R) * (HALF - DS / 24.0D0 * - . (FIVE + THREE * T + TEN * C - FOUR * CS - NINE * ESP - . - DS / 30.0D0 * (61.0D0 + 90.0D0 * T + 298.0D0 * C + - . 45.0D0 * TS - 252.0D0 * ESP - THREE * CS))) - GEOG(1) = ADJLZ0 (LON0 + (D * (ONE - DS / SIX * (ONE + TWO * - . T + C - DS / 20.0D0 * (FIVE - TWO * C + 28.0D0 * T - - . THREE * CS + EIGHT * ESP + 24.0D0 * TS))) / COSPHI)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ10Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * STEREOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ10Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ10/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ10Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 102 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(G + ONE) .GT. EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ10Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 103 - RETURN - 140 KSP = TWO / (ONE + G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(10) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 104 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = TWO * DATAN (RH / (TWO * A)) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ11Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * LAMBERT AZIMUTHAL EQUAL-AREA * -C ********************************************************************** -C - SUBROUTINE PJ11Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ11/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ11Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 112 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .NE. -ONE) GO TO 140 - CON = TWO * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO A CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 113 - RETURN - 140 KSP = DSQRT (TWO / (ONE + G)) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(11) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 114 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - CON = RH / (TWO * A) - IF (CON .LE. ONE) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ11Z0'/ - . ' INPUT DATA ERROR') - IERROR = 115 - RETURN - 230 Z = TWO * ASINZ0 (CON) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (CON .EQ. ZERO) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ12Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * AZIMUTHAL EQUIDISTANT * -C ********************************************************************** -C - SUBROUTINE PJ12Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ12/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ12Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 122 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (DABS(DABS(G) - ONE) .GE. EPSLN) GO TO 140 - KSP = ONE - IF (G .GE. ZERO) GO TO 160 - CON = TWO * HALFPI * A - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) CON - 2020 FORMAT (' POINT PROJECTS INTO CIRCLE OF RADIUS =',F12.2, - . ' METERS') - IERROR = 123 - RETURN - 140 Z = DACOS (G) - KSP = Z / DSIN (Z) - 160 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(12) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 124 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. (TWO * HALFPI * A)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ12Z0'/ - . ' INPUT DATA ERROR') - IERROR = 125 - RETURN - 230 Z = RH / A - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ13Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GNOMONIC * -C ********************************************************************** -C - SUBROUTINE PJ13Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ13/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ13Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 132 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GT. ZERO) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT PROJECTS INTO INFINITY') - IERROR = 133 - RETURN - 140 KSP = ONE / G - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(13) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 134 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - Z = DATAN (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ14Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ORTHOGRAPHIC * -C ********************************************************************** -C - SUBROUTINE PJ14Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ***************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ14/ A,LON0,X0,Y0,COSPH0,LAT0,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ14Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 142 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - KSP = ONE - IF (G.GT.ZERO .OR. DABS(G).LE.EPSLN) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 143 - RETURN - 140 PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(14) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 144 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - IF (RH .LE. A) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ14Z0'/ - . ' INPUT DATA ERROR') - IERROR = 145 - RETURN - 230 Z = ASINZ0 (RH / A) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ15Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * GENERAL VERTICAL NEAR-SIDE PERSPECTIVE * -C ********************************************************************** -C - SUBROUTINE PJ15Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,P,LON0,LAT0,X0,Y0,SINPH0,COSPH0 *************** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ15/ A,LON0,X0,Y0,COSPH0,LAT0,P,SINPH0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE /0.0D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ15Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 152 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - SINPHI = DSIN (GEOG(2)) - COSPHI = DCOS (GEOG(2)) - COSLON = DCOS (LON) - G = SINPH0 * SINPHI + COSPH0 * COSPHI * COSLON - IF (G .GE. (ONE / P)) GO TO 140 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT (' POINT CANNOT BE PROJECTED') - IERROR = 153 - RETURN - 140 KSP = (P - ONE) / (P - G) - PROJ(1) = X0 + A * KSP * COSPHI * DSIN (LON) - PROJ(2) = Y0 + A * KSP * (COSPH0 * SINPHI - SINPH0 * COSPHI * - . COSLON) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(15) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 154 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - RH = DSQRT (X * X + Y * Y) - R = RH / A - CON = P - ONE - COM = P + ONE - IF (R .LE. DSQRT (CON / COM)) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2030) - 2030 FORMAT ('0ERROR PJ15Z0'/ - . ' INPUT DATA ERROR') - IERROR = 155 - RETURN - 230 SINZ = (P - DSQRT (ONE - R * R * COM / CON)) / - . (CON / R + R / CON) - Z = ASINZ0 (SINZ) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(2) = ASINZ0 (COSZ * SINPH0 + Y * SINZ * COSPH0 / RH) - CON = DABS (LAT0) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 260 - IF (LAT0 .LT. ZERO) GO TO 250 - GEOG(1) = ADJLZ0 (LON0 + DATAN2 (X , -Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 250 GEOG(1) = ADJLZ0 (LON0 - DATAN2 (-X , Y)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 260 CON = COSZ - SINPH0 * DSIN (GEOG(2)) - IF (DABS(CON).LT.EPSLN.AND.DABS(X).LT.EPSLN) RETURN - GEOG(1) = ADJLZ0 (LON0 + DATAN2 ((X*SINZ*COSPH0) , (CON*RH))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ16Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SINUSOIDAL * -C ********************************************************************** -C - SUBROUTINE PJ16Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ16/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ16Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 162 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS (GEOG(2)) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(16) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 163 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 230 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ16Z0'/ - . ' INPUT DATA ERROR') - IERROR = 164 - RETURN - 230 CON = DABS (GEOG(2)) - HALFPI - IF (DABS (CON) .GT. EPSLN) GO TO 240 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS (GEOG(2)))) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ17Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * EQUIRECTANGULAR * -C ********************************************************************** -C - SUBROUTINE PJ17Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0,LAT1 ******************************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ17/ A,LON0,X0,Y0,LAT1 - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ17Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 172 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON * DCOS(LAT1) - PROJ(2) = Y0 + A * GEOG(2) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(17) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 173 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(2) = Y / A - IF (DABS(GEOG(2)) .LE. HALFPI) GO TO 240 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2020) - 2020 FORMAT ('0ERROR PJ17Z0'/ - . ' INPUT DATA ERROR') - IERROR = 174 - RETURN - 240 GEOG(1) = ADJLZ0 (LON0 + X / (A * DCOS(LAT1) )) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ18Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MILLER CYLINDRICAL * -C ********************************************************************** -C - SUBROUTINE PJ18Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ18/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA FORTPI /0.78539816339744833D0/ - DATA ZERO,ONEQ,TWOH /0.0D0,1.25D0,2.5D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ18Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 182 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 + A * DLOG (DTAN (FORTPI + GEOG(2) / TWOH)) * ONEQ - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(18) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 183 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - GEOG(1) = ADJLZ0 (LON0 + X / A) - GEOG(2) = TWOH * DATAN (DEXP (Y / A / ONEQ)) - FORTPI * TWOH - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ19Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * VAN DER GRINTEN I * -C ********************************************************************** -C - SUBROUTINE PJ19Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ19/ A,LON0,X0,Y0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN/1.0D-10/ - DATA ZERO,HALF,ONE,TWO,THREE/0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ19Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 192 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - LAT = GEOG(2) - IF (DABS(LAT) .GT. EPSLN) GO TO 140 - PROJ(1) = X0 + A * LON - PROJ(2) = Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 140 THETA = ASINZ0 (DMIN1(DABS (LAT /HALFPI),ONE)) - IF (DABS(LON).GT.EPSLN.AND.DABS(DABS(LAT)-HALFPI).GT.EPSLN) - . GO TO 160 - PROJ(1) = X0 - PROJ(2) = Y0 + PI * A * DSIGN( DTAN (HALF * THETA), LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - 160 AL = HALF * DABS (PI / LON - LON / PI) - ASQ = AL * AL - SINTHT = DSIN (THETA) - COSTHT = DCOS (THETA) - G = COSTHT / (SINTHT + COSTHT - ONE) - GSQ = G * G - M = G * (TWO / SINTHT - ONE) - MSQ = M * M - CON = PI * A * (AL * (G - MSQ) + DSQRT (ASQ * (G - MSQ)**2 - - . (MSQ + ASQ) * (GSQ - MSQ))) / (MSQ + ASQ) - CON = DSIGN (CON , LON) - PROJ(1) = X0 + CON - CON = DABS (CON / (PI * A)) - PROJ(2) = Y0 + DSIGN (PI * A * DSQRT (ONE - CON * CON - - . TWO * AL * CON) , LAT) - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ALGORITHM DEVELOPED BY D.P. RUBINCAM, THE AMERICAN CARTOGRAPHER, -C 1981, V. 8, NO. 2, P. 177-180. -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(19) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 193 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - CON = PI * A - XX = X / CON - YY = Y / CON - XYS = XX * XX + YY * YY - C1 = -DABS(YY) * (ONE + XYS) - C2 = C1 - TWO * YY * YY + XX * XX - C3 = -TWO * C1 + ONE + TWO * YY * YY + XYS*XYS - D = YY * YY / C3 + (TWO * C2 * C2 * C2/ C3/ C3/ C3 - 9.0D0 * C1 - . * C2/ C3/ C3) / 27.0D0 - A1 = (C1 - C2 * C2/ THREE/ C3)/ C3 - M1 = TWO * DSQRT(-A1/ THREE) - CON = ((THREE * D) / A1) / M1 - IF (DABS(CON).GT.ONE) CON = DSIGN(ONE,CON) - TH1 = DACOS(CON)/THREE - GEOG(2) = (-M1 * DCOS(TH1 + PI/ THREE) - C2/ THREE/ C3) - . * DSIGN(PI,Y) - IF (DABS(XX).GE.EPSLN) GO TO 230 - GEOG(1) = LON0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 230 CONTINUE - GEOG(1) = LON0 + PI * (XYS - ONE + DSQRT(ONE + TWO * (XX * XX - . - YY * YY) + XYS * XYS))/ TWO/ XX - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ20Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * OBLIQUE MERCATOR (HOTINE) * -C ********************************************************************** -C - SUBROUTINE PJ20Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,KS0,ALPHA,LONC,LON1,LAT1,LON2,LAT2,LAT0 ** -C ********************** X0,Y0,GAMMA,LON0,AL,BL,EL ********************* - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ20/ LON0,X0,Y0,AL,BL,COSALF,COSGAM,E,EL,SINALF,SINGAM,U0 - COMMON /TOGGLE/ SWITCH - DATA PI /3.14159265358979323846D0/ - DATA HALFPI /1.5707963267948966D0/ - DATA TOL,EPSLN /1.0D-7,1.0D-10/ - DATA ZERO,HALF,ONE /0.0D0,0.5D0,1.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - 2050 FORMAT ('0ERROR PJ20Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 204 - RETURN - 220 SINPHI = DSIN (GEOG(2)) - DLON = ADJLZ0 (GEOG(1) - LON0) - VL = DSIN (BL * DLON) - IF (DABS(DABS(GEOG(2)) - HALFPI) .GT. EPSLN) GO TO 230 - UL = SINGAM * DSIGN (ONE , GEOG(2)) - US = AL * GEOG(2) / BL - GO TO 250 - 230 TS = TSFNZ0 (E,GEOG(2),SINPHI) - Q = EL / TS ** BL - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - UL = (S * SINGAM - VL * COSGAM) / T - CON = DCOS (BL * DLON) - IF (DABS(CON) .LT. TOL) GO TO 240 - US = AL * DATAN ((S * COSGAM + VL * SINGAM) / CON) / BL - IF (CON .LT. ZERO) US = US + PI * AL / BL - GO TO 250 - 240 US = AL * BL * DLON - 250 IF (DABS(DABS(UL) - ONE) .GT. EPSLN) GO TO 255 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2060) - 2060 FORMAT ('0ERROR PJ20Z0'/ - . ' POINT PROJECTS INTO INFINITY') - IERROR = 205 - RETURN - 255 VS = HALF * AL * DLOG ((ONE - UL) / (ONE + UL)) / BL - US = US - U0 - PROJ(1) = X0 + VS * COSALF + US * SINALF - PROJ(2) = Y0 + US * COSALF - VS * SINALF - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(20) .NE. 0) GO TO 280 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2050) - IERROR = 206 - RETURN - 280 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - VS = X * COSALF - Y * SINALF - US = Y * COSALF + X * SINALF - US = US + U0 - Q = DEXP (- BL * VS / AL) - S = HALF * (Q - ONE / Q) - T = HALF * (Q + ONE / Q) - VL = DSIN (BL * US / AL) - UL = (VL * COSGAM + S * SINGAM) / T - IF (DABS (DABS (UL) - ONE) .GE. EPSLN) GO TO 300 - GEOG(1) = LON0 - GEOG(2) = DSIGN (HALFPI , UL) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 300 CON = ONE / BL - TS = (EL / DSQRT ((ONE + UL) / (ONE - UL))) ** CON - GEOG(2) = PHI2Z0 (E,TS) - CON = DCOS (BL * US / AL) - LON = LON0 - DATAN2 ((S * COSGAM - VL * SINGAM) , CON) / BL - GEOG(1) = ADJLZ0 (LON) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ21Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * ROBINSON * -C ********************************************************************** -C - SUBROUTINE PJ21Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,IP1,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . PR(20),XLR(20) -C **** PARAMETERS **** A,LON0,X0,Y0 ************************************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ21/ A,LON0,X0,Y0,PR,XLR - COMMON /TOGGLE/ SWITCH - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA EPSLN /1.0D-10/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ21Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 212 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) - P2=DABS(GEOG(2)/5.0D0/DG1) - IP1=IDINT(P2-EPSLN) -C -C STIRLING'S INTERPOLATION FORMULA (USING 2ND DIFF.) -C USED WITH LOOKUP TABLE TO COMPUTE RECTANGULAR COORDINATES -C FROM LAT/LONG. -C - P2=P2-DBLE(IP1) - X=A*(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0)*LON - Y=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . *DSIGN(1.0D0,GEOG(2)) - PROJ(1) = X0 + X - PROJ(2) = Y0 + Y - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(21) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 213 - RETURN - 220 X = PROJ(1) - X0 - Y = PROJ(2) - Y0 - YY = 2.0D0 * Y / PI / A - PHID = YY * 90.0D0 - P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - IF (IP1.EQ.0) IP1 = 1 - NN = 0 -C -C STIRLING'S INTERPOLATION FORMULA AS USED IN FORWARD TRANSFORMATION -C IS REVERSED FOR FIRST ESTIMATION OF LAT. FROM RECTANGULAR -C COORDINATES. LAT. IS THEN ADJUSTED BY ITERATION UNTIL USE OF -C FORWARD SERIES PROVIDES CORRECT VALUE OF Y WITHIN TOLERANCE. -C - 230 U = PR(IP1 + 3) - PR(IP1 + 1) - V = PR(IP1 + 3) - 2.0D0 * PR(IP1 + 2) + PR(IP1 + 1) - T = 2.0D0 * (DABS(YY) - PR(IP1 + 2))/ U - C = V / U - P2 = T * (1.0D0 - C * T * (1.0D0 - 2.0D0 * C * T)) - IF (P2.LT.0.0D0.AND.IP1.NE.1) GO TO 240 - PHID = DSIGN((P2 + DBLE(IP1)) * 5.0D0, Y) - 235 P2 = DABS(PHID / 5.0D0) - IP1 = IDINT(P2 - EPSLN) - P2 = P2 - DBLE(IP1) - Y1=A*(PR(IP1+2)+P2*(PR(IP1+3)-PR(IP1+1))/2.0D0 - . +P2*P2*(PR(IP1+3)-2.0D0*PR(IP1+2)+PR(IP1+1))/2.0D0)*PI/2.0D0 - . * DSIGN(1.0D0,Y) - PHID = PHID - 180.0D0* (Y1 - Y) / PI / A - NN = NN + 1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,245) - IERROR = 214 - RETURN - 237 IF (DABS(Y1 - Y).GT.0.00001D0) GO TO 235 - GO TO 250 - 240 IP1 = IP1 - 1 - GO TO 230 - 245 FORMAT ('0ERROR PJ21Z0'/ - . ' TOO MANY ITERATIONS FOR INVERSE ROBINSON') - 250 GEOG(2) = PHID * DG1 -C -C CALCULATE LONG. USING FINAL LAT. WITH TRANSPOSED FORWARD -C STIRLING'S INTERPOLATION FORMULA. -C - GEOG(1)=LON0+X/A/(XLR(IP1+2)+P2*(XLR(IP1+3)-XLR(IP1+1))/2.0D0 - . +P2*P2*(XLR(IP1+3)-2.0D0*XLR(IP1+2)+XLR(IP1+1))/2.0D0) - GEOG(1) = ADJLZ0(GEOG(1)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ22Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * SPACE OBLIQUE MERCATOR * -C ********************************************************************** -C - SUBROUTINE PJ22Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,PATH,LAND,NN,L - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2) -C **** PARAMETERS **** A,E,ES,LON0,LATC,X0,Y0,MCS,TCS,FAC,IND ********** - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - COMMON /PJ22/ A,X0,Y0,A2,A4,B,C1,C3,LAND,PATH - COMMON /TOGGLE/ SWITCH - DATA TOL /1.0D-7/ - DATA DG1 /0.01745329252D0/ - DATA PI /3.14159265358979323846D0/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ22Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 222 - RETURN - 220 IF (LAND.GE.4) GO TO 225 - LON=GEOG(1)-128.87D0*DG1+PI*TWO/251.D0*DBLE(PATH) - GO TO 230 - 225 LON=GEOG(1)-129.30D0*DG1+PI*TWO/233.D0*DBLE(PATH) - 230 LAT=GEOG(2) -C -C TEST FOR LAT. AND LONG. APPROACHING 90 DEGREES. -C - IF (LAT.GT.1.570796D0) LAT=1.570796D0 - IF (LAT.LT.-1.570796D0) LAT =-1.570796D0 - IF (LAT.GE.0) LAMPP=PI/TWO - IF (LAT.LT.0) LAMPP=1.5D0*PI - NN=0 - 231 SAV=LAMPP - L=0 - LAMTP=LON+P22*LAMPP - CL=DCOS(LAMTP) - IF (DABS(CL).LT.TOL) LAMTP=LAMTP-TOL - FAC=LAMPP-(DSIGN(ONE,CL))*DSIN(LAMPP)*PI/TWO - 232 LAMT=LON+P22*SAV - C=DCOS(LAMT) - IF (DABS(C).LT.TOL) THEN - LAMDP = SAV - GO TO 233 - END IF - XLAM=((ONE-ES)*DTAN(LAT)*SA+DSIN(LAMT)*CA)/C - LAMDP=DATAN(XLAM) - LAMDP=LAMDP+FAC - DIF=DABS(SAV)-DABS(LAMDP) - IF (DABS(DIF).LT.TOL) GO TO 233 - SAV=LAMDP - L=L+1 - IF (L.GT.50) GO TO 234 - GO TO 232 -C -C ADJUST FOR LANDSAT ORIGIN. -C - 233 RLM=PI*(16.D0/31.D0+ONE/248.D0) - RLM2=RLM+TWO*PI - NN=NN+1 - IF (NN.GE.3) GO TO 236 - IF (LAMDP.GT.RLM.AND.LAMDP.LT.RLM2) GO TO 236 - IF (LAMDP.LE.RLM) LAMPP=2.5D0*PI - IF (LAMDP.GE.RLM2) LAMPP=PI/TWO - GO TO 231 - 234 IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ22Z0'/ - . ' 50 ITERATIONS WITHOUT CONVERGENCE.') - IERROR = 223 - 236 CONTINUE -C -C LAMDP COMPUTED. NOW COMPUTE PHIDP. -C - SP=DSIN(LAT) - PHIDP=ASINZ0(((ONE-ES)*CA*SP-SA*DCOS(LAT)*DSIN(LAMT))/DSQRT(ONE - . -ES*SP*SP)) -C -C COMPUTE X AND Y -C - TANPH=DLOG(DTAN(PI/4.0D0+PHIDP/TWO)) - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE - . +Q*SDSQ))) - D=DSQRT(XJ*XJ+S*S) - X=B*LAMDP+A2*DSIN(TWO*LAMDP)+A4*DSIN(4.0D0*LAMDP)-TANPH*S/D - X=A*X - Y=C1*SD+C3*DSIN(3.0D0*LAMDP)+TANPH*XJ/D - Y=A*Y - PROJ(1)=X+X0 - PROJ(2)=Y+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(22) .NE. 0) GO TO 320 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 224 - RETURN - 320 X = PROJ(1) -X0 - Y = PROJ(2) -Y0 -C -C COMPUTE TRANSFORMED LAT/LONG AND GEODETIC LAT/LONG, GIVEN X,Y. -C -C BEGIN INVERSE COMPUTATION WITH APPROXIMATION FOR LAMDP. SOLVE -C FOR TRANSFORMED LONG. -C - LAMDP=X/A/B - NN=0 - 325 SAV=LAMDP - SD=DSIN(LAMDP) - SDSQ=SD*SD - S=P22*SA*DCOS(LAMDP)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ)*(ONE+Q - . *SDSQ))) - LAMDP=X/A+Y/A*S/XJ-A2*DSIN(TWO*LAMDP)-A4*DSIN(4.0D0*LAMDP) - . -(S/XJ)*(C1*DSIN(LAMDP)+C3*DSIN(3.0D0*LAMDP)) - LAMDP=LAMDP/B - DIF=LAMDP-SAV - IF (DABS(DIF).LT.TOL) GO TO 330 - NN=NN+1 - IF (NN.EQ.50) GO TO 330 - GO TO 325 -C -C COMPUTE TRANSFORMED LAT. -C - 330 SL=DSIN(LAMDP) - FAC=DEXP(DSQRT(ONE+S*S/XJ/XJ)*(Y/A-C1*SL-C3*DSIN(3.0D0*LAMDP))) - ACTAN=DATAN(FAC) - PHIDP=TWO*(ACTAN-PI/4.0D0) -C -C COMPUTE GEODETIC LATITUDE. -C - DD=SL*SL - IF (DABS(DCOS(LAMDP)).LT.TOL) LAMDP=LAMDP-TOL - SPP=DSIN(PHIDP) - SPPSQ=SPP*SPP - LAMT=DATAN(((ONE-SPPSQ/(ONE-ES))*DTAN(LAMDP)*CA-SPP*SA*DSQRT(( - . ONE+Q*DD)*(ONE-SPPSQ)-SPPSQ*U)/DCOS(LAMDP))/(ONE-SPPSQ*(ONE+U)) - . ) -C -C CORRECT INVERSE QUADRANT. -C - IF (LAMT.GE.0) SL=ONE - IF (LAMT.LT.0) SL=-ONE - IF (DCOS(LAMDP).GE.0) SCL=ONE - IF (DCOS(LAMDP).LT.0) SCL=-ONE - LAMT=LAMT-PI/TWO*(ONE-SCL)*SL - LON=LAMT-P22*LAMDP -C -C COMPUTE GEODETIC LATITUDE. -C - IF (DABS(SA).LT.TOL) LAT=ASINZ0(SPP/DSQRT((ONE-ES)*(ONE-ES) - . +ES*SPPSQ)) - IF (DABS(SA).LT.TOL) GO TO 335 - LAT=DATAN((DTAN(LAMDP)*DCOS(LAMT)-CA*DSIN(LAMT))/((ONE-ES)*SA)) - 335 CONTINUE - IF (LAND.GE.4) GO TO 370 - GEOG(1)=LON+128.87D0*DG1-PI*TWO/251.D0*DBLE(PATH) - GO TO 380 - 370 GEOG(1)=LON+129.30D0*DG1-PI*TWO/233.D0*DBLE(PATH) - 380 GEOG(2)=LAT - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C PJ23Z0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ** MATHEMATICAL ANALYSIS BY JOHN SNYDER ** -C ********************************************************************** -C * MODIFIED-STEREOGRAPHIC CONFORMAL (FOR ALASKA) * -C ********************************************************************** -C - SUBROUTINE PJ23Z0 (COORD,CRDIO,INDIC) -C - IMPLICIT REAL*8 (A-Z) - INTEGER*4 IERROR,IPEMSG,IPELUN,IPPARM,IPPLUN,N,J,NN - INTEGER*4 SWITCH(23) - INTEGER*2 INDIC - DIMENSION GEOG(2),PROJ(2),COORD(2),CRDIO(2), - . ACOEF(6),BCOEF(6) -C **** PARAMETERS **** A,E,ES,LON0,LAT0,X0,Y0,SINPH0,COSPH0 ************ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PJ23/ A,LON0,X0,Y0,ACOEF,BCOEF,EC,LAT0,CCHIO,SCHIO,N - COMMON /TOGGLE/ SWITCH - DATA HALFPI /1.5707963267948966D0/ - DATA EPSLN /1.0D-10/ - DATA ZERO,ONE,TWO /0.0D0,1.0D0,2.0D0/ -C -C ...................................................................... -C . FORWARD TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 0) THEN -C - GEOG(1) = COORD(1) - GEOG(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 120 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - 2010 FORMAT ('0ERROR PJ23Z0'/ - . ' PROJECTION WAS NOT INITIALIZED') - IERROR = 232 - RETURN - 120 LON = ADJLZ0 (GEOG(1) - LON0) -C -C CALCULATE X-PRIME AND Y-PRIME FOR OBLIQUE STEREOGRAPHIC PROJ. -C FROM LAT/LONG. -C - SINLON = DSIN (LON) - COSLON = DCOS (LON) - ESPHI = EC *DSIN(GEOG(2)) - CHI=TWO*DATAN(DTAN((HALFPI+GEOG(2))/TWO)*((ONE-ESPHI)/(ONE - . +ESPHI))**(EC/TWO)) - HALFPI - SCHI=DSIN(CHI) - CCHI=DCOS(CHI) - G=SCHIO*SCHI+CCHIO*CCHI*COSLON - S=TWO/(ONE+G) - XP=S*CCHI*SINLON - YP=S*(CCHIO*SCHI-SCHIO*CCHI*COSLON) -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C OBLIQUE STEREOGRAPHIC TO MODIFIED-STEREOGRAPHIC COORD. -C - R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - DO 140 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 140 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - 140 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - X=XP*AR-YP*AI+BR - Y=YP*AR+XP*AI+BI - PROJ(1)=X*A+X0 - PROJ(2)=Y*A+Y0 - CRDIO(1) = PROJ(1) - CRDIO(2) = PROJ(2) - RETURN - END IF -C -C ...................................................................... -C . INVERSE TRANSFORMATION . -C ...................................................................... -C - IF (INDIC .EQ. 1) THEN -C - PROJ(1) = COORD(1) - PROJ(2) = COORD(2) - IERROR = 0 - IF (SWITCH(23) .NE. 0) GO TO 220 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,2010) - IERROR = 234 - RETURN - 220 X = (PROJ(1) - X0)/A - Y = (PROJ(2) - Y0)/A - XP=X - YP=Y - NN=0 -C -C USE KNUTH ALGORITHM FOR SUMMING COMPLEX TERMS, TO CONVERT -C MODIFIED-STEREOGRAPHIC CONFORMAL TO OBLIQUE STEREOGRAPHIC -C COORDINATES (XP,YP). -C - 225 R=XP+XP - S=XP*XP+YP*YP - AR=ACOEF(N) - AI=BCOEF(N) - BR=ACOEF(N-1) - BI=BCOEF(N-1) - CR=DBLE(N)*AR - CI=DBLE(N)*AI - DR=(DBLE(N-1))*BR - DI=(DBLE(N-1))*BI - DO 230 J=2,N - ARN=BR+R*AR - AIN=BI+R*AI - IF (J.EQ.N) GO TO 230 - BR=ACOEF(N-J)-S*AR - BI=BCOEF(N-J)-S*AI - AR=ARN - AI=AIN - CRN=DR+R*CR - CIN=DI+R*CI - DR=DBLE(N-J)*ACOEF(N-J)-S*CR - DI=DBLE(N-J)*BCOEF(N-J)-S*CI - CR=CRN - CI=CIN - 230 CONTINUE - BR=-S*AR - BI=-S*AI - AR=ARN - AI=AIN - FXYR=XP*AR-YP*AI+BR-X - FXYI=YP*AR+XP*AI+BI-Y - FPXYR=XP*CR-YP*CI+DR - FPXYI=YP*CR+XP*CI+DI - DEN=FPXYR*FPXYR+FPXYI*FPXYI - DXP=-(FXYR*FPXYR+FXYI*FPXYI)/DEN - DYP=-(FXYI*FPXYR-FXYR*FPXYI)/DEN - XP=XP+DXP - YP=YP+DYP - DS=DABS(DXP)+DABS(DYP) - NN=NN+1 - IF (NN.LE.20) GO TO 237 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,235) - 235 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN ITERATING INVERSE') - IERROR = 235 - GO TO 238 - 237 IF (DS.GT.EPSLN) GO TO 225 -C -C CONVERT OBLIQUE STEREOGRAPHIC COORDINATES TO LAT/LONG. -C - 238 RH = DSQRT (XP * XP + YP * YP) - Z = TWO * DATAN (RH / TWO) - SINZ = DSIN (Z) - COSZ = DCOS (Z) - GEOG(1) = LON0 - IF (DABS(RH) .GT. EPSLN) GO TO 240 - GEOG(2) = LAT0 - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - 240 CHI = ASINZ0 (COSZ * SCHIO + YP *SINZ * CCHIO / RH) - NN=0 - PHI=CHI - 250 ESPHI=EC*DSIN(PHI) - DPHI=TWO*DATAN(DTAN((HALFPI+CHI)/TWO)*((ONE+ESPHI)/(ONE-ESPHI)) - . **(EC/TWO)) - HALFPI - PHI - PHI = PHI + DPHI - NN = NN + 1 - IF (NN.LE.20) GO TO 257 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,255) - 255 FORMAT ('0ERROR PJ23Z0'/ - . ' TOO MANY ITERATIONS IN CALCULATING PHI FROM CHI') - IERROR = 236 - GO TO 260 - 257 IF (DABS(DPHI).GT.EPSLN) GO TO 250 - 260 GEOG(2)=PHI - GEOG(1) = ADJLZ0 (LON0 + DATAN2(XP*SINZ, RH*CCHIO*COSZ-YP*SCHIO - . *SINZ)) - CRDIO(1) = GEOG(1) - CRDIO(2) = GEOG(2) - RETURN - END IF -C - END -C QSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION QSFNZ0 (ECCENT,SINPHI,COSPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL Q). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE,TWO /0.5D0,1.0D0,2.0D0/ - DATA EPSLN /1.0D-7/ -C - IF (ECCENT .LT. EPSLN) GO TO 020 - CON = ECCENT * SINPHI - QSFNZ0 = (ONE - ECCENT * ECCENT) * (SINPHI / (ONE - CON * CON) - - . (HALF / ECCENT) * DLOG ((ONE - CON) / (ONE + CON))) - RETURN -C - 020 QSFNZ0 = TWO * SINPHI - RETURN - END -C RADDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE RADDZ0 (RAD,SGNA,DEGS,MINS,SECS) -C -C SUBROUTINE TO CONVERT ANGLE FROM RADIANS TO SIGNED DMS -C SGNA : SIGN OF ANGLE -C DEGS : DEGREES PORTION OF ANGLE -C MINS : MINUTES PORTION OF ANGLE -C SECS : SECONDS PORTION OF ANGLE -C - REAL*8 RAD,CON,RADSEC,ZERO,TOL - REAL*4 SECS - INTEGER*4 DEGS,MINS - CHARACTER*1 SGNA,BLANK,NEG - DATA RADSEC /206264.806247D0/ - DATA ZERO,TOL /0.0D0,1.0D-4/ - DATA BLANK,NEG /' ','-'/ -C -C CONVERT THE ANGLE TO SECONDS. -C - CON = DABS(RAD) * RADSEC - ISEC = IDINT(CON + TOL) -C -C DETERMINE THE SIGN OF THE ANGLE. -C - SGNA = BLANK - IF (RAD .LT. ZERO .AND. CON .GE. 0.00005D0) SGNA = NEG - IF (CON .LT. 0.00005D0) CON = ZERO -C -C COMPUTE DEGREES PART OF THE ANGLE. -C - INTG = ISEC / 3600 - DEGS = INTG - ISEC = INTG * 3600 - CON = CON - DBLE(ISEC) - ISEC = IDINT(CON + TOL) -C -C COMPUTE MINUTES PART OF THE ANGLE. -C - MINS = ISEC / 60 - ISEC = MINS * 60 - CON = CON - DBLE(ISEC) -C -C COMPUTE SECONDS PART OF THE ANGLE. -C - SECS = SNGL(CON) -C -C INCREASE MINS IF SECS CLOSE TO 60.000 -C - IF(SECS .LT. 59.9995D0) RETURN - MINS = MINS + 1 - SECS = 0.0 -C -C INCREASE DEGS IF MINS EQUAL 60 -C - IF(MINS .LE. 59) RETURN - MINS = 0 - DEGS = DEGS + 1 -C - RETURN - END -C SERAZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SERAZ0 (FB,FA2,FA4,FC1,FC3,LAM) -C -C COMPUTES INTEGRAL FUNCTION OF TRANSFORMED LONG. FOR FOURIER -C CONSTANTS A2, A4, B, C1, AND C3. -C LAM IS INTEGRAL VALUE OF TRANSFORMED LONG. -C - IMPLICIT REAL*8 (A-Z) - COMMON /NORM/ Q,T,U,W,ES,P22,SA,CA,XJ - DATA DG1 /0.01745329252D0/ - DATA ONE,TWO /1.0D0,2.0D0/ - LAM=LAM*DG1 - SD=DSIN(LAM) - SDSQ=SD*SD - S=P22*SA*DCOS(LAM)*DSQRT((ONE+T*SDSQ)/((ONE+W*SDSQ) - . *(ONE+Q*SDSQ))) - H=DSQRT((ONE+Q*SDSQ)/(ONE+W*SDSQ))*(((ONE+W*SDSQ)/ - . ((ONE+Q*SDSQ)**TWO))-P22*CA) - SQ=DSQRT(XJ*XJ+S*S) - FB=(H*XJ-S*S)/SQ - FA2=FB*DCOS(TWO*LAM) - FA4=FB*DCOS(4.0D0*LAM) - FC=S*(H+XJ)/SQ - FC1=FC*DCOS(LAM) - FC3=FC*DCOS(3.0D0*LAM) - RETURN - END -C SPHDZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE SPHDZ0(ISPH,PARM) -C -C SUBROUTINE TO COMPUTE SPHEROID PARAMETERS -C -C ISPH IS THE SPHEROID CODE FROM THE FOLLOWING LIST: -C 0 = CLARKE 1866 1 = CLARKE 1880 -C 2 = BESSEL 3 = NEW INTERNATIONAL 1967 -C 4 = INTERNATIONAL 1909 5 = WGS 72 -C 6 = EVEREST 7 = WGS 66 -C 8 = GRS 1980 9 = AIRY -C 10 = MODIFIED EVEREST 11 = MODIFIED AIRY -C 12 = WGS 84 13 = SOUTHEAST ASIA -C 14 = AUSTRALIAN NATIONAL 15 = KRASSOVSKY -C 16 = HOUGH 17 = MERCURY 1960 -C 18 = MODIFIED MERC 1968 19 = SPHERE OF RADIUS 6370997 M -C 20 = INTERNATIONAL 1924 -C -C PARM IS ARRAY OF PROJECTION PARAMETERS: -C PARM(1) IS THE SEMI-MAJOR AXIS -C PARM(2) IS THE ECCENTRICITY SQUARED -C -C IF ISPH IS NEGATIVE, USER SPECIFIED PROJECTION PARAMETERS ARE TO -C DEFINE THE RADIUS OF SPHERE OR ELLIPSOID CONSTANTS AS APPROPRIATE -C -C IF ISPH = 0 , THE DEFAULT IS RESET TO CLARKE 1866 -C -C **** ***** -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION PARM(15),AXIS(21),BXIS(21) -C - COMMON /ELLPZ0/ AZ,EZ,ESZ,E0Z,E1Z,E2Z,E3Z,E4Z - COMMON /SPHRZ0/ AZZ - COMMON /ERRMZ0/ IERROR - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - COMMON /PROJZ0/ IPROJ -C - DATA ZERO,ONE /0.0D0,1.0D0/ -C - DATA AXIS/6378206.4D0,6378249.145D0,6377397.155D0,6378157.5D0, - . 6378388.0D0,6378135.0D0,6377276.3452D0,6378145.0D0,6378137.0D0, - . 6377563.396D0,6377304.063D0,6377340.189D0,6378137.0D0,6378155.D0, - . 6378160.0D0,6378245.0D0,6378270.0D0,6378166.0D0,6378150.0D0, - . 6370997.0D0,6378388.0D0/ -C - DATA BXIS/6356583.8D0,6356514.86955D0,6356078.96284D0, - . 6356772.2D0,6356911.94613D0,6356750.519915D0,6356075.4133D0, - . 6356759.769356D0,6356752.314140D0,6356256.91D0,6356103.039D0, - . 6356034.448D0,6356752.314245D0,6356773.3205D0,6356774.719D0, - . 6356863.0188D0,6356794.343479D0,6356784.283666D0,6356768.337303D0 - . ,6370997.0D0,6356911.95D0/ -C - IF (ISPH.GE.0) GO TO 5 -C -C INITIALIZE USER SPECIFIED SPHERE AND ELLIPSOID PARAMETERS -C - AZZ = ZERO - AZ = ZERO - EZ = ZERO - ESZ = ZERO - E0Z = ZERO - E1Z = ZERO - E2Z = ZERO - E3Z = ZERO - E4Z = ZERO -C -C FETCH FIRST TWO USER SPECIFIED PROJECTION PARAMETERS -C - A = DABS(PARM(1)) - B = DABS(PARM(2)) - IF (A .GT. ZERO .AND. B .GT. ZERO) GO TO 13 - IF (A .GT. ZERO .AND. B .LE. ZERO) GO TO 12 - IF (A .LE. ZERO .AND. B .GT. ZERO) GO TO 11 -C -C DEFAULT NORMAL SPHERE AND CLARKE 1866 ELLIPSOID -C - JSPH = 1 - GO TO 10 -C -C DEFAULT CLARKE 1866 ELLIPSOID -C - 11 A = AXIS(1) - B = BXIS(1) - GO TO 14 -C -C USER SPECIFIED RADIUS OF SPHERE -C - 12 AZZ = A - GO TO 15 -C -C USER SPECIFIED SEMI-MAJOR AND SEMI-MINOR AXES OF ELLIPSOID -C - 13 IF (B .LE. ONE) GO TO 15 - 14 ES = ONE - (B / A)**2 - GO TO 16 -C -C USER SPECIFIED SEMI-MAJOR AXIS AND ECCENTRICITY SQUARED -C - 15 ES = B - 16 AZ = A - ESZ = ES - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - PARM(1) = A - PARM(2) = ES - RETURN -C -C CHECK FOR VALID SPHEROID SELECTION -C - 5 IF (PARM(1).NE.ZERO.AND.IPROJ.NE.1) RETURN - JSPH = IABS(ISPH) + 1 - IF (JSPH.LE.21) GO TO 10 - IERROR = 999 - IF (IPEMSG .EQ. 0) WRITE (IPELUN,1) ISPH - 1 FORMAT('0ERROR SPHDZ0: SPHEROID CODE OF ',I5,' RESET TO 0') - ISPH = 0 - JSPH = 1 -C -C RETRIEVE A AND B AXES FOR SELECTED SPHEROID -C - 10 A = AXIS(JSPH) - B = BXIS(JSPH) - ES = ONE - (B / A)**2 -C -C SET COMMON BLOCK PARAMETERS FOR SELECTED SPHEROID -C - AZZ = 6370997.0D0 - EZ = DSQRT(ES) - E0Z = E0FNZ0(ES) - E1Z = E1FNZ0(ES) - E2Z = E2FNZ0(ES) - E3Z = E3FNZ0(ES) - E4Z = E4FNZ0(EZ) - AZ = A - ESZ = ES - IF (ES.EQ.ZERO) AZZ=A -C - PARM(1) = A - PARM(2) = ES - RETURN - END -C TSFNZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - DOUBLE PRECISION FUNCTION TSFNZ0 (ECCENT,PHI,SINPHI) -C -C FUNCTION TO COMPUTE CONSTANT (SMALL T). -C - IMPLICIT REAL*8 (A-Z) - DATA HALF,ONE /0.5D0,1.0D0/ - DATA HALFPI /1.5707963267948966D0/ -C - CON = ECCENT * SINPHI - COM = HALF * ECCENT - CON = ((ONE - CON) / (ONE + CON)) ** COM - TSFNZ0 = DTAN (HALF * (HALFPI - PHI)) / CON -C - RETURN - END -C UNTFZ0 -C ********************************************************************** -C ** GENERAL CARTOGRAPHIC TRANSFORMATION PACKAGE (GCTP) VERSION 2.0.2 ** -C ** U. S. GEOLOGICAL SURVEY - SNYDER, ELASSAL, AND LINCK 06/08/94 ** -C ********************************************************************** -C - SUBROUTINE UNTFZ0 (INUNIT,IOUNIT,FACTOR,IFLG) -C -C SUBROUTINE TO DETERMINE CONVERGENCE FACTOR BETWEEN TWO LINEAL UNITS -C -C * INPUT ........ -C * INUNIT * UNIT CODE OF SOURCE. -C * IOUNIT * UNIT CODE OF TARGET. -C -C * OUTPUT ....... -C * FACTOR * CONVERGENCE FACTOR FROM SOURCE TO TARGET. -C * IFLG * RETURN FLAG .EQ. 0 , NORMAL RETURN. -C RETURN FLAG .NE. 0 , ABNORMAL RETURN. -C - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION FACTRS(6,6) - COMMON /PRINZ0/ IPEMSG,IPELUN,IPPARM,IPPLUN - PARAMETER (ZERO = 0.0D0, MAXUNT = 6) - DATA FACTRS /0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.2062648062470963D06 , - . 0.5729577951308231D02 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.3048006096012192D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000002000004000D01 , - . 0.0000000000000000D00 , 0.3280833333333333D01 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3280839895013124D01 , - . 0.4848136811095360D-5 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 , - . 0.2777777777777778D-3 , 0.0000000000000000D00 , - . 0.1745329251994330D-1 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.3600000000000000D04 , - . 0.1000000000000000D01 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.9999980000000000D00 , - . 0.3048000000000000D00 , 0.0000000000000000D00 , - . 0.0000000000000000D00 , 0.1000000000000000D01 / -C - IF (INUNIT .GE. 0 .AND. INUNIT .LT. MAXUNT .AND. - . IOUNIT .GE. 0 .AND. IOUNIT .LT. MAXUNT) THEN - FACTOR = FACTRS(IOUNIT+1 , INUNIT+1) - IF (FACTOR .NE. ZERO) THEN - IFLG = 0 - RETURN - ELSE - IF (IPEMSG .NE. 0) WRITE (IPELUN,2000) INUNIT,IOUNIT - 2000 FORMAT (' INCONSISTENT UNIT CODES = ',I6,' / ',I6) - IFLG = 12 - RETURN - END IF - ELSE - IF (INUNIT.LT.0 .OR. INUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) INUNIT,IOUNIT - 2010 FORMAT (' ILLEGAL SOURCE OR TARGET UNIT CODE = ',I6,' / ', - . I6) - END IF - IF (IOUNIT.LT.0 .OR. IOUNIT.GE.MAXUNT) THEN - IF (IPEMSG .NE. 0) WRITE (IPELUN,2010) IOUNIT,IOUNIT - END IF - IFLG = 11 - RETURN - END IF -C - END diff --git a/CALPUFF_SRC/TERREL/cornr.trl b/CALPUFF_SRC/TERREL/cornr.trl deleted file mode 100644 index a869414..0000000 --- a/CALPUFF_SRC/TERREL/cornr.trl +++ /dev/null @@ -1,13 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /CORNR/ -- Corners of sheet of terrain data TERREL -c----------------------------------------------------------------------- - common /CORNR/ xne,yne,xse,yse,xsw,ysw,xnw,ynw - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c xne,yne (m) Coord of NE corner of DB sheet (in output map proj) [r] -c xse,yse (m) Coord of SE corner of DB sheet (in output map proj) [r] -c xsw,ysw (m) Coord of SW corner of DB sheet (in output map proj) [r] -c xnw,ynw (m) Coord of NW corner of DB sheet (in output map proj) [r] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/cpl.bat b/CALPUFF_SRC/TERREL/cpl.bat deleted file mode 100644 index 707d449..0000000 --- a/CALPUFF_SRC/TERREL/cpl.bat +++ /dev/null @@ -1,17 +0,0 @@ -REM Compiling and linking with TERREL using Lahey LF95 for Windows - -lf95 terrel.for -o0 -co -sav -trap doi -out terrel.exe >cpl.txt - -del *.obj -del *.map - -rem Switch settings ------------------------------ -rem -o0 No optimization -rem -co Display the compiler options that are used -rem -sav Save local variables -rem -trap doi Trap NDP divide-by-zero (d), overflow (o), and invalid operation (i) -rem -out Name the compiled executable to "terrel.exe" -rem > Send compiler screen output to file "cpl.txt" -REM Compiling and linking with LF95 - - diff --git a/CALPUFF_SRC/TERREL/dbinf.trl b/CALPUFF_SRC/TERREL/dbinf.trl deleted file mode 100644 index 68abe9f..0000000 --- a/CALPUFF_SRC/TERREL/dbinf.trl +++ /dev/null @@ -1,59 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /DBINF/ -- Terrain Data Base information TERREL -c----------------------------------------------------------------------- - logical lnotgrid,l50by40,lbigendian,lsrtmend - character filenm*11,srtmnm*11,globnm*7 - character*8 dbdatum - - common /DBINF/ lonsedb,latsedb,ndx,nxdb,nydb,nxydb,nd, - & stepa,stepb,npt,nstr,delx,dely,zfac, - & lonnwdb,latnwdb,l50by40, - & lbigendian,lsrtmend,notused,lnotgrid,dbtmsf, - & index(indmax),filenm(indmax),globnm(mxfil), - & srtmnm(indmax),dbdatum, - & alonsedb,alatsedb,hor_res - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c lonsedb (deg) longitude of SE corner of area in DB file [i] -c latsedb (deg) latitude of SE corner of area in DB file [i] -c lonnwdb (deg) longitude of NW corner of area in DB file [i] -c (positive for western hemisphere) -c latnwdb (deg) latitude of NW corner of area in DB file [i] -c (positive for northern hemisphere) -c l50by40 flag indicating data file covers 50 degrees of latitude -c and 40 degrees of longitude, or 30 degrees of latitude -c and 60 degrees of longitude. [l] -c lbigendian flag indicating whether the machine platform is -c "big endian" (LBIGENDIAN=.TRUE., for Motorola, SUN, -c HP and SGI), or "little endian" (LBIGENDIAN=.FALSE., -c for Intel and DEC). [l] -c lsrtmend flag indicating whether the SRTM file is "little -c endian" (LSRTEND=.TRUE. for HGT files, .FALSE. for -c BIL files [l] -c ndx pointer for ARM3 index array [i] -c nxdb,nydb number of degree-squares in ARM3 or GTOPO30 file -c in (x,y) or in (long,lat) [i] -c nxydb number of degree-squares = nxdb*nydb [i] -c nd number of ARM3 indices [i] -c stepa distance between points Along strip (DB units) [r] -c stepb distance between points Between strips (DB units) [r] -c npt number of elevations in one profile (strip) [i] -c nstr number of profiles (strips) in one square [i] -c delx,dely (m) physical distance between points in meters [r] -c zfac vertical scaling factor used to recover physical [r] -c units (e.g. zfac=0.1 if heights in the data base -c represent 10.9 as the integer 109) -c notused count of the # of input data files not on the grid [i] -c lnotgrid flag indicating data file is not in specified grid [l] -c dbtmsf Scale Factor for current DB file (TM projection) [r] -c index ARM3 index for degree-square in DB file [ia] -c filenm name of DB file [ca] -c globnm name of GTOPO30 DB file [ca] -c srtmnm name of SRTM DB file [ca] -c dbdatum Datum string for current DB file [a] -c alonsedb (deg) longitude of SE corner of area in DB file, real! [r] -c alatsedb (deg) latitude of SE corner of area in DB file, real! [r] -c hor_res hor. resolution of CDED data (0.75 or 3 arc sec) [r] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/dd_dem.for b/CALPUFF_SRC/TERREL/dd_dem.for deleted file mode 100644 index 78a253f..0000000 --- a/CALPUFF_SRC/TERREL/dd_dem.for +++ /dev/null @@ -1,24 +0,0 @@ - program dd_dem - -c --- Read USGS DEM file as downloaded and construct logical records -c --- of 1024 bytes (insert delimiters) - - character*40 filein,fileout - character*1024 aline - - write(*,*)' Enter USGS filename: ' - read(*,*) filein - write(*,*)' Enter filename for output: ' - read(*,*) fileout - - open(7,file=filein,form='binary',access='transparent', - & status='old') - open(8,file=fileout) - -c --- Loop over physical records -10 read(7,err=999) aline - write(8,'(a1024)') aline - goto 10 - -999 stop - end diff --git a/CALPUFF_SRC/TERREL/filnam.trl b/CALPUFF_SRC/TERREL/filnam.trl deleted file mode 100644 index d2c0803..0000000 --- a/CALPUFF_SRC/TERREL/filnam.trl +++ /dev/null @@ -1,51 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /FILNAM/ -- File names TERREL -c----------------------------------------------------------------------- - character*132 runinp,outfil,lstfil,pltfil,prevfil,savefil - character*132 xyinp,xyout,gshhsin,coastbln,rawecho - character datafil*132, datatyp*6, justname*132 - logical lcfiles - - common /FILNAM/ ntdf,runinp,outfil,lstfil,pltfil,prevfil,savefil, - & xyinp,xyout,gshhsin,coastbln,rawecho, - & datafil(mxfil),justname(mxfil),datatyp(mxfil) - common /FILLOG/ lcfiles - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c ntdf Number of terrain DB files for this run [i] -c runinp Path & filename for the control file [c] -c (default: TERREL.INP) -c outfil Path & filename for the output TERREL data file [c] -c (default: TERREL.DAT) -c lstfil Path & filename for the output TERREL list file [c] -c (default: TERREL.LST) -c pltfil Path & filename for the output TERREL plot file [c] -c (default: TERREL.GRD) -c prevfil Path & filename for previous binary intermediate [c] -c file used as input (optional) -c (default: PREV.SAV) -c savefil Filename of binary output intermediate file (.SAV) [c] -c (default: TERREL.SAV) -c xyinp Path & filename for input discrete XY points file [c] -c (default: XYINP.DAT) -c xyout Path & filename for output discrete XY points file [c] -c (default: XYOUT.DAT) -c gshhsin Path & filename for input GSHHS binary [c] -c full-resolution datafile -c (default: GSHHS_F.B) -c coastbln Path & filename for output SURFER .BLN for coasts [c] -c (default: COAST.BLN) -c rawecho Path & filename for echoed output of datapoints in [c] -c grid units (optional) -c (default: RAWECHO.DAT) -c datafil name of each DB file, may include path info. [ca] -c justname name of each DB file, no path info. [ca] -c datatyp type of each DB file (USGS90,USGSD2,USGSQD,ARM3, [ca] -c 3CD,GLOB30,DD1,USGSGL,NZGNR,GNR,SRTM1,SRTM3) -c lcfiles Switch indicating if all characters in the [l] -c filenames are to be converted to lower case -c letters (LCFILES=T) or converted to UPPER -c case letters (LCFILES=F). -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/grid.trl b/CALPUFF_SRC/TERREL/grid.trl deleted file mode 100644 index bab163b..0000000 --- a/CALPUFF_SRC/TERREL/grid.trl +++ /dev/null @@ -1,73 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /GRID/ -- Grid for output data TERREL -c----------------------------------------------------------------------- - logical lzone,lbranch - character*4 utmhem - character*8 datum - character*16 clat0,clon0,clat1,clat2 - - common /GRID/ nx,ny,nxy,xllk,yllk,sizek,ihdr(7), - & xllm,yllm,sizem,xurk,yurk,xurm,yurm,scale, - & disk(mxnx),ang(mxny),cbdism(mxnx),cbang(mxny), - & xorgm,yorgm,xorgk,yorgk,feast,fnorth, - & izone,tmscaleo,rlat,rlon,xlat1,xlat2,icode(4), - & lzone,utmhem,datum,clat0,clon0,clat1,clat2, - & npextr,npnoise,npmiss,lbranch - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c nx,ny actual number of cells in x,y (or r,theta) [i] -c nxy actual number of cells in grid [i] -c (x,y)llk (km) coordinates of SW corner of cell1 (lower left [r] -c corner) of output Cartesian grid -c sizek (km) length of side of output grid Cartesian grid cell [r] -c ihdr(7) grid definition and number of discrete receptors [i] -c for contents of "save" file -c (x,y)llm (m) coordinates of SW corner of cell1 (lower left [r] -c corner) of output Cartesian grid -c sizem (m) length of side of output cartesian grid cell [r] -c (x,y)urk (km) coordinates of upper right corner of output grid [r] -c (x,y)urm (m) coordinates of upper right corner of output grid [r] -c scale (1/m) scale factor for unit grid cell length [r] -c disk (km) array of ring distances from center of polar grid [ra] -c ang (deg) array of radials (angles CW from N) of polar grid [ra] -c cbdism (m) array of cell boundary distances for polar grid [ra] -c cbang (deg) array of cell boundary angles for polar grid [ra] -c (x,y)orgm (m) reference coordinates of grid origin [r] -c (x,y)orgk (km) reference coordinates of grid origin [r] -c feast (km) false easting at projection origin [r] -c (Used only if PMAP= LCC, TTM, or LAZA) -c fnorth (km) false northing at projection origin [r] -c (Used only if PMAP= LCC, TTM, or LAZA) -c izone base zone for UTM grid [i] -c tmscaleo scaling factor for TTM projection [r] -c rlat, latitude & longitude of x=0 and y=0 of map [r] -c rlon (deg) projection (Used only if PMAP= LCC, PS, EM, or LAZA) -c NOTE: longitude is East Longitude (neg in west hem) -c xlat1, matching latitude(s) used for projection [r] -c xlat2 (deg) (Used only if PMAP= LCC, PS, or EM) -c LCC : Projection cone slices through Earth's surface -c at XLAT1 and XLAT2 -c PS : Projection plane slices through Earth at XLAT1 -c EM : Projection cylinder slices through Earth at -c [+/-] XLAT1 -c icode(4) USGS DEM codes from logical record type A header [i] -c icode(1) = DEM level code -c icode(2) = code defining elevation pattern -c icode(3) = code defining ground planimetric ref. system -c icode(4) = zone of ground planimetric reference system -c lzone flag indicating data and base UTM zones differ [l] -c (T = zones are different; F = zones are the same) -c utmhem base hemisphere for output UTM projection [c] -c (S=southern, N=northern) -c datum Datum-Region for grid coordinates [c] -c clat0 character version of RLAT [c] -c clon0 character version of RLON [c] -c clat1 character version of XLAT1 [c] -c clat2 character version of XLAT2 [c] -c npextr total number of DB points extracted within grid [i] -c npnoise total number of extracted points considered noisy [i] -c npmiss total number of extracted points considered missing [i] -c lbranch flag indicating if grid spans International Date Ln [l] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/gspan.trl b/CALPUFF_SRC/TERREL/gspan.trl deleted file mode 100644 index dd412d6..0000000 --- a/CALPUFF_SRC/TERREL/gspan.trl +++ /dev/null @@ -1,33 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /GSPAN/ -- Coordinate Range for Output Grid TERREL -c----------------------------------------------------------------------- - common /GSPAN/ minx,miny,maxx,maxy, - & min30x,min30y,max30x,max30y, - & nquadmnx,nquadmxx,nquadmny,nquadmxy, - & ylatsw,xlonsw,ylatse,xlonse, - & ylatnw,xlonnw,ylatne,xlonne - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c minx,miny minimum value of coord of output grid in the units [i] -c of the DB file. -c maxx,maxy maximum value of coord of output grid in the units [i] -c of the DB file. -c ylatsw north latitude of the SW corner of output grid [r] -c xlonsw west longitude of the SW corner of output grid [r] -c ylatse north latitude of the SE corner of output grid [r] -c xlonse west longitude of the SE corner of output grid [r] -c ylatnw north latitude of the NW corner of output grid [r] -c xlonnw west longitude of the NW corner of output grid [r] -c ylatne north latitude of the NE corner of output grid [r] -c xlonne west longitude of the NE corner of output grid [r] -c min30x,min30y minimum value of coord of output grid in the units [i] -c of the 30-meter DB file. -c max30x,max30y maximum value of coord of output grid in the units [i] -c of the 30-meter DB file. -c nquadmnx, number of 7.5 minute quads to eliminate from the [i] -c nquadmxx 1 degree DEM coverage of the grid in the x direction -c nquadmny, number of 7.5 minute quads to eliminate from the [i] -c nquadmxy 1 degree DEM coverage of the grid in the y direction -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/masaya.grd b/CALPUFF_SRC/TERREL/masaya.grd deleted file mode 100644 index 452ce88..0000000 --- a/CALPUFF_SRC/TERREL/masaya.grd +++ /dev/null @@ -1,555 +0,0 @@ -DSAA - 91 55 - 525.5942 615.5942 - 1294.739 1348.739 - 4.000000 1063.000 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 7.0 16.0 - 49.0 27.0 35.0 44.0 47.0 49.0 59.0 58.0 67.0 69.0 - 96.0 112.0 62.0 102.5 105.0 99.0 110.0 129.0 149.0 170.0 - 159.0 170.0 195.5 215.0 217.0 225.0 205.0 176.0 182.0 178.0 - 171.0 164.0 148.5 158.0 156.0 146.0 153.0 113.0 96.0 96.0 - 98.0 88.0 83.0 80.0 77.0 70.0 67.0 64.0 73.0 54.0 - 51.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 10.0 16.0 32.0 - 36.0 32.0 38.0 52.0 57.0 65.0 64.0 70.0 74.0 79.0 - 105.0 99.0 76.0 84.0 88.0 91.0 99.0 106.0 123.0 136.0 - 136.0 158.0 161.5 199.0 201.0 208.0 200.0 174.0 158.0 158.0 - 149.0 142.0 135.0 126.0 121.0 122.0 111.0 101.0 97.0 94.0 - 93.0 89.0 83.0 78.0 76.0 73.0 72.0 70.0 65.0 52.0 - 46.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 9.5 11.5 12.0 16.0 36.0 32.5 - 35.0 42.5 62.0 61.2 62.5 68.5 77.0 80.5 86.0 96.0 - 112.0 104.5 113.0 107.7 128.0 110.5 116.5 119.0 128.0 136.5 - 139.0 144.5 179.2 189.0 197.0 220.5 270.5 209.0 172.5 164.0 - 156.5 149.0 134.0 124.0 119.0 113.0 108.0 102.0 96.0 96.0 - 99.0 94.0 82.5 79.0 82.0 83.0 80.0 71.0 68.0 56.0 - 43.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 11.0 22.0 20.0 21.0 55.0 38.0 36.0 - 60.0 53.0 55.0 72.5 67.0 76.0 84.0 96.0 101.0 110.0 - 138.0 125.0 130.0 135.0 159.0 145.0 146.0 149.0 148.0 151.0 - 160.0 172.0 196.5 210.0 231.0 216.0 232.0 219.0 196.0 188.0 - 175.0 164.0 147.0 135.5 126.5 121.5 117.0 112.0 106.0 103.5 - 106.5 101.0 91.8 85.0 94.0 93.5 88.0 77.5 69.0 69.5 - 54.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 7.0 20.0 22.0 27.0 36.0 38.0 39.0 63.0 - 71.0 58.0 68.0 80.5 76.0 87.0 92.0 108.0 114.0 118.0 - 130.0 152.0 147.0 165.0 183.0 190.0 172.0 171.0 170.0 177.0 - 192.0 198.0 212.5 222.0 233.0 235.0 242.0 228.0 219.0 211.0 - 200.0 182.0 165.0 154.0 145.0 137.0 130.0 124.0 119.0 116.0 - 113.0 109.0 99.5 90.0 103.0 91.0 89.0 86.0 74.0 77.0 - 56.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 7.0 11.0 24.5 28.0 47.0 43.0 37.0 67.0 84.0 - 69.0 66.0 80.0 84.0 88.0 97.0 104.0 125.0 125.0 132.0 - 148.0 155.0 173.0 180.0 189.0 197.0 200.0 203.0 204.0 211.0 - 220.0 236.0 235.0 244.0 249.0 255.0 255.0 246.0 237.0 230.0 - 214.0 195.0 181.0 169.0 160.0 150.0 146.0 140.0 129.0 122.0 - 119.0 112.0 104.5 92.0 95.0 88.0 85.0 73.0 63.0 64.0 - 47.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 13.0 20.0 20.0 24.0 45.0 43.0 53.0 55.0 84.0 82.0 - 73.0 78.0 90.0 87.5 99.0 109.0 130.0 154.0 153.0 143.0 - 158.0 181.0 194.5 210.0 222.0 225.0 231.0 237.0 236.0 246.0 - 247.0 263.0 260.0 264.0 269.0 273.0 277.0 268.0 261.0 248.0 - 232.0 217.0 201.0 181.0 175.0 166.0 164.0 151.0 139.0 130.0 - 125.0 120.0 110.0 98.0 91.0 76.0 68.0 57.0 52.0 59.0 - 46.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 18.0 - 22.0 24.0 28.0 34.0 66.0 50.0 58.0 84.0 87.0 79.0 - 80.0 90.0 96.0 101.5 118.0 119.0 151.0 175.0 163.0 162.0 - 172.0 204.0 222.0 236.0 247.0 256.0 260.0 267.0 267.0 273.0 - 280.0 291.0 290.5 294.0 294.0 297.0 301.0 292.0 283.0 268.0 - 258.0 240.0 221.5 201.0 190.0 183.0 171.0 157.0 144.0 140.0 - 135.0 125.0 115.5 102.0 95.0 81.0 62.0 60.0 52.0 50.0 - 46.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 9.0 13.0 22.0 - 26.0 31.0 32.0 42.5 62.0 60.0 77.0 64.0 74.0 83.0 - 92.0 98.0 104.5 125.0 137.0 135.0 162.0 189.0 187.0 207.0 - 209.0 226.0 251.0 262.0 271.0 283.0 293.0 297.0 300.0 306.0 - 317.0 321.0 320.0 320.0 321.0 317.0 324.0 316.0 307.0 292.0 - 282.0 266.0 237.0 218.0 209.0 194.0 182.0 167.0 152.0 151.0 - 143.0 137.0 131.0 117.0 113.0 106.0 100.0 83.0 62.0 52.0 - 46.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 13.0 16.0 20.0 - 29.0 34.0 40.0 50.5 60.0 76.0 87.0 78.0 75.0 84.0 - 93.0 104.0 116.5 129.0 158.0 160.0 174.0 202.0 221.0 229.0 - 255.0 262.0 283.0 294.0 306.0 311.0 323.0 327.0 330.0 335.0 - 345.0 351.0 351.0 345.0 345.0 338.0 346.0 337.0 328.0 318.0 - 301.0 292.0 261.0 249.0 237.0 218.0 197.0 181.0 166.0 161.0 - 156.0 156.0 155.0 141.0 165.0 143.0 142.0 112.0 99.0 78.0 - 75.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 18.0 18.0 18.0 - 28.0 44.0 47.0 52.0 69.0 83.0 96.0 85.0 86.0 94.0 - 104.0 109.0 127.0 139.0 167.0 186.0 204.0 223.0 246.0 260.0 - 281.0 293.0 312.0 329.0 332.0 344.0 352.0 359.0 362.0 370.0 - 379.0 382.0 380.5 374.0 373.0 365.0 362.0 359.0 348.0 335.0 - 327.0 314.0 285.5 266.0 249.0 236.0 216.0 193.0 179.0 177.0 - 172.0 175.0 193.0 183.0 201.0 205.0 196.0 195.0 170.0 156.0 - 126.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 23.0 23.0 24.0 - 42.0 36.0 51.0 60.0 79.0 81.0 90.0 101.0 101.0 109.0 - 117.0 116.0 140.0 160.0 172.0 206.0 228.0 247.0 269.0 287.0 - 297.0 321.0 339.0 359.0 367.0 373.0 378.0 387.0 399.0 403.0 - 415.0 410.0 406.5 405.0 401.0 397.0 382.0 384.0 370.0 359.0 - 343.0 330.0 301.5 278.0 259.0 248.0 225.0 199.0 194.0 198.0 - 193.0 204.0 223.5 243.0 270.0 318.0 309.0 323.0 313.0 253.0 - 195.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 18.0 30.0 30.0 33.0 - 50.0 62.0 76.0 70.5 73.0 82.0 86.0 99.0 113.0 121.0 - 141.0 138.0 156.5 179.0 200.0 230.0 252.0 275.0 294.0 310.0 - 331.0 337.0 366.0 388.0 397.0 399.0 410.0 416.0 429.0 431.0 - 438.0 440.0 433.5 434.0 425.0 424.0 407.0 395.0 388.0 379.0 - 356.0 335.0 301.0 277.0 256.0 247.0 227.0 223.0 211.0 213.0 - 216.0 235.0 263.0 330.0 400.0 499.0 488.0 551.0 548.0 403.0 - 286.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 13.5 26.5 40.5 42.5 48.5 - 70.5 84.0 90.0 87.0 91.0 93.0 98.5 107.5 130.0 136.0 - 156.0 158.0 171.5 204.0 229.0 250.0 274.0 295.0 318.0 338.0 - 356.0 363.0 392.0 415.0 422.0 435.0 437.0 442.0 460.0 462.0 - 466.0 466.0 466.0 464.0 445.0 446.0 423.0 411.0 399.0 387.0 - 364.0 343.0 303.5 281.0 270.0 251.0 245.0 238.0 223.0 216.0 - 238.0 259.0 321.0 449.0 583.0 743.0 624.0 883.0 818.0 596.0 - 430.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 17.0 25.0 48.0 61.0 55.0 66.0 - 69.0 88.0 95.5 100.0 106.0 112.0 113.0 124.0 136.0 162.5 - 163.0 190.0 206.0 229.0 255.5 279.5 302.0 326.5 353.5 377.0 - 396.0 413.0 430.5 454.0 464.5 476.0 478.0 488.0 496.0 505.0 - 513.0 513.5 507.5 494.0 475.5 464.5 446.5 434.0 421.0 406.5 - 383.0 355.0 305.8 285.5 281.0 274.5 258.0 257.5 247.0 229.0 - 246.5 286.0 347.3 527.0 688.0 1026.0 923.0 1063.0 992.0 717.0 - 533.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 8.5 23.0 40.0 44.0 52.0 103.0 70.0 - 67.0 78.0 82.0 101.0 109.0 123.0 125.0 143.0 151.0 156.0 - 189.0 186.0 242.0 280.0 288.0 310.0 340.0 363.0 385.0 407.0 - 428.0 449.0 466.5 494.0 502.0 513.0 523.0 537.0 533.0 550.0 - 552.0 555.0 543.0 519.0 502.0 484.0 469.0 455.0 440.0 421.0 - 402.0 365.0 322.0 310.0 298.0 286.0 280.0 273.0 263.0 254.0 - 255.0 286.0 409.0 589.5 714.0 861.5 835.0 780.0 542.5 474.0 - 430.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 14.0 32.0 35.0 46.0 81.0 92.0 113.0 - 82.0 86.0 90.0 94.0 102.0 120.0 132.0 153.0 176.0 172.0 - 196.0 213.0 245.0 296.0 321.0 334.0 364.0 380.0 414.0 432.0 - 445.0 472.0 497.5 522.0 539.0 549.0 551.0 564.0 562.0 572.0 - 579.0 570.0 558.0 527.0 506.0 499.0 488.0 474.0 459.0 445.0 - 407.0 373.0 343.5 326.0 315.0 305.0 297.0 289.0 282.0 269.0 - 272.0 269.0 344.5 393.0 428.0 473.0 469.0 465.0 407.0 303.0 - 271.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 7.0 24.0 38.0 42.0 55.0 75.0 76.0 99.0 - 118.0 98.0 91.0 102.0 119.0 128.0 137.0 149.0 179.0 210.0 - 218.0 229.0 258.5 312.0 337.0 366.0 383.0 411.0 432.0 464.0 - 479.0 497.0 530.5 560.0 560.0 577.0 584.0 583.0 589.0 593.0 - 593.0 587.0 570.0 521.0 507.0 499.0 489.0 480.0 470.0 456.0 - 417.0 391.0 366.5 347.0 336.0 321.0 310.0 312.0 303.0 295.0 - 295.0 285.0 297.0 315.0 361.0 346.0 320.0 309.0 286.0 230.0 - 193.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 6.0 12.0 32.0 37.0 60.0 81.0 64.0 75.0 99.0 - 129.0 107.0 104.0 115.0 128.0 137.0 149.0 161.0 171.0 223.0 - 247.0 258.0 286.5 314.0 360.0 387.0 407.0 435.0 463.0 488.0 - 510.0 534.0 561.5 563.0 588.0 592.0 601.0 604.0 614.0 613.0 - 618.0 606.0 573.0 519.0 510.0 497.0 488.0 482.0 476.0 463.0 - 431.0 410.0 389.0 370.0 360.0 346.0 328.0 333.0 325.0 318.0 - 308.0 297.0 283.5 288.0 289.0 272.0 245.0 233.0 199.0 188.0 - 150.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 7.0 14.0 33.0 51.0 54.0 86.0 80.0 103.0 90.0 123.0 - 128.0 115.0 123.0 132.0 160.0 151.0 161.0 176.0 194.0 192.0 - 230.0 283.0 305.0 350.0 364.0 400.0 433.0 462.0 481.0 514.0 - 534.0 559.0 586.5 578.0 601.0 607.0 619.0 626.0 634.0 635.0 - 630.0 610.0 552.0 512.0 497.0 485.0 480.0 474.0 484.0 474.0 - 445.0 431.0 410.5 400.0 384.0 367.0 348.0 345.0 345.0 344.0 - 338.0 315.0 307.0 308.0 276.0 235.0 186.0 159.0 141.0 166.0 - 156.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 13.0 - 14.0 19.0 40.0 51.5 70.0 78.0 107.0 102.0 127.0 133.0 - 130.0 138.0 147.5 144.0 179.0 184.0 177.0 193.0 218.0 234.0 - 233.0 266.0 330.0 360.0 400.0 411.0 442.0 488.0 503.0 514.0 - 555.0 578.0 607.0 612.0 627.0 638.0 644.0 647.0 655.0 649.0 - 616.0 583.0 544.0 503.0 484.0 476.0 473.0 468.0 481.0 478.0 - 460.0 449.0 432.0 421.0 414.0 401.0 375.0 374.0 372.0 377.0 - 378.0 380.5 292.0 262.0 240.0 165.0 118.0 100.0 110.0 115.0 - 126.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 13.0 22.0 - 22.0 41.0 52.0 54.5 77.0 99.0 113.0 128.0 145.0 141.0 - 139.0 148.0 172.5 176.0 168.0 195.0 210.0 213.0 226.0 265.0 - 289.0 268.0 330.0 385.0 405.0 441.0 464.0 499.0 533.0 557.0 - 563.0 608.0 635.0 645.0 659.0 671.0 667.0 662.0 654.0 636.0 - 594.0 569.0 536.0 483.0 476.0 465.0 463.0 464.0 476.0 475.0 - 467.0 457.0 450.5 443.0 447.0 446.0 424.0 408.0 301.0 290.0 - 377.0 385.0 330.0 204.0 180.0 132.0 101.0 88.0 93.0 93.0 - 70.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 10.0 15.0 22.0 - 32.0 39.0 46.0 57.0 87.0 104.0 104.0 123.0 128.0 141.0 - 145.0 158.0 188.0 204.0 187.0 186.0 203.0 233.0 251.0 273.0 - 295.0 323.0 330.5 391.0 423.0 461.0 483.0 518.0 544.0 583.0 - 605.0 636.0 669.0 683.0 688.0 683.0 669.0 654.0 636.0 614.0 - 585.0 561.0 521.0 478.0 468.0 451.0 448.0 459.0 471.0 470.0 - 461.0 453.0 458.5 470.0 481.0 485.0 354.0 206.0 106.0 88.0 - 154.0 161.0 296.0 205.0 153.0 126.0 92.0 84.0 73.0 74.0 - 42.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 9.0 11.0 16.0 32.0 - 46.0 39.0 48.0 65.5 88.0 87.0 105.0 117.0 128.0 141.0 - 152.0 166.0 201.0 217.0 225.0 202.0 213.0 227.0 265.0 289.0 - 318.0 332.0 370.5 378.0 432.0 465.0 504.0 547.0 578.0 603.0 - 636.0 673.0 710.5 720.0 709.0 687.0 665.0 645.0 627.0 599.0 - 576.0 554.0 512.0 473.0 462.0 435.0 431.0 454.0 464.0 470.0 - 453.0 435.0 440.5 464.0 503.0 517.0 280.0 86.0 78.0 78.0 - 78.0 78.0 158.0 176.0 149.0 119.0 99.0 81.0 65.0 48.0 - 39.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 12.0 16.0 20.0 36.0 - 37.0 49.0 52.0 65.0 77.0 91.0 104.0 112.0 121.0 127.0 - 141.0 157.0 179.0 220.0 247.0 254.0 272.0 278.0 264.0 294.0 - 325.0 357.0 391.0 429.0 443.0 486.0 524.0 555.0 590.0 623.0 - 668.0 717.0 751.5 744.0 712.0 690.0 664.0 629.0 605.0 578.0 - 566.0 541.0 493.5 454.0 430.0 412.0 403.0 434.0 444.0 448.0 - 433.0 404.0 415.5 444.0 492.0 556.0 314.0 86.0 78.0 78.0 - 78.0 78.5 180.0 172.0 139.0 111.0 93.0 77.0 66.0 47.0 - 36.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 4.0 12.0 22.5 33.5 34.5 - 35.5 40.5 57.0 72.5 73.0 82.0 91.5 104.0 125.5 137.5 - 141.5 153.0 205.2 223.5 232.5 249.0 278.5 302.5 316.0 325.0 - 340.5 361.0 409.8 459.0 481.0 518.0 550.5 584.5 623.0 669.0 - 707.0 758.0 781.5 741.0 732.0 711.0 677.0 649.0 607.0 582.0 - 578.0 545.0 514.5 471.0 450.0 373.0 362.0 385.0 412.0 393.0 - 390.0 369.0 398.0 422.0 457.0 484.0 353.0 98.0 78.0 78.0 - 78.0 78.5 162.0 165.0 140.0 107.0 88.0 74.0 62.0 47.0 - 32.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 6.0 17.0 25.0 29.0 34.0 - 37.0 47.0 63.5 66.0 76.0 81.0 90.0 99.0 112.0 124.0 - 148.0 151.0 188.5 232.0 249.0 261.0 278.0 293.0 307.0 334.0 - 366.0 389.0 427.0 489.0 522.0 554.0 597.0 619.0 673.0 718.0 - 763.5 820.0 803.0 784.5 760.5 754.0 722.0 682.5 656.5 645.5 - 613.0 575.0 540.0 511.5 466.0 387.5 310.0 290.0 303.5 277.0 - 276.5 295.2 341.5 362.0 380.5 388.5 365.0 241.0 165.0 118.0 - 103.0 139.0 171.5 151.0 129.5 106.0 87.5 76.0 62.0 44.0 - 31.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 4.0 9.0 14.0 17.0 23.0 39.0 - 45.0 63.0 66.5 67.0 70.0 75.0 84.0 91.0 100.0 109.0 - 147.0 165.0 189.5 226.0 243.0 281.0 304.0 312.0 324.0 334.0 - 356.0 386.0 446.0 498.0 525.0 569.0 608.0 661.0 694.0 723.0 - 826.0 848.0 808.5 793.0 787.0 770.0 732.0 720.0 677.0 632.0 - 563.0 478.0 450.5 449.0 446.0 353.0 305.0 259.0 182.0 135.0 - 124.0 180.0 291.0 300.0 311.0 312.0 308.0 299.0 289.0 270.0 - 245.0 198.0 156.0 138.0 117.0 97.0 83.0 69.5 58.0 42.0 - 31.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 9.0 16.0 16.0 30.0 33.0 43.0 - 56.0 59.0 76.0 88.0 80.0 82.0 90.0 100.0 106.0 113.0 - 124.0 139.0 181.0 218.0 260.0 289.0 310.0 328.0 354.0 362.0 - 370.0 385.0 440.5 507.0 545.0 588.0 627.0 664.0 726.0 787.0 - 850.0 824.0 783.0 760.0 698.0 654.0 664.0 638.0 589.0 592.0 - 522.0 487.0 447.0 406.0 377.0 355.0 326.0 239.0 192.0 154.0 - 124.0 153.0 255.0 268.0 283.0 290.0 278.0 273.0 255.0 240.0 - 221.0 187.5 151.0 124.0 110.0 92.0 77.0 62.0 50.0 40.0 - 31.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 4.0 18.0 23.0 16.0 25.0 32.0 46.0 - 43.0 58.0 78.0 84.0 91.0 84.0 91.0 101.0 109.0 118.0 - 128.0 140.0 162.0 194.0 215.0 272.0 297.0 338.0 361.0 380.0 - 401.0 416.0 446.0 506.0 549.0 595.0 642.0 686.0 747.0 834.0 - 863.0 841.0 801.5 707.0 689.0 635.0 542.0 555.0 516.0 484.0 - 499.0 499.0 486.0 463.0 430.0 415.0 374.0 285.0 215.0 166.0 - 126.0 153.0 242.0 253.0 267.0 267.0 259.0 242.0 224.0 213.0 - 195.0 167.0 137.0 115.0 98.0 87.0 72.0 61.0 50.0 41.0 - 31.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 7.5 41.0 20.0 22.0 23.0 29.0 39.0 - 43.0 49.0 63.5 79.0 69.0 83.0 94.0 96.0 104.0 115.0 - 133.0 142.0 166.0 185.0 214.0 238.0 272.0 290.0 327.0 375.0 - 409.0 439.0 474.0 530.0 562.0 608.0 653.0 710.0 763.0 860.0 - 883.0 863.0 802.5 739.0 604.0 533.0 475.0 427.0 435.0 436.0 - 447.0 491.0 527.5 402.0 469.0 498.0 423.0 306.0 217.0 173.0 - 133.0 156.5 243.0 252.0 255.0 250.0 239.0 215.0 194.0 183.0 - 169.0 143.0 117.0 102.0 87.0 79.0 65.0 55.0 46.0 42.0 - 33.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 15.5 37.0 12.0 26.0 27.0 36.0 38.0 - 38.0 45.0 55.0 63.0 67.0 75.0 82.0 87.0 102.0 114.0 - 125.0 147.0 168.0 193.0 214.0 241.0 264.0 286.0 308.0 356.0 - 401.0 441.0 489.0 541.0 578.0 624.0 669.0 714.0 776.0 872.0 - 900.0 869.0 805.5 720.0 675.0 592.0 486.0 429.0 400.0 399.0 - 407.0 440.5 330.0 379.0 487.0 520.0 528.0 301.0 217.0 177.0 - 137.0 199.0 245.0 249.0 247.0 238.0 230.0 202.0 174.0 165.0 - 152.0 125.0 99.0 85.0 76.0 69.0 60.0 50.0 47.0 43.0 - 36.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 4.0 4.0 15.5 16.0 14.0 20.0 23.0 32.0 38.0 - 45.0 52.0 56.5 65.0 70.0 79.0 86.0 93.0 101.0 114.0 - 127.0 141.0 169.5 196.0 209.0 233.0 261.0 306.0 327.0 349.0 - 392.0 430.0 498.5 554.0 597.0 636.0 684.0 740.0 785.0 863.0 - 914.0 899.0 836.0 763.0 668.0 592.0 556.0 408.0 370.0 367.0 - 384.0 384.5 305.0 349.0 390.0 394.0 373.0 298.0 240.0 209.0 - 170.0 216.5 266.0 252.0 246.0 231.0 223.0 196.0 162.0 149.0 - 143.0 115.0 89.0 76.0 67.0 59.0 53.0 50.0 48.0 42.0 - 39.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4.0 6.0 11.0 30.5 17.0 19.0 17.0 20.0 29.0 29.0 - 38.0 39.0 56.0 60.0 65.0 74.0 82.0 88.0 100.0 118.0 - 120.0 135.0 169.0 190.0 216.0 240.0 259.0 286.0 317.0 354.0 - 383.0 420.0 482.0 558.0 610.0 647.0 695.0 735.0 799.0 812.0 - 809.0 864.0 865.5 781.0 712.0 640.0 504.0 398.0 353.0 334.0 - 353.0 392.0 305.0 315.0 317.0 303.0 298.0 285.0 272.0 247.0 - 222.0 217.0 226.0 250.0 254.0 240.0 234.0 204.0 166.0 143.0 - 130.0 106.0 79.0 69.0 60.0 54.0 47.0 43.0 42.0 41.0 - 40.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 52.0 - 13.0 6.0 25.0 32.0 15.0 25.0 30.0 23.0 38.0 30.0 - 32.0 42.0 48.5 58.0 64.0 79.0 87.0 101.0 123.0 127.0 - 139.0 145.0 154.5 176.0 194.0 229.0 260.0 281.0 317.0 347.0 - 382.0 423.0 491.5 552.0 597.0 644.0 693.0 753.0 754.0 738.0 - 754.0 766.0 831.5 832.0 754.0 630.0 528.0 482.0 350.0 317.0 - 319.0 356.0 297.0 287.0 296.0 285.0 279.0 278.0 273.0 232.0 - 215.0 209.5 214.0 242.0 254.0 242.0 219.0 203.0 168.0 142.0 - 126.0 100.5 70.0 60.0 54.0 49.0 45.0 42.0 40.0 40.0 - 40.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 54.0 - 9.0 18.0 20.0 11.5 16.0 22.0 34.0 26.0 36.0 41.0 - 34.0 36.0 45.0 56.0 67.0 76.0 84.0 96.0 131.0 154.0 - 160.0 162.0 169.0 183.0 204.0 215.0 250.0 295.0 325.0 359.0 - 394.0 429.0 486.0 559.0 601.0 656.0 706.0 741.0 696.0 681.0 - 696.0 709.0 722.5 741.0 763.0 709.0 589.0 477.0 363.0 314.0 - 291.0 313.5 312.0 280.0 294.0 287.0 277.0 273.0 237.0 210.0 - 206.0 201.5 217.0 239.0 242.0 234.0 213.0 190.0 163.0 140.0 - 124.0 102.0 68.0 56.0 51.0 46.0 45.0 43.0 51.0 43.0 - 40.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 25.0 15.0 17.0 - 24.0 31.0 31.0 9.5 18.0 31.0 47.5 44.5 49.0 38.0 - 44.0 44.0 49.5 58.0 75.0 88.0 87.0 97.0 113.0 132.0 - 148.0 179.0 200.0 211.0 217.0 257.0 272.0 302.0 320.0 356.0 - 399.0 433.0 487.5 560.0 622.0 666.0 712.0 676.0 632.0 633.0 - 629.0 648.0 662.0 686.0 679.0 668.0 632.0 541.0 453.0 301.0 - 274.0 277.0 290.0 288.0 292.0 278.0 259.0 235.0 207.0 195.0 - 197.0 196.0 211.0 231.0 226.0 221.0 209.0 187.0 160.0 137.0 - 121.0 98.5 68.0 54.0 48.0 45.0 42.0 42.0 49.0 42.0 - 39.0 - 4.0 4.0 4.0 4.0 4.0 4.0 4.0 43.0 23.0 32.0 - 56.0 47.0 14.0 12.5 25.0 36.0 42.0 44.0 50.5 49.5 - 50.5 53.5 58.2 74.0 91.0 96.5 96.5 104.0 114.5 125.5 - 138.0 147.5 174.0 223.5 244.5 261.5 287.5 316.5 344.5 377.0 - 413.0 451.0 510.5 570.0 617.5 662.0 633.5 579.0 555.0 551.5 - 547.5 557.5 582.0 586.5 585.0 545.0 534.5 537.0 435.5 276.5 - 245.5 248.0 248.0 241.0 241.0 232.0 219.0 211.0 196.0 188.0 - 190.0 198.0 219.0 224.0 219.0 210.0 199.0 182.0 156.0 134.0 - 115.0 91.5 63.0 49.0 44.0 44.0 42.0 41.0 40.0 40.0 - 40.0 - 4.0 4.0 4.0 4.0 4.0 4.0 8.0 15.0 44.0 47.0 - 56.0 28.0 13.0 23.0 21.0 42.0 52.0 57.0 43.0 46.0 - 50.0 55.0 66.0 80.0 91.0 96.0 102.0 109.0 116.0 123.0 - 133.0 144.0 163.5 192.0 218.0 254.0 274.0 303.0 342.0 376.0 - 411.0 443.0 505.5 583.0 572.0 528.0 494.0 489.0 484.0 490.0 - 475.0 494.0 507.5 516.0 492.0 466.0 433.0 384.0 317.0 245.0 - 224.0 219.8 208.5 195.0 192.5 187.5 173.5 171.5 172.0 179.0 - 188.0 208.0 216.5 206.0 202.0 193.0 181.5 165.0 142.0 121.0 - 102.5 80.5 58.5 46.5 44.0 41.5 41.0 40.5 40.0 40.0 - 40.0 - 4.0 4.0 4.0 4.0 4.0 4.0 23.0 43.0 51.0 75.0 - 67.0 21.0 19.0 28.0 26.0 42.0 59.0 50.0 48.0 53.0 - 56.0 58.0 74.0 90.0 93.0 97.0 103.0 109.0 114.0 123.0 - 133.0 146.0 167.5 196.0 217.0 243.0 275.0 311.0 340.0 372.0 - 408.0 443.0 504.5 544.0 456.0 462.0 434.0 434.0 437.0 441.0 - 439.0 456.0 458.0 468.0 433.0 425.0 391.0 324.0 284.0 248.0 - 226.0 199.0 181.0 167.0 151.0 149.0 143.0 142.0 146.0 183.0 - 199.0 202.0 202.0 192.0 181.0 174.0 159.0 142.0 125.0 105.0 - 90.0 71.0 50.0 43.0 42.0 41.0 40.0 40.0 40.0 40.0 - 40.0 - 4.0 4.0 4.0 4.0 4.0 21.0 19.0 36.0 52.0 47.0 - 28.0 17.0 22.5 33.0 37.0 49.0 58.0 50.0 53.0 56.0 - 60.0 63.0 77.0 90.0 93.0 100.0 109.0 115.0 119.0 129.0 - 137.0 146.0 166.5 201.0 227.0 237.0 264.0 291.0 334.0 380.0 - 411.0 461.0 508.0 451.0 413.0 415.0 394.0 395.0 413.0 386.0 - 392.0 405.5 408.0 423.0 385.0 378.0 354.0 314.0 276.0 249.0 - 229.0 197.5 174.0 159.0 137.0 127.0 124.0 123.0 133.0 178.0 - 195.0 193.5 191.0 182.0 171.0 161.0 147.0 128.0 112.0 96.0 - 80.0 62.5 48.0 42.0 39.0 39.0 39.0 39.0 40.0 39.0 - 39.5 - 4.0 4.0 4.0 4.0 15.0 33.0 48.0 31.0 44.0 59.0 - 51.0 35.0 22.5 30.0 47.0 66.0 54.0 46.0 51.0 57.0 - 62.0 69.0 76.5 87.0 93.0 101.0 111.0 121.0 125.0 141.0 - 157.0 158.0 190.0 233.0 238.0 257.0 278.0 305.0 338.0 374.0 - 410.0 458.0 453.5 386.0 369.0 358.0 355.0 367.0 352.0 340.0 - 353.0 357.5 362.0 372.0 343.0 339.0 318.0 290.0 261.0 242.0 - 236.0 208.5 180.0 153.0 138.0 125.0 119.0 117.0 116.0 154.0 - 181.0 181.5 179.0 171.0 163.0 149.0 137.0 118.0 101.0 88.0 - 74.0 55.5 45.0 41.0 38.0 37.0 38.0 39.0 39.0 40.0 - 40.5 - 4.0 4.0 4.0 4.0 12.0 32.0 54.0 49.0 105.0 124.0 - 162.0 86.0 24.5 39.0 38.0 48.0 41.0 51.0 52.0 63.0 - 65.0 71.0 80.0 88.0 100.0 110.0 119.0 136.0 154.0 155.0 - 164.0 171.0 187.0 224.0 246.0 271.0 286.0 309.0 333.0 373.0 - 405.0 447.0 370.5 337.0 327.0 321.0 322.0 330.0 318.0 290.0 - 321.0 313.5 323.0 322.0 302.0 294.0 285.0 267.0 254.0 233.0 - 224.0 206.5 176.0 152.0 133.0 120.0 111.0 108.0 107.0 130.0 - 161.0 170.5 166.0 159.0 154.0 139.0 127.0 110.0 93.0 77.0 - 63.0 50.5 42.0 40.0 38.0 37.0 38.0 38.0 39.0 39.0 - 41.5 - 4.0 4.0 4.0 11.0 20.0 34.0 51.0 87.0 149.0 168.0 - 131.0 36.0 29.0 49.0 57.0 46.0 43.0 48.0 53.0 65.0 - 70.0 76.0 84.0 94.0 101.0 110.0 126.0 133.0 150.0 169.0 - 176.0 196.0 203.5 224.0 233.0 256.0 284.0 312.0 344.0 379.0 - 420.0 432.0 316.0 288.0 289.0 288.0 288.0 307.0 268.0 269.0 - 278.0 273.0 278.0 268.0 260.0 253.0 244.0 236.0 241.0 223.0 - 205.0 187.5 164.0 141.0 129.0 112.0 107.0 106.0 102.0 110.0 - 143.0 161.0 153.0 145.0 137.0 129.0 114.0 101.0 86.0 69.0 - 57.0 47.0 42.0 40.0 36.0 33.0 35.0 38.0 39.0 39.0 - 40.5 - 4.0 4.0 4.0 11.0 18.0 38.0 41.0 106.0 146.0 153.0 - 135.0 41.0 35.5 52.0 70.0 68.0 51.0 52.0 60.0 68.0 - 76.0 83.0 89.0 96.0 102.0 108.0 120.0 142.0 164.0 184.0 - 189.0 193.0 221.0 229.0 248.0 260.0 281.0 315.0 343.0 378.0 - 424.0 368.0 279.5 259.0 263.0 252.0 251.0 266.0 258.0 236.0 - 247.0 235.5 240.0 218.0 220.0 216.0 205.0 206.0 210.0 206.0 - 189.0 167.5 144.0 118.0 102.0 102.0 99.0 101.0 99.0 95.0 - 126.0 147.0 139.0 132.0 124.0 117.0 107.0 93.0 75.0 59.0 - 50.0 44.0 42.0 40.0 36.0 33.0 33.0 37.0 40.0 40.0 - 41.5 - 4.0 4.0 4.0 13.0 28.0 51.0 79.0 122.0 122.0 114.0 - 101.0 36.0 43.0 71.0 83.0 80.0 61.0 58.0 61.0 65.0 - 74.0 82.0 91.0 99.0 105.0 109.0 117.0 125.0 132.0 145.0 - 159.0 184.0 207.0 234.0 258.0 276.0 296.0 325.0 349.0 391.0 - 428.0 324.0 256.0 232.0 230.0 223.0 220.0 224.0 137.0 214.0 - 210.0 199.5 194.0 183.0 185.0 179.0 174.0 175.0 176.0 174.0 - 168.0 146.0 124.0 99.0 89.0 91.0 90.0 91.0 86.0 84.0 - 100.0 130.5 128.0 122.0 117.0 105.0 102.0 86.0 67.0 56.0 - 47.0 42.5 41.0 40.0 36.0 33.0 35.0 37.0 37.0 37.0 - 39.5 - 4.0 4.0 4.0 23.0 41.0 59.0 78.0 89.0 91.0 125.0 - 66.0 52.0 48.5 61.0 93.0 90.0 78.0 71.0 81.0 78.0 - 82.0 86.0 96.0 104.0 110.0 116.0 126.0 139.0 158.0 173.0 - 177.0 186.0 223.5 244.0 256.0 283.0 317.0 342.0 354.0 389.0 - 405.0 278.0 225.0 202.0 203.0 200.0 197.0 204.0 82.0 175.0 - 171.0 169.0 148.0 147.0 150.0 149.0 145.0 147.0 147.0 144.0 - 140.0 127.0 106.0 86.0 82.0 83.0 82.0 82.0 80.0 79.0 - 82.0 113.5 118.0 111.0 111.0 99.0 90.0 73.0 58.0 49.0 - 43.0 41.0 41.0 40.0 35.0 33.0 35.0 37.0 39.0 40.0 - 41.5 - 4.0 4.0 4.0 27.5 37.0 44.0 39.0 78.0 102.0 131.0 - 55.0 45.0 52.0 76.0 94.0 107.0 99.0 99.0 114.0 115.0 - 111.0 94.0 114.0 116.0 117.0 120.0 137.0 148.0 164.0 181.0 - 203.0 200.0 235.5 261.0 279.0 279.0 318.0 348.0 386.0 402.0 - 327.0 237.0 194.5 174.0 177.0 177.0 178.0 221.0 180.0 151.0 - 153.0 141.0 125.0 119.0 119.0 122.0 123.0 123.0 126.0 122.0 - 119.0 107.5 90.0 77.0 76.0 76.0 73.0 74.0 74.0 74.0 - 72.0 95.5 105.0 101.0 105.0 90.0 77.0 65.0 53.0 46.0 - 43.0 43.0 41.0 39.0 38.0 38.0 39.0 42.0 45.0 46.0 - 46.0 - 4.0 4.0 8.5 24.2 36.0 30.0 71.0 86.5 113.5 94.5 - 95.5 85.0 56.5 78.0 93.0 104.5 115.5 123.0 126.0 136.5 - 144.5 147.5 158.0 155.0 155.0 148.0 164.5 174.5 159.0 185.0 - 210.0 232.0 245.5 276.0 291.0 318.0 323.0 349.0 385.0 369.0 - 243.0 194.0 161.5 152.0 154.0 153.0 155.0 154.0 93.0 54.0 - 117.0 118.0 111.0 93.0 95.0 98.0 102.0 103.0 107.0 105.0 - 102.0 93.0 79.0 70.0 69.0 67.0 65.0 66.0 66.0 66.0 - 65.0 83.5 92.0 95.0 96.0 77.0 69.0 61.0 53.0 46.0 - 44.5 42.0 41.0 41.0 41.0 42.0 43.0 46.0 49.0 50.0 - 47.0 - 4.0 5.0 21.0 33.5 66.0 53.0 69.0 103.0 140.0 129.0 - 136.0 147.0 60.5 64.0 76.0 101.0 122.0 140.0 153.0 155.0 - 153.0 159.0 169.0 186.0 186.0 189.0 176.0 177.0 184.0 194.0 - 213.0 224.5 257.5 287.0 308.5 332.0 356.0 375.5 370.5 250.0 - 182.5 139.0 129.0 124.5 125.0 125.5 130.0 136.5 72.0 77.5 - 83.5 84.8 77.0 70.5 66.0 68.0 72.5 74.5 78.5 80.0 - 74.5 72.2 67.5 59.0 58.0 57.5 56.0 56.0 56.5 57.0 - 57.0 68.7 82.0 93.0 83.0 68.0 60.0 57.0 49.0 46.0 - 44.5 44.0 42.0 42.0 43.0 47.0 50.0 50.0 51.0 52.0 - 47.5 - 4.0 6.0 11.0 47.5 82.0 72.0 74.0 119.0 122.0 130.0 - 124.0 93.0 63.5 71.0 93.0 104.0 106.0 121.0 142.0 152.0 - 168.0 175.0 174.0 193.0 194.0 203.0 214.0 224.0 205.0 210.0 - 222.0 247.0 261.5 279.0 294.0 326.0 343.0 375.0 294.0 171.0 - 143.0 109.0 101.0 102.0 102.0 101.0 126.0 94.0 50.0 51.0 - 51.0 51.0 49.0 41.0 39.0 39.0 43.0 45.0 50.0 51.0 - 48.0 50.0 55.0 50.0 50.0 50.0 49.0 50.0 51.0 51.0 - 51.0 66.3 80.0 81.5 68.0 62.0 59.0 52.5 46.0 43.5 - 43.8 42.0 43.5 44.5 46.5 51.0 52.5 53.5 54.0 54.0 - 50.5 - 4.0 5.0 21.0 41.5 79.0 61.0 87.0 99.0 109.0 110.0 - 108.0 106.0 115.5 142.0 95.0 115.0 134.0 128.0 132.0 146.0 - 152.0 162.0 179.0 188.0 196.0 204.0 214.0 224.0 239.0 226.0 - 230.0 244.0 255.5 288.0 289.0 308.0 334.0 362.0 240.0 152.0 - 122.0 96.0 90.0 90.0 94.0 91.0 92.0 42.0 39.0 41.0 - 42.0 39.5 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 - 39.0 39.5 45.0 43.0 45.0 46.0 46.0 45.0 49.0 49.0 - 48.0 55.0 72.0 73.0 68.0 63.0 57.0 48.0 45.0 43.0 - 44.0 44.0 45.0 48.0 53.0 55.0 53.0 55.0 55.0 55.0 - 52.5 - 7.0 9.0 16.0 36.0 44.0 53.0 77.0 68.0 95.0 85.0 - 96.0 107.0 147.5 126.0 113.0 157.0 138.0 134.0 135.0 148.0 - 162.0 171.0 183.0 197.0 207.0 218.0 233.0 239.0 237.0 249.0 - 254.0 281.0 282.5 282.0 315.0 319.0 339.0 354.0 198.0 132.0 - 105.0 85.5 81.0 78.0 74.0 77.0 82.0 39.0 39.0 39.0 - 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 - 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 40.0 40.0 - 41.0 49.5 66.0 71.0 66.0 59.0 53.0 46.0 43.0 44.0 - 44.5 46.0 49.0 52.0 55.0 55.0 54.0 56.0 56.0 56.0 - 53.0 - 8.0 19.0 35.0 56.0 45.0 55.0 62.0 71.0 83.0 77.0 - 99.0 108.0 132.0 133.0 248.0 180.0 138.0 139.0 139.0 146.0 - 152.0 157.0 166.0 182.0 200.0 219.0 231.0 242.0 263.0 257.0 - 275.0 282.0 305.0 328.0 325.0 345.0 373.0 296.0 161.0 115.0 - 91.0 77.5 76.0 74.0 68.0 63.0 61.0 48.0 39.0 39.0 - 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 - 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 - 41.0 49.0 58.0 64.0 62.0 54.0 50.0 45.0 45.0 46.0 - 47.0 48.0 51.0 53.0 52.0 53.0 56.0 57.0 57.0 57.0 - 53.5 - 12.0 13.0 48.0 40.5 29.0 55.0 70.0 69.0 76.0 79.0 - 102.0 105.0 118.0 168.0 269.0 153.0 117.0 119.0 128.0 129.0 - 142.0 153.0 171.5 183.0 195.0 214.0 230.0 244.0 263.0 263.0 - 257.0 277.0 300.5 331.0 331.0 339.0 361.0 258.0 135.0 99.0 - 81.0 75.0 78.0 77.0 75.0 72.0 70.0 91.0 41.0 40.0 - 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 - 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 - 40.5 50.0 57.0 61.0 59.0 53.0 48.0 48.0 49.0 51.0 - 52.5 54.0 55.0 56.0 57.0 58.0 59.0 58.0 60.0 58.0 - 55.0 diff --git a/CALPUFF_SRC/TERREL/masaya.lst b/CALPUFF_SRC/TERREL/masaya.lst deleted file mode 100644 index 2ac8d85..0000000 --- a/CALPUFF_SRC/TERREL/masaya.lst +++ /dev/null @@ -1,1320 +0,0 @@ - - - - TERREL OUTPUT SUMMARY - VERSION: 7.0.0 LEVEL: 141010 - - - - Internal Coordinate Transformations by - --- COORDLIB Version: 1.99 Level: 070921 - - - - - -------------------------- - SETUP Information - -------------------------- - - - Control File Used ----- - terrel.inp - - - Processing Options ----- - igrid : Cartesian-Corner - imodel : CALMET - LXY : T - LINTXY : F - nxycol : 2 - xyradkm : 5.000000 - - Continuation Run? : F - - Interpolate voids? : F - - QA Threshold (%) = 75 - - For Data Base (DB) files with data points - distributed in latitude-longitude ------- - DB Lat-Lon to x-y : Interpolate from sheet corners (TERREL Version < 3.69) - - Coastal processing? : F - - Read BLN coast data?: F - - Minimum elevation for noise & replacement option - - ocean = 1.500000 , 2 - - mainland = 4.000000 , 2 - - Default elevation & replacement option - - ocean = 1.500000 , 3 - - mainland = 0.0000000E+00 , 0 - - Terrain Data Input File Names ------------- - xyinp : - data/xy_masaya.dat - - dbfile :GLOB30 data/w100n40.dem - - Default Datum-Region for each File Type -------- - USGS90 : WGS-72 - USGS30 : NAS-C - ARM3 : NAS-C - 3CD : WGS-72 - DMDF : NAS-C - GTOPO30: WGS-84 - USGSLA : ESR-S - SRTM1 : WGS-96 - SRTM3 : WGS-96 - NZGEN : WGS-84 - GEN : WGS-84 - CDED : WGS-84 - GEOTIFF: WGS-84 - Coastal Data - WVS : WGS-84 - WDBII : WGS-72 - - Output File Names ------------- - lstfil : - masaya.lst - - pltfil : - masaya.grd - - outfil : - masaya.dat - - savefil : - masaya.sav - - rawecho : - raw_masaya.dat - - xyout : - xyoutput_masaya.rec - - - Grid Info (for output) --------------------- - datum : WGS-84 - pmap : UTM - Hemisphere : N - UTM zone : 16 - xorgk : 525.0942 - yorgk : 1294.239 - sizek : 1.000000 - nx : 91 - ny : 55 - - -------------------------- - SPAN Results - -------------------------- - - NLat,WLon [SE] = 11.70578 85.93474 - NLat,WLon [SW] = 11.70767 86.76973 - NLat,WLon [NW] = 12.20506 86.76930 - NLat,WLon [NE] = 12.20309 85.93279 - Output Grid Coordinates (km) - -- UTM Zone = 16 - [SE] = 616.0942 1294.239 - [SW] = 525.0942 1294.239 - [NW] = 525.0942 1349.239 - [NE] = 616.0942 1349.239 - - -------------------------- - Data File Information - -------------------------- - - SE sheet starts at LONSEDB = 85 - LATSEDB = 11 - Number of 1 Degree DEMs (NXDB) = 2 - (NYDB) = 2 - Number of 30 Meter DEMs (N30X) = 8 - (N30Y) = 5 - - The following 1-degree data files are needed: - 11n085w.DEM - 11n086w.DEM - 12n085w.DEM - 12n086w.DEM - - The following SRTM data files are needed: - n11w086.HGT or .BIL - n11w087.HGT or .BIL - n12w086.HGT or .BIL - n12w087.HGT or .BIL - - The following GTOPO30 data files are needed: - W100N40.DEM - - CELLIN: No Previous Save File is Used - - ----------------------------- - GTOPO30 Data File Information - ----------------------------- - - LONSEDB = 60 - LATSEDB = -10 - Is the machine platform "big endian?" F - - CORNERS (m) of DB sheet - xsw,ysw = 719233.1 1106077. - xnw,ynw = 718529.2 1216708. - xne,yne = 827871.4 1217618. - xse,yse = 828928.8 1106909. - For SE corner Nlat,Wlon = 10.00000 84.00000 - - LOADSTRP: j,lat,lon = 1 10 84 - xnear,ynear,xfar,yfar = 718529.2 1216708. 827871.4 - 1217618. - xlnear,ylnear,xlfar,ylfar = 85.00000 11.00000 84.00000 - 11.00000 - LOADSTRP: j,lat,lon = 120 10 84 - xnear,ynear,xfar,yfar = 719227.2 1106999. 828919.9 - 1107832. - xlnear,ylnear,xlfar,ylfar = 85.00000 10.00833 84.00000 - 10.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 609600.8 1105579. - xnw,ynw = 609249.0 1216161. - xne,yne = 718529.2 1216708. - xse,yse = 719233.1 1106077. - For SE corner Nlat,Wlon = 10.00000 85.00000 - - LOADSTRP: j,lat,lon = 1 10 85 - xnear,ynear,xfar,yfar = 609249.0 1216161. 718529.2 - 1216708. - xlnear,ylnear,xlfar,ylfar = 86.00000 11.00000 85.00000 - 11.00000 - LOADSTRP: j,lat,lon = 120 10 85 - xnear,ynear,xfar,yfar = 609597.9 1106500. 719227.2 - 1106999. - xlnear,ylnear,xlfar,ylfar = 86.00000 10.00833 85.00000 - 10.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 500000.0 1105413. - xnw,ynw = 500000.0 1215980. - xne,yne = 609249.0 1216161. - xse,yse = 609600.8 1105579. - For SE corner Nlat,Wlon = 10.00000 86.00000 - - LOADSTRP: j,lat,lon = 1 10 86 - xnear,ynear,xfar,yfar = 500000.0 1215980. 609249.0 - 1216161. - xlnear,ylnear,xlfar,ylfar = 87.00000 11.00000 86.00000 - 11.00000 - LOADSTRP: j,lat,lon = 120 10 86 - xnear,ynear,xfar,yfar = 500000.0 1106334. 609597.9 - 1106500. - xlnear,ylnear,xlfar,ylfar = 87.00000 10.00833 86.00000 - 10.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 390399.2 1105579. - xnw,ynw = 390751.0 1216161. - xne,yne = 500000.0 1215980. - xse,yse = 500000.0 1105413. - For SE corner Nlat,Wlon = 10.00000 87.00000 - - LOADSTRP: j,lat,lon = 1 10 87 - xnear,ynear,xfar,yfar = 390751.0 1216161. 500000.0 - 1215980. - xlnear,ylnear,xlfar,ylfar = 88.00000 11.00000 87.00000 - 11.00000 - LOADSTRP: j,lat,lon = 120 10 87 - xnear,ynear,xfar,yfar = 390402.2 1106500. 500000.0 - 1106334. - xlnear,ylnear,xlfar,ylfar = 88.00000 10.00833 87.00000 - 10.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 718529.2 1216708. - xnw,ynw = 717758.9 1327344. - xne,yne = 826714.7 1328333. - xse,yse = 827871.4 1217618. - For SE corner Nlat,Wlon = 11.00000 84.00000 - - LOADSTRP: j,lat,lon = 1 11 84 - xnear,ynear,xfar,yfar = 717758.9 1327344. 826714.7 - 1328333. - xlnear,ylnear,xlfar,ylfar = 85.00000 12.00000 84.00000 - 12.00000 - LOADSTRP: j,lat,lon = 120 11 84 - xnear,ynear,xfar,yfar = 718522.8 1217630. 827861.8 - 1218541. - xlnear,ylnear,xlfar,ylfar = 85.00000 11.00833 84.00000 - 11.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 609249.0 1216161. - xnw,ynw = 608864.2 1326751. - xne,yne = 717758.9 1327344. - xse,yse = 718529.2 1216708. - For SE corner Nlat,Wlon = 11.00000 85.00000 - - LOADSTRP: j,lat,lon = 1 11 85 - xnear,ynear,xfar,yfar = 608864.2 1326751. 717758.9 - 1327344. - xlnear,ylnear,xlfar,ylfar = 86.00000 12.00000 85.00000 - 12.00000 - LOADSTRP: j,lat,lon = 120 11 85 - xnear,ynear,xfar,yfar = 609245.8 1217083. 718522.8 - 1217630. - xlnear,ylnear,xlfar,ylfar = 86.00000 11.00833 85.00000 - 11.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 500000.0 1215980. - xnw,ynw = 500000.0 1326554. - xne,yne = 608864.2 1326751. - xse,yse = 609249.0 1216161. - For SE corner Nlat,Wlon = 11.00000 86.00000 - - LOADSTRP: j,lat,lon = 1 11 86 - xnear,ynear,xfar,yfar = 500000.0 1326554. 608864.2 - 1326751. - xlnear,ylnear,xlfar,ylfar = 87.00000 12.00000 86.00000 - 12.00000 - LOADSTRP: j,lat,lon = 120 11 86 - xnear,ynear,xfar,yfar = 500000.0 1216901. 609245.8 - 1217083. - xlnear,ylnear,xlfar,ylfar = 87.00000 11.00833 86.00000 - 11.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 390751.0 1216161. - xnw,ynw = 391135.8 1326751. - xne,yne = 500000.0 1326554. - xse,yse = 500000.0 1215980. - For SE corner Nlat,Wlon = 11.00000 87.00000 - - LOADSTRP: j,lat,lon = 1 11 87 - xnear,ynear,xfar,yfar = 391135.8 1326751. 500000.0 - 1326554. - xlnear,ylnear,xlfar,ylfar = 88.00000 12.00000 87.00000 - 12.00000 - LOADSTRP: j,lat,lon = 120 11 87 - xnear,ynear,xfar,yfar = 390754.2 1217083. 500000.0 - 1216901. - xlnear,ylnear,xlfar,ylfar = 88.00000 11.00833 87.00000 - 11.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 717758.9 1327344. - xnw,ynw = 716922.6 1437988. - xne,yne = 825458.7 1439054. - xse,yse = 826714.7 1328333. - For SE corner Nlat,Wlon = 12.00000 84.00000 - - LOADSTRP: j,lat,lon = 1 12 84 - xnear,ynear,xfar,yfar = 716922.6 1437988. 825458.7 - 1439054. - xlnear,ylnear,xlfar,ylfar = 85.00000 13.00000 84.00000 - 13.00000 - LOADSTRP: j,lat,lon = 120 12 84 - xnear,ynear,xfar,yfar = 717751.9 1328266. 826704.2 - 1329256. - xlnear,ylnear,xlfar,ylfar = 85.00000 12.00833 84.00000 - 12.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 608864.2 1326751. - xnw,ynw = 608446.4 1437349. - xne,yne = 716922.6 1437988. - xse,yse = 717758.9 1327344. - For SE corner Nlat,Wlon = 12.00000 85.00000 - - LOADSTRP: j,lat,lon = 1 12 85 - xnear,ynear,xfar,yfar = 608446.4 1437349. 716922.6 - 1437988. - xlnear,ylnear,xlfar,ylfar = 86.00000 13.00000 85.00000 - 13.00000 - LOADSTRP: j,lat,lon = 120 12 85 - xnear,ynear,xfar,yfar = 608860.7 1327673. 717751.9 - 1328266. - xlnear,ylnear,xlfar,ylfar = 86.00000 12.00833 85.00000 - 12.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 500000.0 1326554. - xnw,ynw = 500000.0 1437136. - xne,yne = 608446.4 1437349. - xse,yse = 608864.2 1326751. - For SE corner Nlat,Wlon = 12.00000 86.00000 - - LOADSTRP: j,lat,lon = 1 12 86 - xnear,ynear,xfar,yfar = 500000.0 1437136. 608446.4 - 1437349. - xlnear,ylnear,xlfar,ylfar = 87.00000 13.00000 86.00000 - 13.00000 - LOADSTRP: j,lat,lon = 120 12 86 - xnear,ynear,xfar,yfar = 500000.0 1327475. 608860.7 - 1327673. - xlnear,ylnear,xlfar,ylfar = 87.00000 12.00833 86.00000 - 12.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 391135.8 1326751. - xnw,ynw = 391553.7 1437349. - xne,yne = 500000.0 1437136. - xse,yse = 500000.0 1326554. - For SE corner Nlat,Wlon = 12.00000 87.00000 - - LOADSTRP: j,lat,lon = 1 12 87 - xnear,ynear,xfar,yfar = 391553.7 1437349. 500000.0 - 1437136. - xlnear,ylnear,xlfar,ylfar = 88.00000 13.00000 87.00000 - 13.00000 - LOADSTRP: j,lat,lon = 120 12 87 - xnear,ynear,xfar,yfar = 391139.3 1327673. 500000.0 - 1327475. - xlnear,ylnear,xlfar,ylfar = 88.00000 12.00833 87.00000 - 12.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 716922.6 1437988. - xnw,ynw = 716020.6 1548639. - xne,yne = 824104.0 1549780. - xse,yse = 825458.7 1439054. - For SE corner Nlat,Wlon = 13.00000 84.00000 - - LOADSTRP: j,lat,lon = 1 13 84 - xnear,ynear,xfar,yfar = 716020.6 1548639. 824104.0 - 1549780. - xlnear,ylnear,xlfar,ylfar = 85.00000 14.00000 84.00000 - 14.00000 - LOADSTRP: j,lat,lon = 120 13 84 - xnear,ynear,xfar,yfar = 716915.1 1438910. 825447.4 - 1439977. - xlnear,ylnear,xlfar,ylfar = 85.00000 13.00833 84.00000 - 13.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 608446.4 1437349. - xnw,ynw = 607995.7 1547954. - xne,yne = 716020.6 1548639. - xse,yse = 716922.6 1437988. - For SE corner Nlat,Wlon = 13.00000 85.00000 - - LOADSTRP: j,lat,lon = 1 13 85 - xnear,ynear,xfar,yfar = 607995.7 1547954. 716020.6 - 1548639. - xlnear,ylnear,xlfar,ylfar = 86.00000 14.00000 85.00000 - 14.00000 - LOADSTRP: j,lat,lon = 120 13 85 - xnear,ynear,xfar,yfar = 608442.6 1438270. 716915.1 - 1438910. - xlnear,ylnear,xlfar,ylfar = 86.00000 13.00833 85.00000 - 13.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 500000.0 1437136. - xnw,ynw = 500000.0 1547726. - xne,yne = 607995.7 1547954. - xse,yse = 608446.4 1437349. - For SE corner Nlat,Wlon = 13.00000 86.00000 - - LOADSTRP: j,lat,lon = 1 13 86 - xnear,ynear,xfar,yfar = 500000.0 1547726. 607995.7 - 1547954. - xlnear,ylnear,xlfar,ylfar = 87.00000 14.00000 86.00000 - 14.00000 - LOADSTRP: j,lat,lon = 120 13 86 - xnear,ynear,xfar,yfar = 500000.0 1438057. 608442.6 - 1438270. - xlnear,ylnear,xlfar,ylfar = 87.00000 13.00833 86.00000 - 13.00833 - - CORNERS (m) of DB sheet - xsw,ysw = 391553.7 1437349. - xnw,ynw = 392004.4 1547954. - xne,yne = 500000.0 1547726. - xse,yse = 500000.0 1437136. - For SE corner Nlat,Wlon = 13.00000 87.00000 - - LOADSTRP: j,lat,lon = 1 13 87 - xnear,ynear,xfar,yfar = 392004.4 1547954. 500000.0 - 1547726. - xlnear,ylnear,xlfar,ylfar = 88.00000 14.00000 87.00000 - 14.00000 - LOADSTRP: j,lat,lon = 120 13 87 - xnear,ynear,xfar,yfar = 391557.4 1438270. 500000.0 - 1438057. - xlnear,ylnear,xlfar,ylfar = 88.00000 13.00833 87.00000 - 13.00833 - - *** TERREL RUN SUMMARY *** - Number of input data files = 1 - Number of input data files NOT used = 0 - - 6017 Total points extracted within grid - 0 Points had missing values - - - 0 cells had noisy data - Elevations were reset to following values: - Type Value-m #noisy #replaced - ocean: 1.5 0 0 - mainland and marine islands: 4.0 0 0 - lakes: 0.0 0 0 - islands in lakes: 0.0 0 0 - ponds on islands: 0.0 0 0 - - - - - -------------------------- - HCOPY: Results - -------------------------- - - - XLLM = 525094 - YLLM = 1294239 - IZONE = 16 - CELL SIZE (m) = 1000 - NX CELLS = 91 - NY CELLS = 55 - - - - TERRAIN HEIGHTS (METERS MSL) FOR MODELING DOMAIN - 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 - ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- - 55 : 12.0 13.0 48.0 40.5 29.0 55.0 70.0 69.0 76.0 79.0 102.0 105.0 118.0 168.0 269.0 153.0 117.0 119.0 128.0 129.0 142.0 153.0 171.5 183.0 195.0 - 54 : 8.0 19.0 35.0 56.0 45.0 55.0 62.0 71.0 83.0 77.0 99.0 108.0 132.0 133.0 248.0 180.0 138.0 139.0 139.0 146.0 152.0 157.0 166.0 182.0 200.0 - 53 : 7.0 9.0 16.0 36.0 44.0 53.0 77.0 68.0 95.0 85.0 96.0 107.0 147.5 126.0 113.0 157.0 138.0 134.0 135.0 148.0 162.0 171.0 183.0 197.0 207.0 - 52 : 4.0 5.0 21.0 41.5 79.0 61.0 87.0 99.0 109.0 110.0 108.0 106.0 115.5 142.0 95.0 115.0 134.0 128.0 132.0 146.0 152.0 162.0 179.0 188.0 196.0 - 51 : 4.0 6.0 11.0 47.5 82.0 72.0 74.0 119.0 122.0 130.0 124.0 93.0 63.5 71.0 93.0 104.0 106.0 121.0 142.0 152.0 168.0 175.0 174.0 193.0 194.0 - 50 : 4.0 5.0 21.0 33.5 66.0 53.0 69.0 103.0 140.0 129.0 136.0 147.0 60.5 64.0 76.0 101.0 122.0 140.0 153.0 155.0 153.0 159.0 169.0 186.0 186.0 - 49 : 4.0 4.0 8.5 24.2 36.0 30.0 71.0 86.5 113.5 94.5 95.5 85.0 56.5 78.0 93.0 104.5 115.5 123.0 126.0 136.5 144.5 147.5 158.0 155.0 155.0 - 48 : 4.0 4.0 4.0 27.5 37.0 44.0 39.0 78.0 102.0 131.0 55.0 45.0 52.0 76.0 94.0 107.0 99.0 99.0 114.0 115.0 111.0 94.0 114.0 116.0 117.0 - 47 : 4.0 4.0 4.0 23.0 41.0 59.0 78.0 89.0 91.0 125.0 66.0 52.0 48.5 61.0 93.0 90.0 78.0 71.0 81.0 78.0 82.0 86.0 96.0 104.0 110.0 - 46 : 4.0 4.0 4.0 13.0 28.0 51.0 79.0 122.0 122.0 114.0 101.0 36.0 43.0 71.0 83.0 80.0 61.0 58.0 61.0 65.0 74.0 82.0 91.0 99.0 105.0 - 45 : 4.0 4.0 4.0 11.0 18.0 38.0 41.0 106.0 146.0 153.0 135.0 41.0 35.5 52.0 70.0 68.0 51.0 52.0 60.0 68.0 76.0 83.0 89.0 96.0 102.0 - 44 : 4.0 4.0 4.0 11.0 20.0 34.0 51.0 87.0 149.0 168.0 131.0 36.0 29.0 49.0 57.0 46.0 43.0 48.0 53.0 65.0 70.0 76.0 84.0 94.0 101.0 - 43 : 4.0 4.0 4.0 4.0 12.0 32.0 54.0 49.0 105.0 124.0 162.0 86.0 24.5 39.0 38.0 48.0 41.0 51.0 52.0 63.0 65.0 71.0 80.0 88.0 100.0 - 42 : 4.0 4.0 4.0 4.0 15.0 33.0 48.0 31.0 44.0 59.0 51.0 35.0 22.5 30.0 47.0 66.0 54.0 46.0 51.0 57.0 62.0 69.0 76.5 87.0 93.0 - 41 : 4.0 4.0 4.0 4.0 4.0 21.0 19.0 36.0 52.0 47.0 28.0 17.0 22.5 33.0 37.0 49.0 58.0 50.0 53.0 56.0 60.0 63.0 77.0 90.0 93.0 - 40 : 4.0 4.0 4.0 4.0 4.0 4.0 23.0 43.0 51.0 75.0 67.0 21.0 19.0 28.0 26.0 42.0 59.0 50.0 48.0 53.0 56.0 58.0 74.0 90.0 93.0 - 39 : 4.0 4.0 4.0 4.0 4.0 4.0 8.0 15.0 44.0 47.0 56.0 28.0 13.0 23.0 21.0 42.0 52.0 57.0 43.0 46.0 50.0 55.0 66.0 80.0 91.0 - 38 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 43.0 23.0 32.0 56.0 47.0 14.0 12.5 25.0 36.0 42.0 44.0 50.5 49.5 50.5 53.5 58.2 74.0 91.0 - 37 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 25.0 15.0 17.0 24.0 31.0 31.0 9.5 18.0 31.0 47.5 44.5 49.0 38.0 44.0 44.0 49.5 58.0 75.0 - 36 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 54.0 9.0 18.0 20.0 11.5 16.0 22.0 34.0 26.0 36.0 41.0 34.0 36.0 45.0 56.0 67.0 - 35 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 52.0 13.0 6.0 25.0 32.0 15.0 25.0 30.0 23.0 38.0 30.0 32.0 42.0 48.5 58.0 64.0 - 34 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 6.0 11.0 30.5 17.0 19.0 17.0 20.0 29.0 29.0 38.0 39.0 56.0 60.0 65.0 - 33 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 15.5 16.0 14.0 20.0 23.0 32.0 38.0 45.0 52.0 56.5 65.0 70.0 - 32 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 15.5 37.0 12.0 26.0 27.0 36.0 38.0 38.0 45.0 55.0 63.0 67.0 - 31 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 7.5 41.0 20.0 22.0 23.0 29.0 39.0 43.0 49.0 63.5 79.0 69.0 - 30 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 18.0 23.0 16.0 25.0 32.0 46.0 43.0 58.0 78.0 84.0 91.0 - 29 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 9.0 16.0 16.0 30.0 33.0 43.0 56.0 59.0 76.0 88.0 80.0 - 28 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 9.0 14.0 17.0 23.0 39.0 45.0 63.0 66.5 67.0 70.0 - 27 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 6.0 17.0 25.0 29.0 34.0 37.0 47.0 63.5 66.0 76.0 - 26 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 12.0 22.5 33.5 34.5 35.5 40.5 57.0 72.5 73.0 - 25 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 12.0 16.0 20.0 36.0 37.0 49.0 52.0 65.0 77.0 - 24 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 9.0 11.0 16.0 32.0 46.0 39.0 48.0 65.5 88.0 - 23 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 10.0 15.0 22.0 32.0 39.0 46.0 57.0 87.0 - 22 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 13.0 22.0 22.0 41.0 52.0 54.5 77.0 - 21 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 13.0 14.0 19.0 40.0 51.5 70.0 - 20 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 7.0 14.0 33.0 51.0 54.0 - 19 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 6.0 12.0 32.0 37.0 - 18 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 7.0 24.0 38.0 - 17 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 14.0 32.0 - 16 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 8.5 23.0 - 15 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 17.0 - 14 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 13 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 12 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 11 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 10 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 9 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 8 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 7 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 6 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 5 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 4 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 3 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 2 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - 1 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 - - TERRAIN HEIGHTS (METERS MSL) FOR MODELING DOMAIN - 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 - ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- - 55 : 214.0 230.0 244.0 263.0 263.0 257.0 277.0 300.5 331.0 331.0 339.0 361.0 258.0 135.0 99.0 81.0 75.0 78.0 77.0 75.0 72.0 70.0 91.0 41.0 40.0 - 54 : 219.0 231.0 242.0 263.0 257.0 275.0 282.0 305.0 328.0 325.0 345.0 373.0 296.0 161.0 115.0 91.0 77.5 76.0 74.0 68.0 63.0 61.0 48.0 39.0 39.0 - 53 : 218.0 233.0 239.0 237.0 249.0 254.0 281.0 282.5 282.0 315.0 319.0 339.0 354.0 198.0 132.0 105.0 85.5 81.0 78.0 74.0 77.0 82.0 39.0 39.0 39.0 - 52 : 204.0 214.0 224.0 239.0 226.0 230.0 244.0 255.5 288.0 289.0 308.0 334.0 362.0 240.0 152.0 122.0 96.0 90.0 90.0 94.0 91.0 92.0 42.0 39.0 41.0 - 51 : 203.0 214.0 224.0 205.0 210.0 222.0 247.0 261.5 279.0 294.0 326.0 343.0 375.0 294.0 171.0 143.0 109.0 101.0 102.0 102.0 101.0 126.0 94.0 50.0 51.0 - 50 : 189.0 176.0 177.0 184.0 194.0 213.0 224.5 257.5 287.0 308.5 332.0 356.0 375.5 370.5 250.0 182.5 139.0 129.0 124.5 125.0 125.5 130.0 136.5 72.0 77.5 - 49 : 148.0 164.5 174.5 159.0 185.0 210.0 232.0 245.5 276.0 291.0 318.0 323.0 349.0 385.0 369.0 243.0 194.0 161.5 152.0 154.0 153.0 155.0 154.0 93.0 54.0 - 48 : 120.0 137.0 148.0 164.0 181.0 203.0 200.0 235.5 261.0 279.0 279.0 318.0 348.0 386.0 402.0 327.0 237.0 194.5 174.0 177.0 177.0 178.0 221.0 180.0 151.0 - 47 : 116.0 126.0 139.0 158.0 173.0 177.0 186.0 223.5 244.0 256.0 283.0 317.0 342.0 354.0 389.0 405.0 278.0 225.0 202.0 203.0 200.0 197.0 204.0 82.0 175.0 - 46 : 109.0 117.0 125.0 132.0 145.0 159.0 184.0 207.0 234.0 258.0 276.0 296.0 325.0 349.0 391.0 428.0 324.0 256.0 232.0 230.0 223.0 220.0 224.0 137.0 214.0 - 45 : 108.0 120.0 142.0 164.0 184.0 189.0 193.0 221.0 229.0 248.0 260.0 281.0 315.0 343.0 378.0 424.0 368.0 279.5 259.0 263.0 252.0 251.0 266.0 258.0 236.0 - 44 : 110.0 126.0 133.0 150.0 169.0 176.0 196.0 203.5 224.0 233.0 256.0 284.0 312.0 344.0 379.0 420.0 432.0 316.0 288.0 289.0 288.0 288.0 307.0 268.0 269.0 - 43 : 110.0 119.0 136.0 154.0 155.0 164.0 171.0 187.0 224.0 246.0 271.0 286.0 309.0 333.0 373.0 405.0 447.0 370.5 337.0 327.0 321.0 322.0 330.0 318.0 290.0 - 42 : 101.0 111.0 121.0 125.0 141.0 157.0 158.0 190.0 233.0 238.0 257.0 278.0 305.0 338.0 374.0 410.0 458.0 453.5 386.0 369.0 358.0 355.0 367.0 352.0 340.0 - 41 : 100.0 109.0 115.0 119.0 129.0 137.0 146.0 166.5 201.0 227.0 237.0 264.0 291.0 334.0 380.0 411.0 461.0 508.0 451.0 413.0 415.0 394.0 395.0 413.0 386.0 - 40 : 97.0 103.0 109.0 114.0 123.0 133.0 146.0 167.5 196.0 217.0 243.0 275.0 311.0 340.0 372.0 408.0 443.0 504.5 544.0 456.0 462.0 434.0 434.0 437.0 441.0 - 39 : 96.0 102.0 109.0 116.0 123.0 133.0 144.0 163.5 192.0 218.0 254.0 274.0 303.0 342.0 376.0 411.0 443.0 505.5 583.0 572.0 528.0 494.0 489.0 484.0 490.0 - 38 : 96.5 96.5 104.0 114.5 125.5 138.0 147.5 174.0 223.5 244.5 261.5 287.5 316.5 344.5 377.0 413.0 451.0 510.5 570.0 617.5 662.0 633.5 579.0 555.0 551.5 - 37 : 88.0 87.0 97.0 113.0 132.0 148.0 179.0 200.0 211.0 217.0 257.0 272.0 302.0 320.0 356.0 399.0 433.0 487.5 560.0 622.0 666.0 712.0 676.0 632.0 633.0 - 36 : 76.0 84.0 96.0 131.0 154.0 160.0 162.0 169.0 183.0 204.0 215.0 250.0 295.0 325.0 359.0 394.0 429.0 486.0 559.0 601.0 656.0 706.0 741.0 696.0 681.0 - 35 : 79.0 87.0 101.0 123.0 127.0 139.0 145.0 154.5 176.0 194.0 229.0 260.0 281.0 317.0 347.0 382.0 423.0 491.5 552.0 597.0 644.0 693.0 753.0 754.0 738.0 - 34 : 74.0 82.0 88.0 100.0 118.0 120.0 135.0 169.0 190.0 216.0 240.0 259.0 286.0 317.0 354.0 383.0 420.0 482.0 558.0 610.0 647.0 695.0 735.0 799.0 812.0 - 33 : 79.0 86.0 93.0 101.0 114.0 127.0 141.0 169.5 196.0 209.0 233.0 261.0 306.0 327.0 349.0 392.0 430.0 498.5 554.0 597.0 636.0 684.0 740.0 785.0 863.0 - 32 : 75.0 82.0 87.0 102.0 114.0 125.0 147.0 168.0 193.0 214.0 241.0 264.0 286.0 308.0 356.0 401.0 441.0 489.0 541.0 578.0 624.0 669.0 714.0 776.0 872.0 - 31 : 83.0 94.0 96.0 104.0 115.0 133.0 142.0 166.0 185.0 214.0 238.0 272.0 290.0 327.0 375.0 409.0 439.0 474.0 530.0 562.0 608.0 653.0 710.0 763.0 860.0 - 30 : 84.0 91.0 101.0 109.0 118.0 128.0 140.0 162.0 194.0 215.0 272.0 297.0 338.0 361.0 380.0 401.0 416.0 446.0 506.0 549.0 595.0 642.0 686.0 747.0 834.0 - 29 : 82.0 90.0 100.0 106.0 113.0 124.0 139.0 181.0 218.0 260.0 289.0 310.0 328.0 354.0 362.0 370.0 385.0 440.5 507.0 545.0 588.0 627.0 664.0 726.0 787.0 - 28 : 75.0 84.0 91.0 100.0 109.0 147.0 165.0 189.5 226.0 243.0 281.0 304.0 312.0 324.0 334.0 356.0 386.0 446.0 498.0 525.0 569.0 608.0 661.0 694.0 723.0 - 27 : 81.0 90.0 99.0 112.0 124.0 148.0 151.0 188.5 232.0 249.0 261.0 278.0 293.0 307.0 334.0 366.0 389.0 427.0 489.0 522.0 554.0 597.0 619.0 673.0 718.0 - 26 : 82.0 91.5 104.0 125.5 137.5 141.5 153.0 205.2 223.5 232.5 249.0 278.5 302.5 316.0 325.0 340.5 361.0 409.8 459.0 481.0 518.0 550.5 584.5 623.0 669.0 - 25 : 91.0 104.0 112.0 121.0 127.0 141.0 157.0 179.0 220.0 247.0 254.0 272.0 278.0 264.0 294.0 325.0 357.0 391.0 429.0 443.0 486.0 524.0 555.0 590.0 623.0 - 24 : 87.0 105.0 117.0 128.0 141.0 152.0 166.0 201.0 217.0 225.0 202.0 213.0 227.0 265.0 289.0 318.0 332.0 370.5 378.0 432.0 465.0 504.0 547.0 578.0 603.0 - 23 : 104.0 104.0 123.0 128.0 141.0 145.0 158.0 188.0 204.0 187.0 186.0 203.0 233.0 251.0 273.0 295.0 323.0 330.5 391.0 423.0 461.0 483.0 518.0 544.0 583.0 - 22 : 99.0 113.0 128.0 145.0 141.0 139.0 148.0 172.5 176.0 168.0 195.0 210.0 213.0 226.0 265.0 289.0 268.0 330.0 385.0 405.0 441.0 464.0 499.0 533.0 557.0 - 21 : 78.0 107.0 102.0 127.0 133.0 130.0 138.0 147.5 144.0 179.0 184.0 177.0 193.0 218.0 234.0 233.0 266.0 330.0 360.0 400.0 411.0 442.0 488.0 503.0 514.0 - 20 : 86.0 80.0 103.0 90.0 123.0 128.0 115.0 123.0 132.0 160.0 151.0 161.0 176.0 194.0 192.0 230.0 283.0 305.0 350.0 364.0 400.0 433.0 462.0 481.0 514.0 - 19 : 60.0 81.0 64.0 75.0 99.0 129.0 107.0 104.0 115.0 128.0 137.0 149.0 161.0 171.0 223.0 247.0 258.0 286.5 314.0 360.0 387.0 407.0 435.0 463.0 488.0 - 18 : 42.0 55.0 75.0 76.0 99.0 118.0 98.0 91.0 102.0 119.0 128.0 137.0 149.0 179.0 210.0 218.0 229.0 258.5 312.0 337.0 366.0 383.0 411.0 432.0 464.0 - 17 : 35.0 46.0 81.0 92.0 113.0 82.0 86.0 90.0 94.0 102.0 120.0 132.0 153.0 176.0 172.0 196.0 213.0 245.0 296.0 321.0 334.0 364.0 380.0 414.0 432.0 - 16 : 40.0 44.0 52.0 103.0 70.0 67.0 78.0 82.0 101.0 109.0 123.0 125.0 143.0 151.0 156.0 189.0 186.0 242.0 280.0 288.0 310.0 340.0 363.0 385.0 407.0 - 15 : 25.0 48.0 61.0 55.0 66.0 69.0 88.0 95.5 100.0 106.0 112.0 113.0 124.0 136.0 162.5 163.0 190.0 206.0 229.0 255.5 279.5 302.0 326.5 353.5 377.0 - 14 : 13.5 26.5 40.5 42.5 48.5 70.5 84.0 90.0 87.0 91.0 93.0 98.5 107.5 130.0 136.0 156.0 158.0 171.5 204.0 229.0 250.0 274.0 295.0 318.0 338.0 - 13 : 4.0 18.0 30.0 30.0 33.0 50.0 62.0 76.0 70.5 73.0 82.0 86.0 99.0 113.0 121.0 141.0 138.0 156.5 179.0 200.0 230.0 252.0 275.0 294.0 310.0 - 12 : 4.0 4.0 23.0 23.0 24.0 42.0 36.0 51.0 60.0 79.0 81.0 90.0 101.0 101.0 109.0 117.0 116.0 140.0 160.0 172.0 206.0 228.0 247.0 269.0 287.0 - 11 : 4.0 4.0 18.0 18.0 18.0 28.0 44.0 47.0 52.0 69.0 83.0 96.0 85.0 86.0 94.0 104.0 109.0 127.0 139.0 167.0 186.0 204.0 223.0 246.0 260.0 - 10 : 4.0 4.0 13.0 16.0 20.0 29.0 34.0 40.0 50.5 60.0 76.0 87.0 78.0 75.0 84.0 93.0 104.0 116.5 129.0 158.0 160.0 174.0 202.0 221.0 229.0 - 9 : 4.0 4.0 9.0 13.0 22.0 26.0 31.0 32.0 42.5 62.0 60.0 77.0 64.0 74.0 83.0 92.0 98.0 104.5 125.0 137.0 135.0 162.0 189.0 187.0 207.0 - 8 : 4.0 4.0 4.0 4.0 18.0 22.0 24.0 28.0 34.0 66.0 50.0 58.0 84.0 87.0 79.0 80.0 90.0 96.0 101.5 118.0 119.0 151.0 175.0 163.0 162.0 - 7 : 4.0 4.0 4.0 4.0 4.0 13.0 20.0 20.0 24.0 45.0 43.0 53.0 55.0 84.0 82.0 73.0 78.0 90.0 87.5 99.0 109.0 130.0 154.0 153.0 143.0 - 6 : 4.0 4.0 4.0 4.0 4.0 4.0 7.0 11.0 24.5 28.0 47.0 43.0 37.0 67.0 84.0 69.0 66.0 80.0 84.0 88.0 97.0 104.0 125.0 125.0 132.0 - 5 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 7.0 20.0 22.0 27.0 36.0 38.0 39.0 63.0 71.0 58.0 68.0 80.5 76.0 87.0 92.0 108.0 114.0 118.0 - 4 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 11.0 22.0 20.0 21.0 55.0 38.0 36.0 60.0 53.0 55.0 72.5 67.0 76.0 84.0 96.0 101.0 110.0 - 3 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 9.5 11.5 12.0 16.0 36.0 32.5 35.0 42.5 62.0 61.2 62.5 68.5 77.0 80.5 86.0 96.0 - 2 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 10.0 16.0 32.0 36.0 32.0 38.0 52.0 57.0 65.0 64.0 70.0 74.0 79.0 - 1 : 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 7.0 16.0 49.0 27.0 35.0 44.0 47.0 49.0 59.0 58.0 67.0 69.0 - - TERRAIN HEIGHTS (METERS MSL) FOR MODELING DOMAIN - 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 - ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- - 55 : 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 40.5 50.0 57.0 61.0 59.0 - 54 : 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 41.0 49.0 58.0 64.0 62.0 - 53 : 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 40.0 40.0 41.0 49.5 66.0 71.0 66.0 - 52 : 42.0 39.5 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.0 39.5 45.0 43.0 45.0 46.0 46.0 45.0 49.0 49.0 48.0 55.0 72.0 73.0 68.0 - 51 : 51.0 51.0 49.0 41.0 39.0 39.0 43.0 45.0 50.0 51.0 48.0 50.0 55.0 50.0 50.0 50.0 49.0 50.0 51.0 51.0 51.0 66.3 80.0 81.5 68.0 - 50 : 83.5 84.8 77.0 70.5 66.0 68.0 72.5 74.5 78.5 80.0 74.5 72.2 67.5 59.0 58.0 57.5 56.0 56.0 56.5 57.0 57.0 68.7 82.0 93.0 83.0 - 49 : 117.0 118.0 111.0 93.0 95.0 98.0 102.0 103.0 107.0 105.0 102.0 93.0 79.0 70.0 69.0 67.0 65.0 66.0 66.0 66.0 65.0 83.5 92.0 95.0 96.0 - 48 : 153.0 141.0 125.0 119.0 119.0 122.0 123.0 123.0 126.0 122.0 119.0 107.5 90.0 77.0 76.0 76.0 73.0 74.0 74.0 74.0 72.0 95.5 105.0 101.0 105.0 - 47 : 171.0 169.0 148.0 147.0 150.0 149.0 145.0 147.0 147.0 144.0 140.0 127.0 106.0 86.0 82.0 83.0 82.0 82.0 80.0 79.0 82.0 113.5 118.0 111.0 111.0 - 46 : 210.0 199.5 194.0 183.0 185.0 179.0 174.0 175.0 176.0 174.0 168.0 146.0 124.0 99.0 89.0 91.0 90.0 91.0 86.0 84.0 100.0 130.5 128.0 122.0 117.0 - 45 : 247.0 235.5 240.0 218.0 220.0 216.0 205.0 206.0 210.0 206.0 189.0 167.5 144.0 118.0 102.0 102.0 99.0 101.0 99.0 95.0 126.0 147.0 139.0 132.0 124.0 - 44 : 278.0 273.0 278.0 268.0 260.0 253.0 244.0 236.0 241.0 223.0 205.0 187.5 164.0 141.0 129.0 112.0 107.0 106.0 102.0 110.0 143.0 161.0 153.0 145.0 137.0 - 43 : 321.0 313.5 323.0 322.0 302.0 294.0 285.0 267.0 254.0 233.0 224.0 206.5 176.0 152.0 133.0 120.0 111.0 108.0 107.0 130.0 161.0 170.5 166.0 159.0 154.0 - 42 : 353.0 357.5 362.0 372.0 343.0 339.0 318.0 290.0 261.0 242.0 236.0 208.5 180.0 153.0 138.0 125.0 119.0 117.0 116.0 154.0 181.0 181.5 179.0 171.0 163.0 - 41 : 392.0 405.5 408.0 423.0 385.0 378.0 354.0 314.0 276.0 249.0 229.0 197.5 174.0 159.0 137.0 127.0 124.0 123.0 133.0 178.0 195.0 193.5 191.0 182.0 171.0 - 40 : 439.0 456.0 458.0 468.0 433.0 425.0 391.0 324.0 284.0 248.0 226.0 199.0 181.0 167.0 151.0 149.0 143.0 142.0 146.0 183.0 199.0 202.0 202.0 192.0 181.0 - 39 : 475.0 494.0 507.5 516.0 492.0 466.0 433.0 384.0 317.0 245.0 224.0 219.8 208.5 195.0 192.5 187.5 173.5 171.5 172.0 179.0 188.0 208.0 216.5 206.0 202.0 - 38 : 547.5 557.5 582.0 586.5 585.0 545.0 534.5 537.0 435.5 276.5 245.5 248.0 248.0 241.0 241.0 232.0 219.0 211.0 196.0 188.0 190.0 198.0 219.0 224.0 219.0 - 37 : 629.0 648.0 662.0 686.0 679.0 668.0 632.0 541.0 453.0 301.0 274.0 277.0 290.0 288.0 292.0 278.0 259.0 235.0 207.0 195.0 197.0 196.0 211.0 231.0 226.0 - 36 : 696.0 709.0 722.5 741.0 763.0 709.0 589.0 477.0 363.0 314.0 291.0 313.5 312.0 280.0 294.0 287.0 277.0 273.0 237.0 210.0 206.0 201.5 217.0 239.0 242.0 - 35 : 754.0 766.0 831.5 832.0 754.0 630.0 528.0 482.0 350.0 317.0 319.0 356.0 297.0 287.0 296.0 285.0 279.0 278.0 273.0 232.0 215.0 209.5 214.0 242.0 254.0 - 34 : 809.0 864.0 865.5 781.0 712.0 640.0 504.0 398.0 353.0 334.0 353.0 392.0 305.0 315.0 317.0 303.0 298.0 285.0 272.0 247.0 222.0 217.0 226.0 250.0 254.0 - 33 : 914.0 899.0 836.0 763.0 668.0 592.0 556.0 408.0 370.0 367.0 384.0 384.5 305.0 349.0 390.0 394.0 373.0 298.0 240.0 209.0 170.0 216.5 266.0 252.0 246.0 - 32 : 900.0 869.0 805.5 720.0 675.0 592.0 486.0 429.0 400.0 399.0 407.0 440.5 330.0 379.0 487.0 520.0 528.0 301.0 217.0 177.0 137.0 199.0 245.0 249.0 247.0 - 31 : 883.0 863.0 802.5 739.0 604.0 533.0 475.0 427.0 435.0 436.0 447.0 491.0 527.5 402.0 469.0 498.0 423.0 306.0 217.0 173.0 133.0 156.5 243.0 252.0 255.0 - 30 : 863.0 841.0 801.5 707.0 689.0 635.0 542.0 555.0 516.0 484.0 499.0 499.0 486.0 463.0 430.0 415.0 374.0 285.0 215.0 166.0 126.0 153.0 242.0 253.0 267.0 - 29 : 850.0 824.0 783.0 760.0 698.0 654.0 664.0 638.0 589.0 592.0 522.0 487.0 447.0 406.0 377.0 355.0 326.0 239.0 192.0 154.0 124.0 153.0 255.0 268.0 283.0 - 28 : 826.0 848.0 808.5 793.0 787.0 770.0 732.0 720.0 677.0 632.0 563.0 478.0 450.5 449.0 446.0 353.0 305.0 259.0 182.0 135.0 124.0 180.0 291.0 300.0 311.0 - 27 : 763.5 820.0 803.0 784.5 760.5 754.0 722.0 682.5 656.5 645.5 613.0 575.0 540.0 511.5 466.0 387.5 310.0 290.0 303.5 277.0 276.5 295.2 341.5 362.0 380.5 - 26 : 707.0 758.0 781.5 741.0 732.0 711.0 677.0 649.0 607.0 582.0 578.0 545.0 514.5 471.0 450.0 373.0 362.0 385.0 412.0 393.0 390.0 369.0 398.0 422.0 457.0 - 25 : 668.0 717.0 751.5 744.0 712.0 690.0 664.0 629.0 605.0 578.0 566.0 541.0 493.5 454.0 430.0 412.0 403.0 434.0 444.0 448.0 433.0 404.0 415.5 444.0 492.0 - 24 : 636.0 673.0 710.5 720.0 709.0 687.0 665.0 645.0 627.0 599.0 576.0 554.0 512.0 473.0 462.0 435.0 431.0 454.0 464.0 470.0 453.0 435.0 440.5 464.0 503.0 - 23 : 605.0 636.0 669.0 683.0 688.0 683.0 669.0 654.0 636.0 614.0 585.0 561.0 521.0 478.0 468.0 451.0 448.0 459.0 471.0 470.0 461.0 453.0 458.5 470.0 481.0 - 22 : 563.0 608.0 635.0 645.0 659.0 671.0 667.0 662.0 654.0 636.0 594.0 569.0 536.0 483.0 476.0 465.0 463.0 464.0 476.0 475.0 467.0 457.0 450.5 443.0 447.0 - 21 : 555.0 578.0 607.0 612.0 627.0 638.0 644.0 647.0 655.0 649.0 616.0 583.0 544.0 503.0 484.0 476.0 473.0 468.0 481.0 478.0 460.0 449.0 432.0 421.0 414.0 - 20 : 534.0 559.0 586.5 578.0 601.0 607.0 619.0 626.0 634.0 635.0 630.0 610.0 552.0 512.0 497.0 485.0 480.0 474.0 484.0 474.0 445.0 431.0 410.5 400.0 384.0 - 19 : 510.0 534.0 561.5 563.0 588.0 592.0 601.0 604.0 614.0 613.0 618.0 606.0 573.0 519.0 510.0 497.0 488.0 482.0 476.0 463.0 431.0 410.0 389.0 370.0 360.0 - 18 : 479.0 497.0 530.5 560.0 560.0 577.0 584.0 583.0 589.0 593.0 593.0 587.0 570.0 521.0 507.0 499.0 489.0 480.0 470.0 456.0 417.0 391.0 366.5 347.0 336.0 - 17 : 445.0 472.0 497.5 522.0 539.0 549.0 551.0 564.0 562.0 572.0 579.0 570.0 558.0 527.0 506.0 499.0 488.0 474.0 459.0 445.0 407.0 373.0 343.5 326.0 315.0 - 16 : 428.0 449.0 466.5 494.0 502.0 513.0 523.0 537.0 533.0 550.0 552.0 555.0 543.0 519.0 502.0 484.0 469.0 455.0 440.0 421.0 402.0 365.0 322.0 310.0 298.0 - 15 : 396.0 413.0 430.5 454.0 464.5 476.0 478.0 488.0 496.0 505.0 513.0 513.5 507.5 494.0 475.5 464.5 446.5 434.0 421.0 406.5 383.0 355.0 305.8 285.5 281.0 - 14 : 356.0 363.0 392.0 415.0 422.0 435.0 437.0 442.0 460.0 462.0 466.0 466.0 466.0 464.0 445.0 446.0 423.0 411.0 399.0 387.0 364.0 343.0 303.5 281.0 270.0 - 13 : 331.0 337.0 366.0 388.0 397.0 399.0 410.0 416.0 429.0 431.0 438.0 440.0 433.5 434.0 425.0 424.0 407.0 395.0 388.0 379.0 356.0 335.0 301.0 277.0 256.0 - 12 : 297.0 321.0 339.0 359.0 367.0 373.0 378.0 387.0 399.0 403.0 415.0 410.0 406.5 405.0 401.0 397.0 382.0 384.0 370.0 359.0 343.0 330.0 301.5 278.0 259.0 - 11 : 281.0 293.0 312.0 329.0 332.0 344.0 352.0 359.0 362.0 370.0 379.0 382.0 380.5 374.0 373.0 365.0 362.0 359.0 348.0 335.0 327.0 314.0 285.5 266.0 249.0 - 10 : 255.0 262.0 283.0 294.0 306.0 311.0 323.0 327.0 330.0 335.0 345.0 351.0 351.0 345.0 345.0 338.0 346.0 337.0 328.0 318.0 301.0 292.0 261.0 249.0 237.0 - 9 : 209.0 226.0 251.0 262.0 271.0 283.0 293.0 297.0 300.0 306.0 317.0 321.0 320.0 320.0 321.0 317.0 324.0 316.0 307.0 292.0 282.0 266.0 237.0 218.0 209.0 - 8 : 172.0 204.0 222.0 236.0 247.0 256.0 260.0 267.0 267.0 273.0 280.0 291.0 290.5 294.0 294.0 297.0 301.0 292.0 283.0 268.0 258.0 240.0 221.5 201.0 190.0 - 7 : 158.0 181.0 194.5 210.0 222.0 225.0 231.0 237.0 236.0 246.0 247.0 263.0 260.0 264.0 269.0 273.0 277.0 268.0 261.0 248.0 232.0 217.0 201.0 181.0 175.0 - 6 : 148.0 155.0 173.0 180.0 189.0 197.0 200.0 203.0 204.0 211.0 220.0 236.0 235.0 244.0 249.0 255.0 255.0 246.0 237.0 230.0 214.0 195.0 181.0 169.0 160.0 - 5 : 130.0 152.0 147.0 165.0 183.0 190.0 172.0 171.0 170.0 177.0 192.0 198.0 212.5 222.0 233.0 235.0 242.0 228.0 219.0 211.0 200.0 182.0 165.0 154.0 145.0 - 4 : 138.0 125.0 130.0 135.0 159.0 145.0 146.0 149.0 148.0 151.0 160.0 172.0 196.5 210.0 231.0 216.0 232.0 219.0 196.0 188.0 175.0 164.0 147.0 135.5 126.5 - 3 : 112.0 104.5 113.0 107.7 128.0 110.5 116.5 119.0 128.0 136.5 139.0 144.5 179.2 189.0 197.0 220.5 270.5 209.0 172.5 164.0 156.5 149.0 134.0 124.0 119.0 - 2 : 105.0 99.0 76.0 84.0 88.0 91.0 99.0 106.0 123.0 136.0 136.0 158.0 161.5 199.0 201.0 208.0 200.0 174.0 158.0 158.0 149.0 142.0 135.0 126.0 121.0 - 1 : 96.0 112.0 62.0 102.5 105.0 99.0 110.0 129.0 149.0 170.0 159.0 170.0 195.5 215.0 217.0 225.0 205.0 176.0 182.0 178.0 171.0 164.0 148.5 158.0 156.0 - - TERRAIN HEIGHTS (METERS MSL) FOR MODELING DOMAIN - 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 - ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- - 55 : 53.0 48.0 48.0 49.0 51.0 52.5 54.0 55.0 56.0 57.0 58.0 59.0 58.0 60.0 58.0 55.0 - 54 : 54.0 50.0 45.0 45.0 46.0 47.0 48.0 51.0 53.0 52.0 53.0 56.0 57.0 57.0 57.0 53.5 - 53 : 59.0 53.0 46.0 43.0 44.0 44.5 46.0 49.0 52.0 55.0 55.0 54.0 56.0 56.0 56.0 53.0 - 52 : 63.0 57.0 48.0 45.0 43.0 44.0 44.0 45.0 48.0 53.0 55.0 53.0 55.0 55.0 55.0 52.5 - 51 : 62.0 59.0 52.5 46.0 43.5 43.8 42.0 43.5 44.5 46.5 51.0 52.5 53.5 54.0 54.0 50.5 - 50 : 68.0 60.0 57.0 49.0 46.0 44.5 44.0 42.0 42.0 43.0 47.0 50.0 50.0 51.0 52.0 47.5 - 49 : 77.0 69.0 61.0 53.0 46.0 44.5 42.0 41.0 41.0 41.0 42.0 43.0 46.0 49.0 50.0 47.0 - 48 : 90.0 77.0 65.0 53.0 46.0 43.0 43.0 41.0 39.0 38.0 38.0 39.0 42.0 45.0 46.0 46.0 - 47 : 99.0 90.0 73.0 58.0 49.0 43.0 41.0 41.0 40.0 35.0 33.0 35.0 37.0 39.0 40.0 41.5 - 46 : 105.0 102.0 86.0 67.0 56.0 47.0 42.5 41.0 40.0 36.0 33.0 35.0 37.0 37.0 37.0 39.5 - 45 : 117.0 107.0 93.0 75.0 59.0 50.0 44.0 42.0 40.0 36.0 33.0 33.0 37.0 40.0 40.0 41.5 - 44 : 129.0 114.0 101.0 86.0 69.0 57.0 47.0 42.0 40.0 36.0 33.0 35.0 38.0 39.0 39.0 40.5 - 43 : 139.0 127.0 110.0 93.0 77.0 63.0 50.5 42.0 40.0 38.0 37.0 38.0 38.0 39.0 39.0 41.5 - 42 : 149.0 137.0 118.0 101.0 88.0 74.0 55.5 45.0 41.0 38.0 37.0 38.0 39.0 39.0 40.0 40.5 - 41 : 161.0 147.0 128.0 112.0 96.0 80.0 62.5 48.0 42.0 39.0 39.0 39.0 39.0 40.0 39.0 39.5 - 40 : 174.0 159.0 142.0 125.0 105.0 90.0 71.0 50.0 43.0 42.0 41.0 40.0 40.0 40.0 40.0 40.0 - 39 : 193.0 181.5 165.0 142.0 121.0 102.5 80.5 58.5 46.5 44.0 41.5 41.0 40.5 40.0 40.0 40.0 - 38 : 210.0 199.0 182.0 156.0 134.0 115.0 91.5 63.0 49.0 44.0 44.0 42.0 41.0 40.0 40.0 40.0 - 37 : 221.0 209.0 187.0 160.0 137.0 121.0 98.5 68.0 54.0 48.0 45.0 42.0 42.0 49.0 42.0 39.0 - 36 : 234.0 213.0 190.0 163.0 140.0 124.0 102.0 68.0 56.0 51.0 46.0 45.0 43.0 51.0 43.0 40.0 - 35 : 242.0 219.0 203.0 168.0 142.0 126.0 100.5 70.0 60.0 54.0 49.0 45.0 42.0 40.0 40.0 40.0 - 34 : 240.0 234.0 204.0 166.0 143.0 130.0 106.0 79.0 69.0 60.0 54.0 47.0 43.0 42.0 41.0 40.0 - 33 : 231.0 223.0 196.0 162.0 149.0 143.0 115.0 89.0 76.0 67.0 59.0 53.0 50.0 48.0 42.0 39.0 - 32 : 238.0 230.0 202.0 174.0 165.0 152.0 125.0 99.0 85.0 76.0 69.0 60.0 50.0 47.0 43.0 36.0 - 31 : 250.0 239.0 215.0 194.0 183.0 169.0 143.0 117.0 102.0 87.0 79.0 65.0 55.0 46.0 42.0 33.0 - 30 : 267.0 259.0 242.0 224.0 213.0 195.0 167.0 137.0 115.0 98.0 87.0 72.0 61.0 50.0 41.0 31.0 - 29 : 290.0 278.0 273.0 255.0 240.0 221.0 187.5 151.0 124.0 110.0 92.0 77.0 62.0 50.0 40.0 31.0 - 28 : 312.0 308.0 299.0 289.0 270.0 245.0 198.0 156.0 138.0 117.0 97.0 83.0 69.5 58.0 42.0 31.0 - 27 : 388.5 365.0 241.0 165.0 118.0 103.0 139.0 171.5 151.0 129.5 106.0 87.5 76.0 62.0 44.0 31.0 - 26 : 484.0 353.0 98.0 78.0 78.0 78.0 78.5 162.0 165.0 140.0 107.0 88.0 74.0 62.0 47.0 32.0 - 25 : 556.0 314.0 86.0 78.0 78.0 78.0 78.5 180.0 172.0 139.0 111.0 93.0 77.0 66.0 47.0 36.0 - 24 : 517.0 280.0 86.0 78.0 78.0 78.0 78.0 158.0 176.0 149.0 119.0 99.0 81.0 65.0 48.0 39.0 - 23 : 485.0 354.0 206.0 106.0 88.0 154.0 161.0 296.0 205.0 153.0 126.0 92.0 84.0 73.0 74.0 42.0 - 22 : 446.0 424.0 408.0 301.0 290.0 377.0 385.0 330.0 204.0 180.0 132.0 101.0 88.0 93.0 93.0 70.0 - 21 : 401.0 375.0 374.0 372.0 377.0 378.0 380.5 292.0 262.0 240.0 165.0 118.0 100.0 110.0 115.0 126.0 - 20 : 367.0 348.0 345.0 345.0 344.0 338.0 315.0 307.0 308.0 276.0 235.0 186.0 159.0 141.0 166.0 156.0 - 19 : 346.0 328.0 333.0 325.0 318.0 308.0 297.0 283.5 288.0 289.0 272.0 245.0 233.0 199.0 188.0 150.0 - 18 : 321.0 310.0 312.0 303.0 295.0 295.0 285.0 297.0 315.0 361.0 346.0 320.0 309.0 286.0 230.0 193.0 - 17 : 305.0 297.0 289.0 282.0 269.0 272.0 269.0 344.5 393.0 428.0 473.0 469.0 465.0 407.0 303.0 271.0 - 16 : 286.0 280.0 273.0 263.0 254.0 255.0 286.0 409.0 589.5 714.0 861.5 835.0 780.0 542.5 474.0 430.0 - 15 : 274.5 258.0 257.5 247.0 229.0 246.5 286.0 347.3 527.0 688.0 1026.0 923.0 1063.0 992.0 717.0 533.0 - 14 : 251.0 245.0 238.0 223.0 216.0 238.0 259.0 321.0 449.0 583.0 743.0 624.0 883.0 818.0 596.0 430.0 - 13 : 247.0 227.0 223.0 211.0 213.0 216.0 235.0 263.0 330.0 400.0 499.0 488.0 551.0 548.0 403.0 286.0 - 12 : 248.0 225.0 199.0 194.0 198.0 193.0 204.0 223.5 243.0 270.0 318.0 309.0 323.0 313.0 253.0 195.0 - 11 : 236.0 216.0 193.0 179.0 177.0 172.0 175.0 193.0 183.0 201.0 205.0 196.0 195.0 170.0 156.0 126.0 - 10 : 218.0 197.0 181.0 166.0 161.0 156.0 156.0 155.0 141.0 165.0 143.0 142.0 112.0 99.0 78.0 75.0 - 9 : 194.0 182.0 167.0 152.0 151.0 143.0 137.0 131.0 117.0 113.0 106.0 100.0 83.0 62.0 52.0 46.0 - 8 : 183.0 171.0 157.0 144.0 140.0 135.0 125.0 115.5 102.0 95.0 81.0 62.0 60.0 52.0 50.0 46.0 - 7 : 166.0 164.0 151.0 139.0 130.0 125.0 120.0 110.0 98.0 91.0 76.0 68.0 57.0 52.0 59.0 46.0 - 6 : 150.0 146.0 140.0 129.0 122.0 119.0 112.0 104.5 92.0 95.0 88.0 85.0 73.0 63.0 64.0 47.0 - 5 : 137.0 130.0 124.0 119.0 116.0 113.0 109.0 99.5 90.0 103.0 91.0 89.0 86.0 74.0 77.0 56.0 - 4 : 121.5 117.0 112.0 106.0 103.5 106.5 101.0 91.8 85.0 94.0 93.5 88.0 77.5 69.0 69.5 54.0 - 3 : 113.0 108.0 102.0 96.0 96.0 99.0 94.0 82.5 79.0 82.0 83.0 80.0 71.0 68.0 56.0 43.0 - 2 : 122.0 111.0 101.0 97.0 94.0 93.0 89.0 83.0 78.0 76.0 73.0 72.0 70.0 65.0 52.0 46.0 - 1 : 146.0 153.0 113.0 96.0 96.0 98.0 88.0 83.0 80.0 77.0 70.0 67.0 64.0 73.0 54.0 51.0 - - - - - - NUMBER OF TERRAIN DATA "HITS" PER CELL - - Multiply all values by 10 ** -3 - - 55 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 54 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 53 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 52 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 51 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 50 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 49 I 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 48 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 47 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 46 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 45 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 44 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 43 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 42 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 41 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 40 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 39 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 38 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 37 I 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 36 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 35 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 34 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 33 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 32 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 31 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 30 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 29 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 28 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 27 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 26 I 1000 1000 1000 2000 1000 1000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 25 I 2000 2000 2000 4000 2000 2000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 24 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 23 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 22 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 21 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 20 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 19 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 18 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 17 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 16 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 15 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 14 I 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 13 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 12 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 11 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 10 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 9 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 8 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 7 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 6 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 5 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 4 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 3 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 2 I 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 1 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - ----------------------------------------------------------------------------------------------------------------------- - 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 - - NUMBER OF TERRAIN DATA "HITS" PER CELL - - Multiply all values by 10 ** -3 - - 55 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 54 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 53 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 52 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 51 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 50 I 1000 1000 2000 1000 1000 1000 1000 1000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 49 I 2000 2000 4000 2000 2000 2000 2000 2000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 48 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 47 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 46 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 45 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 44 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 43 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 42 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 41 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 40 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 39 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 38 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 37 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 36 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 35 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 34 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 33 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 32 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 31 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 30 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 29 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 28 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 27 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 26 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 25 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 24 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 23 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 22 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 21 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 20 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 19 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 18 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 17 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 16 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 15 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + + + + + + + + + + - 14 I 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 1000 - I + + + + + + + + + + + + + + + + + + + + - 13 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 12 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 11 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 10 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 9 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 8 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 7 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 6 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 5 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 4 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 3 I 1000 1000 1000 2000 1000 1000 1000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 2 I 2000 2000 2000 4000 2000 2000 2000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 1 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - ----------------------------------------------------------------------------------------------------------------------- - 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 - - NUMBER OF TERRAIN DATA "HITS" PER CELL - - Multiply all values by 10 ** -3 - - 55 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 54 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 53 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 52 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 51 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 50 I 2000 3000 3000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 49 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 48 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 47 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 46 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 45 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 44 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 43 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 42 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 41 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 40 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 39 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 38 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 37 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 36 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 35 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 34 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 33 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 32 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 31 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 30 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 29 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 28 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 27 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 26 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 25 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 24 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 23 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 22 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 21 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 20 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 19 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 18 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 17 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 16 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 15 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 14 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 13 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 12 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 11 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 10 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 9 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 8 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 7 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 6 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 5 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 4 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 3 I 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 3000 3000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 2 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 1 I 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - ----------------------------------------------------------------------------------------------------------------------- - 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 - - NUMBER OF TERRAIN DATA "HITS" PER CELL - - Multiply all values by 10 ** -3 - - 55 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 54 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 53 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 52 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 51 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 3000 2000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 50 I 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 3000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 49 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 48 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 47 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 46 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 45 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 44 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 43 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 42 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 41 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 40 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 39 I 1000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 38 I 2000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 37 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 36 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 35 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 34 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 33 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 32 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 31 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 30 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 29 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 28 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 27 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 26 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 25 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 24 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 23 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 22 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 21 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 20 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 19 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 18 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 17 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 16 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 15 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 14 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 13 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 12 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 11 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 10 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 9 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 8 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 7 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 6 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 5 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 4 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 4000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + + + + + + + + + + - 3 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 2 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - 1 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + + + + + + + + + + - ----------------------------------------------------------------------------------------------------------------------- - 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 - - NUMBER OF TERRAIN DATA "HITS" PER CELL - - Multiply all values by 10 ** -3 - - 55 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 54 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 53 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 52 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 51 I 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 4000 - I + + + + + + + + + + + - 50 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 49 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 48 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 47 I 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 46 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 45 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 44 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 43 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 42 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 41 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 40 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 2000 - I + + + + + + + + + + + - 39 I 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + - 38 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 37 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 36 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 35 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 34 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 33 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 32 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 31 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 30 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 29 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 28 I 1000 2000 1000 1000 1000 1000 1000 2000 2000 2000 2000 - I + + + + + + + + + + + - 27 I 2000 4000 2000 2000 2000 2000 2000 1000 1000 1000 1000 - I + + + + + + + + + + + - 26 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 25 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 24 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 23 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 22 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 21 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 20 I 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 19 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 18 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 17 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 16 I 1000 1000 3000 2000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + - 15 I 2000 2000 3000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 14 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 13 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 12 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 11 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 10 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 9 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 8 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 7 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 6 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 5 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 4 I 2000 2000 4000 2000 2000 2000 2000 2000 2000 2000 2000 - I + + + + + + + + + + + - 3 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 2 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - 1 I 1000 1000 2000 1000 1000 1000 1000 1000 1000 1000 1000 - I + + + + + + + + + + + - ----------------------------------------------------------------- - 81 82 83 84 85 86 87 88 89 90 91 - - -Summary Information for cells with data: - -- Number of cells with data 5005 - -- Average number of hits per cell 1 - -- 0 cells have fewer hits than 1 - -- 920 cells have more hits than 1 - - - End of run -- Clock time: 10:56:17 - Date: 20-Feb-2018 - - Elapsed Clock Time: 1 (seconds) - - CPU Time: 1 (seconds) diff --git a/CALPUFF_SRC/TERREL/masaya.sav b/CALPUFF_SRC/TERREL/masaya.sav deleted file mode 100644 index e613121..0000000 Binary files a/CALPUFF_SRC/TERREL/masaya.sav and /dev/null differ diff --git a/CALPUFF_SRC/TERREL/nima.crd b/CALPUFF_SRC/TERREL/nima.crd deleted file mode 100644 index fb463a1..0000000 --- a/CALPUFF_SRC/TERREL/nima.crd +++ /dev/null @@ -1,34 +0,0 @@ -c************************************************************ -c -c --- BUILD manufactored NIMA INCLUDE statement -c --- NIMA.CRD -c --- Uses NIMA text file dated: 02-21-2003 -c --- Uses BUILD version: VERSION 1.3 -c -c************************************************************ -c - Parameter (ndt = 132) - Parameter (nd = 234) -c -c --- Stamp this NIMA include file - Character*12 daten - Parameter (daten='02-21-2003 ') -c - Character*60 geodat1, geodat2, geodat3 - Character*8 datcod - Character*52 datum - Character*20 atlas - Character*12 dateb,dstamp -c - Real*4 dxmod, dymod, dzmod - Real*8 dradim, dflat, dec2 -c - Integer*4 dattyp -c - common /datr4/ dxmod(nd), dymod(nd), dzmod(nd) - common /datr8/ dradim(nd), dflat(nd), dec2(nd) - common /datchr/ datcod(nd), geodat1(nd), geodat2(nd), - 1 geodat3(nd), atlas(ndt), datum(ndt), - 2 dstamp,dateb - common /dati4/ kmax, nudat, dattyp(nd) -c diff --git a/CALPUFF_SRC/TERREL/params.cal b/CALPUFF_SRC/TERREL/params.cal deleted file mode 100644 index 6a77e6b..0000000 --- a/CALPUFF_SRC/TERREL/params.cal +++ /dev/null @@ -1,12 +0,0 @@ -c---------------------------------------------------------------------- -c --- PARAMETER statements CALUTILS -c---------------------------------------------------------------------- -c --- Specify parameters - parameter(mxvar=60,mxcol=200) -c -c --- CONTROL FILE READER definitions: -c MXVAR - Maximum number of variables in each input group -c MXCOL - Maximum length (bytes) of a control file input record -c---------------------------------------------------------------------- - - \ No newline at end of file diff --git a/CALPUFF_SRC/TERREL/qa.trl b/CALPUFF_SRC/TERREL/qa.trl deleted file mode 100644 index 2d96c55..0000000 --- a/CALPUFF_SRC/TERREL/qa.trl +++ /dev/null @@ -1,18 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /QA/ -- Model QA parameters TERREL -c----------------------------------------------------------------------- - character*12 ver,level - character*8 rtime - character*10 rdate -c - common/QA/rcpu,ver,level,rtime,rdate -c -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c rcpu computed CPU time of the run [r] -c ver version number of TERREL [c] -c level level number of TERREL [c] -c rtime system time at start of run (HH:MM:SS) [c] -c rdate system date at start of run (MM-DD-YYYY) [c] -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/shores.trl b/CALPUFF_SRC/TERREL/shores.trl deleted file mode 100644 index dd95ba3..0000000 --- a/CALPUFF_SRC/TERREL/shores.trl +++ /dev/null @@ -1,36 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /SHORES/ -- Land/water interface info TERREL -c----------------------------------------------------------------------- - real xp(mxcoastp),yp(mxcoastp) - integer nshore,nspts(mxcoast),itypes(mxcoast),istart(mxcoast), - & isourcep(mxcoast),ipolyid(mxcoast) - real pxmax(mxcoast),pymax(mxcoast),pxmin(mxcoast),pymin(mxcoast) - - - common /SHORES/ nshore,nspts,itypes,istart,isourcep,ipolyid, - & xp,yp,pxmax,pymax,pxmin,pymin -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c nshore number of polygons defining land-water interface [i] -c nspts array of 'nshore' numbers of points in each polygon [i] -c itypes array of 'nshore' types of each polygon [i] -c 1 - mainland and marine island -c 2 - lake -c 3 - island in lake -c 4 - pond within island -c istart array of 'nshore' indices of start of each polygon [i] -c in the coordinate arrays (xp, yp) -c isourcep array indicating the original source of the polygon [i] -c 1 - WDBII -c 2 - WVS -c ipolyid array indicating the GSHHS_F id of the polygon [i] -c xp array of x-coordinates of the points in all [r] -c polygons, in output datum -c yp array of y-coordinates of the points in all [r] -c polygons, in output datum -c pxmax, pymax array of maximum values of x- and y-coordinates for [r] -c each of the 'nshore' polygons, in output datum -c pxmin, pymin array of minimum values of x- and y-coordinates for [r] -c each of the 'nshore' polygons, in output datum -c----------------------------------------------------------------------- diff --git a/CALPUFF_SRC/TERREL/tiffinfo.for b/CALPUFF_SRC/TERREL/tiffinfo.for deleted file mode 100644 index ea0e7e2..0000000 --- a/CALPUFF_SRC/TERREL/tiffinfo.for +++ /dev/null @@ -1,955 +0,0 @@ -c -c --- TIFFINFO Version: 1.03 Level: 090123 -c K. Morrison, Hatch -c -c This file contains subroutines for extracting geographic -c information from GeoTIFF files. Externally, only GET_IFD and -c READTIFF are called, the other routines only being used internally -c to read information within the GeoTIFF, allowing for byte -c flipping if needed based on the byte order in the file and on -c the host machine. -c -c----------------------------------------------------------------------- - subroutine get_ifd(ioinp,nxi,nyi,dxi,dyi,cdatumi,rlati,rloni, - & xlat1i,xlat2i,feasti,fnorthi,cproji,xorg,yorg,utmhemi,iutmzni, - & tmscalei,itifftype,ltiffreset) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 090123 GET_IFD -c K. Morrison, Hatch -c -c PURPOSE: GET_IFD reads all the tags and geokeys from the Image -c File Directory of a GeoTIFF file, passes useful fields -c back to the calling subroutine for projection and datum -c identification, and puts variables into the TIFF_TAGS -c common for subsequent use by READTIFF. -c -c UPDATES: -c Version 1.03 Level 090123 from Version 1.02 Level 070706 -c - Change resets for datum and projection -c Version 1.02 Level 070706 from Version 1.01 Level 061214 -c - Change test for UTMs -c - Include half-pixel shift in origin if GeoTIFF values -c are areas (assumed default) and not points -c -c INPUTS: IOINP (i) - input unit for the GeoTIFF file (already -c opened in the calling program) -c LTIFFRESET(l) - logical to reset the projection and datum -c -c OUTPUTS: NXI, NYI (i) - number of columns and rows in the file -c DXI, DYI (r) - spacing of pixels in X and Y -c CDATUMI (c*8) - datum of data in the file -c RLATI, RLONI (r) - reference/origin latitude and longitude -c of the projection of the data -c XLAT1I, XLAT2I (r) - equator-ward and pole-ward parallels -c FEASTI, FNORTHI (r) - false easting and northing of the data -c CPROJI (c*8) - projection of the data -c XORG, YORG (r) - coordinates of the origin of the data -c UTMHEMI (c*4) - hemisphere if data are in UTM -c IUTMZNI (i) - UTM zone if data are in UTM -c TMSCALEI (r) - TM scaling factor -c ITIFFTYPE (i) - type of TIFF (1-values,2-RGB,3-palette) -c----------------------------------------------------------------------- - logical lflip,loffset,lbig,lbig_end,lutm,lprojerr,lerror, - & ltiffreset,lpixel - integer*1 ival1(200000) - integer*2 ival2(200000),ntag,ittag,numbytes(12),ired(200000), - & igreen(200000),iblue(200000) - integer*4 itag,iltag,ivtag,ival4(200000),idum1,idum2 - real val4(200000) - real*8 val8(200000) - character*8 cdatumi,cproji - character*8 char8(1000) - character*1 char1(1000) - character*1000 char1000 - character*4 utmhemi - character*8 ctproj(16)/ - & 'LL ','TM ',' ',' ',' ', - & ' ',' ','EM ','LCC ',' ', - & 'LAZA ','ACEA ',' ',' ',' ', - & 'PS '/ - character*8 ctdatum(132)/ - & 'ADI-M ','AUA ','AUG ','AIN-A ','AFG ', - & ' ',' ',' ',' ',' ', - & ' ',' ',' ',' ',' ', - & 'BER ',' ','BOO ','BUR ',' ', - & 'CAI ','CAP ','CGE ','CHU ','COA ', - & ' ',' ',' ','OEG ','EUR-M ', - & 'EUS ',' ',' ',' ',' ', - & 'HTN ',' ','IDN ','INF-A ','INH-A ', - & ' ',' ',' ','KAN ','KEA ', - & ' ',' ','PRP-M ',' ','LEH ', - & 'LIB ',' ','LUZ-A ',' ','HEN ', - & 'MIK ',' ',' ',' ',' ', - & 'MER ','MAS ','MIN-A ',' ',' ', - & 'MPO ','NAS-C ',' ','NAR-C ','NAH-A ', - & 'NAP ',' ',' ',' ',' ', - & ' ',' ',' ',' ',' ', - & ' ','PTN ','WGS-84 ','PUK ','QAT ', - & ' ','QUO ',' ',' ',' ', - & 'SAN-M ','SAP ','SCK ',' ',' ', - & ' ','TAN ','TIL ',' ',' ', - & 'TOY-M ',' ',' ','VOI ','VOR ', - & ' ','NSD ',' ','YAC ',' ', - & 'ZAN ',' ',' ',' ',' ', - & ' ',' ',' ',' ',' ', - & ' ','WGS-72 ',' ',' ',' ', - & 'WGS-84 ',' ',' ',' ',' ', - & ' ',' '/ - common /tiff_tags/ nbitsi,iptypei,idtypei, - & idstarti,iorienti,numpixv,zorgtif, - & icmodel,icordunit,iangunit, - & lbig,lflip,zorg,zmul -c - data numbytes/1,1,2,4,8,1,1,2,4,4,4,8/ - equivalence(char1000,char1(1)) -c -c set or reset defaults for data characteristics, units, projections -c - if(ltiffreset) then - cdatumi=' ' - cproji=' ' - endif - idatum=0 - lpixel=.true. - dxi=0. - dyi=0. - rlati=-999. - rloni=-999. - feasti=0. - fnorthi=0. - xorg=0. - yorg=0. - zorg=0. - utmhemi=' ' - iutmzni=0 - tmscalei=1. - icmodel=1 - icordunt=1 - nxi=0 - nyi=0 - nbitsi=1 - iptypei=0 - iptypidx=0 - idtypei=1 - idstart=0 - iorienti=1 - numpixv=1 - ixorgtif=1 - iyorgtif=1 - zorgtif=0. - iangunt=2 - ielevunt=1 - ctrlat=-999. - ctrlon=-999. - xlat1i=0. - xlat2i=0. - tmscalec=1. - icompress=1 - ired=0 - igreen=0 - iblue=0 - iproj=-99 - lutm=.false. - lerror=.false. - lprojerr=.false. - indxpar1=0 - indxpar2=0 - indxorlon=0 - indxorlat=0 - indxfalse=0 - indxfalsn=0 - indxctrlon=0 - indxctrlat=0 - indxtmscalo=0 - indxtmscalc=0 -c -c check byte order of current platform -c - lflip=.false. - lbig=lbig_end(1) -c -c read the byte order of the file, and if it's not the same as the -c current platform, set logical for byte flipping -c first byte = 'I' (73) (INTEL) or 'M' (77) (MOTOROLA) -c - read(ioinp,rec=1) ival1(1) - if((ival1(1).eq.77.and..not.lbig).or.(ival1(1).eq.73.and.lbig)) - & lflip=.true. -c -c check the answer to the ultimate question of life, the universe, -c and everything -c - ipos=3 - call read2b(ioinp,ipos,ival2(1),lflip) - if(ival2(1).ne.42) then - write(*,*) 'Invalid TIFF ID - ',ival2 - stop - endif -c -c get the offset of the IFD and set the position to read it -c - ipos=5 - call read4b(ioinp,ipos,ival4(1),lflip) - ipos=ival4(1)+1 -c -c get the number of TAGS -c - call read2b(ioinp,ipos,ntag,lflip) -c -c read and decode the 12-byte tags -c - do i=1,ntag -c -c retain the start of the next tag -c - iopos=ipos+12 -c -c read the tag ID -c - call read24b(ioinp,ipos,itag,lflip,lbig) -c -c read the tag type: -c 1 - 1-byte unsigned integer -c 2 - 1-byte character -c 3 - 2-byte unsigned integer -c 4 - 4-byte unsigned integer -c 5 - 8-byte ratio, 2 type-4s, numerator and then denominator -c 6 - 1-byte signed integer -c 7 - 1-byte undefined -c 8 - 2-byte signed integer -c 9 - 4-byte signed integer -c 10 - 8-byte ratio, 2 type-9s, numerator and then denominator -c 11 - 4-byte real -c 12 - 8-byte real -c - call read2b(ioinp,ipos,ittag,lflip) -c -c check for end of tags -c - if(itag.eq.0.and.ittag.eq.0) exit -c -c read the number of values in this tag -c - call read4b(ioinp,ipos,iltag,lflip) -c -c if the number of bytes for the tag value(s) is too large for -c the 4-byte field, the value instead is an offset to where -c the values are stored -c - loffset=.false. - if(iltag*numbytes(ittag).gt.4) then - loffset=.true. - call read4b(ioinp,ipos,ioffset,lflip) - ipos=ioffset+1 - endif -c -c read the tag value(s) according to type -c - do j=1,iltag - if(ittag.eq.1) call read12b(ioinp,ipos,ival2(j),lbig) - if(ittag.eq.2) call read1c(ioinp,ipos,char1(j)) - if(ittag.eq.3) call read24b(ioinp,ipos,ival4(j),lflip,lbig) - if(ittag.eq.4) call read4b(ioinp,ipos,ival4(j),lflip) - if(ittag.eq.5) then - call read4b(ioinp,ipos,idum1,lflip) - call read4b(ioinp,ipos,idum2,lflip) - val4(j)=float(idum1)/float(idum2) - endif - if(ittag.eq.6) call read1b(ioinp,ipos,ival1(j)) - if(ittag.eq.7) call read1c(ioinp,ipos,char1(j)) - if(ittag.eq.8) call read2b(ioinp,ipos,ival2(j),iflip) - if(ittag.eq.9) call read4b(ioinp,ipos,ival4(j),lflip) - if(ittag.eq.10) then - call read4b(ioinp,ipos,idum1,lflip) - call read4b(ioinp,ipos,idum2,lflip) - val4(j)=float(idum1)/float(idum2) - endif - if(ittag.eq.11) call read4r(ioinp,ipos,val4(j)) - if(ittag.eq.12) call read8r(ioinp,ipos,val8(j),lflip) - enddo -c -c put the useful tags into appropriate variables -c -c number of columns and rows -c - if(itag.eq.256) nxi=ival4(1) - if(itag.eq.257) nyi=ival4(1) -c -c number of bits per value - assume additional values are the same -c as the first (RGB) -c - if(itag.eq.258) nbitsi=ival4(1) -c -c compression type - only 1 (uncompressed) supported -c - if(itag.eq.259) icompress=ival4(1) -c -c photometric interpretation -c 1 - B&W - black is zero -c 2 - RGB -c 3 - Palette -c - if(itag.eq.262) iptypei=ival4(1) -c -c strip offsets - only first value used (assumes sequential) -c - if(itag.eq.273) idstarti=ival4(1) -c -c image orientation -c 1 - left to right, top to bottom -c 4 - left to right, bottom to top -c - if(itag.eq.274) iorienti=ival4(1) -c -c number of values per pixel - only 1 or 3 supported -c - if(itag.eq.277) numpixv=ival4(1) -c -c read the palette - reduce to 0-255 from 0-65535 -c - if(itag.eq.320) then - ncrclass=iltag/3 - do kk=1,ncrclass - icount=(kk-1)*3+1 - ired(kk)=ival4(icount)/256 - igreen(kk)=ival4(icount+ncrclass)/256 - iblue(kk)=ival4(icount+2*ncrclass)/256 - enddo - endif -c -c data types for the image data -c 1 - unsigned integer -c 2 - signed integer -c 3 - real -c - if(itag.eq.339) idtypei=ival4(1) -c -c read indexing (equivalent to palette type) -c - if(itag.eq.346) iptypidx=ival4(1) -c -c read and decode GeoTIFF keys in extended tags -c -c read the pixel scale (spacing) -c - if(itag.eq.33550) then - dxi=val8(1) - dyi=val8(2) - endif -c -c read the reference point -c - if(itag.eq.33922) then - ixorgtif=int(val8(1))+1 - iyorgtif=int(val8(2))+1 - zorgtif=sngl(val8(3)) - xorg=sngl(val8(4)) - yorg=sngl(val8(5)) - zorg=sngl(val8(6)) - endif -c -c GeoKey Directory -c - if(itag.eq.34735) then -c -c read the keys, starting with #2 (#1 is simply a header) -c - do kk=5,iltag-3,4 -c -c get the ID, the TAG containg the key (0 if the value fits -c in the 4th field), the number of values, and the element -c offet in the containing tag (0 means first) or the actual -c key value if it will fit -c - keyid=ival4(kk) - intag=ival4(kk+1) - nkeyval=ival4(kk+2) - keyval=ival4(kk+3) - if(keyval.eq.32767) cycle -c -c model type - 1 is projection coordinates, 2 is lat-lon -c - if(keyid.eq.1024) icmodel=keyval -c -c pixel type - 1 is area, 2 is point -c - if(keyid.eq.1025.and.keyval.eq.2) lpixel=.false. -c -c datum may be in 1 of 3 keys, the last for UTMs -c - if(keyid.eq.2048) idatum=keyval-4200 - if(keyid.eq.2050) idatum=keyval-6200 - if(keyid.eq.3072) then - iproj=1 - lutm=.true. - idatum=keyval/100-200 - if(idatum.eq.67.or.idatum.eq.69) then - iutmzni=mod(keyval,100) - if(iutmzni.ge.3.and.iutmzni.le.23) then - utmhemi='N ' - else - iutmzni=0 - endif - endif - if(idatum.gt.121.and.idatum.lt.127) then - utmhemi='N ' - if(mod(idatum,2).eq.1) then - utmhemi='S ' - idatum=idatum-1 - endif - endif - iutmzni=mod(keyval,100) -c -c check for arbitrary zoning -c - if(iutmzni.gt.60) iutmzni=0 - endif -c -c coordinate, angle, elevation units -c coords: 1 - meters, 2 - feet, 35 - mile, 36 - kilometers -c angles: 2 - degrees, 3 - arc-minutes, 4 - arc-seconds -c elevs: 1 - meters, 2 - feet -c - if(keyid.eq.2052) icordunt=keyval-9000 - if(keyid.eq.2054) iangunt=keyval-9100 - if(keyid.eq.4099) ielevunt=keyval-9000 -c -c get the projection -c - if(keyid.eq.3075) iproj=keyval -c -c indices for various projection parameters in TAG 34736 -c - if(keyid.eq.3078) indxpar1=keyval+1 - if(keyid.eq.3079) indxpar2=keyval+1 - if(keyid.eq.3080) indxorlon=keyval+1 - if(keyid.eq.3081) indxorlat=keyval+1 - if(keyid.eq.3082) indxfalse=keyval+1 - if(keyid.eq.3083) indxfalsn=keyval+1 - if(keyid.eq.3088) indxctrlon=keyval+1 - if(keyid.eq.3089) indxctrlat=keyval+1 - if(keyid.eq.3092) indxtmscalo=keyval+1 - if(keyid.eq.3093) indxtmscalc=keyval+1 - enddo - endif -c -c extract projection parameters: -c - equator-ward ref lat -c - pole-ward reference latitude -c - projection origin longitude -c - projection origin latitude -c - false easting -c - false northing -c - projection center longitude (overridden by origin) -c - projection center latitude (overridden by origin) -c - TM scaling at origin -c - TM scaling at center (overridden by origin) -c - if(itag.eq.34736) then - if(indxpar1.gt.0) xlat1i=val8(indxpar1) - if(indxpar2.gt.0) xlat2i=val8(indxpar2) - if(indxorlon.gt.0) rloni=val8(indxorlon) - if(indxorlat.gt.0) rlati=val8(indxorlat) - if(indxfalse.gt.0) feasti=val8(indxfalse) - if(indxfalsn.gt.0) fnorthi=val8(indxfalsn) - if(indxctrlon.gt.0) ctrlon=val8(indxctrlon) - if(indxctrlat.gt.0) ctrlat=val8(indxctrlat) - if(indxtmscalo.gt.0) tmscalei=val8(indxtmscalo) - if(indxtmscalc.gt.0) tmscalec=val8(indxtmscalc) - endif -c -c reset position to read next tag -c - ipos=iopos - enddo -c -c select the datum and projection strings -c - if(iproj.eq.-99.and.icmodel.eq.2) iproj=0 - if(idatum.gt.0) cdatumi=ctdatum(idatum) - if(iproj.gt.-99.and.iproj.lt.15) cproji=ctproj(iproj+1) - if(lutm) then - cproji='UTM ' - if(iutmzni.eq.0) lprojerr=.true. - endif -c -c equate indexing with palette -c - if(iptypei.eq.0.and.iptypidx.eq.1) iptypei=3 -c -c handle overrides -c - if(rloni.lt.-998..and.ctrlon.gt.-998.) rloni=ctrlon - if(rlati.lt.-998..and.ctrlat.gt.-998.) rlati=ctrlat - if(tmscalei.eq.1..and.tmscalec.ne.1.) tmscalei=tmscalec -c -c test for supported TIFF values -c - if(icompress.ne.1) lerror=.true. -c note: iptypei value of 0 or 1 might occur for DEM files - if(iptypei.gt.3) lerror=.true. - if(numpixv.ne.1.and.numpixv.ne.3) lerror=.true. - if(idtypei.gt.3) lerror=.true. - if(iorienti.ne.1.and.iorienti.ne.4) lerror=.true. -c -c test for supported datum/projection -c - if(cproji.eq.' '.or.cdatumi.eq.' ') lprojerr=.true. -c -c print error messages and stop -c - if(lerror.or.lprojerr) then - write(*,*) 'ERROR: GEOTIFF PROCESSING STOPPED' - if(lerror) then - write(*,*) 'TIFF tag values for one of the following are' - write(*,*) ' not supported in this application:' - write(*,*) 'compression : must be 1 (uncompressed)' - write(*,*) 'photometric : must be 2 or 3 or indexed' - write(*,*) 'pixel number : must be 1 or 3' - write(*,*) 'sample type : must be 1 or 2 (integer)', - & ' or 3 (real)' - write(*,*) 'orientation : must be 1 or 4' - endif - if(lprojerr) then - write(*,*) 'GEOTIFF datum or projection are not supported' - write(*,*) ' in this application' - endif - stop - endif -c -c convert X-Y units if necessary, starting with lat-lon and then -c coordinates - output units are decimal degrees or kilometers -c - xmul=1. - if(iangunt.eq.2) xmul=1. - if(iangunt.eq.3) xmul=1./60. - if(iangunt.eq.4) xmul=1./3600. - rlati=rlati*xmul - rloni=rloni*xmul - xlat1i=xlat1i*xmul - xlat2i=xlat2i*xmul - if(icmodel.eq.1.and.ltiffreset) then - xmul=0.001 - if(icordunt.eq.1) xmul=0.001 - if(icordunt.eq.2) xmul=0.0003048 - if(icordunt.eq.35) xmul=1.609344 - if(icordunt.eq.36) xmul=1. - endif - dxi=dxi*xmul - dyi=dyi*xmul - xorg=xorg*xmul - yorg=yorg*xmul - dyi=abs(dyi) - if(iorienti.eq.1) dyi=-dyi -c -c if pixel is an area, offset the origin to the center of the pixel -c - if(lpixel) then - xorg=xorg+dxi/2. - yorg=yorg+dyi/2. - endif -c -c if origin is not pixel 1, offset the origin to the center of -c pixel 1 -c - if(ixorgtif.ne.1.or.iyorgtif.ne.1) then - xorg=xorg-(dxi*float(ixorgtif-1)) - yorg=yorg-(dyi*float(iyorgtif-1)) - endif -c - zmul=1. - if(ielevunt.eq.2) zmul=0.3048 -c - itifftype=max(1,iptypei) - return - end -c----------------------------------------------------------------------- - subroutine read1b(ioinp,ipos,ival1) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ1B -c K. Morrison, Hatch -c -c PURPOSE: READ1B reads a single-byte integer in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL1 - the integer*1 value as read -c -c----------------------------------------------------------------------- - - integer*1 ival - read(ioinp,rec=ipos) ival - ipos=ipos+1 - return - end -c----------------------------------------------------------------------- - subroutine read12b(ioinp,ipos,ival2,lbig) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ12B -c K. Morrison, Hatch -c -c PURPOSE: READ12B reads a single-byte unsigned integer in a -c direct-access file into a signed two-byte integer, -c and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LBIG - logical indicating if the machine is big-endian -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL2 - the integer*1 value as read and assigned to integer*2 -c -c----------------------------------------------------------------------- - - integer*1 ival(2) - integer*2 ival2,ivalt - logical lbig - equivalence (ivalt,ival(1)) - ivalt=0 - ind=1 - if(lbig) ind=2 - read(ioinp,rec=ipos) ival(ind) - ipos=ipos+1 - ival2=ivalt - return - end -c----------------------------------------------------------------------- - subroutine read1c(ioinp,ipos,char1) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ1C -c K. Morrison, Hatch -c -c PURPOSE: READ1B reads a single-byte character in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c CHAR1 - the characterr*1 value as read -c -c----------------------------------------------------------------------- - - character*1 char1 - read(ioinp,rec=ipos) char1 - ipos=ipos+1 - return - end -c----------------------------------------------------------------------- - subroutine read2b(ioinp,ipos,ival2,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ2B -c K. Morrison, Hatch -c -c PURPOSE: READ2B reads a two-byte integer in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL2 - the integer*1 value as read and assigned to integer*2 -c -c----------------------------------------------------------------------- - - logical lflip - integer*2 ival2,itmp2 - integer*1 itmp1(2) - equivalence (itmp2,itmp1(1)) - if(lflip) then - do i=2,1,-1 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - else - do i=1,2 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - endif - ival2=itmp2 - return - end -c----------------------------------------------------------------------- - subroutine read4b(ioinp,ipos,ival4,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ4B -c K. Morrison, Hatch -c -c PURPOSE: READ4B reads a four-byte integer in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL4 - the integer*4 value as read -c -c----------------------------------------------------------------------- - - logical lflip - integer*4 ival4,itmp4 - integer*1 itmp1(4) - equivalence (itmp4,itmp1(1)) - if(lflip) then - do i=4,1,-1 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - else - do i=1,4 - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - endif - ival4=itmp4 - return - end -c----------------------------------------------------------------------- - subroutine read24b(ioinp,ipos,ival4,lflip,lbig) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ24B -c K. Morrison, Hatch -c -c PURPOSE: READ24B reads a two-byte unsigned integer in a -c direct-access file into a signed four-byte integer, -c and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c LBIG - logical indicating if the machine is big-endian -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c IVAL4 - the integer*2 value as read and assigned to integer*4 -c -c----------------------------------------------------------------------- - - logical lflip,lbig - integer*4 ival4,itmp4 - integer*1 itmp1(4) - equivalence (itmp4,itmp1(1)) - itmp4=0 - idi=1 - if(lflip) then - idi=-1 - istart=2 - if(lbig) istart=4 - else - istart=1 - if(lbig) istart=3 - endif - iend=istart+idi - do i=istart,iend,idi - read(ioinp,rec=ipos) itmp1(i) - ipos=ipos+1 - enddo - ival4=itmp4 - return - end -c----------------------------------------------------------------------- - subroutine read4r(ioinp,ipos,val,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ4R -c K. Morrison, Hatch -c -c PURPOSE: READ4R reads a four-byte real in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c VAL - the real*4 value as read -c -c----------------------------------------------------------------------- - - logical lflip - integer*1 ival(4) - real*4 val,valt - equivalence (ival(1),valt) - istart=1 - iend=4 - indx=1 - if(lflip) then - istart=4 - iend=1 - indx=-1 - endif - do i=istart,iend,indx - read(ioinp,rec=ipos) ival(i) - ipos=ipos+1 - enddo - val=valt - return - end -c----------------------------------------------------------------------- - subroutine read8r(ioinp,ipos,val,lflip) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READ8R -c K. Morrison, Hatch -c -c PURPOSE: READ8R reads an eight-byte real in a direct-access -c file and updates the pointer to the next byte -c -c INPUTS: IOINP - the i/o unit of the data file -c IPOS - the position in the file to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c VAL - the real*8 value as read -c -c----------------------------------------------------------------------- - - logical lflip - integer*1 ival(8) - real*8 val,valt - equivalence (ival(1),valt) - istart=1 - iend=8 - indx=1 - if(lflip) then - istart=8 - iend=1 - indx=-1 - endif - do i=istart,iend,indx - read(ioinp,rec=ipos) ival(i) - ipos=ipos+1 - enddo - val=valt - return - end - -c----------------------------------------------------------------------- - subroutine readtiff(ioinp,kcnt,iclass,rval4,ipos) -c----------------------------------------------------------------------- -c -c --- TIFFINFO Version: 1.03 Level: 061214 READTIFF -c K. Morrison, Hatch -c -c PURPOSE: READTIFF reads the actual data in a GeoTIFF file, -c pixel by pixel -c -c INPUTS: IOINP - the i/o unit of the data file -c KCNT - the position relative to the first value in the file -c to read -c LFLIP - logical indicating if the file and the current machine -c have the same byte order -c -c OUTPUTS: IPOS - the position in the file incremented for the next read -c ICLASS - the integer*4 value as read -c VAL - the real*4 value as read -c -c----------------------------------------------------------------------- - - common /tiff_tags/ nbitsi,iptypei,idtypei, - & idstarti,iorienti,numpixv,izorgtif, - & icmodel,icordunit,iangunit, - & lbig,lflip,zadd,zmul -c - integer*2 ival2(3) - integer ival4 - logical lflip,lbig - real rval4 - real*8 rval8 - - ival2=0 - ival4=0 - rval4=-999. - rval8=-999.d0 -c -c branch based on the file type -c -c RGB -c - if(iptypei.eq.2) then - if(numpixv.ne.3) then - write(*,*) 'ERROR: Invalid number of values per pixel for' - write(*,*) ' RGB GeoTIFF - only 3 values supported' - stop - endif - ipos=idstarti + 1 + (kcnt-1)*3 -c -c read the triad RGB, and if 0-65535, reduce to 0-255 -c - do i=1,3 - if(nbitsi.eq.8) then - call read12b(ioinp,ipos,ival2(i),lbig) - else - call read24b(ioinp,ipos,ival4,lflip,lbig) - ival2(i)=ival4/256 - endif - enddo -c -c return value as 9 digits - RRRGGGBBB -c - iclass=(ival2(1)*1000+ival2(2)) * 1000 + ival2(3) - return -c - else -c -c palette or other -c - if(idtypei.eq.1.or.idtypei.eq.2) then - if(nbitsi.le.8) then - ipos=idstarti + 1 + (kcnt-1) - call read12b(ioinp,ipos,ival2(1),lbig) - ival4=ival2(1) - elseif(nbitsi.gt.8.and.nbitsi.le.16) then - ipos=idstarti + 1 + (kcnt-1)*2 - call read24b(ioinp,ipos,ival4,lflip,lbig) - else - ipos=idstarti + 1 + (kcnt-1)*4 - call read4b(ioinp,ipos,ival4,lflip) - endif - iclass=ival4 -c -c DEM may have integer elevation -c - if(iptypei.eq.1) rval4=(float(iclass)+zadd)*zmul -c - return -c -c real value - probably DEM -c - elseif(idtypei.eq.3) then - if(nbitsi.eq.32) then - ipos=idstarti + 1 + (kcnt-1)*4 - call read4r(ioinp,ipos,rval4,lflip) - else - ipos=idstarti + 1 + (kcnt-1)*8 - call read8r(ioinp,ipos,rval8,lflip) - rval4=sngl(rval8) - endif - rval4=(rval4+zadd)*zmul - return - else - write(*,*) 'ERROR: Undefined image values not supported' - stop - endif -c - return -c - endif - end diff --git a/CALPUFF_SRC/TERREL/xy.trl b/CALPUFF_SRC/TERREL/xy.trl deleted file mode 100644 index ef86b18..0000000 --- a/CALPUFF_SRC/TERREL/xy.trl +++ /dev/null @@ -1,25 +0,0 @@ -c----------------------------------------------------------------------- -c --- COMMON BLOCK /XY/ -- Discrete location data TERREL -c----------------------------------------------------------------------- - common /XY/ nxyrec,nxycol,xyradkm, - & xreckm(mxrecxy),yreckm(mxrecxy), - & elrecm(mxrecxy),zrecm(mxrecxy), - & xx(4,mxrecxy),yy(4,mxrecxy),zz(4,mxrecxy), - & distxy(4,mxrecxy) - -c----------------------------------------------------------------------- -c DEFINITIONS [i]=integer [r]=real [l]=logical [c]=character -c----------------------------------------------------------------------- -c nxyrec number of discrete locations [i] -c nxycol number of columns in the receptor input file [i] -c 2: (X,Y) only; 4: (X,Y,Elevation,Flagpole height) -c xyradkm search radius (km) for selection max elevation [r] -c xreckm(mxrecxy) x-coordinate of discrete locations (km) [ra] -c yreckm(mxrecxy) y-coordinate of discrete locations (km) [ra] -c elrecm(mxrecxy) elevation at discrete locations (m) [ra] -c zrecm(mxrecxy) discrete location height above ground (m) [ra] -c xx(4,mxrecxy) x-coordinates for 4 DEM points nearest location[ra] -c yy(4,mxrecxy) y-coordinates for 4 DEM points nearest location[ra] -c zz(4,mxrecxy) elevations for 4 DEM points nearest location [ra] -c distxy(4,mxrecxy) distance to 4 DEM points from location [ra] -c----------------------------------------------------------------------- diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d7fb5a7 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2019 CEMAC (UoL) + +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/NAM_data/README.md b/NAM_data/README.md new file mode 100644 index 0000000..e69de29 diff --git a/Python/Create3DDAT.py b/Python/Create3DDAT.py index e956024..692ba68 100755 --- a/Python/Create3DDAT.py +++ b/Python/Create3DDAT.py @@ -228,7 +228,13 @@ def writeRec9(): ##### #####GET REQUIRED GIDS (AT REQUIRED LEVELS) -gidPRMSL = varNames.index("prmsl")+1 # Pressure reduced to mean sea level +try: + gidPRMSL = varNames.index("prmsl")+1 # Pressure reduced to mean sea level +except ValueError: + print('Variables not found, usually this is due to a NAM data download failure') + print('1. please check NAM_data/raw files for corresponting day contain full sized grib files') + print('2. Erroroneous files may contain html code with futher information') + sys.exit() gidHGT = np.flipud([i+1 for i in range(len(varNames)) if (varNames[i] == 'gh' and levels[i] in levsIncl)]) #Height gidTMP = np.flipud([i+1 for i in range(len(varNames)) if (varNames[i] == 't' and levels[i] in levsIncl)]) #Temperature gidU = np.flipud([i+1 for i in range(len(varNames)) if (varNames[i] == 'u' and levels[i] in levsIncl)]) #U-component of wind diff --git a/Python/comming_soon/maptoolkit.py b/Python/comming_soon/maptoolkit.py deleted file mode 100644 index 419431f..0000000 --- a/Python/comming_soon/maptoolkit.py +++ /dev/null @@ -1,368 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- -"""Gen_Maps -.. module:: Gen_Maps - :platform: Unix - :synopis: -.. moduleauther: CEMAC (UoL) -.. description: This module was developed by CEMAC as part of the UNRESP - Project. This Script plots CALPUFF concrec data on a map. - :copyright: © 2018 University of Leeds. - :license: BSD-2 Clause. -Example: - To use:: - ./generateMaps.py - - Date string, format YYYYMMDD, of the current CALPUFF run. - Used to locate directory containing the SO2 output files - (with assumed naming convention 'concrec0100**.dat', - where '**' goes from '01' through to '48') -.. CEMAC_UNRESPForcastingSystem: - https://github.com/cemac/UNRESPForcastingSystem -""" - -import numpy as np -import matplotlib.pyplot as plt -import matplotlib.image as mpimg -from mpl_toolkits.mplot3d import axes3d -import matplotlib as mpl -from mpl_toolkits.basemap import Basemap -from matplotlib.font_manager import FontProperties -import os -import datetime as dt -import pytz -import utm -import gmplot -from dateutil.parser import parse - - -def Read_Two_Column_File(file_name): - with open(file_name, 'r') as data: - x = [] - y = [] - for line in data: - p = line.split() - x.append(float(p[0])) - y.append(float(p[1])) - - return x, y - - -def concfiles(nConcFiles, concDir, SOX='SO2'): - filenames = [] - filePaths = [] - if SOX == 'SO2': - concrecx = 'concrec0100' - elif SOX == 'SO4': - concrecx = 'concrec0200' - else: - concrecx = 'concrec0100' - print("WARNING: SOX option not valid setting to 'SO2'") - print("Options available are 'SO2' or 'SO4'") - for i in range(nConcFiles): - s = str('{:02}'.format(i + 1)) # Ensures e.g. '1' is converted to '01' - fileName = concrecx + s + '.dat' - filenames.append(fileName) - filePath = os.path.join(concDir, fileName) - filePaths.append(filePath) - assert os.path.exists(filePath), "File " + \ - filePath + " not found. Check path." - return filenames, filePaths - - -def genxy(xyFile): - x, y = Read_Two_Column_File(xyFile) # read in x,y data - xunq, yunq = np.unique(x), np.unique(y) # get unique x,y coordinates - nx, ny = len(xunq), len(yunq) # number of unique x,y coordinates - # Use utm package to convert from x,y to lat,lon... - # ...Nicaragua is UTM zone 16P, and we must convert to metres first: - lat = [utm.to_latlon(x[i] * 1000, y[i] * 1000, 16, 'P')[0] - for i in np.arange(0, len(x))] - lon = [utm.to_latlon(x[i] * 1000, y[i] * 1000, 16, 'P')[1] - for i in np.arange(0, len(x))] - # Create gridded field of lat,lon of appropriate size: - glat, glon = np.reshape(lat, (ny, nx)), np.reshape(lon, (ny, nx)) - # Also grab range for static plots - latMin = min(lat) - latMax = max(lat) - lonMin = min(lon) - lonMax = max(lon) - return glat, glon, latMin, latMax, lonMin, lonMax, ny, nx - - -def genGxy(xyFile): - # READ IN X,Y DATA AND CONVERT TO LAT,LON - x, y = Read_Two_Column_File(xyFile) # read in x,y data - xunq, yunq = np.unique(x), np.unique(y) # get unique x,y coordinates - # Get x,y coordinates of all the corners of the square cells centred on - # each x,y (for google plots): - x2unq = [v - (xunq[1] - xunq[0]) / 2. for v in xunq] - x2unq.append(x2unq[-1] + (xunq[1] - xunq[0])) - y2unq = [v - (yunq[1] - yunq[0]) / 2. for v in yunq] - y2unq.append(y2unq[-1] + (yunq[1] - yunq[0])) - nx, ny = len(x2unq), len(y2unq) - x2grd, y2grd = np.meshgrid(x2unq, y2unq) - x2, y2 = np.reshape(x2grd, (nx * ny)), np.reshape(y2grd, (nx * ny)) - lat = [utm.to_latlon(x2[i] * 1000, y2[i] * 1000, 16, 'P')[0] - for i in np.arange(0, len(x2))] - lon = [utm.to_latlon(x2[i] * 1000, y2[i] * 1000, 16, 'P')[1] - for i in np.arange(0, len(x2))] - glat, glon = np.reshape(lat, (ny, nx)), np.reshape(lon, (ny, nx)) - return glat, glon, lat, lon, ny, nx - - -def conc_array(ny, nx, filePaths, binLims): - # Read in concentration data: - f = open(filePaths, 'r') - lines = f.read().splitlines() - f.close - # Process concentration data into desired format: - conc = np.array([float(X) for X in lines]) * 100**3 # ug/cm^3 -> ug/m^3 - concAry = np.reshape(conc, (ny, nx)) # Reshape data onto latlon grid - concA = np.ma.masked_array(concAry, concAry < binLims[0]) - return concA, conc - - -def gen_im(lonMin, latMin, lonMax, latMax, imtype="World_Imagery",): - """imtype='World_Imagery' or imtype='World_Shaded_Relief' - """ - xpixels = 1700 # Zoom lvl for satellite basemap (higher=bigger file sizes) - bmap = Basemap(llcrnrlon=lonMin, llcrnrlat=latMin, - urcrnrlon=lonMax, urcrnrlat=latMax) - esri_url = \ - "http://server.arcgisonline.com/ArcGIS/rest/services/" + imtype + "/MapServer/export?\ -bbox=%s,%s,%s,%s&\ -bboxSR=%s&\ -imageSR=%s&\ -size=%s,%s&\ -dpi=%s&\ -format=png32&\ -f=image" %\ - (bmap.llcrnrlon, bmap.llcrnrlat, bmap.urcrnrlon, bmap.urcrnrlat, - bmap.epsg, bmap.epsg, xpixels, bmap.aspect * xpixels, 96) - ESRIimg = mpimg.imread(esri_url) - return ESRIimg - - -class Masaya_Maps(object): - '''Plot Masaya Maps - Consitsts of X plotting functions that output 48 static maps - members: - plot_staticmap: plot either topo or statellite - plot_googlemaps: plot google maps html - plot_diff: comming soon - plot_NAMWIND: comming soon - plot_CAL_WIND_IN: comming soon - plot_CAL_WIND_OUT: comming soon - - ''' - def __init__(s, date): - """Initialise with date - - Args: - date (str): YYYYMMDD string - """ - s.concDir = "../CALPUFF_OUT/CALPUFF/" + date - s.xyFile = "../data/xy_masaya.dat" - s.outDir = "../vis/" + date - s.sat = 'World_Imagery' - s.topo = 'World_Shaded_Relief' - s.nConcFiles = 48 # Number of conc files to process (48 = full 2 days) - s.binLims = [10, 350, 600, 2600, 9000, 14000] # SO2 bin limits - s.binLimsSO4 = [1E-8, 12, 35, 55, 150, 250] # SO4 bin limits from: - # http://mkwc.ifa.hawaii.edu/vmap/hysplit/ - s.colsHex = ['#FFFFFF', '#0cec0c', '#FFFF00', '#FF6600', '#FF0000', - '#800080', '#8F246B'] # Hex codes for SO2 colour bins - s.towns = (' El Panama', ' Rigoberto', ' Pacaya', ' El Crucero', - ' La Concepcion', ' Masaya', ' San Marcos', - ' San Rafael del Sur', ' Diriamba', ' Jinotepe', - ' Masatepe') - s.townCoords = ((-86.2058, 11.972), (-86.2021, 11.9617), - (-86.3013, 11.9553), (-86.3113, 11.9923), - (-86.189772, 11.936161), (-86.096053, 11.973523), - (-86.20317, 11.906584), (-86.43639, 11.847034), - (-86.239592, 11.85632), (-86.19993, 11.85017), - (-86.143758, 11.91512)) - s.cities = (' MANAGUA',) - s.cityCoords = ((-86.29, 12.12),) - s.volcCoords = (-86.1608, 11.9854) - s.font = FontProperties() - s.font.set_weight('bold') - s.font.set_family('monospace') - - # CHECK PATHS/FILES EXIST - assert os.path.exists( - s.concDir), "CALPUFF output directory does not exist for this date." - assert os.path.exists( - s.xyFile), "Cannot find data/xy_masaya.dat coordinate data file." - assert os.path.exists(s.outDir), "Output directory vis/ does not exist." - s.filenames, s.filePaths = concfiles(s.nConcFiles, - s.concDir, SOX='SO2') - - # GET DATES/TIMES - startDate = pytz.utc.localize(parse(date)) - dates = [] - for i in range(s.nConcFiles): - iDate = startDate + dt.timedelta(hours=i + 1) - dates.append(iDate) - s.dates = dates - # SET BIN COLOURS - s.cmap = mpl.colors.ListedColormap(s.colsHex[1:-1]) - s.cmap.set_under(s.colsHex[0]) - s.cmap.set_over(s.colsHex[-1]) - s.normso4 = mpl.colors.BoundaryNorm(boundaries=s.binLimsSO4, ncolors=5) - s.norm = mpl.colors.BoundaryNorm(boundaries=s.binLims, ncolors=5) - s.glat, s.glon, s.latMin, s.latMax, s.lonMin, s.lonMax, s.ny, s.nx = genxy(s.xyFile) - s.Gglat, s.Gglon, s.Glat, s.Glon, s.Gny, s.Gnx = genGxy(s.xyFile) - - def plot_staticmaps(s, maptype, SOX='SO2'): - """loop through and plot all static maps - """ - if maptype == 'satellite': - Imflag = s.sat - tc = 'w' - out = '' - elif maptype == 'topo': - Imflag = s.topo - tc = 'k' - out = 'topo' - else: - print('Not a valid option... setting to topo') - Imflag = s.topo - tc = 'k' - out = 'topo' - im = gen_im(s.lonMin, s.latMin, s.lonMax, s.latMax, imtype=Imflag) - filenames, filePaths = concfiles(s.nConcFiles, s.concDir, SOX=SOX) - for i, fname in enumerate(s.filePaths): - s.plot_staticmap1(i, im, tc, filePaths, out, SOX=SOX) - - def plot_staticmap1(s, ita, im, tc, filePaths, out, SOX): - """Plot static maps - """ - SOXf = r'SO$_' + SOX[-1] + '$' - so2title = ('Atmospheric ' + SOXf + ' concentrations at ' + - 'ground level (hourly means). \n GCRF UNRESP') - plt.figure(figsize=(16, 12)) - fle = filePaths[ita] - if SOX == "SO4": - binLims = s.binLimsSO4 - norm = s.normso4 - else: - binLims = s.binLims - norm = s.norm - concA, concx = conc_array(s.ny, s.nx, fle, binLims) - latMin, latMax, lonMin = s.latMin, s.latMax, s.lonMin - lonMax = s.lonMax - bmap = Basemap(llcrnrlon=lonMin, llcrnrlat=latMin, - urcrnrlon=lonMax, urcrnrlat=latMax) - bmap.imshow(im, origin='upper') - bmap.pcolormesh(s.glon, s.glat, concA, - norm=norm, cmap=s.cmap, alpha=0.5) - cbar = bmap.colorbar(location='bottom', pad='20%', cmap=s.cmap, - norm=norm, boundaries=[0.] + binLims - + [100000.], extend='both', extendfrac='auto', - ticks=binLims, spacing='uniform') - cbar.ax.set_xticklabels(['v low', 'low', 'moderate', 'mod high', - 'high', 'v high']) # horizontal colorbar - cbar.set_label(label=(SOX + ' concentration'), fontsize=18) - cbar.ax.tick_params(labelsize=16) - cbar.solids.set(alpha=1) - latTicks = np.arange(round(latMin, 1), round(latMax, 1) + 0.1, 0.1) - lonTicks = np.arange(round(lonMin, 1), round(lonMax, 1) + 0.1, 0.2) - bmap.drawparallels(latTicks, labels=[1, 0, 0, 0], linewidth=0.0, - fontsize=16) - bmap.drawmeridians(lonTicks, labels=[0, 0, 0, 1], linewidth=0.0, - fontsize=16) - for i, town in enumerate(s.towns): - plt.plot(s.townCoords[i][0], s.townCoords[i] - [1], 'ok', markersize=4) - plt.text(s.townCoords[i][0], s.townCoords[i][1], town, - color=tc, fontproperties=s.font, fontsize=12) - for i, city in enumerate(s.cities): - plt.plot(s.cityCoords[i][0], s.cityCoords[i] - [1], 'sk', markersize=6) - plt.text(s.cityCoords[i][0], s.cityCoords[i][1], city, - fontproperties=s.font, fontsize=16) - font0 = FontProperties() - font0.set_family('monospace') - plt.plot(s.volcCoords[0], s.volcCoords[1], '^r', markersize=6) - plt.suptitle(so2title, fontsize=24) - plt.title(s.dates[ita].strftime('%c'), fontsize=18) - PNGfile = SOX + '_static_' + out + fle[-17:-4] + '.png' - print("Writing out file " + PNGfile) - PNGpath = os.path.join(s.outDir, PNGfile) - plt.savefig(PNGpath, dpi=250) - plt.close() - - def plot_google(s, SOX='SO2'): - """loop through and plot all static maps - """ - codesFile = os.path.join('GM_API_KEY.txt') - gmstring = ("Can't find file GM_API_KEY.txt in same" + - " directory as python script") - try: - f = open(codesFile, 'r') - lines = f.readlines() - f.close() - s.googlekey = lines[0].strip() - filenames, filePaths = concfiles(s.nConcFiles, s.concDir, SOX=SOX) - for i, fname in enumerate(filePaths): - s.plot_googlemap1(i, filePaths, SOX) - except FileNotFoundError: - print("### WARNING #### GM_API_KEY.txt not found \n turning off google maps plotter") - print(" If you would like to plot goolge maps \n please see README" + - " for API key information.") - - def plot_googlemap1(s, ita, filePaths, SOX): - """plot goolemaps - """ - gKey = s.googlekey - fle = filePaths[ita] - if SOX == "SO4": - binLims = s.binLimsSO4 - norm = s.normso4 - else: - binLims = s.binLims - norm = s.norm - glat, glon, lat, lon = s.Gglat, s.Gglon, s.Glat, s.Glon - concA, conc = conc_array(s.ny, s.nx, fle, binLims) - gmap = gmplot.GoogleMapPlotter(min(lat) + np.ptp(lat) / 2., - min(lon) + np.ptp(lon) / 2., zoom=11, - apikey=gKey) - for i in np.arange(0, s.nx): - for j in np.arange(0, s.ny): - for k in np.arange(0, len(s.binLims) - 1): - if concA[j, i] > s.binLims[k] and concA[j, i] <= binLims[k + 1]: - gmap.polygon((glat[j + 1, i], glat[j, i], - glat[j, i + 1], glat[j + 1, i + 1]), - (glon[j + 1, i], glon[j, i], - glon[j, i + 1], glon[j + 1, i + 1]), - color=s.colsHex[k + 1], edge_width=0.001) - if conc[j] > binLims[-1]: - gmap.polygon((glat[j + 1, i], glat[j, i], - glat[j, i + 1], glat[j + 1, i + 1]), - (glon[j + 1, i], glon[j, i], - glon[j, i + 1], glon[j + 1, i + 1]), - color=s.colsHex[-1], edge_width=0.001) - HTMLfile = SOX + '_google_' + fle[-17:-4] + '.html' - print("Writing out file " + HTMLfile) - gmap.draw(os.path.join(s.outDir, HTMLfile)) - - def plot_diff(s): - """ - """ - print('This feature does not exist yet') - - def plot_NAMWIND(s): - """ - """ - print('This feature does not exist yet') - - def plot_CAL_WIND_IN(s): - """ - """ - print('This feature does not exist yet') - - def plot_CAL_WIND_OUT(s): - """ - """ - print('This feature does not exist yet') diff --git a/Python/generateMaps.py b/Python/deprecated/generateMaps.py similarity index 100% rename from Python/generateMaps.py rename to Python/deprecated/generateMaps.py diff --git a/Python/comming_soon/genmaps.py b/Python/genmaps.py similarity index 61% rename from Python/comming_soon/genmaps.py rename to Python/genmaps.py index f6527fe..fabd79e 100755 --- a/Python/comming_soon/genmaps.py +++ b/Python/genmaps.py @@ -23,17 +23,16 @@ import argparse from dateutil.parser import parse import maptoolkit as mtk +import sys -# Manual Flags (will be overwrittend by commandline flags) -StaticMaps = True -GoogleMaps = True -SO24 = True +# Set everything to off +TopoMaps = False +SatelliteMaps = False +GoogleMaps = False SO2 = False SO4 = False -# Not yet Functioning -diffMaps = False -windfield = False -Layers = False + + # READ IN COMMAND LINE ARGUMENTS dstring = ("Used to generate a series (48hrs) of static and interactive" + "(google) maps \n showing SO2 concentrations around the Masaya " + @@ -42,107 +41,98 @@ "to + locate \n directory containing the SO2 output files (with " + "assumed naming convention 'concrec0100**.dat', \n where '**' " + " goes from '01' through to '48'") +hstring = ("number of concrec files e.g. 24 or 48") parser = argparse.ArgumentParser(description=dstring) parser.add_argument("date", help=hstring, type=str) +parser.add_argument("--conc", help=hstring, type=str) # Switches parser.add_argument('--all', help='Plots all types of maps', action='store_true') -parser.add_argument('--layers', help='Plots as raster layers', - action='store_true') -parser.add_argument('--custom', help='Allows single switches', - action='store_true') -parser.add_argument('--SO24', help=r'Plot both SO$_2$ and SO$_4$', +parser.add_argument('--SO2', help=r'Plot SO$_2$', action='store_true') -parser.add_argument('--SO2', help=r'Plot SO$_2$ only', +parser.add_argument('--SO4', help=r'Plot SO$_4$', action='store_true') -parser.add_argument('--SO4', help=r'Plot SO$_4$ only', +parser.add_argument('--topo', help='Turn on basic maps', action='store_true') -parser.add_argument('--static', help='Turn on static', +parser.add_argument('--satellite', help='Turn on satellite maps', action='store_true') parser.add_argument('--google', help='Turn on googlemaps', action='store_true') -parser.add_argument('--diff', help='Turn on IMO vs UoL', - action='store_true') -parser.add_argument('--wind', help='Turn on wind quiverplots (NAM)', - action='store_true') args = parser.parse_args() if args.SO2: - SO24 = False SO2 = True -if args.all: - SO24 = True - StaticMaps = True - GoogleMaps = True - diffMaps = True - windfield = True - Layers = False - print('some options selected are not yet available') - diffMaps = False - windfield = False - -if args.all and args.custom: - print('--all and --custom can not be used together, setting to custom') - -if args.layers: - Layers = True - print('some options selected are not yet available') - Layers = False - -# Bespoke options -if args.custom: - SO24 = False - StaticMaps = False - GoogleMaps = False - diffMaps = False - windfield = False - Layers = False - -if args.static: - StaticMaps = True +if args.SO4: + SO4 = True + +if args.satellite: + SatelliteMaps = True + +if args.topo: + TopoMaps = True + if args.google: GoogleMaps = True -if args.diff: - diffMaps = True - print('some options selected are not yet available') - diffMaps = False -if args.wind: - windfield = True - print('some options selected are not yet available') - windfield = False + +if args.all: + SO2 = True + SO4 = True + GoogleMaps = True + TopoMaps = True + SatelliteMaps = True + + # echo what is being done print('Generating Maps with following settings:') -print("StaticMaps = ", StaticMaps) -print("GooogleMaps =", GoogleMaps) -print(r"Both SO$_2$ and SO$_4$ = ", SO24) -print("IMO vs UoL =", diffMaps) -print("NAM quiver plots", windfield) -print("Plot as raster layers", Layers) +print(r"SO$_2$ = ", SO2) +print(r"SO$_4$ = ", SO4) +print("Basic Maps =", TopoMaps) +print("Satallite Maps =", SatelliteMaps) +print("Gooogle Maps =", GoogleMaps) # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% date = args.date -mpt = mtk.Masaya_Maps(date) +if args.conc: + nconc = args.conc +else: + nconc = 48 + +try: + mpt = mtk.MasayaMaps(date, n_conc_files=int(nconc)) +except AssertionError: + print('CALPUFF output directory does not exist for' + date) + print('Stopping, please check output exists for ' + date) -if StaticMaps: - if SO24: +if TopoMaps: + if SO2 and SO4: mpt.plot_staticmaps('topo', SOX='SO2') mpt.plot_staticmaps('topo', SOX='SO4') + elif SO4: + mpt.plot_staticmaps('topo', SOX='SO4') + elif SO2: + mpt.plot_staticmaps('topo', SOX='SO2') + else: + print(r'Conc must be set to SO$_2$ or SO$_4$ or both (default)') + print(r'most likely the --custom flag has been used with out:') + print(' --SO2', 'or --SO4',) + +if SatelliteMaps: + if SO2 and SO4: mpt.plot_staticmaps('satellite', SOX='SO2') mpt.plot_staticmaps('satellite', SOX='SO4') elif SO2: - mpt.plot_staticmaps('topo', SOX='SO2') mpt.plot_staticmaps('satellite', SOX='SO2') elif SO4: - mpt.plot_staticmaps('topo', SOX='SO4') mpt.plot_staticmaps('satellite', SOX='SO4') else: print(r'Conc must be set to SO$_2$ or SO$_4$ or both (default)') print(r'most likely the --custom flag has been used with out:') print(' --SO24', ' --SO2', 'or --SO4',) + if GoogleMaps: - if SO24: + if SO2 and SO4: mpt.plot_google(SOX='SO2') mpt.plot_google(SOX='SO4') elif SO2: @@ -150,6 +140,6 @@ elif SO4: mpt.plot_google(SOX='SO4') else: - print(r'Conc must be set to SO$_2$ or SO$_4$ or both (default)') + print(r'Conc must be set to SO$_2$ and/or SO$_4$ ') print(r'most likely the --custom flag has been used with out:') - print(' --SO24', ' --SO2', 'or --SO4',) + print('--SO2', 'or --SO4',) diff --git a/Python/maptoolkit.py b/Python/maptoolkit.py new file mode 100644 index 0000000..baaaeea --- /dev/null +++ b/Python/maptoolkit.py @@ -0,0 +1,495 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- +"""Gen_Maps +.. module:: Gen_Maps + :platform: Unix + :synopis: +.. moduleauther: CEMAC (UoL) +.. description: This module was developed by CEMAC as part of the UNRESP + Project. This Script plots CALPUFF concrec data on a map. + :copyright: © 2018 University of Leeds. + :license: BSD-2 Clause. +Example: + To use:: + ./generateMaps.py + - Date string, format YYYYMMDD, of the current CALPUFF run. + Used to locate directory containing the SO2 output files + (with assumed naming convention 'concrec0100**.dat', + where '**' goes from '01' through to '48') +.. CEMAC_UNRESPForcastingSystem: + https://github.com/cemac/UNRESPForcastingSystem +""" +import os +import sys +import datetime as dt +import numpy as np +import matplotlib.image as mpimg +import matplotlib as mpl +import matplotlib.pyplot as plt +from matplotlib.font_manager import FontProperties +from mpl_toolkits.basemap import Basemap +import pytz +import utm +import gmplot +from dateutil.parser import parse +import warnings +warnings.filterwarnings("ignore") +# University System python may be broken +# If some one insists on using it... +BACKEND = mpl.get_backend() +if BACKEND == 'Qt4Agg' and sys.version_info[0] == 2: + # Fix the backend + print('swapping to Agg Backend') + mpl.pyplot.switch_backend('Agg') + + +# defaults +# Defualt directory concentrations are in +CONCDIR = "../CALPUFF_OUT/CALPUFF/" +# Default location of xy ascii file +XYFILE = "../data/xy_masaya.dat" + + +def read_two_column_file(file_name): + """read_two_column_file + description: extracts x and y from calpuff x and y file + args: + file_name (str): file to read containing ascii x and y + returns: + x (list): list of x values + y (list): list of y values + """ + with open(file_name, 'r') as data: + x = [] + y = [] + for line in data: + xy_vals = line.split() + x.append(float(xy_vals[0])) + y.append(float(xy_vals[1])) + + return x, y + + +def concfiles(n_conc_files, conc_dir, SOX='SO2'): + """concfiles + description: generate list of concentration files + n_conc_files (int): number of concentration files e.g. 48 or 24 + conc_dir (str): path to directory containing conc files + SOX (str): SO species, default = 'SO2' + returns: + filenames (list): list of filenames e.g. concrec0100.dat + file_paths (list): list of filepaths e.g + """ + filenames = [] + file_paths = [] + if SOX == 'SO2': + concrecx = 'concrec0100' + elif SOX == 'SO4': + concrecx = 'concrec0200' + else: + concrecx = 'concrec0100' + print("WARNING: SOX option not valid setting to 'SO2'") + print("Options available are 'SO2' or 'SO4'") + for i in range(n_conc_files): + # Ensure e.g. '1' is converted to '01' + f_name = concrecx + str('{:02}'.format(i + 1)) + '.dat' + filenames.append(f_name) + f_path = os.path.join(conc_dir, f_name) + file_paths.append(f_path) + assert os.path.exists(f_path), "File " + \ + f_path + " not found. Check path." + return filenames, file_paths + + +def genxy(xy_file): + """genxy + description: + Reading the xy_file and Convert the list of UTM points and to lat lons + args: + xy_file (str): filename for ascii file of xy points (2 cols) + returns: + glat (array): gridded latitudes + glon (array): gridded longitudes + latMin (float): min latitude extent + latMax (float): max latitude extent + lonMin (float): min longitude extent + lonMax (float): max longitude extent + ny (int): number of x points + nx (int): number of y points + """ + x, y = read_two_column_file(xy_file) # read in x,y data + xunq, yunq = np.unique(x), np.unique(y) # get unique x,y coordinates + nx, ny = len(xunq), len(yunq) # number of unique x,y coordinates + # Use utm package to convert from x,y to lat,lon... + # ...Nicaragua is UTM zone 16P, and we must convert to metres first: + lat = [utm.to_latlon(x[i] * 1000, y[i] * 1000, 16, 'P')[0] + for i in np.arange(0, len(x))] + lon = [utm.to_latlon(x[i] * 1000, y[i] * 1000, 16, 'P')[1] + for i in np.arange(0, len(x))] + # Create gridded field of lat,lon of appropriate size: + glat, glon = np.reshape(lat, (ny, nx)), np.reshape(lon, (ny, nx)) + # Also grab range for static plots + latMin = min(lat) + latMax = max(lat) + lonMin = min(lon) + lonMax = max(lon) + return glat, glon, latMin, latMax, lonMin, lonMax, ny, nx + + +def gen_gxy(xy_file): + """gen_gxy + description: + Reading the xy_file and Convert the list of UTM points and to lat lons + In format required for google + args: + xy_file (str): filename for ascii file of xy points (2 cols) + returns: + glat (array): gridded latitudes + glon (array): gridded longitudes + lat (list): list of latitudes (corners) + lon (list): list of longitudes (corners) + ny (int): number of x points + nx (int): number of y points + """ + # READ IN X,Y DATA AND CONVERT TO LAT,LON + x, y = read_two_column_file(xy_file) # read in x,y data + xunq, yunq = np.unique(x), np.unique(y) # get unique x,y coordinates + # Get x,y coordinates of all the corners of the square cells centred on + # each x,y (for google plots): + x2unq = [v - (xunq[1] - xunq[0]) / 2. for v in xunq] + x2unq.append(x2unq[-1] + (xunq[1] - xunq[0])) + y2unq = [v - (yunq[1] - yunq[0]) / 2. for v in yunq] + y2unq.append(y2unq[-1] + (yunq[1] - yunq[0])) + nx, ny = len(x2unq), len(y2unq) + x2grd, y2grd = np.meshgrid(x2unq, y2unq) + x2, y2 = np.reshape(x2grd, (nx * ny)), np.reshape(y2grd, (nx * ny)) + lat = [utm.to_latlon(x2[i] * 1000, y2[i] * 1000, 16, 'P')[0] + for i in np.arange(0, len(x2))] + lon = [utm.to_latlon(x2[i] * 1000, y2[i] * 1000, 16, 'P')[1] + for i in np.arange(0, len(x2))] + glat, glon = np.reshape(lat, (ny, nx)), np.reshape(lon, (ny, nx)) + return glat, glon, lat, lon, ny, nx + + +def conc_array(ny, nx, file_path, binLims): + """conc_array + description: + create an array of concentrations + args: + ny (int): number of x points + nx (int): number of y points + file_path (str): filename + binLims (list): list of concentrations to bin the data + returns: + concA (array): array of concentrations in ug/m^3 + (greater than value of smallest bin) + conc (array): array of concentrations in ug/m^3 + """ + # Read in concentration data: + f = open(file_path, 'r') + lines = f.read().splitlines() + f.close() + # Process concentration data into desired format: + conc = np.array([float(X) for X in lines]) * 100**3 # ug/cm^3 -> ug/m^3 + concAry = np.reshape(conc, (ny, nx)) # Reshape data onto latlon grid + concA = np.ma.masked_array(concAry, concAry < binLims[0]) + return concA, conc + + +def gen_im(lonMin, latMin, lonMax, latMax, imtype="World_Street_Map",): + """gen_im + description + args: + lonMin (int): minimum longitude + latMin (int): minimum latitude + lonMax (int): maximum longitude + latMax (int): maximum latitude + imtype (str): 'World_Imagery' or 'World_Shaded_Relief' + returns: + ESRIimg (basemap image): background image either satellite or + topography for concentration plots + """ + xpixels = 1700 # Zoom lvl for satellite basemap (higher=bigger file sizes) + bmap = Basemap(llcrnrlon=lonMin, llcrnrlat=latMin, + urcrnrlon=lonMax, urcrnrlat=latMax) + esri_url = ("http://server.arcgisonline.com/ArcGIS/rest/services/" + + imtype + "/MapServer/export?\ +bbox=%s,%s,%s,%s&\ +bboxSR=%s&\ +imageSR=%s&\ +size=%s,%s&\ +dpi=%s&\ +format=png32&\ +f=image" % (bmap.llcrnrlon, bmap.llcrnrlat, bmap.urcrnrlon, bmap.urcrnrlat, + bmap.epsg, bmap.epsg, xpixels, bmap.aspect * xpixels, 96)) + ESRIimg = mpimg.imread(esri_url) + return ESRIimg + + +class MasayaMaps(): + '''Plot Masaya Maps + Consitsts of X plotting functions that output 48 static maps + members: + plot_staticmap: plot either topo or statellite + plot_staticmap1: plot either topo or statellite + plot_googlemaps: plot google maps html + plot_googlemap1: plot google maps html + Args: + date (str): YYYYMMDD string + conc_dir (str):path to conc directory + default: "../CALPUFF_OUT/CALPUFF/" + xy_file (str): path to xy file, default: "../data/xy_masaya.dat" + n_conc_files (int) = 48 + attributes: + outDir = "../vis/" + date + sat = 'World_Imagery' + topo = 'World_Shaded_Relief' + n_conc_files = 48 + binLims: [10, 350, 600, 2600, 9000, 14000] SO2 bin limits + binLimsSO4: [1E-8, 12, 35, 55, 150, 250] SO4 bin limits + colsHex: set hex codes for colours + towns = El Panama, Rigoberto, Pacaya, El Crucero, La Concepcion, + Masaya, San Marcos, San Rafael del Sur, Diriamba, Jinotepe, + Masatepe + townCoords: latlons of the above towns + cities: MANAGUA + cityCoords: latlon MANAGUA -86.29, 12.12) + volcCoords: latlon of Maysaya -86.1608, 11.9854 + googlekey: API Key will be read in file if there and required + ''' + + def __init__(self, date, conc_dir=CONCDIR, xy_file=XYFILE, + n_conc_files=48): + """Initialise with date, concrec file location, xy file locations and + forecast length e.g 48 hours or 24 + """ + self.conc_dir = conc_dir + date + self.xy_file = xy_file + self.outDir = "../vis/" + date + self.sat = 'World_Imagery' + self.topo = 'World_Shaded_Relief' + # Number of conc files to process (48 = full 2 days) + self.n_conc_files = n_conc_files + self.binLims = [10, 350, 600, 2600, 9000, 14000] # SO2 bin limits + self.binLimsSO4 = [1E-8, 12, 35, 55, 150, 250] # SO4 bin limits from: + # http://mkwc.ifa.hawaii.edu/vmap/hysplit/ + self.colsHex = ['#FFFFFF', '#0cec0c', '#FFFF00', '#FF6600', '#FF0000', + '#800080', '#8F246B'] # Hex codes for SO2 colour bins + self.towns = (' El Panama', ' Rigoberto', ' Pacaya', ' El Crucero', + ' La Concepcion', ' Masaya', ' San Marcos', + ' San Rafael del Sur', ' Diriamba', ' Jinotepe', + ' Masatepe') + self.townCoords = ((-86.2058, 11.972), (-86.2021, 11.9617), + (-86.3013, 11.9553), (-86.3113, 11.9923), + (-86.189772, 11.936161), (-86.096053, 11.973523), + (-86.20317, 11.906584), (-86.43639, 11.847034), + (-86.239592, 11.85632), (-86.19993, 11.85017), + (-86.143758, 11.91512)) + self.cities = (' MANAGUA',) + self.cityCoords = ((-86.29, 12.12),) + self.volcCoords = (-86.1608, 11.9854) + self.font = FontProperties() + self.font.set_weight('bold') + self.font.set_family('monospace') + + # CHECK PATHS/FILES EXIST + assert os.path.exists(self.conc_dir), ("CALPUFF output directory " + + "does not exist for this date.") + assert os.path.exists(self.xy_file), ("Cannot find data/xy_masaya.da" + + "t coordinate data file.") + assert os.path.exists(self.outDir), ("Output directory vis/ " + + "does not exist.") + self.filenames, self.file_paths = concfiles(self.n_conc_files, + self.conc_dir, SOX='SO2') + + # GET DATES/TIMES + startDate = pytz.utc.localize(parse(date)) + dates = [] + for i in range(self.n_conc_files): + iDate = startDate + dt.timedelta(hours=i + 1) + dates.append(iDate) + self.dates = dates + # SET BIN COLOURS + self.cmap = mpl.colors.ListedColormap(self.colsHex[1:-1]) + self.cmap.set_under(self.colsHex[0]) + self.cmap.set_over(self.colsHex[-1]) + self.normso4 = mpl.colors.BoundaryNorm( + boundaries=self.binLimsSO4, ncolors=5) + self.norm = mpl.colors.BoundaryNorm(boundaries=self.binLims, ncolors=5) + (self.glat, self.glon, self.latMin, self.latMax, + self.lonMin, self.lonMax, self.ny, self.nx) = genxy(self.xy_file) + (self.Gglat, self.Gglon, self.Glat, self.Glon, self.Gny, + self.Gnx) = gen_gxy(self.xy_file) + # GoogleKey assigned later + self.googlekey = "" + + def plot_staticmaps(self, maptype, SOX='SO2'): + """plot_staticmaps + description + plot png per hour for either topo or satellite and SOX set to SO2 + SO4 + args: + maptype (str): satellite or topo + SOX (str): SO2 or SO4, default'SO2' + returns: + 24/48 (n_conc_files) pngs of concentration on map + """ + if maptype == 'satellite': + Imflag = self.sat + tc = 'w' + out = '' + elif maptype == 'topo': + Imflag = self.topo + tc = 'k' + out = 'topo' + else: + print('Not a valid option... setting to topo') + Imflag = self.topo + tc = 'k' + out = 'topo' + im = gen_im(self.lonMin, self.latMin, self.lonMax, + self.latMax, imtype=Imflag) + file_paths = concfiles(self.n_conc_files, self.conc_dir, SOX=SOX)[1] + for i, fname in enumerate(file_paths): + self.plot_staticmap1(i, im, tc, fname, out, SOX=SOX) + + def plot_staticmap1(self, ita, im, tc, fname, out, SOX): + """plot_staticmap1 + description + plot a single for either topo or satellite and SOX set to SO2 + SO4 + args: + ita (int): index of conc file list (which sim hour) + im (basemap image): background image + tc (str): text colour + file_paths: list of conc files + out (str): filename + SOX (str): SO2 or SO4, default'SO2' + returns: + png of concentration on map + """ + SOXf = r'SO$_' + SOX[-1] + '$' + so2title = ('Atmospheric ' + SOXf + ' concentrations at ' + + 'ground level (hourly means). \n GCRF UNRESP') + plt.figure(figsize=(16, 12)) + fle = fname + if SOX == "SO4": + binLims = self.binLimsSO4 + norm = self.normso4 + else: + binLims = self.binLims + norm = self.norm + concA = conc_array(self.ny, self.nx, fle, binLims)[0] + latMin, latMax, lonMin = self.latMin, self.latMax, self.lonMin + lonMax = self.lonMax + bmap = Basemap(llcrnrlon=lonMin, llcrnrlat=latMin, + urcrnrlon=lonMax, urcrnrlat=latMax) + bmap.imshow(im, origin='upper') + bmap.pcolormesh(self.glon, self.glat, concA, + norm=norm, cmap=self.cmap, alpha=0.5) + cbar = bmap.colorbar(location='bottom', pad='20%', cmap=self.cmap, + norm=norm, boundaries=[0.] + binLims + + [100000.], extend='both', extendfrac='auto', + ticks=binLims, spacing='uniform') + cbar.ax.set_xticklabels(['v low', 'low', 'moderate', 'mod high', + 'high', 'v high']) # horizontal colorbar + cbar.set_label(label=(SOX + ' concentration'), fontsize=18) + cbar.ax.tick_params(labelsize=16) + cbar.solids.set(alpha=1) + latTicks = np.arange(round(latMin, 1), round(latMax, 1) + 0.1, 0.1) + lonTicks = np.arange(round(lonMin, 1), round(lonMax, 1) + 0.1, 0.2) + bmap.drawparallels(latTicks, labels=[1, 0, 0, 0], linewidth=0.0, + fontsize=16) + bmap.drawmeridians(lonTicks, labels=[0, 0, 0, 1], linewidth=0.0, + fontsize=16) + for i, town in enumerate(self.towns): + plt.plot(self.townCoords[i][0], self.townCoords[i] + [1], 'ok', markersize=4) + plt.text(self.townCoords[i][0], self.townCoords[i][1], town, + color=tc, fontproperties=self.font, fontsize=12) + for i, city in enumerate(self.cities): + plt.plot(self.cityCoords[i][0], self.cityCoords[i] + [1], 'sk', markersize=6) + plt.text(self.cityCoords[i][0], self.cityCoords[i][1], city, + fontproperties=self.font, fontsize=16) + font0 = FontProperties() + font0.set_family('monospace') + plt.plot(self.volcCoords[0], self.volcCoords[1], '^r', markersize=6) + plt.suptitle(so2title, fontsize=24) + plt.title(self.dates[ita].strftime('%c %z'), fontsize=18) + PNGfile = SOX + '_static_' + out + fle[-17:-4] + '.png' + print("Writing out file " + PNGfile) + PNGpath = os.path.join(self.outDir, PNGfile) + plt.savefig(PNGpath, dpi=250) + plt.close() + + def plot_google(self, SOX='SO2'): + """plot_google + description + plot google html per hour for either SOX set to SO2 concentrations + SO4. Requires API key - will exit gracefully if no key found. + args: + SOX (str): SO2 or SO4, default'SO2' + returns: + 24/48 (n_conc_files) google htmls + """ + codesFile = os.path.join('GM_API_KEY.txt') + try: + f = open(codesFile, 'r') + lines = f.readlines() + f.close() + self.googlekey = lines[0].strip() + file_paths = concfiles(self.n_conc_files, + self.conc_dir, SOX=SOX)[1] + for i, fname in enumerate(file_paths): + self.plot_googlemap1(i, fname, SOX) + except FileNotFoundError: + print("### WARNING #### GM_API_KEY.txt not found \n turning off " + + "google maps plotter") + print(" If you would like to plot goolge maps \n please see" + + " README for API key information.") + + def plot_googlemap1(self, ita, file_paths, SOX): + """plot_staticmaps + description + plot a single google html for either SOX set to SO2 or SO4 + args: + ita (int): index of conc file list (which sim hour) + file_paths: list of conc files + SOX (str): SO2 or SO4, default'SO2' + returns: + png of concentration on map + """ + gKey = self.googlekey + fle = file_paths + if SOX == "SO4": + binLims = self.binLimsSO4 + else: + binLims = self.binLims + glat, glon, lat, lon = self.Gglat, self.Gglon, self.Glat, self.Glon + concA, conc = conc_array(self.ny, self.nx, fle, binLims) + gmap = gmplot.GoogleMapPlotter(min(lat) + np.ptp(lat) / 2., + min(lon) + np.ptp(lon) / 2., zoom=11, + apikey=gKey) + for i in np.arange(0, self.nx): + for j in np.arange(0, self.ny): + for k in np.arange(0, len(self.binLims) - 1): + if ( + concA[j, i] > self.binLims[k] and + concA[j, i] <= binLims[k + 1] + ): + gmap.polygon((glat[j + 1, i], glat[j, i], + glat[j, i + 1], glat[j + 1, i + 1]), + (glon[j + 1, i], glon[j, i], + glon[j, i + 1], glon[j + 1, i + 1]), + color=self.colsHex[k + 1], + edge_width=0.001) + if conc[j] > binLims[-1]: + gmap.polygon((glat[j + 1, i], glat[j, i], + glat[j, i + 1], glat[j + 1, i + 1]), + (glon[j + 1, i], glon[j, i], + glon[j, i + 1], glon[j + 1, i + 1]), + color=self.colsHex[-1], edge_width=0.001) + HTMLfile = SOX + '_google_' + fle[-17:-4] + '.html' + print("Writing out file " + HTMLfile) + gmap.draw(os.path.join(self.outDir, HTMLfile)) diff --git a/Python/nam23ddat.py b/Python/nam23ddat.py new file mode 100755 index 0000000..279f5b5 --- /dev/null +++ b/Python/nam23ddat.py @@ -0,0 +1,581 @@ +#!/usr/bin/env python +""" +Script name: Create3DDAT.py +Author: JO'N, CEMAC (University of Leeds) +Date: March 2018 +Purpose: Generate input file to CALMET from NAM met data +Usage: ./Create3DDAT.py + - Start date of NAM data in format YYYYMMDD, e.g. 20171204 +Output: File written to /NAM_data/processed/met_.dat +.. CEMAC_UNRESP: + https://github.com/cemac/UNRESPForecastingSystem +""" +import argparse +from mpl_toolkits.basemap import Basemap +import matplotlib.pyplot as plt +import datetime as dt +from dateutil.parser import parse +import numpy as np +import gribapi +import os +import sys + + +def take_along_axis(arr, ind, axis): + """ + ... here means a "pack" of dimensions, possibly empty + + arr: array_like of shape (A..., M, B...) + source array + ind: array_like of shape (A..., K..., B...) + indices to take along each 1d slice of `arr` + axis: int + index of the axis with dimension M + + out: array_like of shape (A..., K..., B...) + out[a..., k..., b...] = arr[a..., inds[a..., k..., b...], b...] + """ + if axis < 0: + if axis >= -arr.ndim: + axis += arr.ndim + else: + raise IndexError('axis out of range') + ind_shape = (1,) * ind.ndim + ins_ndim = ind.ndim - (arr.ndim - 1) #inserted dimensions + + dest_dims = list(range(axis)) + [None] + list(range(axis+ins_ndim, ind.ndim)) + + # could also call np.ix_ here with some dummy arguments, then throw those results away + inds = [] + for dim, n in zip(dest_dims, arr.shape): + if dim is None: + inds.append(ind) + else: + ind_shape_dim = ind_shape[:dim] + (-1,) + ind_shape[dim+1:] + inds.append(np.arange(n).reshape(ind_shape_dim)) + + return arr[tuple(inds)] + + +def writeRec1(): + # DATASET='3D.DAT' #Dataset name + # DATAVER='2.1' #Dataset version + # DATAMOD='Created using Create3DDAT.py' #Dataset message field + # fout.write('{:16}{:16}{}\n'.format(DATASET,DATAVER,DATAMOD)) + fout.write( + 'M3D file Created from ETA AWIPS 212 Grid for Falconbridge CALMET\n') + # just replicate Sara's data file for now + + +def writeRec2(): + # NCOMM=1 #Number of comment records to follow + # fout.write('{:1d}\n'.format(NCOMM)) + # COMMENT="Currently set up to process GRIB data file from NAM's Central + # American/Caribbean domain" #Comments + # fout.write('{}\n'.format(COMMENT)) + fout.write('MM53D.DAT 1.0 020715 \n') + # just replicate Sara's data file for now + + +def writeRec3(): + IOUTW = 1 # Vertical velocity flag + IOUTQ = 1 # Relative humidity flag + IOUTC = 0 # cloud/rain mixing ration flag + IOUTI = 0 # ice/snow MR flag + IOUTG = 0 # graupel MP flag + IOSRF = 0 # create surface 2D files flag + fout.write(('{:3d}' * 6 + '\n').format(IOUTW, + IOUTQ, IOUTC, IOUTI, IOUTG, IOSRF)) + + +def writeRec4(): + MAPTXT = 'LLC' # Map projection (LLC=lat/lon) + RLATC = (lats[iLatMinGRIB] + lats[iLatMaxGRIB]) / 2. + # centre latitude of GRIB subset grid + RLONC = (lons[iLonMinGRIB] + lons[iLonMaxGRIB]) / 2. + # centre longitude of GRIB subset grid + TRUELAT1 = lats[iLatMinGRIB] # First latitude in GRIB subset grid + TRUELAT2 = lats[iLatMinGRIB + 1] # Second latitude in GRIB subset grid + X1DMN = 0.0 # Not used so set to zero + Y1DMN = 0.0 # Not used so set to zero + DXY = 0.0 # Not used so set to zero + fout.write(('{:4}{:9.4f}{:10.4f}' + '{:7.2f}' * 2 + '{:10.3f}' * 2 + '{:8.3f}' + '{:4d}' * 2 + '{:3d}\n'). + format(MAPTXT, RLATC, RLONC, TRUELAT1, TRUELAT2, X1DMN, Y1DMN, DXY, NX, NY, NZ)) + + +def writeRec5(): + # Flags that aren't used unless using MM5 model + fout.write(('{:3d}' * 23 + '\n').format(0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) + + +def writeRec6(): + IBYRM = int(date[0:4]) # Beginning year of GRIB data + IBMOM = int(date[4:6]) # Beginning month of GRIB data + IBDYM = int(date[6:8]) # Beginning day of GRIB data + IBHRM = 0 # Beginning hour (GMT) of GRIB data + # Length of period (hours of data in file (Replicate Sara's file but should possibly be 3* this value?) + NHRSMM5 = (nfiles-1)*6 + fout.write(('{:4d}' + '{:02d}' * 3 + '{:5d}' + '{:4d}' * 3 + + '\n').format(IBYRM, IBMOM, IBDYM, IBHRM, NHRSMM5, NX, NY, NZ)) + + +def writeRec7(): + NX1 = 1 # I-index (x-direction) of lower left corner + NY1 = 1 # J-index (y-direction) of lower left corner + NX2 = NX # I-index (x-direction) of upper right corner + NY2 = NY # J-index (y-direction) of upper right corner + NZ1 = 1 # K-index of lowest extracted layer + NZ2 = NZ # K-index of highest extracted layer + RXMIN = lons[iLonMinGRIB] # W-most E longitude + RXMAX = lons[iLonMaxGRIB] # E-most E longitude + RYMIN = lats[iLatMinGRIB] # S-most N latitude + RYMAX = lats[iLatMaxGRIB] # N-most N latitude + fout.write(('{:4d}' * 6 + '{:10.4f}' * 2 + '{:9.4f}' * 2 + + '\n').format(NX1, NY1, NX2, NY2, NZ1, NZ2, RXMIN, RXMAX, RYMIN, RYMAX)) + SIGMA = np.array(levsIncl) / 1013.25 + # Sigma-p values for each vertical layer (pressure/reference pressure) + for s in SIGMA: + fout.write('{:6.3f}\n'.format(s)) + + +def writeRec8(): + # terrain elevation above MSL (m). Set to zero for now to replicate Sara's file + IELEVDOT = 0 + ILAND = -9 # Lansuse categories (set to -9 to replicae Sara's file) + XLATCRS = -999 # Not used + XLONGCRS = -999 # Not used + IELEVCRS = -999 # Not used + for j in range(NY): + JINDEX = j + 1 # J-index (y-direction) of grid point + XLATDOT = lats[iLatMinGRIB + j] # N latitude of grid point + for i in range(NX): + IINDEX = i + 1 # I-index (x-direction) of grid point + XLONGDOT = lons[iLonMinGRIB + i] # E longitude of grid point + fout.write(('{:4d}' * 2 + '{:9.4f}{:10.4f}{:5d}{:3d} {:9.4f}{:10.4f}{:5d}\n').format( + IINDEX, JINDEX, XLATDOT, XLONGDOT, IELEVDOT, ILAND, XLATCRS, XLONGCRS, IELEVCRS)) + + +def writeRec10(): + PRES = 1013.0 # Sea level presure (replicate Sara's file) + # total accumulated rainfall from past hour (replicate Sara's file) + RAIN = 0.0 + SC = 0 # snow cover + RADSW = 0.0 # SW radiation at surface (replicate Sara's file) + RADLW = 0.0 # LW radiation at top (replicate Sara's file) + VAPMR = 0.0 # Vagour mixing ratio (replicate Sara's file) + for t in range(nfiles): + print("Processing file " + filenames[t]) + dateTime = parse(date) + dt.timedelta(hours=t * 6) + MYR = dateTime.year # Year of data block + MMO = dateTime.month # Month of data block + MDAY = dateTime.day # Day of data block + MHR = dateTime.hour # Hour of data block + # GRIB file processing: + f = open(filePaths[t], 'r') # Open GRIB file + gribapi.grib_multi_support_on() # Turn on multi-message support + mcount = gribapi.grib_count_in_file(f) # number of messages in file + [gribapi.grib_new_from_file(f) for i in range( + mcount)] # Get handles for all messages + f.close() # Close GRIB file + # Initialse 3D arrays for holding required fields: + HGTgrd = np.zeros(shape=(Nj, Ni, NZ)) + TMPgrd = np.zeros(shape=(Nj, Ni, NZ)) + Ugrd = np.zeros(shape=(Nj, Ni, NZ)) + Vgrd = np.zeros(shape=(Nj, Ni, NZ)) + Wgrd = np.zeros(shape=(Nj, Ni, NZ)) + RHgrd = np.zeros(shape=(Nj, Ni, NZ)) + # Loop through included levels and store the values in the appropriate k index of the 3D arrays + for k in range(NZ): + HGTvals = gribapi.grib_get_values(int(gidHGT[k])) + HGTgrd[:, :, k] = np.reshape(HGTvals, (Nj, Ni), 'C') + TMPvals = gribapi.grib_get_values(int(gidTMP[k])) + TMPgrd[:, :, k] = np.reshape(TMPvals, (Nj, Ni), 'C') + Uvals = gribapi.grib_get_values(int(gidU[k])) + Ugrd[:, :, k] = np.reshape(Uvals, (Nj, Ni), 'C') + Vvals = gribapi.grib_get_values(int(gidV[k])) + Vgrd[:, :, k] = np.reshape(Vvals, (Nj, Ni), 'C') + Wvals = gribapi.grib_get_values(int(gidW[k])) + Wgrd[:, :, k] = np.reshape(Wvals, (Nj, Ni), 'C') + RHvals = gribapi.grib_get_values(int(gidRH[k])) + RHgrd[:, :, k] = np.reshape(RHvals, (Nj, Ni), 'C') + WSgrd = np.sqrt(Ugrd**2 + Vgrd**2) # Calculate wins speed (pythagoras) + # Calculate wind direction: + # radians, between [-pi,pi], positive anticlockwise from positive x-axis + WDgrd = np.arctan2(Vgrd, Ugrd) + # degrees, between [-180,180], positive anticlockwise from positive x-axis + WDgrd *= 180 / np.pi + # degrees, between [0,360], positive anticlockwise from negative x-axis (Since we specify the direction the wind is blowing FROM, not TO) + WDgrd += 180 + # degrees, between [-360,0], positive clockwise from negative x-axis (Since wind direction is positive clockwise) + WDgrd = - WDgrd + # degrees, between [-270,90], positive clockwise from positive y-axis (Since wind direction is from North) + WDgrd += 90 + # degrees, between [0,360], positive clockwise from positive y-axis (DONE!) + WDgrd = np.mod(WDgrd, 360) + # Loop over grid cells: + for j in range(NY): + JX = j + 1 # J-index of grid cell + for i in range(NX): + IX = i + 1 # i-index of grid cell + fout.write(('{:4d}' + '{:02d}' * 3 + '{:3d}' * 2 + '{:7.1f}{:5.2f}{:2d}' + '{:8.1f}' + * 2 + '\n').format(MYR, MMO, MDAY, MHR, IX, JX, PRES, RAIN, SC, RADSW, RADLW)) + for k in range(NZ): + PRES2 = levsIncl[k] # Pressure (mb) + # Elevation (m above sea level) + Z = int(HGTgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + # Temperature (Kelvin) + TEMPK = TMPgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Wind direction (degrees) + WD = int(WDgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + # Wind speed (m/s) + WS = WSgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Vertical velocity (m/s) + W = Wgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Relative humidity (%) + RH = int(RHgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + fout.write(('{:4d}{:6d}{:6.1f}{:4d}{:5.1f}{:6.2f}{:3d}{:5.2f}\n').format( + PRES2, Z, TEMPK, WD, WS, W, RH, VAPMR)) + # Release all messages: + for i in range(mcount): + gribapi.grib_release(i + 1) + + +def writeRec9(): + PRES = 1013.0 # Sea level presure (replicate Sara's file) + # total accumulated rainfall from past hour (replicate Sara's file) + RAIN = 0.0 + SC = 0 # snow cover + RADSW = 0.0 # SW radiation at surface (replicate Sara's file) + RADLW = 0.0 # LW radiation at top (replicate Sara's file) + VAPMR = 0.0 # Vagour mixing ratio (replicate Sara's file) + for t in range(nfiles): + print("Processing file " + filenames[t]) + dateTime = parse(date) + dt.timedelta(hours=t * 6) + MYR = dateTime.year # Year of data block + MMO = dateTime.month # Month of data block + MDAY = dateTime.day # Day of data block + MHR = dateTime.hour # Hour of data block + # GRIB file processing: + f = open(filePaths[t], 'r') # Open GRIB file + gribapi.grib_multi_support_on() # Turn on multi-message support + mcount = gribapi.grib_count_in_file(f) # number of messages in file + [gribapi.grib_new_from_file(f) for i in range( + mcount)] # Get handles for all messages + f.close() # Close GRIB file + # Initialse 3D arrays for holding required fields: + HGTgrd = np.zeros(shape=(Nj, Ni, NZ)) + TMPgrd = np.zeros(shape=(Nj, Ni, NZ)) + Ugrd = np.zeros(shape=(Nj, Ni, NZ)) + Vgrd = np.zeros(shape=(Nj, Ni, NZ)) + Wgrd = np.zeros(shape=(Nj, Ni, NZ)) + RHgrd = np.zeros(shape=(Nj, Ni, NZ)) + # Loop through included levels and store the values in the appropriate k index of the 3D arrays + for k in range(NZ): + HGTvals = gribapi.grib_get_values(int(gidHGT[k])) + HGTgrd[:, :, k] = np.reshape(HGTvals, (Nj, Ni), 'C') + TMPvals = gribapi.grib_get_values(int(gidTMP[k])) + TMPgrd[:, :, k] = np.reshape(TMPvals, (Nj, Ni), 'C') + Uvals = gribapi.grib_get_values(int(gidU[k])) + Ugrd[:, :, k] = np.reshape(Uvals, (Nj, Ni), 'C') + Vvals = gribapi.grib_get_values(int(gidV[k])) + Vgrd[:, :, k] = np.reshape(Vvals, (Nj, Ni), 'C') + Wvals = gribapi.grib_get_values(int(gidW[k])) + Wgrd[:, :, k] = np.reshape(Wvals, (Nj, Ni), 'C') + RHvals = gribapi.grib_get_values(int(gidRH[k])) + RHgrd[:, :, k] = np.reshape(RHvals, (Nj, Ni), 'C') + WSgrd = np.sqrt(Ugrd**2 + Vgrd**2) # Calculate wins speed (pythagoras) + # Calculate wind direction: + # radians, between [-pi,pi], positive anticlockwise from positive x-axis + WDgrd = np.arctan2(Vgrd, Ugrd) + # degrees, between [-180,180], positive anticlockwise from positive x-axis + WDgrd *= 180 / np.pi + # degrees, between [0,360], positive anticlockwise from negative x-axis (Since we specify the direction the wind is blowing FROM, not TO) + WDgrd += 180 + # degrees, between [-360,0], positive clockwise from negative x-axis (Since wind direction is positive clockwise) + WDgrd = - WDgrd + # degrees, between [-270,90], positive clockwise from positive y-axis (Since wind direction is from North) + WDgrd += 90 + # degrees, between [0,360], positive clockwise from positive y-axis (DONE!) + WDgrd = np.mod(WDgrd, 360) + if t > 0: + dateTime = parse(date) + dt.timedelta(hours=(t * 6)-3) + print('interpolating') + print(dateTime) + MYR = dateTime.year # Year of data block + MMO = dateTime.month # Month of data block + MDAY = dateTime.day # Day of data block + MHR = dateTime.hour # Hour of data block + HGTgrd = np.mean(np.array([HGTgrd + HGTgrd_ini]), axis=0) + TMPgrd = np.mean(np.array([TMPgrd + TMPgrd_ini]), axis=0) + Wgrd = np.mean(np.array([Wgrd + Wgrd_ini]), axis=0) + RHgrd = np.mean(np.array([RHgrd + RHgrd_ini]), axis=0) + WDgrd = np.mean(np.array([WDgrd + WDgrd_ini]), axis=0) + WSgrd = np.mean(np.array([WSgrd + WSgrd_ini]), axis=0) + inds = HGTgrd.argsort(axis=2) + HGTgrd = take_along_axis(HGTgrd, inds, axis=2) + TMPgrd = take_along_axis(TMPgrd, inds, axis=2) + Wgrd = take_along_axis(Wgrd, inds, axis=2) + RHgrd = take_along_axis(RHgrd, inds, axis=2) + WSgrd = take_along_axis(WSgrd, inds, axis=2) + WDgrd = take_along_axis(WDgrd, inds, axis=2) + # Loop over grid cells: + for j in range(NY): + JX = j + 1 # J-index of grid cell + for i in range(NX): + IX = i + 1 # i-index of grid cell + fout.write(('{:4d}' + '{:02d}' * 3 + '{:3d}' * 2 + '{:7.1f}{:5.2f}{:2d}' + '{:8.1f}' + * 2 + '\n').format(MYR, MMO, MDAY, MHR, IX, JX, PRES, RAIN, SC, RADSW, RADLW)) + for k in range(NZ): + PRES2 = levsIncl[k] # Pressure (mb) + # Elevation (m above sea level) + Z = int(HGTgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + # Temperature (Kelvin) + TEMPK = TMPgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Wind direction (degrees) + WD = int(WDgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + # Wind speed (m/s) + WS = WSgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Vertical velocity (m/s) + W = Wgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Relative humidity (%) + RH = int(RHgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + fout.write(('{:4d}{:6d}{:6.1f}{:4d}{:5.1f}{:6.2f}{:3d}{:5.2f}\n').format( + PRES2, Z, TEMPK, WD, WS, W, RH, VAPMR)) + # Release all messages: + for i in range(mcount): + gribapi.grib_release(i + 1) + # GRIB file processing: + dateTime = parse(date) + dt.timedelta(hours=t * 6) + print('processing') + print(dateTime) + MYR = dateTime.year # Year of data block + MMO = dateTime.month # Month of data block + MDAY = dateTime.day # Day of data block + MHR = dateTime.hour # Hour of data block + f = open(filePaths[t], 'r') # Open GRIB file + gribapi.grib_multi_support_on() # Turn on multi-message support + mcount = gribapi.grib_count_in_file(f) # number of messages in file + [gribapi.grib_new_from_file(f) for i in range( + mcount)] # Get handles for all messages + f.close() # Close GRIB file + # Initialse 3D arrays for holding required fields: + HGTgrd = np.zeros(shape=(Nj, Ni, NZ)) + TMPgrd = np.zeros(shape=(Nj, Ni, NZ)) + Ugrd = np.zeros(shape=(Nj, Ni, NZ)) + Vgrd = np.zeros(shape=(Nj, Ni, NZ)) + Wgrd = np.zeros(shape=(Nj, Ni, NZ)) + RHgrd = np.zeros(shape=(Nj, Ni, NZ)) + # Loop through included levels and store the values in the appropriate k index of the 3D arrays + for k in range(NZ): + HGTvals = gribapi.grib_get_values(int(gidHGT[k])) + HGTgrd[:, :, k] = np.reshape(HGTvals, (Nj, Ni), 'C') + TMPvals = gribapi.grib_get_values(int(gidTMP[k])) + TMPgrd[:, :, k] = np.reshape(TMPvals, (Nj, Ni), 'C') + Uvals = gribapi.grib_get_values(int(gidU[k])) + Ugrd[:, :, k] = np.reshape(Uvals, (Nj, Ni), 'C') + Vvals = gribapi.grib_get_values(int(gidV[k])) + Vgrd[:, :, k] = np.reshape(Vvals, (Nj, Ni), 'C') + Wvals = gribapi.grib_get_values(int(gidW[k])) + Wgrd[:, :, k] = np.reshape(Wvals, (Nj, Ni), 'C') + RHvals = gribapi.grib_get_values(int(gidRH[k])) + RHgrd[:, :, k] = np.reshape(RHvals, (Nj, Ni), 'C') + HGTgrd_ini = HGTgrd + TMPgrd_ini = TMPgrd + Wgrd_ini = Wgrd + RHgrd_ini = RHgrd + WSgrd = np.sqrt(Ugrd**2 + Vgrd**2) # Calculate wins speed (pythagoras) + # Calculate wind direction: + # radians, between [-pi,pi], positive anticlockwise from positive x-axis + WDgrd = np.arctan2(Vgrd, Ugrd) + # degrees, between [-180,180], positive anticlockwise from positive x-axis + WDgrd *= 180 / np.pi + # degrees, between [0,360], positive anticlockwise from negative x-axis (Since we specify the direction the wind is blowing FROM, not TO) + WDgrd += 180 + # degrees, between [-360,0], positive clockwise from negative x-axis (Since wind direction is positive clockwise) + WDgrd = - WDgrd + # degrees, between [-270,90], positive clockwise from positive y-axis (Since wind direction is from North) + WDgrd += 90 + # degrees, between [0,360], positive clockwise from positive y-axis (DONE!) + WDgrd = np.mod(WDgrd, 360) + WDgrd_ini = WDgrd + WSgrd_ini = WSgrd + inds = HGTgrd.argsort(axis=2) + HGTgrd = take_along_axis(HGTgrd, inds, axis=2) + TMPgrd = take_along_axis(TMPgrd, inds, axis=2) + Wgrd = take_along_axis(Wgrd, inds, axis=2) + RHgrd = take_along_axis(RHgrd, inds, axis=2) + WSgrd = take_along_axis(WSgrd, inds, axis=2) + WDgrd = take_along_axis(WDgrd, inds, axis=2) + # Loop over grid cells: + for j in range(NY): + JX = j + 1 # J-index of grid cell + for i in range(NX): + IX = i + 1 # i-index of grid cell + fout.write(('{:4d}' + '{:02d}' * 3 + '{:3d}' * 2 + '{:7.1f}{:5.2f}{:2d}' + '{:8.1f}' + * 2 + '\n').format(MYR, MMO, MDAY, MHR, IX, JX, PRES, RAIN, SC, RADSW, RADLW)) + for k in range(NZ): + PRES2 = levsIncl[k] # Pressure (mb) + # Elevation (m above sea level) + Z = int(HGTgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + # Temperature (Kelvin) + TEMPK = TMPgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Wind direction (degrees) + WD = int(WDgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + # Wind speed (m/s) + WS = WSgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Vertical velocity (m/s) + W = Wgrd[iLatMinGRIB + j, iLonMinGRIB + i, k] + # Relative humidity (%) + RH = int(RHgrd[iLatMinGRIB + j, iLonMinGRIB + i, k]) + fout.write(('{:4d}{:6d}{:6.1f}{:4d}{:5.1f}{:6.2f}{:3d}{:5.2f}\n').format( + PRES2, Z, TEMPK, WD, WS, W, RH, VAPMR)) + # Release all messages: + for i in range(mcount): + gribapi.grib_release(i + 1) + +# READ IN COMMAND LINE ARGUMENTS +parser = argparse.ArgumentParser(description="Script to generate input file to CALMET from NAM met data", + epilog="Example of use: ./Create3DDAT.py 20171204") +parser.add_argument( + "date", help="Start date of NAM data in format YYYYMMDD, e.g. 20171204", type=str) +args = parser.parse_args() +date = args.date + +# PARAMETERS +latMinCP = 11.7 # Min lat of CALPUFF grid +latMaxCP = 12.2 # Max lat of CALPUFF grid +lonMinCP = 273.2 # Min lon of CALPUFF grid +lonMaxCP = 274.1 # Max lon of CALPUFF grid +inDir = '/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/NAM_data/raw/' + date # Directory containing GRIB files +# Number of GRIB files (files are 6 hourly, +# so 24 hours is 5 files including hours 00 24) +nfiles = 5 +outFile = '/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/NAM_data/processed/met_' + date + '.dat' # Output file path +# pressure levels to include in output +levsIncl = [1000, 950, 925, 900, 850, 800, 700, 600, 500, 400, 300, 250, 200, + 150, 100, 75, 50, 30, 20, 10, 7, 5, 2] + +# SET FILENAMES +filePrefix = 'nam.t' +fileSuffix = 'z.afwaca00.tm00.grib2' +# fileSuffix = 'z.afwaca00.grb2.tm00' +filenames = [] +filePaths = [] +for i in range(nfiles): + filenames.append(filePrefix + '{:02d}'.format(i * 6) + fileSuffix) + filePaths.append(os.path.join(inDir, filenames[i])) +##### + +# OPEN FIRST GRIB FILE, GET MESSAGE HANDLERS AND CLOSE +f = open(filePaths[0], 'r') +gribapi.grib_multi_support_on() +mcount = gribapi.grib_count_in_file(f) # number of messages in file +gids = [gribapi.grib_new_from_file(f) for i in range(mcount)] +f.close() +##### + +# GET NAME AND LEVEL OF EACH MESSAGE +varNames = [] +levels = [] +for i in range(mcount): + gid = gids[i] + varNames.append(gribapi.grib_get(gid, 'shortName')) + levels.append(gribapi.grib_get(gid, 'level')) +##### + +# GET REQUIRED GIDS (AT REQUIRED LEVELS) +gidPRMSL = varNames.index("prmsl") + 1 # Pressure reduced to mean sea level +# Height +gidHGT = np.flipud([i + 1 for i in range(len(varNames)) + if (varNames[i] == 'gh' and levels[i] in levsIncl)]) +# Temperature +gidTMP = np.flipud([i + 1 for i in range(len(varNames)) + if (varNames[i] == 't' and levels[i] in levsIncl)]) +# U-component of wind +gidU = np.flipud([i + 1 for i in range(len(varNames)) + if (varNames[i] == 'u' and levels[i] in levsIncl)]) +# V-component of wind +gidV = np.flipud([i + 1 for i in range(len(varNames)) + if (varNames[i] == 'v' and levels[i] in levsIncl)]) +# W-component of wind +gidW = np.flipud([i + 1 for i in range(len(varNames)) + if (varNames[i] == 'wz' and levels[i] in levsIncl)]) +# Relative humidity +gidRH = np.flipud([i + 1 for i in range(len(varNames)) + if (varNames[i] == 'r' and levels[i] in levsIncl)]) +# GET LATS, LONS, NI AND NJ +lats = gribapi.grib_get_array(gidPRMSL, 'distinctLatitudes') +lons = gribapi.grib_get_array(gidPRMSL, 'distinctLongitudes') +Ni = gribapi.grib_get(gidPRMSL, 'Ni') +Nj = gribapi.grib_get(gidPRMSL, 'Nj') +##### + +# DETERMINE SUBDOMAIN INDICES BASED ON CALPUFF GRID EXTENT +for i in range(len(lats) - 1): + if lats[i + 1] >= latMinCP: + iLatMinGRIB = i + break +for i in range(len(lats) - 1): + if lats[i + 1] > latMaxCP: + iLatMaxGRIB = i + 1 + break +for i in range(len(lons) - 1): + if lons[i + 1] >= lonMinCP: + iLonMinGRIB = i + break +for i in range(len(lons) - 1): + if lons[i + 1] > lonMaxCP: + iLonMaxGRIB = i + 1 + break +##### + +# SET SUBDOMAIN SIZE +# NX, i.e. number of longitudes in GRIB subset grid +NX = iLonMaxGRIB - iLonMinGRIB + 1 +# NY, i.e. number of latitudes in GRIB subset grid +NY = iLatMaxGRIB - iLatMinGRIB + 1 +# NZ, i.e. number of levels to be extracted from GRIB subset grid +NZ = len(levsIncl) +##### + +# PLOT A MESSAGE +# gidPlot=gidHGT[-2] +# Ni=gribapi.grib_get(gidPlot,'Ni') +# Nj=gribapi.grib_get(gidPlot,'Nj') +# missingValue=gribapi.grib_get(gidPlot,"missingValue") +# values=gribapi.grib_get_values(gidPlot) +# msg=np.reshape(values,(Nj,Ni),'C') +# msgmasked = np.ma.masked_values(msg,missingValue) +# xx,yy=np.meshgrid(lons,lats) +# map = Basemap(llcrnrlon=250,llcrnrlat=-10,urcrnrlon=310,urcrnrlat=40) +# map.drawcoastlines() +# map.drawcountries() +# cs=map.contourf(xx,yy,msgmasked) +# map.colorbar(cs) +# plt.show() +##### + +# RELEASE ALL MESSAGES +for i in range(mcount): + gribapi.grib_release(i + 1) +##### + +# OPEN OUTPUT FILE +fout = open(outFile, 'w') +##### + +# WRITE RECORDS +writeRec1() +writeRec2() +writeRec3() +writeRec4() +writeRec5() +writeRec6() +writeRec7() +writeRec8() +writeRec9() + +# CLOSE OUTPUT FILE +fout.close() +##### diff --git a/README.md b/README.md index 783f5c3..e4b8072 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,9 @@ # UNRESP Forecasting System -[![GitHub release](https://img.shields.io/github/release/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases) [![GitHub top language](https://img.shields.io/github/languages/top/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem) [![GitHub issues](https://img.shields.io/github/issues/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/issues) [![GitHub last commit](https://img.shields.io/github/last-commit/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/commits/master) [![GitHub All Releases](https://img.shields.io/github/downloads/cemac/UNRESPForecastingSystem/total.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases) +[![GitHub release](https://img.shields.io/github/release/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases) [![GitHub top language](https://img.shields.io/github/languages/top/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem) [![GitHub issues](https://img.shields.io/github/issues/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/issues) [![GitHub last commit](https://img.shields.io/github/last-commit/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/commits/master) [![GitHub All Releases](https://img.shields.io/github/downloads/cemac/UNRESPForecastingSystem/total.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases) ![GitHub](https://img.shields.io/github/license/cemac/UNRESPForecastingSystem.svg) [![DOI](https://zenodo.org/badge/131827149.svg)](https://zenodo.org/badge/latestdoi/131827149) +[![HitCount](http://hits.dwyl.com/{cemac}/{UNRESPForecastingSystem}.svg)](http://hits.dwyl.com/{cemac}/{UNRESPForecastingSystem}) +
@@ -15,58 +17,110 @@ Repository for the [UNRESP](https://vumo.cloud/) Forecasting System: An automated forecasting system has been created that uses the [CALPUFF](http://www.src.com/) dispersion model to predict S02 and S04 concentrations around the Masaya volcano. This is based on the current forecasting system implemented by IMO, but with modifications and improvements. This work is displayed at: [homepages.see.leeds.ac.uk/~earunres](https://homepages.see.leeds.ac.uk/~earunres) +Documentation can be accessed at [https://cemac.github.io/UNRESPForecastingSystem/](https://cemac.github.io/UNRESPForecastingSystem/) + +The repository hosts the scripts required to run the CALPUFF dispersion model to predict SO2 concentrations around the Masaya volcano forecasting for 48 hours using NAM data. The hourly output is plotted in individual png and googlemaps files (visualisation can be turned on or off). + +## [DOCUMENTATION](https://github.com/cemac/UNRESPForecastingSystem/wiki) ## +**Full** Documentation can be found on this Repository's [wiki](https://github.com/cemac/UNRESPForecastingSystem/wiki) -## Description ## +Summary documention +- [Requirements](#Requirements) +- [Installation](#Installation) +- [Usage-Quick-Start](#Usage-Quick-Start) +- [Visualization](#Visualization) +- [Contributions](#Contributions) +- [Licence](#Licence) +- [Acknowledgements](#Acknowledgements) -The repository hosts the scripts required to run the CALPUFF dispersion model to predict SO2 concentrations around the Masaya volcano forecasting for 48 hours using NAM data. The hourly output is plotted in individual png files and collated into a mp4 movie. +- [Full-User-Guide](https://github.com/cemac/UNRESPForecastingSystem/wiki/User-Guide) +- [Developer-Guide](https://github.com/cemac/UNRESPForecastingSystem/wiki/Developer-Guide) ## Requirements ## * UNIX operating system (tested: CentOS Ubuntu) -* [anaconda python](https://www.anaconda.com/distribution/#download-section)(recommended code works in python 2 and 3) - * requirements in environment.yml (python 3) - * non environment set up can be followed using requirements.txt if desired +* [anaconda python](https://www.anaconda.com/distribution/#download-section)(recommended code works in python 2 and 3) (conda => 4.7.1 recommended) + * requirements in `environment.yml` (python 3) + * Analysis code requires additional packages covered in `unresp_analysis.yml` instead of environment.yml * Intel compiler **OR** executables and library (only for similar architecture as built) Non anaconda installations require a separate build of ecCodes python API: * [ecCodes python API](https://confluence.ecmwf.int//display/ECC/Releases) + * non environment set up can be followed using requirements.txt if desired -## Installation +## Installation ## -Anaconda python, unix systems (recommended) +Anaconda python (conda 4.7.1), unix systems (recommended), intel compilers or compiled executables ``` git clone https://github.com/cemac/UNRESPForecastingSystem.git cd UNRESPForecastingSystem +./installcalpuff.sh conda env create -f environment.yml ``` -## Usage ## +## Usage Quick-Start ## -For external users, once installed to run full forecast and visualisation with default options: +Once installed to run full forecast and visualisation with default options: ```bash cd $HOME/UNRESPForecastingSystem -./Run_ext.sh +./Run.sh -p ``` **NB** If no intel compilers the executables and libraries must be copied over to CALPUFF_EXE -For help run `.\Run_ext.sh -h` +For help run `.\Run.sh -h` ``` - optional arguments: - -d YYYYMMDD DEFAULT: - -n name of viz defaults to $HOME/UNRESPForecastingSystem/VIZ_SITE_CODE + Run.sh + + A CEMAC script to Run CALPUFF WITH NAM DATA input + winds and produces plots of SO2 and SO4. + + Usage: + .\Run.sh + + No options runs a default production configuration: + + Today, Viz off. 48 hours. + + Options: + -d YYYYMMDD DEFAULT: + -v name of viz defaults to UNRESPForecastingSystem/VIZ_SITE_CODE + -n forescast hours defaults to 48 + -x resolution in m (100 < x < 1000) + ** The following switches can be used to overwrite Default behaviour. - -m turn OFF FORECAST Model (e.g. to run viz option only) - -p turn OFF viz steps (no jpgs etc to be produced) + + DEFAULT: output todays SO2 concrec files on topography + background + ** + -m turn OFF Forecasting model + -p turn ON viz steps: default to SO2 on topography only + -a turn ON all viz options except ffmpeg + -b plot BOTH SO2 and SO4 + -t output BOTH satellite and topo backgrounds + -g turn ON GOOGLE PLOTS + -r SWITCH to satellite background + -s SWITCH to SO4 + -y plot ONLY GOOGLE PLOTS -f turn ON ffmpeg mp4 production + -h HELP: prints this message! + + ** TROUBLESHOOTING + * Missing .so file --> most like intel library + Try loading system intel e.g. module load intel or set LD_LIBRARY_PATH + * Missing python modules --> mostly likely conda environment failure + try `source activate unresp` + or `conda activate unresp` + or `load your system python libraries` + ^^^ these fixes can be added to .env file for bespoke Setup ``` -Run.sh is set up default to leeds production behaviour to run as a chronjob displaying at [~earunres](https://homepages.see.leeds.ac.uk/~earunres/UNRESP_VIZ/index.html) +## Visualization The output can be viewed by running: @@ -76,75 +130,54 @@ python -m http.server ``` And opening http://0.0.0.0:8000/ in any browser -## Further Usage notes - -* In Run.sh various parameters can be set: - 1. `res` to alter the resolution between 100 - 1000 m - 2. `runVis=True` Enable visualization creating static and movie visualisations of the CALPUFF model output via a python script (generateMaps.py) and the Linux tool 'ffmpeg', respectively. - 3. `runTERREL=true` - The part of the CALPUFF - 4. `runCTGPROC=true` - The part of the CALPUFF system that grids the land-use data - 5. `runMAKEGEO=true` - The part of the CALPUFF system that combines the gridded terrain and land-use data into a file appropriate for input to CALMET - 6. `run3DDAT=true` - Downloads the required met (NAM) data and runs a python script (Create3DDAT.py) to extract the required data into a file appropriate for input to CALMET. - 7. `runCALMET=true` - The 3-D diagnostic meteorological model part of the CALPUFF system - 8. `runCALPUFF=true` - The main dispersion model part of the CALPUFF system -* To forecast for the current day default visualization home to ~earunres (production): - ```bash - ./Run.sh - ``` -* To forecast for a specific day: - ```bash - ./Run.sh -d YYYYMMDD - ``` - Note, however, that the external met (NAM) data that the script will try to download is only accessible for around 10 days after the original date before it is removed from the ftp site. -* Chronjobs: 2 chronjobs are required - 1 . Everyday at 10.30am run the forecast - ```bash - 30 10 * * * cd && ./Run.sh - ``` - 2. Everyday at 10.30am etches the IMO CALPUFF output and plots it onto a map for viewing on the web [here](http://homepages.see.leeds.ac.uk/~earunres/masayaSO2.html). - ```bash - 30 10 * * * makeMasayaFig.gmt - ``` - 3. transfers the output data from the forecast runs to the shared UNRESP space on the N-drive at 10:45am - ```sh - 45 10 * * * updateNDrive.sh - ``` +All the code can be transported to desired location e.g. Apache server and the +forecasting scripts ran with a `-n` option to move to that location. -
+Currently 2 versions of the web vizulisation tool exist: -## Overview of Repository ## +1. Full: all output generated, SO2, SO4, googlemaps, satellite and topography plots +2. Light: SO2 and SO4, only on topography plots (if running daily and want reduced output) -The directory structure of the repository is as follows: -- The source code for the various parts of the CALPUFF system is stored in subdirectory `CALPUFF_SRC`. The source data corresponds to Version 7, which is downloadable from [here](http://www.src.com/calpuff/download/mod7_codes.htm), with a few minimal code changes required to allow the model to be built on a Linux system with Intel compilers; these changes are described in [this](https://github.com/cemac/UNRESP/blob/master/Docs/CEMACUserGuide_UNRESP.tex) version-controlled file. -- All user-editable input files for the various parts of the CALPUFF system are stored in subdirectory `CALPUFF_INP`. Template versions of these files have been set up specifically for the Masaya case and are version controlled. Various run-specific fields (e.g. run date) are then filled in at run-time. Information about setting up these input files for the Masaya case is also within [this](https://github.com/cemac/UNRESP/blob/master/Docs/CEMACUserGuide_UNRESP.tex) file. -- All other input data files are stored in the `data` subdirectory. These include the 90m resolution DEM data files from the SRTM 3-sec dataset covering the Masaya region (4 .bil files), the old 1km resolution DEM data file from the GTOPO30 dataset (w100n40.dem) which isn't used any more but is retained for reference, the USGS land-use data file covering North/Central America (nalulcl20.bil), and a two-column file of UTM zone 16P coordinates which specify discrete receptor points at which we want output data (xy_masaya.dat). Some of the output files from parts of the forecasting system that serve as input files to subsequent parts are also copied into this directory during run-time. -- All executables for the various parts of the CALPUFF system are stored in subdirectory `CALPUFF_EXE`. These are not version-controlled but will be built automatically with the run script is first used. They are only then rebuilt if deleted, so if you make any changes to the source code, be sure to delete the old executables so that new ones are made. -- All output from the various parts of the CALPUFF system are moved to within subdirectory `CALPUFF_OUT` during runtime. -- All downloaded and processed NAM data during run-time are stored within subdirectory `NAM_data`. -- All visualisation output data files are stored within subdirectory `vis`. -- All python scripts are stored within subdirectory `Python`. +to use full: -
+```bash +cd $HOME/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/_includes/ +ln -sf navbar_full.html navbar.html +ln -sf navbar_sensors_full.html navbar_sensors.html +``` - -| Version | Release | -|---------------------|------------------| -| **UoL 2018** | [![GitHubrelease](https://img.shields.io/badge/release-v.1.0-blue.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases/tag/v1.0) | -| **Current Stable** | [![GitHubrelease](https://img.shields.io/badge/release-v.2.2-blue.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases/tag/v2.2) | -| **SO4** | *coming soon* | - +to use light: + +```bash +cd $HOME/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/_includes/ +ln -sf navbar_light.html navbar.html +ln -sf navbar_sensors_light.html navbar_sensors.html +``` + +
## Contributions ## -## Licence information ## +*coming soon: issues/suggestions - documentation improvements - code improvements/developments welcome* + -*Coming soon* +## Licence ## + +*This code is Open Source EXCEPT the CALPUFF code you will download*. The code changes to set up the model to run +CALPUFF for Masaya Region, forecast pipeline tools (preprocessing, postprocessing and visualisation), Python tools and static site image viewer (VIZ_SITE_CODE) are all covered under the MIT Licence.
## Acknowledgements ## -*Coming soon* -*IMO, UoL, Exponent* +This repository has been developed in Collaboration with Sara Barsotti (Icelandic meteorological office), + Evgenia Ilyinskaya (University of Leeds) as well as the code authors in the commit history. The Air quality sensor data stored in the visualization folders was produced in Collaboration with INITER. + +Resources & References: +* Calpuff model code provided by Exponent +* *Scire, J.S., F.R. Robe, M.E. Fernau, and R.J. Yamartino. 2000a. A User’s Guide for the CALMET Meteorological Model(Version5). Tech. Rep.,EarthTech,Inc., Concord, MA 332pp.( + [CALMET_UsersGuide.pdf](http://www.src.com/calpuff/download/CALMET_UsersGuide.pdf)).* +* *Scire, J.S., D.G. Strimaitis, and R.J.Yamartino. 2000b. A User’s Guide for the CALPUFF Dispersion Model(Version5),Tech.Rep.,EarthTech,Inc.,Concord,MA,521pp.( + [CALPUFF_UsersGuide.pdf](http://www.src.com/calpuff/download/CALPUFF_UsersGuide.pdf)).*
diff --git a/Run.sh b/Run.sh index 7d0d7e5..c2aed64 100755 --- a/Run.sh +++ b/Run.sh @@ -1,18 +1,29 @@ -#!/usr/bin/bash --login +#!/usr/bin/bash - -#This script was created by CEMAC (University of Leeds) as part of the UNRESP -#Project -#Setup environment -set -e #stop at first error -module load intel/17.0.0 -module load python2 python-libs - -# Defaults that can be overwritten via command line -rundate=$(date +%Y%m%d) -vizhome=~earunres -runVIS=true -runSO4=true -runffmpeg=false +# This script was created by CEMAC (University of Leeds) as +# part of the UNRESP Project +# Setup environment (should not need to be edited) +set -e # stop at first error +# load modules (Leeds) +if [ $USER == earmgr ]; then + module load intel/17.0.0 + module load python2 python-libs + # For Mark only: + export PYTHONPATH="/nfs/see-fs-02_users/earmgr/SW/eccodes-2.6.0/lib/python2.7/site-packages:${PYTHONPATH}" + vizhome=~earunres +else + if [ $CONDA_DEFAULT_ENV != unresp ]; then + echo "trying to activate unresp python environment..." + eval "$(conda shell.bash hook)" + conda activate + conda activate unresp + fi + # Put any bespoke setup steps in .env + source .env + vizhome=$HOME/UNRESPForecastingSystem/VIZ_SITE_CODE +fi +# Resolution (m) of intended CALPUFF grid. 100 < (integer) < 1000 +res=500 # Defaults that can be overwritten by editing HERE: # Command line option m switches all to false runTERREL=true @@ -23,6 +34,36 @@ runCALMET=true runCALPUFF=true runmodel=true +set -e # stop at first error +# Set other parameters (unlikely to need editing) +let NX=90000/$res+1 +let NY=54000/$res+1 +DGRIDKM=$(echo "scale=3; $res/1000" | bc) +let MESHGLAZ=1000/$res+1 +cwd=$(pwd) +# Number of nam files for 48 hours +NAMno=17 + +#------------------------------------------------------------------------# +#------------------- DO NOT ALTER BELOW THIS LINE------------------------# +#------------------------------------------------------------------------# + +# COMMAND LINE FLAG HANDELING # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # + +# Defaults that can be overwritten via command line +rundate=$(date +%Y%m%d) +numhours=48 +runVIS=false +runallVIS=false +rungoogle=false +runsatellite=false +runtopo=false +runSO4=false +runSO2=false +runSO24=false +runffmpeg=false + print_usage() { echo " Run.sh @@ -34,29 +75,130 @@ print_usage() { .\Run.sh No options runs a default production configuration: - Today, Viz on, plots production area (~earunres). + Today, Viz off, 48 hours. Options: -d YYYYMMDD DEFAULT: - -n name of viz defaults to ~earunres + -v name of viz defaults to UNRESPForecastingSystem/VIZ_SITE_CODE + -n forescast hours defaults to 48 + -x resolution in m (100 < x < 1000) ** The following switches can be used to overwrite Default behaviour. + + DEFAULT: output todays SO2 concrec files on topography + background ** - -m turn OFF Forecasting model (e.g to run viz only) - -p turn OFF viz steps (no jpgs etc to be produced) + -m turn OFF Forecasting model + -p turn ON viz steps: default to SO2 on topography only + -a turn ON all viz options except ffmpeg + -b plot BOTH SO2 and SO4 + -t output BOTH satellite and topo backgrounds + -g turn ON GOOGLE PLOTS + -r SWITCH to satellite background + -s SWITCH to SO4 + -y plot ONLY GOOGLE PLOTS -f turn ON ffmpeg mp4 production + -h HELP: prints this message! + long options are currently not avaible. - " + + ------------------------------------------------ + + Other Code Possible Options: + + The model is split into various components, these can + be induvidually turned on or off for development purposes + via editing the upper part of this script. + + runTERREL=true + runCTGPROC=true + runMAKEGEO=true + run3DDAT=true + runCALMET=true + runCALPUFF=true + runmodel=true + +** TROUBLESHOOTING + * Missing .so file --> most like intel library + Try loading system intel e.g. module load intel or set LD_LIBRARY_PATH + * Missing python modules --> mostly likely conda environment failure + try `source activate unresp` + or `conda activate unresp` + or `load your system python libraries` + ^^^ these fixes can be added to .env file for bespoke Setup + + " } set_viz() { - runVIS=false + # description flags + runVIS=true + runSO2=true + runtopo=true + # code option + SOopt=" --SO2 " + vizopt=" --topo " +} + +set_allviz() { + # description flags + runallVIS=true + runVIS=true + runtopo=true + runSO24=true + rungoogle=ture + runsatellite=false + # code option + vizopt=" --all " + SOopt=" --SO2 --SO4 " } set_SO4() { + # description flags + runSO4=true + runSO2=false + # code option + SOopt=" --SO4 " +} + +set_SO24() { + # description flags + runSO24=true + runSO2=false runSO4=false + # code option + SOopt=" --SO2 --SO4 " +} + +add_google() { + googleopt=" --google " +} +only_google() { + # description flags + rungoogle=ture + runsatellite=false + runtopo=false + # code option + vizopt=" --google " +} + +set_satellite() { + # description flags + runsatellite=true + runtopo=false + # code option + vizopt=" --satellite " +} + +set_sattopo() { + # description flags + runsatellite=true + runtopo=true + # code option + vizopt=" --topo --satellite" } + set_ffmpeg() { runffmpeg=true } @@ -70,35 +212,153 @@ set_model() { runCALPUFF=false runmodel=false } -while getopts 'd:n:pmsfh' flag; do +while getopts 'd:n:v:x:pamsbgrtyfh' flag; do case "${flag}" in d) rundate="${OPTARG}" ;; - n) vizhome="${OPTARG}" ;; + n) numhours="${OPTARG}" ;; + v) vizhome="${OPTARG}" ;; + x) res="${OPTARG}" ;; p) set_viz ;; + a) set_allviz ;; m) set_model ;; s) set_SO4 ;; + b) set_SO24 ;; + y) set_google ;; + y) only_google ;; + r) set_satellite ;; + t) set_sattopo ;; f) set_ffmpeg ;; h) print_usage - exit 1 ;; + exit 1 ;; *) print_usage - exit 1 ;; + exit 1 ;; esac done +## Checking for inconsistent flags + +has_param() { + local term="$1" + shift + for arg; do + if [[ $arg == "$term" ]]; then + return 0 + fi + done + return 1 +} + +# SO24 +if has_param '-b' "$@" ; then +if has_param '-s' "$@" ; then + echo "WARNING: inconsistent settings" + echo "-b sets both SO2 and SO4" + echo "-s sets ONLY SO4" + exit 0 +fi +fi + +# plot both +if has_param '-t' "$@" ; then +if has_param '-r' "$@" ; then + echo "WARNING: inconsistent settings" + echo "-t sets both satellite and topography" + echo "-r sets ONLY statellite" + exit 0 +fi +if has_param '-y' "$@" ; then + echo "WARNING: inconsistent settings" + echo "-t sets both satellite and topography" + echo "-y sets ONLY googleplots" + exit 0 +fi +fi + +if ! has_param '-p' "$@" ; then + if has_param '-b' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-s' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-g' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-y' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-r' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-t' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-f' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-a' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi +fi + +# Description of Settings # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # + echo 'Running with the following options set:' +echo 'CALPUFF grid resolution: ' $res echo 'date: '$rundate +echo 'forecast hours: ' $numhours echo 'run model: '$runmodel +echo 'resoltuion: '$res echo 'vizulisation: '$runVIS -echo 'SO4 output: '$runSO4 -echo 'make mp4: ' $runffmpeg -# VISUALISATION PATH --> public_html/UNRESP_VIZ/ folders must exist in -# viz destination. -VIZPATH=$vizhome/public_html/UNRESP_VIZ/ -echo 'vizulisation output to: '$VIZPATH - -prevdate=$(date -d "$rundate - 1 day" +%Y%m%d) -middate=$(date -d "$rundate + 1 day" +%Y%m%d) -enddate=$(date -d "$rundate + 2 days" +%Y%m%d) +if [ ${runVIS} = true ]; then + echo 'vizulisation options:' + echo '..defaults..' + echo 'basic plots on: '$runtopo + echo 'plot SO2: '$runSO2 + echo '..extra..' + echo 'plot BOTH SO2 and SO4: '$runSO24 + echo 'plot ONLY SO4: '$runSO4 + echo 'include goolge htmls: '$rungoogle + echo 'plot ONLY SO4: '$runSO4 + echo 'plot ONLY high res set_satellite: '$runsatellite + echo 'make mp4: ' $runffmpeg + # VISUALISATION PATH --> public_html/UNRESP_VIZ/ folders must exist in + # viz destination. + VIZPATH=$vizhome/public_html/UNRESP_VIZ/ + echo 'vizulisation output to: '$VIZPATH +fi + +if [ ${runVIS} = false ] && [ ${runmodel} = false ]; then + echo 'running model and vizulisation turned off' + echo 'terminating programme' + echo 'plrease review options' + print_usage + exit 1 +fi + +# RUN DATE # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # +case $numhours in + 48) + prevdate=$(date -d "$rundate - 1 day" +%Y%m%d) + middate=$(date -d "$rundate + 1 day" +%Y%m%d) + enddate=$(date -d "$rundate + 2 days" +%Y%m%d) + ;; + 24) + prevdate=$(date -d "$rundate + 0 day" +%Y%m%d) + middate=$(date -d "$rundate + 1 day" +%Y%m%d) + enddate=$(date -d "$rundate + 1 days" +%Y%m%d) + ;; +esac startYear=${rundate:0:4} startMonth=${rundate:4:2} startDay=${rundate:6:2} @@ -109,151 +369,141 @@ endYear=${enddate:0:4} endMonth=${enddate:4:2} endDay=${enddate:6:2} -#Set other parameters -res=1000 #Resolution (m) of intended CALPUFF grid. 100 < (integer) < 1000 -let NX=90000/$res+1 -let NY=54000/$res+1 -DGRIDKM=$(echo "scale=3; $res/1000" | bc) -let MESHGLAZ=1000/$res+1 - -cwd=$(pwd) - - -#------------------------------------------------------------------------# -#------------------- DO NOT ALTER BELOW THIS LINE------------------------# -#------------------------------------------------------------------------# +# RUN MODEL # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # if [ "$runmodel" = true ]; then -echo "### RUNNING FORECAST SYSTEM FOR DATE "${rundate}" ###" + echo "### RUNNING FORECAST SYSTEM FOR DATE "${rundate}" ###" fi -###TERREL### +### TERREL ### if [ "$runTERREL" = true ]; then - #Compile TERREL if required: + # Compile TERREL if required: cd CALPUFF_EXE if [ ! -f ./terrel_intel.exe ]; then - echo -n "### COMPILING TERREL" + echo -n "### COMPILING TERREL" ifort -O0 -fltconsistency -w ../CALPUFF_SRC/TERREL/terrel.for -o terrel_intel.exe - echo " ---> FINISHED ###" + echo " ---> FINISHED ###" else - echo "### TERREL ALREADY COMPILED ###" + echo "### TERREL ALREADY COMPILED ###" fi cd .. - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD TERREL OUTPUT FILES" rm -rf *.dat *.grd *.lst *.sav *.log cd CALPUFF_OUT/TERREL find . ! -name 'README' -type f -exec rm -f {} + cd ../.. echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP TERREL INPUT FILE" sed -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/terrel_template.inp > ./CALPUFF_INP/terrel.inp echo " ---> FINISHED ###" - #Run TERREL: + # Run TERREL: echo "### RUNNING TERREL" ./CALPUFF_EXE/terrel_intel.exe ./CALPUFF_INP/terrel.inp > terrel.log echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING TERREL OUTPUT FILES" mv *.dat *.grd *.lst *.sav *.log ./CALPUFF_OUT/TERREL/. echo " ---> FINISHED ###" fi -###CTGPROC### +### CTGPROC ### if [ "$runCTGPROC" = true ]; then - #Compile CTGPROC if required: + # Compile CTGPROC if required: cd CALPUFF_EXE if [ ! -f ./ctgproc_intel.exe ]; then - echo -n "### COMPILING CTGPROC" - ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CTGPROC/ctgproc.for -o ctgproc_intel.exe - echo " ---> FINISHED ###" + echo -n "### COMPILING CTGPROC" + ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CTGPROC/ctgproc.for -o ctgproc_intel.exe + echo " ---> FINISHED ###" else - echo "### CTGPROC ALREADY COMPILED ###" + echo "### CTGPROC ALREADY COMPILED ###" fi cd .. - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD CTGPROC OUTPUT FILES" rm -rf *.dat *.lst *.log cd CALPUFF_OUT/CTGPROC find . ! -name 'README' -type f -exec rm -f {} + cd ../.. echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP CTGPROC INPUT FILE" sed -e "s/?MESHGLAZ?/$MESHGLAZ/g" -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/ctgproc_template.inp > ./CALPUFF_INP/ctgproc.inp echo " ---> FINISHED ###" - #Run CTGPROC: + # Run CTGPROC: echo "### RUNNING CTGPROC" ./CALPUFF_EXE/ctgproc_intel.exe ./CALPUFF_INP/ctgproc.inp > ctgproc.log echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING CTGPROC OUTPUT FILES" mv *.dat *.lst *.log ./CALPUFF_OUT/CTGPROC/. echo " ---> FINISHED ###" fi -###MAKEGEO### +### MAKEGEO ### if [ "$runMAKEGEO" = true ]; then - #Compile MAKEGEO if required: + # Compile MAKEGEO if required: cd CALPUFF_EXE if [ ! -f ./makegeo_intel.exe ]; then - echo -n "### COMPILING MAKEGEO" - ifort -O0 -fltconsistency -w ../CALPUFF_SRC/MAKEGEO/makegeo.for -o makegeo_intel.exe - echo " ---> FINISHED ###" + echo -n "### COMPILING MAKEGEO" + ifort -O0 -fltconsistency -w ../CALPUFF_SRC/MAKEGEO/makegeo.for -o makegeo_intel.exe + echo " ---> FINISHED ###" else - echo "### MAKEGEO ALREADY COMPILED ###" + echo "### MAKEGEO ALREADY COMPILED ###" fi cd .. - #Copy data files from TERREL and CTGPROC across to the data directory + # Copy data files from TERREL and CTGPROC across to the data directory echo -n "### COPYING GEO DATA FILES ACROSS" cp -f ./CALPUFF_OUT/TERREL/masaya.dat data/. cp -f ./CALPUFF_OUT/CTGPROC/lulc1km_masaya.dat data/. echo " ---> FINISHED ###" - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD MAKEGEO OUTPUT FILES" rm -rf *.dat *.lst *.clr *.log *.grd cd CALPUFF_OUT/MAKEGEO find . ! -name 'README' -type f -exec rm -f {} + cd ../.. echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP MAKEGEO INPUT FILE" sed -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/makegeo_template.inp > ./CALPUFF_INP/makegeo.inp echo " ---> FINISHED ###" - #Run MAKEGEO: + # Run MAKEGEO: echo "### RUNNING MAKEGEO" ./CALPUFF_EXE/makegeo_intel.exe ./CALPUFF_INP/makegeo.inp > makegeo.log echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING MAKEGEO OUTPUT FILES" mv *.dat *.lst *.clr *.log *.grd ./CALPUFF_OUT/MAKEGEO/. echo " ---> FINISHED ###" fi -###NAM data### +# GET AND PROCESS NAM DATA # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # if [ "$run3DDAT" = true ]; then - ##Download NAM data if required: - #How many files downloaded already?: + ## Download NAM data if required: + # How many files downloaded already?: if [ -d ./NAM_data/raw/${rundate} ]; then eval numfiles=$(ls ./NAM_data/raw/${rundate} | wc -l) else numfiles=0 fi - #if not 17 files, need to download more: - if [ ${numfiles} != 17 ]; then + # if not correct no files, need to download more: + if [ ${numfiles} != $NAMno ]; then echo "### ATTEMPTING TO DOWNLOAD NAM DATA" - #Make data directory if required: + # Make data directory if required: if [ ! -d ./NAM_data/raw/${rundate} ]; then mkdir NAM_data/raw/${rundate} fi cd NAM_data/raw/${rundate} - #Download each NAM data file if required: + # Download each NAM data file if required: for i in `seq 0 3 48`; do hour=`printf "%02d" $i` if [ ! -f nam.t00z.afwaca${hour}.tm00.grib2 ]; then echo "### DOWNLOADING DATA FOR FORECAST HOUR "${hour}" ###" - #Entire GRIB file: - #wget http://www.ftp.ncep.noaa.gov/data/nccf/com/nam/prod/nam.${rundate}/nam.t00z.afwaca${hour}.tm00.grib2 - #Subset of GRIB file using GRIB filter (http://nomads.ncep.noaa.gov/cgi-bin/filter_nam_crb.pl): + # Entire GRIB file: + # wget http://www.ftp.ncep.noaa.gov/data/nccf/com/nam/prod/nam.${rundate}/nam.t00z.afwaca${hour}.tm00.grib2 + # Subset of GRIB file using GRIB filter (http://nomads.ncep.noaa.gov/cgi-bin/filter_nam_crb.pl): #WARNING https not http as of Jan 2019 curl "https://nomads.ncep.noaa.gov/cgi-bin/filter_nam_crb.pl?file=nam.t00z.afwaca"${hour}".tm00.grib2&"\ "lev_1000_mb=on&lev_100_mb=on&lev_10_mb=on&lev_150_mb=on&lev_200_mb=on&lev_20_mb=on&lev_250_mb=on&"\ @@ -267,7 +517,15 @@ if [ "$run3DDAT" = true ]; then cd ../../.. echo " ---> FINISHED ###" fi - #Extract NAM data into CALMET input file format: + # CHECK files are all as expected! + cd NAM_data/raw/${rundate} + eval checkgrib=$(file -b --mime-type * | sed 's|/.*||' | grep text | wc -l) + cd ../../.. + # Extract NAM data into CALMET input file format: + if [ ${checkgrib} != 0 ]; then + echo "Grib check failed, check internet connect or NAM data availability" + exit 0 + fi echo "### EXTRACTING NAM DATA INTO CALMET INPUT FILE FORMAT" rm -f NAM_data/processed/met_${rundate}.dat cd Python @@ -276,72 +534,72 @@ if [ "$run3DDAT" = true ]; then echo " ---> FINISHED ###" fi -###CALMET### +### CALMET ### if [ "$runCALMET" = true ]; then - #Compile CALMET if required: + # Compile CALMET if required: cd CALPUFF_EXE if [ ! -f ./calmet_intel.exe ]; then - echo -n "### COMPILING CALMET" - ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALMET/calmet.for -o calmet_intel.exe - echo " ---> FINISHED ###" + echo -n "### COMPILING CALMET" + ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALMET/calmet.for -o calmet_intel.exe + echo " ---> FINISHED ###" else - echo "### CTGPROC ALREADY COMPILED ###" + echo "### CALMET ALREADY COMPILED ###" fi cd .. - #Remove any old data files and copy relevant new files into the data directory + # Remove any old data files and copy relevant new files into the data directory echo -n "### SETTING UP DATA DIRECTORY" rm -f data/geo_masaya.dat cp -f ./CALPUFF_OUT/MAKEGEO/geo_masaya.dat data/. rm -f data/met_*.dat cp -f ./NAM_data/processed/met_${rundate}.dat data/. echo " ---> FINISHED ###" - #Remove any old CALMET files before running: + # Remove any old CALMET files before running: echo -n "### DELETING ANY OLD CALMET OUTPUT FILES" rm -rf *.dat *.DAT *.bna *.lst *.aux rm -rf ./CALPUFF_OUT/CALMET/${rundate} echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP CALMET INPUT FILE" sed -e "s/YYYYb/$startYear/g" -e "s/MMb/$startMonth/g" -e "s/DDb/$startDay/g" -e "s/YYYYe/$endYear/g" \ -e "s/MMe/$endMonth/g" -e "s/DDe/$endDay/g" -e "s/?3DDAT?/met_${rundate}.dat/g" \ -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/calmet_template.inp > ./CALPUFF_INP/calmet.inp echo " ---> FINISHED ###" - #Run CALMET: + # Run CALMET: echo "### RUNNING CALMET" ./CALPUFF_EXE/calmet_intel.exe ./CALPUFF_INP/calmet.inp echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING CALMET OUTPUT FILES" mkdir ./CALPUFF_OUT/CALMET/${rundate} mv *.dat *.DAT *.bna *.lst *.aux ./CALPUFF_OUT/CALMET/${rundate}/. echo " ---> FINISHED ###" fi -###CALPUFF### +### CALPUFF ### if [ "$runCALPUFF" = true ]; then - #Compile CALPUFF if required: + # Compile CALPUFF if required: if [ ! -f ./CALPUFF_EXE/calpuff_intel.exe ]; then - echo -n "### COMPILING CALPUFF" - cd CALPUFF_SRC/CALPUFF - ifort -c modules.for - cd ../../CALPUFF_EXE - ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALPUFF/calpuff.for ../CALPUFF_SRC/CALPUFF/modules.o -o calpuff_intel.exe - cd .. - echo " ---> FINISHED ###" + echo -n "### COMPILING CALPUFF" + cd CALPUFF_SRC/CALPUFF + ifort -c modules.for + cd ../../CALPUFF_EXE + ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALPUFF/calpuff.for ../CALPUFF_SRC/CALPUFF/modules.o -o calpuff_intel.exe + cd .. + echo " ---> FINISHED ###" else - echo "### CALPUFF ALREADY COMPILED ###" + echo "### CALPUFF ALREADY COMPILED ###" fi - #Remove old and copy new CALMET data file across to the data directory + # Remove old and copy new CALMET data file across to the data directory echo -n "### SETTING UP DATA DIRECTORY" rm -f data/calmet_*.dat cp -f ./CALPUFF_OUT/CALMET/${rundate}/calmet.dat data/calmet_${rundate}.dat echo " ---> FINISHED ###" - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD CALPUFF OUTPUT FILES" rm -rf *.con *.lst *.dat *.clr *.bna *.grd rm -rf ./CALPUFF_OUT/CALPUFF/${rundate} echo " ---> FINISHED ###" - #Set up input file for first 24hrs: + # Set up input file for first 24hrs: echo -n "### SETTING UP CALPUFF INPUT FILE FOR FIRST 24 HOURS" if [ -f ./CALPUFF_OUT/CALPUFF/${prevdate}/restart_${rundate}.dat ]; then mres=3 @@ -357,58 +615,65 @@ if [ "$runCALPUFF" = true ]; then -e "s/?MRES?/$mres/g" -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" \ ./CALPUFF_INP/calpuff_template.inp > ./CALPUFF_INP/calpuff.inp echo " ---> FINISHED ###" - #Run CALPUFF for first 24 hours: + # Run CALPUFF for first 24 hours: echo "### RUNNING CALPUFF FOR FIRST 24 HOURS" ./CALPUFF_EXE/calpuff_intel.exe ./CALPUFF_INP/calpuff.inp echo " ---> FINISHED ###" - #Move output files from first 24 hours: + # Move output files from first 24 hours: echo -n "### MOVING CALPUFF OUTPUT FILES FROM FIRST 24 HOURS" mkdir ./CALPUFF_OUT/CALPUFF/${rundate} mv concrec*.dat restart_${middate}.dat ./CALPUFF_OUT/CALPUFF/${rundate}/. rm -rf *.con *.lst *.dat *.clr *.bna *.grd - cp CALPUFF_OUT/CALPUFF/${rundate}/restart_${middate}.dat . - echo " ---> FINISHED ###" - #Set up input file for second 24hrs: - echo -n "### SETTING UP CALPUFF INPUT FILE FOR SECOND 24 HOURS" - sed -e "s/YYYYb/$midYear/g" -e "s/MMb/$midMonth/g" -e "s/DDb/$midDay/g" -e "s/YYYYe/$endYear/g" \ + if [ ${numhours} == 48 ] ; then + cp CALPUFF_OUT/CALPUFF/${rundate}/restart_${middate}.dat . + echo " ---> FINISHED ###" + # Set up input file for second 24hrs: + echo -n "### SETTING UP CALPUFF INPUT FILE FOR SECOND 24 HOURS" + sed -e "s/YYYYb/$midYear/g" -e "s/MMb/$midMonth/g" -e "s/DDb/$midDay/g" -e "s/YYYYe/$endYear/g" \ -e "s/MMe/$endMonth/g" -e "s/DDe/$endDay/g" -e "s/?METDAT?/calmet_${rundate}.dat/g" \ -e "s/?RSTARTB?/restart_$middate.dat/g" -e "s/?RSTARTE?/restart_$enddate.dat/g" \ -e "s/?MRES?/1/g" -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" \ ./CALPUFF_INP/calpuff_template.inp > ./CALPUFF_INP/calpuff.inp - echo " ---> FINISHED ###" - #Run CALPUFF for second 24 hours: - echo "### RUNNING CALPUFF FOR SECOND 24 HOURS" - ./CALPUFF_EXE/calpuff_intel.exe ./CALPUFF_INP/calpuff.inp - echo " ---> FINISHED ###" - #Rename and move output files from second 24 hours: - echo -n "### RENAMING AND MOVING CALPUFF OUTPUT FILES FROM SECOND 24 HOURS" - for i in `seq 1 24`; do - let "j = i + 24" - i2=`printf "%02d" $i` - j2=`printf "%02d" $j` - mv concrec0100${i2}.dat concrec0100${j2}.dat - mv concrec0200${i2}.dat concrec0200${j2}.dat - done - mv concrec*.dat ./CALPUFF_OUT/CALPUFF/${rundate}/. - rm -rf *.con *.lst *.dat *.clr *.bna *.grd - echo " ---> FINISHED ###" + echo " ---> FINISHED ###" + # Run CALPUFF for second 24 hours: + echo "### RUNNING CALPUFF FOR SECOND 24 HOURS" + ./CALPUFF_EXE/calpuff_intel.exe ./CALPUFF_INP/calpuff.inp + echo " ---> FINISHED ###" + # Rename and move output files from second 24 hours: + echo -n "### RENAMING AND MOVING CALPUFF OUTPUT FILES FROM SECOND 24 HOURS" + for i in `seq 1 24`; do + let "j = i + 24" + i2=`printf "%02d" $i` + j2=`printf "%02d" $j` + mv concrec0100${i2}.dat concrec0100${j2}.dat + mv concrec0200${i2}.dat concrec0200${j2}.dat + done + mv concrec*.dat ./CALPUFF_OUT/CALPUFF/${rundate}/. + rm -f *.con *.lst *.dat *.clr *.bna *.grd + echo " ---> FINISHED ###" + fi fi -###VISUALISATION### -if [ "$runVIS" = true ]; then +# RUN VISUALIZATION # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # +if [ ${runVIS} = true ]; then echo "### RUNNING VISUALISATION TOOLS" rm -rf ./vis/${rundate} mkdir ./vis/${rundate} cd Python - if [ "$runSO4" = true ]; then - ./genmaps.py ${rundate} - else - ./genmaps.py ${rundate} + case $numhours in + 48) + python genmaps.py $rundate $vizopt $SOopt $googleopt + ;; + 24) + python genmaps.py $rundate --conc 24 $vizopt $SOopt $googleopt + ;; + esac cd .. cd vis/${rundate} if [ ${runffmpeg} = true ]; then - echo "Running ffmpeg" - ffmpeg -f image2 -r 4 -i SO2_static_concrec0100%02d.png -vcodec mpeg4 -y -s 7680x4320 movie_${rundate}.mp4 + echo "Running ffmpeg" + ffmpeg -i SO2_static_concrec0100%02d.png -c:v libx264 -crf 23 -profile:v baseline -level 3.0 -pix_fmt yuv420p -c:a aac -ac 2 -b:a 128k -r 4 -movflags faststart movie_${rundate}.mp4 fi cd ../.. echo " ---> FINISHED ###" @@ -419,12 +684,16 @@ if [ "$runVIS" = true ]; then echo "Reformatting png to jpg" mogrify -format jpg *.png rm -f *.png - setfacl -m other:r-x *.jpg + echo 'making readable by all' + setfacl -m other:r *.jpg chmod og+rx *.jpg if [ ! -e $VIZPATH${rundate} ] then + echo 'making folder' mkdir $VIZPATH${rundate} fi + echo 'checking for google files' + # add in a check for goolge files incase missing API key count=`ls -1 *.html 2>/dev/null | wc -l` if [ $count != 0 ] then @@ -432,12 +701,28 @@ if [ "$runVIS" = true ]; then chmod og+rx *.html mv *.html $VIZPATH${rundate} fi + echo 'moving to public_html' mv *.jpg $VIZPATH${rundate} cd $VIZPATH + echo 'Linking run to Today' rm -f Today ln -sf $(date +%Y%m%d) Today cd $cwd + echo 'COMPLETED all visualisation steps' fi + +#------------------------------------------------------------------------# +#------------------- BESPOKE LEEDS ARCHIVNG FLAGS------------------------# +#------------------------------------------------------------------------# +if [ $USER == earmgr ]; then +# On the first day of each month archive last month. +day=`date '+%d'` +if [[ "$day" == 01 ]]; +then + echo "### WARNING: Time to Archive Previous month ###" +fi +fi + if [ "$runmodel" = true ]; then echo "### SUCCESSFULLY COMPLETED FORECAST ###" else diff --git a/VIZ_SITE_CODE/README.md b/VIZ_SITE_CODE/README.md new file mode 100644 index 0000000..ea8d1e8 --- /dev/null +++ b/VIZ_SITE_CODE/README.md @@ -0,0 +1,26 @@ +# Static Site image viewer. + +In `VIZ SITE CODE` the folder `public html` contains a fully developed static site build through JavaScript, HTML and css designed to view the days forecast. This can be hosted on a web server or simply viewed via a light weight python web server. + +* css - custom style files +* fonts - custom fonts +* images - banners, icons, etc +* _includes - common html code to multiple pages e.g. naviation bar etc. +* index.html - Landing page. +* js - Javascript library for animating, loading in the days images etc +* UNRESP_VIZ - folder containing image archive, + +This code will work out of the box with `Run.sh` or can be adapted for other purposes. + +## Viewing Output + +The output can be viewed by running: + +```bash +cd $HOME/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html +python -m http.server +``` +And opening http://0.0.0.0:8000/ in any browser + +All the code can be transported to desired location e.g. Apache server and the +forecasting scripts ran with a `-n` option to move to that location. diff --git a/VIZ_SITE_CODE/public_html/404.html b/VIZ_SITE_CODE/public_html/404.html deleted file mode 100644 index 449f382..0000000 --- a/VIZ_SITE_CODE/public_html/404.html +++ /dev/null @@ -1,101 +0,0 @@ - - - - - - - - - - - - - HBURNS PUB HTML - - - - - - - - - - - - - - - - - - - - - -
-

Whoops, this page doesn't exist, here's a lovely meerkat.

-

Move along. (404 error)

-
-
- -
-
- - - - - - - - - - - - - - - diff --git a/VIZ_SITE_CODE/public_html/README.md b/VIZ_SITE_CODE/public_html/README.md new file mode 100644 index 0000000..e69de29 diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/785150_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/785150_index.html index e017622..9f67b17 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/785150_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/785150_index.html @@ -13,16 +13,16 @@ - - + + + - - + - +

@@ -31,20 +31,21 @@ -
+
-
+
- - - - - - + + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/861150_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/861150_index.html index 45d5e27..72c194e 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/861150_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/861150_index.html @@ -12,18 +12,19 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -32,7 +33,7 @@ -
+
@@ -40,15 +41,15 @@ -
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElCrucero_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElCrucero_index.html index 219ece7..2c5118b 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElCrucero_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElCrucero_index.html @@ -11,18 +11,19 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -31,7 +32,7 @@ -
+
@@ -40,15 +41,15 @@ -
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElPanama_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElPanama_index.html index 5c44983..46ad294 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElPanama_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElPanama_index.html @@ -11,18 +11,19 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -31,19 +32,19 @@ -
+
-
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Met_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Met_index.html index 9e57a03..9e225d7 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Met_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Met_index.html @@ -11,19 +11,20 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -32,20 +33,20 @@ -
+
-
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Pacaya_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Pacaya_index.html index 5ee930d..724e9bb 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Pacaya_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Pacaya_index.html @@ -11,18 +11,19 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -31,19 +32,19 @@ -
+
-
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/README.md b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/README.md new file mode 100644 index 0000000..e69de29 diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Rigoberto_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Rigoberto_index.html index 468a105..584bf56 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Rigoberto_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Rigoberto_index.html @@ -11,18 +11,19 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -31,19 +32,19 @@ -
+
-
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJu1_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJu1_index.html index 07b8e9a..6fa68e1 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJu1_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJu1_index.html @@ -11,18 +11,19 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -31,20 +32,20 @@ -
+
-
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJuan2_index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJuan2_index.html index d9cef4b..4d086df 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJuan2_index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJuan2_index.html @@ -11,19 +11,20 @@ Sensor Data Masaya - + - - + + + - - + + - +

@@ -32,21 +33,21 @@ -
+
-
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/README.md b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/README.md new file mode 100644 index 0000000..e69de29 diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/Today b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/Today index 8eadeae..f04a1a4 120000 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/Today +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/Today @@ -1 +1 @@ -20190409 \ No newline at end of file +20191021 \ No newline at end of file diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index.html index fc5cb05..30e8848 100755 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index.html @@ -3,7 +3,6 @@ - @@ -11,25 +10,25 @@ SOX concentrations Masaya - + - - + + + - - + + - +


-
- - + +
@@ -37,22 +36,19 @@   NOT FOR OPERATIONAL USE. FORECAST UNDER DEVELOPMET. -
+
- - -
- -
+ +
- - - - - + + + + + + - diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_AQts.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_AQts.html index ea506f3..b835045 100644 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_AQts.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_AQts.html @@ -11,18 +11,17 @@ SOX concentrations Masaya - + - - + + + - - - - + +

@@ -43,14 +42,12 @@

Senor Map (stations in -
+
- - - - - - - + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_google.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_google.html index 02e56c7..e5ca7e9 100755 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_google.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_google.html @@ -11,50 +11,51 @@ SOX concentrations Masaya - + - - + + + - - + - - + +



- - + + NOT FOR OPERATIONAL USE. FORECAST UNDER DEVELOPMET.

-
+
-
+
- - - - - - + + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_satellite.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_satellite.html new file mode 100755 index 0000000..53884c8 --- /dev/null +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_satellite.html @@ -0,0 +1,60 @@ + + + + + + + + + + + SOX concentrations Masaya + + + + + + + + + + + + + + + +
+
+
+
+ + +
+ + + +
+   + NOT FOR OPERATIONAL USE. FORECAST UNDER DEVELOPMET. +

Masaya - SO2 and SO4

+
+ + + +
+ +
+ + + + + + + + + + diff --git a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_topo.html b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_topo.html index d1b182e..1a42cbc 100755 --- a/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_topo.html +++ b/VIZ_SITE_CODE/public_html/UNRESP_VIZ/index_topo.html @@ -3,7 +3,6 @@ - @@ -11,24 +10,25 @@ SOX concentrations Masaya - + - - + + + - - + + - +


- - + +
@@ -36,18 +36,18 @@   NOT FOR OPERATIONAL USE. FORECAST UNDER DEVELOPMET. -
+
-
+
- - - - - - + + + + + + diff --git a/VIZ_SITE_CODE/public_html/_includes/animation.html b/VIZ_SITE_CODE/public_html/_includes/animation.html index 53788a7..47030a1 100644 --- a/VIZ_SITE_CODE/public_html/_includes/animation.html +++ b/VIZ_SITE_CODE/public_html/_includes/animation.html @@ -1,20 +1,16 @@ -
-
-
-

Masaya - SO2 and SO4

- UNRESP - University of Leeds 2018 +
+

Masaya Emissions

+
+ UNRESP - University of Leeds 2018
Generated by CEMAC (UoL) -     Select date an time below to view previous forecasts: (non operational currently) +    
-
-
-
-
- +
+
@@ -79,10 +75,10 @@

Masaya - SO2 and SO4

+ 45 hours
+ 46 hours
+ 47 hours
- + 48 hours
+ + 48 hours
- + diff --git a/VIZ_SITE_CODE/public_html/_includes/footer.html b/VIZ_SITE_CODE/public_html/_includes/footer.html index 2bc6f65..d509fcf 100644 --- a/VIZ_SITE_CODE/public_html/_includes/footer.html +++ b/VIZ_SITE_CODE/public_html/_includes/footer.html @@ -1,10 +1,20 @@ - +
+
+ +DOI +
-
-

Copyright © CEMAC (UoL) 2018

+

Copyright © University of Leeds 2019

+
+ diff --git a/VIZ_SITE_CODE/public_html/_includes/google.html b/VIZ_SITE_CODE/public_html/_includes/google.html index da2093e..f454a54 100644 --- a/VIZ_SITE_CODE/public_html/_includes/google.html +++ b/VIZ_SITE_CODE/public_html/_includes/google.html @@ -5,78 +5,83 @@

UNRESP Sulphur Dioxide - SO2 and SO4

- -

GoogleMaps in Free Mode will not load after 900 loads / day

+ +

GoogleMaps in Free Mode will not load after 900 loads / day

- -
+
+ +
+
+ + +
- + 1 hour
- + 2 hours
- + 3 hours
- + 4 hours
- + 5 hours
- + 6 hours
+ + 1 hour
+ + 2 hours
+ + 3 hours
+ + 4 hours
+ + 5 hours
+ + 6 hours
- + 7 hours
- + 8 hours
- + 9 hours
- + 10 hours
- + 11 hours
- + 12 hours
+ + 7 hours
+ + 8 hours
+ + 9 hours
+ + 10 hours
+ + 11 hours
+ + 12 hours
- + 13 hours
- + 14 hours
- + 15 hours
- + 16 hours
- + 17 hours
- + 18 hours
+ + 13 hours
+ + 14 hours
+ + 15 hours
+ + 16 hours
+ + 17 hours
+ + 18 hours
- + 19 hours
- + 20 hours
- + 21 hours
- + 22 hours
- + 23 hours
- + 24 hours
+ + 19 hours
+ + 20 hours
+ + 21 hours
+ + 22 hours
+ + 23 hours
+ + 24 hours
- + 25 hours
- + 26 hours
- + 27 hours
- + 28 hours
- + 29 hours
- + 30 hours
+ + 25 hours
+ + 26 hours
+ + 27 hours
+ + 28 hours
+ + 29 hours
+ + 30 hours
- + 31 hours
- + 32 hours
- + 33 hours
- + 34 hours
- + 35 hours
- + 36 hours
+ + 31 hours
+ + 32 hours
+ + 33 hours
+ + 34 hours
+ + 35 hours
+ + 36 hours
- + 37 hours
- + 38 hours
- + 39 hours
- + 40 hours
- + 41 hours
- + 42 hours
+ + 37 hours
+ + 38 hours
+ + 39 hours
+ + 40 hours
+ + 41 hours
+ + 42 hours
- + 43 hours
- + 44 hours
- + 45 hours
- + 46 hours
- + 47 hours
- + 48 hours
+ + 43 hours
+ + 44 hours
+ + 45 hours
+ + 46 hours
+ + 47 hours
+ + 48 hours
+
- - + diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar.html b/VIZ_SITE_CODE/public_html/_includes/navbar.html deleted file mode 100644 index efc03b1..0000000 --- a/VIZ_SITE_CODE/public_html/_includes/navbar.html +++ /dev/null @@ -1,56 +0,0 @@ - - - -
- - - - -
- - diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar.html b/VIZ_SITE_CODE/public_html/_includes/navbar.html new file mode 120000 index 0000000..81f6062 --- /dev/null +++ b/VIZ_SITE_CODE/public_html/_includes/navbar.html @@ -0,0 +1 @@ +navbar_light.html \ No newline at end of file diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar_full.html b/VIZ_SITE_CODE/public_html/_includes/navbar_full.html new file mode 100644 index 0000000..efc03b1 --- /dev/null +++ b/VIZ_SITE_CODE/public_html/_includes/navbar_full.html @@ -0,0 +1,56 @@ + + + +
+ + + + +
+ + diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar_light.html b/VIZ_SITE_CODE/public_html/_includes/navbar_light.html new file mode 100644 index 0000000..a472873 --- /dev/null +++ b/VIZ_SITE_CODE/public_html/_includes/navbar_light.html @@ -0,0 +1,50 @@ + + + +
+ + + + +
+ + diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar_sensors.html b/VIZ_SITE_CODE/public_html/_includes/navbar_sensors.html deleted file mode 100644 index 707a710..0000000 --- a/VIZ_SITE_CODE/public_html/_includes/navbar_sensors.html +++ /dev/null @@ -1,55 +0,0 @@ - - - -
- - - - -
- diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar_sensors.html b/VIZ_SITE_CODE/public_html/_includes/navbar_sensors.html new file mode 120000 index 0000000..364900a --- /dev/null +++ b/VIZ_SITE_CODE/public_html/_includes/navbar_sensors.html @@ -0,0 +1 @@ +navbar_sensors_light.html \ No newline at end of file diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar_sensors_full.html b/VIZ_SITE_CODE/public_html/_includes/navbar_sensors_full.html new file mode 100644 index 0000000..707a710 --- /dev/null +++ b/VIZ_SITE_CODE/public_html/_includes/navbar_sensors_full.html @@ -0,0 +1,55 @@ + + + +
+ + + + +
+ diff --git a/VIZ_SITE_CODE/public_html/_includes/navbar_sensors_light.html b/VIZ_SITE_CODE/public_html/_includes/navbar_sensors_light.html new file mode 100644 index 0000000..43e1631 --- /dev/null +++ b/VIZ_SITE_CODE/public_html/_includes/navbar_sensors_light.html @@ -0,0 +1,49 @@ + + + +
+ + + + +
+ diff --git a/VIZ_SITE_CODE/public_html/css/custom4.css b/VIZ_SITE_CODE/public_html/css/custom4.css index 40d938b..aa1c204 100644 --- a/VIZ_SITE_CODE/public_html/css/custom4.css +++ b/VIZ_SITE_CODE/public_html/css/custom4.css @@ -74,7 +74,7 @@ header .header-content .header-content-inner p { header .header-content .header-content-inner { margin-right: auto; margin-left: auto; - max-width: 1000px; + max-width: 800px; } header .header-content .header-content-inner h1 { @@ -102,11 +102,8 @@ header .header-content .header-content-inner p { } .content { - max-width: 60%; - color: #fff; - background-color: #fff - padding: 70px 0; - text-align: center; + max-width: 500px; + margin: auto; } .content-2 { diff --git a/VIZ_SITE_CODE/public_html/css/social.css b/VIZ_SITE_CODE/public_html/css/social.css new file mode 100644 index 0000000..13ce78d --- /dev/null +++ b/VIZ_SITE_CODE/public_html/css/social.css @@ -0,0 +1,76 @@ +/*html { + box-sizing: border-box; +} + +*, *:before, *:after { + box-sizing: inherit; +} + +html { + background: #0e1a25; + font-size: 0.625em; +} +*/ +.soc { + display: block; + font-size: 0; + list-style: none; + margin: 0; + padding: 8px; + padding: 1.8rem; + text-align: center; +} +.soc li { + display: inline-block; + margin: 12px; + margin: 1.2rem; +} +.soc a, .soc svg { + display: block; +} +.soc a { + position: relative; + height: 66px; + height: 6.6rem; + width: 66px; + width: 6.6rem; +} +.soc svg { + height: 100%; + width: 100%; +} + +.icon-1:hover, .icon-2:hover, .icon-3:hover { + border-radius: 100%; + color: #343638; + fill: #343638; + -webkit-transform: scale(1.25); + transform: scale(1.25); + transition: background-color 0.5s, -webkit-transform 0.5s ease-out; + transition: background-color 0.5s, transform 0.5s ease-out; + transition: background-color 0.5s, transform 0.5s ease-out, -webkit-transform 0.5s ease-out; +} + +.icon-1 { + color: #0e1a25; + fill: #0e1a25; +} +.icon-1:hover { + background: #26d991; +} + +.icon-2 { + color: #2691d9; + fill: #2691d9; +} +.icon-2:hover { + background: #26d991; +} + +.icon-3 { + color: #0077B5; + fill: #0077B5; +} +.icon-3:hover { + background: #26d991; +} diff --git a/VIZ_SITE_CODE/public_html/css/styles.css b/VIZ_SITE_CODE/public_html/css/styles.css old mode 100755 new mode 100644 index 9e1164c..5376396 --- a/VIZ_SITE_CODE/public_html/css/styles.css +++ b/VIZ_SITE_CODE/public_html/css/styles.css @@ -1,23 +1,76 @@ - /* Container holding the image and the text */ -.container { - position: relative; - text-align: center; - color: black; -} - -/* Bottom left text */ -.bottom-left { - position: absolute; - bottom: 8px; - left: 16px; -} -.umid-left { - position: absolute; - top: 160px; - left: 16px; -} -.bmid-left { - position: absolute; - bottom: 35px; - left: 16px; +html, +body { + width: 80%; + height: 90%; + font-family: 'Open Sans','Helvetica Neue',Arial,sans-serif; + +} + +.column { + float: left; + width: 33%; +} + +/* Clear floats after the columns */ +.row:after { + content: ""; + display: table; + clear: both; +} + + /* Responsive layout - when the screen is less than 600px wide, make the three columns stack on top of each other instead of next to each other */ +@media screen and (max-width: 600px) { + .column { + width: 100%; + } +} + +.collist3 { + -webkit-column-count: 3; /* Old Chrome, Safari and Opera */ + -moz-column-count: 3; /* Old Firefox */ + column-count: 3; +} + +.collist4 { + -webkit-column-count: 4; /* Old Chrome, Safari and Opera */ + -moz-column-count: 4; /* Old Firefox */ + column-count: 4; +} + +.collist2 { + -webkit-column-count: 2; /* Old Chrome, Safari and Opera */ + -moz-column-count: 2; /* Old Firefox */ + column-count: 2; + with: 20% ; +} + +ul { + margin: 0; +} +ul.dashed { + list-style-type: none; +} +ul.dashed > li { + text-indent: -5px; +} +ul.dashed > li:before { + content: "-"; + text-indent: -5px; +} + +.content { + max-width: 500px; + margin: auto; +} + + // Replace X and Y with a number and u with a unit. do calculations + // and remove parens +.centered_div { + width: 70%; + height: 100%; + position: absolute; + top: 50%; + left: 50%; + margin-left: -(70/2)%; + margin-top: -(100/2)%; } diff --git a/VIZ_SITE_CODE/public_html/index.html b/VIZ_SITE_CODE/public_html/index.html index adccff6..6be6ef6 100644 --- a/VIZ_SITE_CODE/public_html/index.html +++ b/VIZ_SITE_CODE/public_html/index.html @@ -11,14 +11,14 @@ UNRESP HOME - + - + @@ -41,7 +41,7 @@

UNRESP Visualization home

Here we're Prototyping UNRESP Visualization: Forcast and Sensor Displays

- Latest Visualization + Latest Visualization

@@ -58,12 +58,12 @@

UNRESP Visualization home

- + - + - + - + diff --git a/VIZ_SITE_CODE/public_html/js/anime.js b/VIZ_SITE_CODE/public_html/js/anime.js index 2fe4a35..fc5980c 100755 --- a/VIZ_SITE_CODE/public_html/js/anime.js +++ b/VIZ_SITE_CODE/public_html/js/anime.js @@ -1,83 +1,106 @@ var current_image = 0; -var play_mode=0; -var oldIndex=0; +var play_mode = 0; +var oldIndex = 0; var last_pict = 47; -var nameSequence = "RUN (Today's Forecaset Only)"; +var nameSequence = "ANIMATE"; var nameStop = "Stop"; -function GoToImage(number){ - play_mode=0; - viewPic(number); - document.control_form.SequenceForm.value=nameSequence; +function GoToImage(number) { + play_mode = 0; + viewPic(number); + if (typeof document.control_form !== 'undefined') { + document.control_form.SequenceForm.value = nameSequence; } -function GoToImageG(){ - var iframe = document.createElement("iframe"), - iframeWindow; - iframe.src = "Today/SO2_google_concrec010001.html"; - document.body.appendChild(iframe); - iframeWindow = iframe.contentWindow || iframe.contentDocument.parentWindow; - iframeWindow.onload = function(){ - }; } -function animate_fwd(){ - if(play_mode==0){return;} - if(current_image>last_pict){ - current_image=0; - setTimeout("animate_fwd()",1500); - } else { - viewPic(current_image); - current_image++; - setTimeout("animate_fwd()",300); - } + +function GoToImageG(number) { + play_mode = 0; + viewPicG(number); + if (typeof document.control_form !== 'undefined') { + document.control_form.SequenceForm.value = nameSequence; + } +} + +function animate_fwd() { + if (play_mode == 0) { + return; + } + if (current_image > last_pict) { + current_image = 0; + setTimeout("animate_fwd()", 1500); + } else { + viewPic(current_image); + current_image++; + setTimeout("animate_fwd()", 300); + } } -function viewPic(nr){ - document.animation.src=theImages[nr].src; - oldIndex=nr; - nextslideindex=nr; + +function viewPic(nr) { + if (typeof document.animation !== 'undefined') { + document.animation.src = theImages[nr].src; } -function startAnimation(){ - if(play_mode==0){ - document.control_form.SequenceForm.value=nameStop; - play_mode=1; - current_image=0; - animate_fwd(); - } else {GoToImage(0)} + oldIndex = nr; + nextslideindex = nr; } -function rotateimage(e){ - var evt=window.event || e - var delta=evt.detail? evt.detail*(-120) : evt.wheelDelta - nextslideindex=(delta<=-120)? nextslideindex+1 : nextslideindex-1 - nextslideindex=(nextslideindex<0)? theImages.length-1 : (nextslideindex>theImages.length-1)? 0 : nextslideindex - GoToImage(nextslideindex) - if (evt.preventDefault) - evt.preventDefault() - else - return false +function viewPicG(nr) { + var animationG = document.getElementById("animation") + if (typeof animationG !== null && typeof animationG !== 'undefined') { + document.getElementById("animation").src = theImages[nr].src; + } + oldIndex = nr; + nextslideindex = nr; } -var viewportwidth=600; -var viewporthalfwidth=300; -var xposclick=400; -function clickflip(e){ - var evt=window.event || e - if (evt.pageX) - xposclick = evt.pageX - if (typeof window.innerWidth != 'undefined') - { viewportwidth = window.innerWidth } - viewporthalfwidth=viewportwidth/2 - if (xposclicktheImages.length-1)? 0 : nextslideindex - GoToImage(nextslideindex) + +function startAnimation() { + if (play_mode == 0) { + document.control_form.SequenceForm.value = nameStop; + play_mode = 1; + current_image = 0; + animate_fwd(); + } else { + GoToImage(0) + } } -function keyflip(e){ - var evt=window.event || e //equalize event object - if ((evt.keyCode == '37') || (evt.keyCode == '38')) - nextslideindex=nextslideindex-1 - if ((evt.keyCode == '32') || (evt.keyCode == '39') || (evt.keyCode == '40')) - nextslideindex=nextslideindex+1 - nextslideindex=(nextslideindex<0)? theImages.length-1 : (nextslideindex>theImages.length-1)? 0 : nextslideindex - GoToImage(nextslideindex) + +function rotateimage(e) { + var evt = window.event || e + var delta = evt.detail ? evt.detail * (-120) : evt.wheelDelta + nextslideindex = (delta <= -120) ? nextslideindex + 1 : nextslideindex - 1 + nextslideindex = (nextslideindex < 0) ? theImages.length - 1 : (nextslideindex > theImages.length - 1) ? 0 : nextslideindex + GoToImage(nextslideindex) + if (evt.preventDefault) + evt.preventDefault() + else + return false + +} +var viewportwidth = 600; +var viewporthalfwidth = 300; +var xposclick = 400; + +function clickflip(e) { + var evt = window.event || e + if (evt.pageX) + xposclick = evt.pageX + if (typeof window.innerWidth != 'undefined') { + viewportwidth = window.innerWidth + } + viewporthalfwidth = viewportwidth / 2 + if (xposclick < viewporthalfwidth) + nextslideindex = nextslideindex - 1 + else + nextslideindex = nextslideindex + 1 + nextslideindex = (nextslideindex < 0) ? theImages.length - 1 : (nextslideindex > theImages.length - 1) ? 0 : nextslideindex + GoToImage(nextslideindex) +} + +function keyflip(e) { + var evt = window.event || e //equalize event object + if ((evt.keyCode == '37') || (evt.keyCode == '38')) + nextslideindex = nextslideindex - 1 + if ((evt.keyCode == '32') || (evt.keyCode == '39') || (evt.keyCode == '40')) + nextslideindex = nextslideindex + 1 + nextslideindex = (nextslideindex < 0) ? theImages.length - 1 : (nextslideindex > theImages.length - 1) ? 0 : nextslideindex + GoToImage(nextslideindex) } diff --git a/VIZ_SITE_CODE/public_html/js/animecontrols.js b/VIZ_SITE_CODE/public_html/js/animecontrols.js index 6133214..071a770 100644 --- a/VIZ_SITE_CODE/public_html/js/animecontrols.js +++ b/VIZ_SITE_CODE/public_html/js/animecontrols.js @@ -1,15 +1,17 @@ var animation = document.getElementById("animation") var nextslideindex = 0 var mousewheelevt = (/Firefox/i.test(navigator.userAgent)) ? "DOMMouseScroll" : "mousewheel" -if (animation.attachEvent) - animation.attachEvent("on" + mousewheelevt, rotateimage) -else if (animation.addEventListener) - animation.addEventListener(mousewheelevt, rotateimage, false, passive = true) -if (animation.attachEvent) - animation.attachEvent('onclick', clickflip) -else if (animation.addEventListener) - animation.addEventListener('click', clickflip, false) -if (window.attachEvent) - window.attachEvent('keydown', keyflip) -else if (window.addEventListener) //WC3 browsers - window.addEventListener('keydown', keyflip, false) +if (typeof animation !== 'undefined' && animation !== null) { + if (animation.attachEvent) + animation.attachEvent("on" + mousewheelevt, rotateimage) + else if (animation.addEventListener) + animation.addEventListener(mousewheelevt, rotateimage, false, passive = true) + if (animation.attachEvent) + animation.attachEvent('onclick', clickflip) + else if (animation.addEventListener) + animation.addEventListener('click', clickflip, false) + if (window.attachEvent) + window.attachEvent('keydown', keyflip) + else if (window.addEventListener) //WC3 browsers + window.addEventListener('keydown', keyflip, false) +} diff --git a/VIZ_SITE_CODE/public_html/js/imgref.js b/VIZ_SITE_CODE/public_html/js/imgref.js index fa1c9c1..64dc406 100755 --- a/VIZ_SITE_CODE/public_html/js/imgref.js +++ b/VIZ_SITE_CODE/public_html/js/imgref.js @@ -1,6 +1,6 @@ function declareims(imtype) { theImages = new Array(); - for (var i = 0; i < 46; i++) { + for (var i = 0; i < 48; i++) { theImages[i] = new Image(); } theImages[0].src = "./Today/" + imtype + "0001.jpg"; @@ -50,6 +50,7 @@ function declareims(imtype) { theImages[44].src = "./Today/" + imtype + "0045.jpg"; theImages[45].src = "./Today/" + imtype + "0046.jpg"; theImages[46].src = "./Today/" + imtype + "0047.jpg"; + theImages[47].src = "./Today/" + imtype + "0048.jpg"; } function declareims2(imtype) { @@ -94,3 +95,58 @@ function declareims2(imtype) { theImages[34].src = imtype + "Nov_2019.png"; theImages[35].src = imtype + "Dec_2019.png"; } + +function declareimsG(imtype) { + theImages = new Array(); + for (var i = 0; i < 48; i++) { + theImages[i] = new Image(); + } + theImages[0].src = "./Today/" + imtype + "0001.html"; + theImages[1].src = "./Today/" + imtype + "0002.html"; + theImages[2].src = "./Today/" + imtype + "0003.html"; + theImages[3].src = "./Today/" + imtype + "0004.html"; + theImages[4].src = "./Today/" + imtype + "0005.html"; + theImages[5].src = "./Today/" + imtype + "0006.html"; + theImages[6].src = "./Today/" + imtype + "0007.html"; + theImages[7].src = "./Today/" + imtype + "0008.html"; + theImages[8].src = "./Today/" + imtype + "0009.html"; + theImages[9].src = "./Today/" + imtype + "0010.html"; + theImages[10].src = "./Today/" + imtype + "0011.html"; + theImages[11].src = "./Today/" + imtype + "0012.html"; + theImages[12].src = "./Today/" + imtype + "0013.html"; + theImages[13].src = "./Today/" + imtype + "0014.html"; + theImages[14].src = "./Today/" + imtype + "0015.html"; + theImages[15].src = "./Today/" + imtype + "0016.html"; + theImages[16].src = "./Today/" + imtype + "0017.html"; + theImages[17].src = "./Today/" + imtype + "0018.html"; + theImages[18].src = "./Today/" + imtype + "0019.html"; + theImages[19].src = "./Today/" + imtype + "0020.html"; + theImages[20].src = "./Today/" + imtype + "0021.html"; + theImages[21].src = "./Today/" + imtype + "0022.html"; + theImages[22].src = "./Today/" + imtype + "0023.html"; + theImages[23].src = "./Today/" + imtype + "0024.html"; + theImages[24].src = "./Today/" + imtype + "0025.html"; + theImages[25].src = "./Today/" + imtype + "0026.html"; + theImages[26].src = "./Today/" + imtype + "0027.html"; + theImages[27].src = "./Today/" + imtype + "0028.html"; + theImages[28].src = "./Today/" + imtype + "0029.html"; + theImages[29].src = "./Today/" + imtype + "0030.html"; + theImages[30].src = "./Today/" + imtype + "0031.html"; + theImages[31].src = "./Today/" + imtype + "0032.html"; + theImages[32].src = "./Today/" + imtype + "0033.html"; + theImages[33].src = "./Today/" + imtype + "0034.html"; + theImages[34].src = "./Today/" + imtype + "0035.html"; + theImages[35].src = "./Today/" + imtype + "0036.html"; + theImages[36].src = "./Today/" + imtype + "0037.html"; + theImages[37].src = "./Today/" + imtype + "0038.html"; + theImages[38].src = "./Today/" + imtype + "0039.html"; + theImages[39].src = "./Today/" + imtype + "0040.html"; + theImages[40].src = "./Today/" + imtype + "0041.html"; + theImages[41].src = "./Today/" + imtype + "0042.html"; + theImages[42].src = "./Today/" + imtype + "0043.html"; + theImages[43].src = "./Today/" + imtype + "0044.html"; + theImages[44].src = "./Today/" + imtype + "0045.html"; + theImages[45].src = "./Today/" + imtype + "0046.html"; + theImages[46].src = "./Today/" + imtype + "0047.html"; + theImages[47].src = "./Today/" + imtype + "0048.html"; +} diff --git a/data/README.md b/data/README.md new file mode 100644 index 0000000..bbddb35 --- /dev/null +++ b/data/README.md @@ -0,0 +1 @@ +All other input data files are stored in the `data` subdirectory. These include the 90m resolution DEM data files from the SRTM 3-sec dataset covering the Masaya region (4 .bil files), the old 1km resolution DEM data file from the GTOPO30 dataset (w100n40.dem) which isn't used any more but is retained for reference, the USGS land-use data file covering North/Central America (nalulcl20.bil), and a two-column file of UTM zone 16P coordinates which specify discrete receptor points at which we want output data (xy_masaya.dat). Some of the output files from parts of the forecasting system that serve as input files to subsequent parts are also copied into this directory during run-time. diff --git a/docs/_config.yml b/docs/_config.yml new file mode 100644 index 0000000..2f7efbe --- /dev/null +++ b/docs/_config.yml @@ -0,0 +1 @@ +theme: jekyll-theme-minimal \ No newline at end of file diff --git a/docs/index.md b/docs/index.md new file mode 100644 index 0000000..7260b93 --- /dev/null +++ b/docs/index.md @@ -0,0 +1,140 @@ +# UNRESP Forecasting System + +[![GitHub release](https://img.shields.io/github/release/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases) [![GitHub top language](https://img.shields.io/github/languages/top/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem) [![GitHub issues](https://img.shields.io/github/issues/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/issues) [![GitHub last commit](https://img.shields.io/github/last-commit/cemac/UNRESPForecastingSystem.svg)](https://github.com/cemac/UNRESPForecastingSystem/commits/master) [![GitHub All Releases](https://img.shields.io/github/downloads/cemac/UNRESPForecastingSystem/total.svg)](https://github.com/cemac/UNRESPForecastingSystem/releases) ![GitHub](https://img.shields.io/github/license/cemac/UNRESPForecastingSystem.svg) [![DOI](https://zenodo.org/badge/131827149.svg)](https://zenodo.org/badge/latestdoi/131827149) +[![HitCount](http://hits.dwyl.io/{cemac}/{UNRESPForecastingSystem}.svg)](http://hits.dwyl.io/{cemac}/{UNRESPForecastingSystem}) + + +
+ +Repository for the [UNRESP](https://vumo.cloud/) Forecasting System: + +An automated forecasting system has been created that uses the [CALPUFF](http://www.src.com/) dispersion model to predict S02 and S04 concentrations around the Masaya volcano. This is based on the current forecasting system implemented by IMO, but with modifications and improvements. + +This work is displayed at: [homepages.see.leeds.ac.uk/~earunres](https://homepages.see.leeds.ac.uk/~earunres) + + +The repository hosts the scripts required to run the CALPUFF dispersion model to predict SO2 concentrations around the Masaya volcano forecasting for 48 hours using NAM data. The hourly output is plotted in individual png and googlemaps files (visualisation can be turned on or off). + +## [DOCUMENTATION](https://github.com/cemac/UNRESPForecastingSystem/wiki) ## + +**Full** Documentation can be found on this Repository's [wiki](https://github.com/cemac/UNRESPForecastingSystem/wiki) + +Summary documention +- [Requirements](#Requirements) +- [Installation](#Installation) +- [Usage-Quick-Start](#Usage-Quick-Start) +- [Visualization](#Visualization) +- [Contributions](#Contributions) +- [Licence](#Licence) +- [Acknowledgements](#Acknowledgements) + +- [Full-User-Guide](https://github.com/cemac/UNRESPForecastingSystem/wiki/User-Guide) +- [Developer-Guide](https://github.com/cemac/UNRESPForecastingSystem/wiki/Developer-Guide) + +## Requirements ## + +* UNIX operating system (tested: CentOS Ubuntu) +* [anaconda python](https://www.anaconda.com/distribution/#download-section)(recommended code works in python 2 and 3) (conda => 4.6.14 recommended) + * requirements in environment.yml (python 3) + * non environment set up can be followed using requirements.txt if desired +* Intel compiler **OR** executables and library (only for similar architecture as built) + +Non anaconda installations require a separate build of ecCodes python API: +* [ecCodes python API](https://confluence.ecmwf.int//display/ECC/Releases) + +## Installation ## + +Anaconda python (conda 4.6.14), unix systems (recommended), intel compilers or compiled executables + +``` +git clone https://github.com/cemac/UNRESPForecastingSystem.git +cd UNRESPForecastingSystem +./installcalpuff.sh +conda env create -f environment.yml +``` + +## Usage Quick-Start ## + +For external users, once installed to run full forecast and visualisation with default options: + +```bash +cd $HOME/UNRESPForecastingSystem +./Run_ext.sh +``` + +**NB** If no intel compilers the executables and libraries must be copied over to CALPUFF_EXE + +For help run `.\Run_ext.sh -h` + +``` + Run_ext.sh + + A CEMAC script to Run CALPUFF WITH NAM DATA input + winds and produces plots of SO2 and SO4. + + Usage: + .\Run_ext.sh + + No options runs a default production configuration: + Today, Viz on, plots production area (~earunres). + + Options: + -d YYYYMMDD DEFAULT: + -n name of viz defaults to ~earunres + ** + The following switches can be used to overwrite + Default behaviour. + ** + -s turn OFF SO4 plotting + -m turn OFF Forecasting model (e.g to run viz only) + -p turn OFF viz steps (no jpgs etc to be produced) + -f turn ON ffmpeg mp4 production + ** TROUBLESHOOTING + * Missing .so file --> most like intel library + Try loading system intel e.g. module load intel or set LD_LIBRARY_PATH + * Missing python modules --> mostly likely conda environment failure + try `source activate unresp` + or `conda activate unresp` + or `load your system python libraries` + ^^^ these fixes can be added to .env file for bespoke Setup +``` + +Run.sh is set up default to leeds production behaviour to run as a chronjob displaying at [~earunres](https://homepages.see.leeds.ac.uk/~earunres/UNRESP_VIZ/index.html) + +## Visualization + +The output can be viewed by running: + +```bash +cd $HOME/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html +python -m http.server +``` +And opening http://0.0.0.0:8000/ in any browser + +All the code can be transported to desired location e.g. Apache server and the +forecasting scripts ran with a `-n` option to move to that location. + +
+ +## Contributions ## + +*coming soon: issues/suggestions - documentation improvements - code improvements/developments welcome* + + +## Licence ## + +*This code is Open Source EXCEPT the CALPUFF code you will download*. The code changes to set up the model to run +CALPUFF for Masaya Region, forecast pipeline tools (preprocessing, postprocessing and visualisation), Python tools and static site image viewer (VIZ_SITE_CODE) are all covered under the MIT Licence. + +
+ +## Acknowledgements ## + +This repository has been developed in Collaboration with Sara Barsotti (Icelandic meteorological office), + Evgenia Ilyinskaya (University of Leeds) as well as the code authors in the commit history. The Air quality sensor data stored in the visualization folders was produced in Collaboration with INITER. + +Resources: + +* Calpuff model code provided by Exponent + +
diff --git a/docs/logo.png b/docs/logo.png new file mode 100644 index 0000000..a0f53d9 Binary files /dev/null and b/docs/logo.png differ diff --git a/environment.yml b/environment.yml index e9f5411..4baefa6 100644 --- a/environment.yml +++ b/environment.yml @@ -3,78 +3,78 @@ channels: - conda-forge - defaults dependencies: - - basemap=1.2.0=py36h673bf1a_2 - - blas=1.0=mkl - - bzip2=1.0.6=h14c3975_1002 - - ca-certificates=2019.1.23=0 - - certifi=2019.3.9=py36_0 - - curl=7.62.0=hbc83047_0 - - cycler=0.10.0=py_1 - - dbus=1.13.6=h746ee38_0 - - eccodes=2.10.0=hb25bff7_1000 - - expat=2.2.6=he6710b0_0 - - fontconfig=2.13.0=h9420a91_0 - - freetype=2.9.1=h8a8886c_1 - - geos=3.7.1=hf484d3e_1000 - - glib=2.56.2=hd408876_0 - - gst-plugins-base=1.14.0=hbbd80ab_1 - - gstreamer=1.14.0=hb453b48_1 - - hdf4=4.2.13=h9a582f1_1002 - - hdf5=1.10.4=nompi_h5598ddc_1105 - - icu=58.2=h9c2bf20_1 - - intel-openmp=2019.1=144 - - jasper=1.900.1=h07fcdf6_1006 - - jpeg=9c=h14c3975_1001 - - kiwisolver=1.0.1=py36h6bb024c_1002 - - libaec=1.0.4=hf484d3e_0 - - libcurl=7.62.0=h20c2e04_0 - - libedit=3.1.20181209=hc058e9b_0 - - libffi=3.2.1=hd88cf55_4 - - libgcc-ng=8.2.0=hdf63c60_1 - - libgfortran=3.0.0=1 - - libgfortran-ng=7.3.0=hdf63c60_0 - - libnetcdf=4.6.2=hbdf4f91_1001 - - libpng=1.6.36=h84994c4_1000 - - libssh2=1.8.1=h22169c7_0 - - libstdcxx-ng=8.2.0=hdf63c60_1 - - libuuid=1.0.3=h1bed415_2 - - libxcb=1.13=h1bed415_1 - - libxml2=2.9.9=he19cac6_0 - - matplotlib=3.0.3=py36h5429711_0 - - mkl=2019.1=144 - - mkl_fft=1.0.11=py36h14c3975_0 - - mkl_random=1.0.2=py36h637b7d7_2 - - ncurses=6.1=he6710b0_1 - - numpy=1.16.2=py36h7e9f1db_0 - - numpy-base=1.16.2=py36hde5b4d6_0 - - openssl=1.1.1b=h7b6447c_1 - - pcre=8.43=he6710b0_0 - - pip=19.0.3=py36_0 - - proj4=5.2.0=h14c3975_1001 - - pyparsing=2.3.1=py_0 - - pyproj=1.9.6=py36hc0953d3_1000 - - pyqt=5.9.2=py36h05f1152_2 - - pyshp=2.1.0=py_0 - - python=3.6.8=h0371630_0 - - python-dateutil=2.8.0=py_0 - - python-eccodes=2.10.0=py36h144eb35_1000 - - pytz=2018.9=py_0 - - qt=5.9.7=h5867ecd_1 - - readline=7.0=h7b6447c_5 - - scipy=1.2.1=py36h7c811a0_0 - - setuptools=40.8.0=py36_0 - - sip=4.19.8=py36hf484d3e_1000 - - six=1.12.0=py36_1000 - - sqlite=3.27.2=h7b6447c_0 - - tk=8.6.8=hbc83047_0 - - tornado=6.0.1=py36h14c3975_0 - - utm=0.4.2=py36_0 - - wheel=0.33.1=py36_0 - - xz=5.2.4=h14c3975_4 - - zlib=1.2.11=h7b6447c_3 + - basemap=1.2.* + - blas=1.0.* + - bzip2=1.0.6 + - ca-certificates=2019.3.9 + - certifi=2019.3.9 + - curl=7.62.0.* + - cycler=0.10.0.* + - dbus=1.13.* + - eccodes=2.12.* + - expat=2.2.* + - fontconfig=2.13.* + - freetype=2.9.* + - geos=3.7.* + - glib=2.56.* + - gst-plugins-base=1.14.* + - gstreamer=1.14.* + - hdf4=4.2.* + - hdf5=1.10.* + - icu=58.2.* + - intel-openmp=2019.1.* + - jasper=1.900.* + - jpeg=9c.* + - kiwisolver=1.0.* + - libaec=1.0.* + - libcurl=7.62.* + - libedit=3.1.20181209 + - libffi=3.2.* + - libgcc-ng=8.2.* + - libgfortran=3.0.* + - libgfortran-ng=7.3.* + - libnetcdf=4.6.* + - libpng=1.6.* + - libssh2=1.8.* + - libstdcxx-ng=8.2.* + - libuuid=1.0.* + - libxcb=1.13.* + - libxml2=2.9.* + - matplotlib=3.0.* + - mkl=2019.1.* + - mkl_fft=1.0.* + - mkl_random=1.0.* + - ncurses=6.1.* + - numpy=1.16.* + - numpy-base=1.16.* + - openssl=1.1.* + - pcre=8.43.* + - pip=19.0.3.* + - proj4=5.2.* + - pyparsing=2.3.* + - pyproj=1.9.* + - pyqt=5.9.* + - pyshp=2.1.* + - python=3.6.* + - python-dateutil=2.8.* + - python-eccodes=2.12.* + - pytz=2018.9.* + - qt=5.9.* + - readline=7.0.* + - scipy=1.2.* + - setuptools=40.8.* + - sip=4.19.* + - six=1.12.* + - sqlite=3.27.* + - tk=8.6.* + - tornado=6.0.* + - utm=0.4.* + - wheel=0.33.* + - xz=5.2.* + - zlib=1.2.* - pip: - - chardet==3.0.4 - - gmplot==1.2.0 - - idna==2.8 - - requests==2.21.0 - - urllib3==1.24.1 + - chardet==3.0.* + - gmplot==1.2.* + - idna==2.8.* + - requests==2.21.* + - urllib3>=1.26.5 diff --git a/installcalpuff.sh b/installcalpuff.sh new file mode 100755 index 0000000..c9075bb --- /dev/null +++ b/installcalpuff.sh @@ -0,0 +1,80 @@ +#!/bin/bash - +#title :installcalpuff.sh +#description :This scripts installs CALPUFF system version 7 in the appropriate location for the CALPUFF MODEL +#author :CEMAC - Helen +#date :20190501 +#version :1.0 +#usage :./installcalpuff.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + + +echo 'Running installcalpuff.sh' +cd CALPUFF_SRC +echo 'Downloading and unzipping CALMET' +wget www.src.com/calpuff/download/Mod7_Files/CALMET_v6.5.0_L150223.zip +mv CALMET_v6.5.0_L150223.zip CALMET.zip +unzip CALMET.zip +rm -f CALMET.zip CALMET_v6.5.0_L150223.zip +if [ -e CALMET ]; + then + rm -rf CALMET +fi +mv CALMET_v6.5.0_L150223/ CALMET/ +cd CALMET +for i in *; do mv $i `echo $i | tr [:upper:] [:lower:]`; done +cd .. +echo 'Downloading and unzipping CALPUFF' +wget http://www.src.com/calpuff/download/Mod7_Files/CALPUFF_v7.2.1_L150618.zip +unzip CALPUFF_v7.2.1_L150618.zip +if [ -e CALPUFF ]; + then + rm -rf CALPUFF +fi +mv CALPUFF_v7.2.1_L150618/ CALPUFF/ +rm -f CALPUFF_v7.2.1_L150618.zip +cd CALPUFF +for i in *; do mv $i `echo $i | tr [:upper:] [:lower:]`; done +cd .. +echo 'Downloading and unzipping CTGPROC' +wget http://www.src.com/calpuff/download/Mod7_Files/CTGPROC_v7.0.0_L150211.zip +unzip CTGPROC_v7.0.0_L150211.zip +if [ -e CTGPROC ]; + then + rm -rf CTGPROC +fi +mv CTGPROC_v7.0.0_L150211/ CTGPROC/ +rm -f CTGPROC_v7.0.0_L150211.zip +cd CTGPROC +for i in *; do mv $i `echo $i | tr [:upper:] [:lower:]`; done +cd .. +echo 'Downloading and unzipping MAKEGEO' +wget http://www.src.com/calpuff/download/Mod7_Files/MAKEGEO_V3.2_L110401.zip +unzip MAKEGEO_V3.2_L110401.zip +if [ -e MAKEGEO ]; + then + rm -rf MAKEGEO +fi +mv MAKEGEO_V3.2_L110401/ MAKEGEO/ +rm -f MAKEGEO_V3.2_L110401.zip +cd MAKEGEO +for i in *; do mv $i `echo $i | tr [:upper:] [:lower:]`; done +cd .. +echo 'Downloading and unzipping TERREL' +wget http://www.src.com/calpuff/download/Mod7_Files/TERREL_v7.0.0_L141010.zip +unzip TERREL_v7.0.0_L141010.zip +if [ -e TERREL ]; + then + rm -rf TERREL +fi +mv TERREL_v7.0.0_L141010/ TERREL/ +rm -f TERREL_v7.0.0_L141010.zip +cd TERREL +for i in *; do mv $i `echo $i | tr [:upper:] [:lower:]`; done +cd .. +cd .. +echo 'complete - ready to compile executables' +echo 'please Agree to CALPUFF License Agreements' +echo 'http://www.src.com/calpuff/calpuff_eula.htm' +./makecodemods.sh diff --git a/makecodemods.sh b/makecodemods.sh new file mode 100755 index 0000000..c76ea61 --- /dev/null +++ b/makecodemods.sh @@ -0,0 +1,52 @@ +#!/bin/bash - +#title :makecodemods.sh +#description :Make code modifications to CALPUF SRC code +#author :CEMAC - Helen +#date :20190501 +#version :1.0 +#usage :./makecodemods.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + + +read -r -p "Do you want to implement CALPUFF code modificiation? [Y/n] " input + +case $input in + [yY][eE][sS]|[yY]) + echo "Yes" + ;; + [nN][oO]|[nN]) + echo "No" + ;; + *) + echo "Invalid input..." + exit 1 + ;; +esac + +echo 'Linking CALPUFF_MODS to CALPUFF_SRC' + +cd CALPUFF_SRC/CALMET +ln -sf ../../CALPUFF_MODS/CALMET/* . +cd .. +cd CALPUFF +ln -sf ../../CALPUFF_MODS/CALPUFF/* . +cd .. +cd CTGPROC +ln -sf ../../CALPUFF_MODS/CTGPROC/* . +cd .. +cd MAKEGEO +ln -sf ../../CALPUFF_MODS/MAKEGEO/* . +cd .. +cd TERREL +ln -sf ../../CALPUFF_MODS/TERREL/* . +cd ../.. + +echo 'COMPLETED:' +echo '*************************************************' +echo ' Please make future code mods in CALPUFF_MODS to keep track of changes' +echo ' Rerun makecodemods.sh to include new files after making changes' +echo '*************************************************' +echo 'Please Agree to CALPUFF License Agreements' +echo 'http://www.src.com/calpuff/calpuff_eula.htm' diff --git a/requirements.txt b/requirements.txt index 24d712a..77815db 100644 --- a/requirements.txt +++ b/requirements.txt @@ -1,77 +1,77 @@ # This file may be used to create an environment using: # $ conda create --name --file # platform: linux-64 -basemap=1.2.0=py36h673bf1a_2 -blas=1.0=mkl -bzip2=1.0.6=h14c3975_1002 -ca-certificates=2019.1.23=0 -certifi=2019.3.9=py36_0 -chardet=3.0.4=pypi_0 -curl=7.62.0=hbc83047_0 -cycler=0.10.0=py_1 -dbus=1.13.6=h746ee38_0 -eccodes=2.10.0=hb25bff7_1000 -expat=2.2.6=he6710b0_0 -fontconfig=2.13.0=h9420a91_0 -freetype=2.9.1=h8a8886c_1 -geos=3.7.1=hf484d3e_1000 -glib=2.56.2=hd408876_0 -gmplot=1.2.0=pypi_0 -gst-plugins-base=1.14.0=hbbd80ab_1 -gstreamer=1.14.0=hb453b48_1 -hdf4=4.2.13=h9a582f1_1002 -hdf5=1.10.4=nompi_h11e915b_1105 -icu=58.2=h9c2bf20_1 -idna=2.8=pypi_0 -intel-openmp=2019.1=144 -jasper=1.900.1=h07fcdf6_1006 -jpeg=9c=h14c3975_1001 -kiwisolver=1.0.1=py36h6bb024c_1002 -libaec=1.0.4=hf484d3e_0 -libcurl=7.62.0=h20c2e04_0 -libedit=3.1.20181209=hc058e9b_0 -libffi=3.2.1=hd88cf55_4 -libgcc-ng=8.2.0=hdf63c60_1 -libgfortran=3.0.0=1 -libgfortran-ng=7.3.0=hdf63c60_0 -libnetcdf=4.6.2=hbdf4f91_1001 -libpng=1.6.36=h84994c4_1000 -libssh2=1.8.1=h22169c7_0 -libstdcxx-ng=8.2.0=hdf63c60_1 -libuuid=1.0.3=h1bed415_2 -libxcb=1.13=h1bed415_1 -libxml2=2.9.9=he19cac6_0 -matplotlib=3.0.3=py36h5429711_0 -mkl=2019.1=144 -mkl_fft=1.0.11=py36h14c3975_0 -mkl_random=1.0.2=py36h637b7d7_2 -ncurses=6.1=he6710b0_1 -numpy=1.16.2=py36h7e9f1db_0 -numpy-base=1.16.2=py36hde5b4d6_0 -openssl=1.1.1b=h7b6447c_1 -pcre=8.43=he6710b0_0 -pip=19.0.3=py36_0 -proj4=5.2.0=h14c3975_1001 -pyparsing=2.3.1=py_0 -pyproj=1.9.6=py36hc0953d3_1000 -pyqt=5.9.2=py36h05f1152_2 -pyshp=2.1.0=py_0 -python=3.6.8=h0371630_0 -python-dateutil=2.8.0=py_0 -python-eccodes=2.10.0=py36h144eb35_1000 -pytz=2018.9=py_0 -qt=5.9.7=h5867ecd_1 -readline=7.0=h7b6447c_5 -requests=2.21.0=pypi_0 -scipy=1.2.1=py36h7c811a0_0 -setuptools=40.8.0=py36_0 -sip=4.19.8=py36hf484d3e_1000 -six=1.12.0=py36_1000 -sqlite=3.27.2=h7b6447c_0 -tk=8.6.8=hbc83047_0 -tornado=6.0.1=py36h14c3975_0 -urllib3=1.24.1=pypi_0 -utm=0.4.2=py36_0 -wheel=0.33.1=py36_0 -xz=5.2.4=h14c3975_4 -zlib=1.2.11=h7b6447c_3 +basemap=1.2.* +blas=1.0.* +bzip2=1.0.* +ca-certificates=2019.3.* +certifi=2019.3.9 +chardet=3.0.* +curl=7.62.0 +cycler=0.10.* +dbus=1.13.* +eccodes=2.12.* +expat=2.2.* +fontconfig=2.13.* +freetype=2.9.* +geos=3.7.* +glib=2.56.* +gmplot=1.2.* +gst-plugins-base=1.14.* +gstreamer=1.14.* +hdf4=4.2.* +hdf5=1.10.* +icu=58.2 +idna=2.8 +intel-openmp=2019.1 +jasper=1.900.1 +jpeg=9c +kiwisolver=1.0.* +libaec=1.0.* +libcurl=7.62.0 +libedit=3.1.20181209 +libffi=3.2.* +libgcc-ng=8.2.* +libgfortran=3.0.* +libgfortran-ng=7.3.* +libnetcdf=4.6.* +libpng=1.6.* +libssh2=1.8.* +libstdcxx-ng=8.2.* +libuuid=1.0.* +libxcb=1.13 +libxml2=2.9.* +matplotlib=3.0.* +mkl=2019.1 +mkl_fft=1.0.* +mkl_random=1.0.* +ncurses=6.1 +numpy=1.16.* +numpy-base=1.16.* +openssl=1.1.* +pcre=8.43 +pip>=19.2 +proj4=5.2.* +pyparsing=2.3.* +pyproj=1.9.* +pyqt=5.9.* +pyshp=2.1.* +python=3.6.* +python-dateutil=2.8.* +python-eccodes=2.12.* +pytz=2018.9 +qt=5.9.* +readline=7.0 +requests=2.21.* +scipy=1.2.* +setuptools=40.8.0 +sip=4.19.* +six=1.12.* +sqlite=3.27.* +tk=8.6.* +tornado=6.0.* +urllib3>=1.26.5 +utm=0.4.* +wheel=0.33.* +xz=5.2.* +zlib=1.2.*1 diff --git a/Run_ext.sh b/tests/flag_test.sh similarity index 52% rename from Run_ext.sh rename to tests/flag_test.sh index 7c64bf0..b870c5f 100755 --- a/Run_ext.sh +++ b/tests/flag_test.sh @@ -1,23 +1,17 @@ -#!/bin/bash - -# Trouble shooting: -# source activate unresp -# module load intel - -#This script was created by CEMAC (University of Leeds) as part of the UNRESP -#Project -#Setup environment -if [ $CONDA_DEFAULT_ENV != unresp ]; then - echo "trying to activate unresp python environment..." - conda activate unresp -fi -set -e #stop at first error -source .env -# Defaults that can be overwritten via command line -rundate=$(date +%Y%m%d) -vizhome=$HOME/UNRESPForecastingSystem/VIZ_SITE_CODE -runVIS=true -runffmpeg=false +#!/usr/bin/bash --login + +# This script was created by CEMAC (University of Leeds) as +# part of the UNRESP Project +# Setup environment (should not need to be edited) +set -e # stop at first error +# load modules (Leeds) +module load intel/17.0.0 +module load python2 python-libs +# For Mark only: +export PYTHONPATH="/nfs/see-fs-02_users/earmgr/SW/eccodes-2.6.0/lib/python2.7/site-packages:${PYTHONPATH}" + +# Resolution (m) of intended CALPUFF grid. 100 < (integer) < 1000 +res=1000 # Defaults that can be overwritten by editing HERE: # Command line option m switches all to false runTERREL=true @@ -28,6 +22,35 @@ runCALMET=true runCALPUFF=true runmodel=true +# Set other parameters (unlikely to need editing) +let NX=90000/$res+1 +let NY=54000/$res+1 +DGRIDKM=$(echo "scale=3; $res/1000" | bc) +let MESHGLAZ=1000/$res+1 +cwd=$(pwd) +# Number of nam files for 48 hours +NAMno=17 + +#------------------------------------------------------------------------# +#------------------- DO NOT ALTER BELOW THIS LINE------------------------# +#------------------------------------------------------------------------# + +# COMMAND LINE FLAG HANDELING # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # + +# Defaults that can be overwritten via command line +rundate=$(date +%Y%m%d) +vizhome=~earunres +runVIS=false +runallVIS=false +rungoogle=false +runsatellite=false +runtopo=false +runSO4=false +runSO2=false +runSO24=false +runffmpeg=false + print_usage() { echo " Run.sh @@ -44,19 +67,114 @@ print_usage() { Options: -d YYYYMMDD DEFAULT: -n name of viz defaults to ~earunres + -x resolution in m (100 < x < 1000) ** The following switches can be used to overwrite Default behaviour. + + DEFAULT: output todays SO2 concrec files on topography + background ** - -m turn OFF Forecasting model (e.g to run viz only) - -p turn OFF viz steps (no jpgs etc to be produced) + -m turn OFF Forecasting model + -p turn ON viz steps: default to SO2 on topography only + -a turn ON all viz options except ffmpeg + -b plot BOTH SO2 and SO4 + -t output BOTH satellite and topo backgrounds + -g turn ON GOOGLE PLOTS + -r SWITCH to satellite background + -s SWITCH to SO4 + -y plot ONLY GOOGLE PLOTS -f turn ON ffmpeg mp4 production + -h HELP: prints this message! + long options are currently not avaible. - " + + ------------------------------------------------ + + Other Code Possible Options: + + The model is split into various components, these can + be induvidually turned on or off for development purposes + via editing the upper part of this script. + + runTERREL=true + runCTGPROC=true + runMAKEGEO=true + run3DDAT=true + runCALMET=true + runCALPUFF=true + runmodel=true + + + " } set_viz() { - runVIS=false + # description flags + runVIS=true + runSO2=true + runtopo=true + # code option + SOopt=" --SO2 " + vizopt=" --topo " +} + +set_allviz() { + # description flags + runallVIS=true + runVIS=true + runtopo=true + runSO24=true + rungoogle=ture + runsatellite=false + # code option + vizopt=" --all " + SOopt=" --SO2 --SO4 " +} + +set_SO4() { + # description flags + runSO4=true + runSO2=false + # code option + SOopt=" --SO4 " +} + +set_SO24() { + # description flags + runSO24=true + runSO2=false + runSO4=false + # code option + SOopt=" --SO2 --SO4 " +} + +add_google() { + googleopt=" --google " +} +only_google() { + # description flags + rungoogle=ture + runsatellite=false + runtopo=false + # code option + vizopt=" --google " +} + +set_satellite() { + # description flags + runsatellite=true + runtopo=false + # code option + vizopt=" --satellite " +} + +set_sattopo() { + # description flags + runsatellite=true + runtopo=true + # code option + vizopt=" --topo --satellite" } set_ffmpeg() { @@ -72,29 +190,139 @@ set_model() { runCALPUFF=false runmodel=false } -while getopts 'd:n:pmfh' flag; do +while getopts 'd:n:x:pamsbgrtyfh' flag; do case "${flag}" in d) rundate="${OPTARG}" ;; n) vizhome="${OPTARG}" ;; + x) res="${OPTARG}" ;; p) set_viz ;; + a) set_allviz ;; m) set_model ;; + s) set_SO4 ;; + b) set_SO24 ;; + y) set_google ;; + y) only_google ;; + r) set_satellite ;; + t) set_sattopo ;; f) set_ffmpeg ;; h) print_usage - exit 1 ;; + exit 1 ;; *) print_usage - exit 1 ;; + exit 1 ;; esac done +## Checking for inconsistent flags + +has_param() { + local term="$1" + shift + for arg; do + if [[ $arg == "$term" ]]; then + return 0 + fi + done + return 1 +} + +# SO24 +if has_param '-b' "$@" ; then +if has_param '-s' "$@" ; then + echo "WARNING: inconsistent settings" + echo "-b sets both SO2 and SO4" + echo "-s sets ONLY SO4" + exit 0 +fi +fi + +# plot both +if has_param '-t' "$@" ; then +if has_param '-r' "$@" ; then + echo "WARNING: inconsistent settings" + echo "-t sets both satellite and topography" + echo "-r sets ONLY statellite" + exit 0 +fi +if has_param '-y' "$@" ; then + echo "WARNING: inconsistent settings" + echo "-t sets both satellite and topography" + echo "-y sets ONLY googleplots" + exit 0 +fi +fi + +if ! has_param '-p' "$@" ; then + if has_param '-b' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-s' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-g' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-y' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-r' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-t' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-f' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi + if has_param '-a' "$@" ; then + echo "WARNING viz turned off" + exit 0 + fi +fi + +# Description of Settings # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # + echo 'Running with the following options set:' +echo 'CALPUFF grid resolution: ' $res echo 'date: '$rundate echo 'run model: '$runmodel +echo 'resoltuion: '$res echo 'vizulisation: '$runVIS -echo 'make mp4: ' $runffmpeg -# VISUALISATION PATH --> public_html/UNRESP_VIZ/ folders must exist in -# viz destination. -VIZPATH=$vizhome/public_html/UNRESP_VIZ/ -echo 'vizulisation output to: '$VIZPATH +if [ ${runVIS} = true ]; then + echo 'vizulisation options:' + echo '..defaults..' + echo 'basic plots on: '$runtopo + echo 'plot SO2: '$runSO2 + echo '..extra..' + echo 'plot BOTH SO2 and SO4: '$runSO24 + echo 'plot ONLY SO4: '$runSO4 + echo 'include goolge htmls: '$rungoogle + echo 'plot ONLY SO4: '$runSO4 + echo 'plot ONLY high res set_satellite: '$runsatellite + echo 'make mp4: ' $runffmpeg + # VISUALISATION PATH --> public_html/UNRESP_VIZ/ folders must exist in + # viz destination. + VIZPATH=$vizhome/public_html/UNRESP_VIZ/ + echo 'vizulisation output to: '$VIZPATH +fi + +if [ ${runVIS} = false ] && [ ${runmodel} = false ]; then + echo 'running model and vizulisation turned off' + echo 'terminating programme' + echo 'plrease review options' + print_usage + exit 1 +fi + +# RUN DATE # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # prevdate=$(date -d "$rundate - 1 day" +%Y%m%d) middate=$(date -d "$rundate + 1 day" +%Y%m%d) @@ -109,151 +337,141 @@ endYear=${enddate:0:4} endMonth=${enddate:4:2} endDay=${enddate:6:2} -#Set other parameters -res=1000 #Resolution (m) of intended CALPUFF grid. 100 < (integer) < 1000 -let NX=90000/$res+1 -let NY=54000/$res+1 -DGRIDKM=$(echo "scale=3; $res/1000" | bc) -let MESHGLAZ=1000/$res+1 - -cwd=$(pwd) - - -#------------------------------------------------------------------------# -#------------------- DO NOT ALTER BELOW THIS LINE------------------------# -#------------------------------------------------------------------------# +# RUN MODEL # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # if [ "$runmodel" = true ]; then -echo "### RUNNING FORECAST SYSTEM FOR DATE "${rundate}" ###" + echo "### RUNNING FORECAST SYSTEM FOR DATE "${rundate}" ###" fi -###TERREL### +### TERREL ### if [ "$runTERREL" = true ]; then - #Compile TERREL if required: + # Compile TERREL if required: cd CALPUFF_EXE if [ ! -f ./terrel_intel.exe ]; then - echo -n "### COMPILING TERREL" + echo -n "### COMPILING TERREL" ifort -O0 -fltconsistency -w ../CALPUFF_SRC/TERREL/terrel.for -o terrel_intel.exe - echo " ---> FINISHED ###" + echo " ---> FINISHED ###" else - echo "### TERREL ALREADY COMPILED ###" + echo "### TERREL ALREADY COMPILED ###" fi cd .. - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD TERREL OUTPUT FILES" rm -rf *.dat *.grd *.lst *.sav *.log cd CALPUFF_OUT/TERREL find . ! -name 'README' -type f -exec rm -f {} + cd ../.. echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP TERREL INPUT FILE" sed -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/terrel_template.inp > ./CALPUFF_INP/terrel.inp echo " ---> FINISHED ###" - #Run TERREL: + # Run TERREL: echo "### RUNNING TERREL" ./CALPUFF_EXE/terrel_intel.exe ./CALPUFF_INP/terrel.inp > terrel.log echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING TERREL OUTPUT FILES" mv *.dat *.grd *.lst *.sav *.log ./CALPUFF_OUT/TERREL/. echo " ---> FINISHED ###" fi -###CTGPROC### +### CTGPROC ### if [ "$runCTGPROC" = true ]; then - #Compile CTGPROC if required: + # Compile CTGPROC if required: cd CALPUFF_EXE if [ ! -f ./ctgproc_intel.exe ]; then - echo -n "### COMPILING CTGPROC" - ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CTGPROC/ctgproc.for -o ctgproc_intel.exe - echo " ---> FINISHED ###" + echo -n "### COMPILING CTGPROC" + ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CTGPROC/ctgproc.for -o ctgproc_intel.exe + echo " ---> FINISHED ###" else - echo "### CTGPROC ALREADY COMPILED ###" + echo "### CTGPROC ALREADY COMPILED ###" fi cd .. - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD CTGPROC OUTPUT FILES" rm -rf *.dat *.lst *.log cd CALPUFF_OUT/CTGPROC find . ! -name 'README' -type f -exec rm -f {} + cd ../.. echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP CTGPROC INPUT FILE" sed -e "s/?MESHGLAZ?/$MESHGLAZ/g" -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/ctgproc_template.inp > ./CALPUFF_INP/ctgproc.inp echo " ---> FINISHED ###" - #Run CTGPROC: + # Run CTGPROC: echo "### RUNNING CTGPROC" ./CALPUFF_EXE/ctgproc_intel.exe ./CALPUFF_INP/ctgproc.inp > ctgproc.log echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING CTGPROC OUTPUT FILES" mv *.dat *.lst *.log ./CALPUFF_OUT/CTGPROC/. echo " ---> FINISHED ###" fi -###MAKEGEO### +### MAKEGEO ### if [ "$runMAKEGEO" = true ]; then - #Compile MAKEGEO if required: + # Compile MAKEGEO if required: cd CALPUFF_EXE if [ ! -f ./makegeo_intel.exe ]; then - echo -n "### COMPILING MAKEGEO" - ifort -O0 -fltconsistency -w ../CALPUFF_SRC/MAKEGEO/makegeo.for -o makegeo_intel.exe - echo " ---> FINISHED ###" + echo -n "### COMPILING MAKEGEO" + ifort -O0 -fltconsistency -w ../CALPUFF_SRC/MAKEGEO/makegeo.for -o makegeo_intel.exe + echo " ---> FINISHED ###" else - echo "### MAKEGEO ALREADY COMPILED ###" + echo "### MAKEGEO ALREADY COMPILED ###" fi cd .. - #Copy data files from TERREL and CTGPROC across to the data directory + # Copy data files from TERREL and CTGPROC across to the data directory echo -n "### COPYING GEO DATA FILES ACROSS" cp -f ./CALPUFF_OUT/TERREL/masaya.dat data/. cp -f ./CALPUFF_OUT/CTGPROC/lulc1km_masaya.dat data/. echo " ---> FINISHED ###" - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD MAKEGEO OUTPUT FILES" rm -rf *.dat *.lst *.clr *.log *.grd cd CALPUFF_OUT/MAKEGEO find . ! -name 'README' -type f -exec rm -f {} + cd ../.. echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP MAKEGEO INPUT FILE" sed -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/makegeo_template.inp > ./CALPUFF_INP/makegeo.inp echo " ---> FINISHED ###" - #Run MAKEGEO: + # Run MAKEGEO: echo "### RUNNING MAKEGEO" ./CALPUFF_EXE/makegeo_intel.exe ./CALPUFF_INP/makegeo.inp > makegeo.log echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING MAKEGEO OUTPUT FILES" mv *.dat *.lst *.clr *.log *.grd ./CALPUFF_OUT/MAKEGEO/. echo " ---> FINISHED ###" fi -###NAM data### +# GET AND PROCESS NAM DATA # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # if [ "$run3DDAT" = true ]; then - ##Download NAM data if required: - #How many files downloaded already?: + ## Download NAM data if required: + # How many files downloaded already?: if [ -d ./NAM_data/raw/${rundate} ]; then eval numfiles=$(ls ./NAM_data/raw/${rundate} | wc -l) else numfiles=0 fi - #if not 17 files, need to download more: - if [ ${numfiles} != 17 ]; then + # if not correct no files, need to download more: + if [ ${numfiles} != $NAMno ]; then echo "### ATTEMPTING TO DOWNLOAD NAM DATA" - #Make data directory if required: + # Make data directory if required: if [ ! -d ./NAM_data/raw/${rundate} ]; then mkdir NAM_data/raw/${rundate} fi cd NAM_data/raw/${rundate} - #Download each NAM data file if required: + # Download each NAM data file if required: for i in `seq 0 3 48`; do hour=`printf "%02d" $i` if [ ! -f nam.t00z.afwaca${hour}.tm00.grib2 ]; then echo "### DOWNLOADING DATA FOR FORECAST HOUR "${hour}" ###" - #Entire GRIB file: - #wget http://www.ftp.ncep.noaa.gov/data/nccf/com/nam/prod/nam.${rundate}/nam.t00z.afwaca${hour}.tm00.grib2 - #Subset of GRIB file using GRIB filter (http://nomads.ncep.noaa.gov/cgi-bin/filter_nam_crb.pl): + # Entire GRIB file: + # wget http://www.ftp.ncep.noaa.gov/data/nccf/com/nam/prod/nam.${rundate}/nam.t00z.afwaca${hour}.tm00.grib2 + # Subset of GRIB file using GRIB filter (http://nomads.ncep.noaa.gov/cgi-bin/filter_nam_crb.pl): #WARNING https not http as of Jan 2019 curl "https://nomads.ncep.noaa.gov/cgi-bin/filter_nam_crb.pl?file=nam.t00z.afwaca"${hour}".tm00.grib2&"\ "lev_1000_mb=on&lev_100_mb=on&lev_10_mb=on&lev_150_mb=on&lev_200_mb=on&lev_20_mb=on&lev_250_mb=on&"\ @@ -267,7 +485,15 @@ if [ "$run3DDAT" = true ]; then cd ../../.. echo " ---> FINISHED ###" fi - #Extract NAM data into CALMET input file format: + # CHECK files are all as expected! + cd NAM_data/raw/${rundate} + eval checkgrib=$(file -b --mime-type * | sed 's|/.*||' | grep text | wc -l) + cd ../../.. + # Extract NAM data into CALMET input file format: + if [ ${checkgrib} != 0 ]; then + echo "Grib check failed, check internet connect or NAM data availability" + exit 0 + fi echo "### EXTRACTING NAM DATA INTO CALMET INPUT FILE FORMAT" rm -f NAM_data/processed/met_${rundate}.dat cd Python @@ -276,72 +502,72 @@ if [ "$run3DDAT" = true ]; then echo " ---> FINISHED ###" fi -###CALMET### +### CALMET ### if [ "$runCALMET" = true ]; then - #Compile CALMET if required: + # Compile CALMET if required: cd CALPUFF_EXE if [ ! -f ./calmet_intel.exe ]; then - echo -n "### COMPILING CALMET" - ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALMET/calmet.for -o calmet_intel.exe - echo " ---> FINISHED ###" + echo -n "### COMPILING CALMET" + ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALMET/calmet.for -o calmet_intel.exe + echo " ---> FINISHED ###" else - echo "### CTGPROC ALREADY COMPILED ###" + echo "### CALMET ALREADY COMPILED ###" fi cd .. - #Remove any old data files and copy relevant new files into the data directory + # Remove any old data files and copy relevant new files into the data directory echo -n "### SETTING UP DATA DIRECTORY" rm -f data/geo_masaya.dat cp -f ./CALPUFF_OUT/MAKEGEO/geo_masaya.dat data/. rm -f data/met_*.dat cp -f ./NAM_data/processed/met_${rundate}.dat data/. echo " ---> FINISHED ###" - #Remove any old CALMET files before running: + # Remove any old CALMET files before running: echo -n "### DELETING ANY OLD CALMET OUTPUT FILES" rm -rf *.dat *.DAT *.bna *.lst *.aux rm -rf ./CALPUFF_OUT/CALMET/${rundate} echo " ---> FINISHED ###" - #Update input file: + # Update input file: echo -n "### SETTING UP CALMET INPUT FILE" sed -e "s/YYYYb/$startYear/g" -e "s/MMb/$startMonth/g" -e "s/DDb/$startDay/g" -e "s/YYYYe/$endYear/g" \ -e "s/MMe/$endMonth/g" -e "s/DDe/$endDay/g" -e "s/?3DDAT?/met_${rundate}.dat/g" \ -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" ./CALPUFF_INP/calmet_template.inp > ./CALPUFF_INP/calmet.inp echo " ---> FINISHED ###" - #Run CALMET: + # Run CALMET: echo "### RUNNING CALMET" ./CALPUFF_EXE/calmet_intel.exe ./CALPUFF_INP/calmet.inp echo " ---> FINISHED ###" - #Move output files: + # Move output files: echo -n "### MOVING CALMET OUTPUT FILES" mkdir ./CALPUFF_OUT/CALMET/${rundate} mv *.dat *.DAT *.bna *.lst *.aux ./CALPUFF_OUT/CALMET/${rundate}/. echo " ---> FINISHED ###" fi -###CALPUFF### +### CALPUFF ### if [ "$runCALPUFF" = true ]; then - #Compile CALPUFF if required: + # Compile CALPUFF if required: if [ ! -f ./CALPUFF_EXE/calpuff_intel.exe ]; then - echo -n "### COMPILING CALPUFF" - cd CALPUFF_SRC/CALPUFF - ifort -c modules.for - cd ../../CALPUFF_EXE - ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALPUFF/calpuff.for ../CALPUFF_SRC/CALPUFF/modules.o -o calpuff_intel.exe - cd .. - echo " ---> FINISHED ###" + echo -n "### COMPILING CALPUFF" + cd CALPUFF_SRC/CALPUFF + ifort -c modules.for + cd ../../CALPUFF_EXE + ifort -O0 -fltconsistency -mcmodel=medium -w ../CALPUFF_SRC/CALPUFF/calpuff.for ../CALPUFF_SRC/CALPUFF/modules.o -o calpuff_intel.exe + cd .. + echo " ---> FINISHED ###" else - echo "### CALPUFF ALREADY COMPILED ###" + echo "### CALPUFF ALREADY COMPILED ###" fi - #Remove old and copy new CALMET data file across to the data directory + # Remove old and copy new CALMET data file across to the data directory echo -n "### SETTING UP DATA DIRECTORY" rm -f data/calmet_*.dat cp -f ./CALPUFF_OUT/CALMET/${rundate}/calmet.dat data/calmet_${rundate}.dat echo " ---> FINISHED ###" - #Remove any old files before running: + # Remove any old files before running: echo -n "### DELETING ANY OLD CALPUFF OUTPUT FILES" rm -rf *.con *.lst *.dat *.clr *.bna *.grd rm -rf ./CALPUFF_OUT/CALPUFF/${rundate} echo " ---> FINISHED ###" - #Set up input file for first 24hrs: + # Set up input file for first 24hrs: echo -n "### SETTING UP CALPUFF INPUT FILE FOR FIRST 24 HOURS" if [ -f ./CALPUFF_OUT/CALPUFF/${prevdate}/restart_${rundate}.dat ]; then mres=3 @@ -357,18 +583,18 @@ if [ "$runCALPUFF" = true ]; then -e "s/?MRES?/$mres/g" -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" \ ./CALPUFF_INP/calpuff_template.inp > ./CALPUFF_INP/calpuff.inp echo " ---> FINISHED ###" - #Run CALPUFF for first 24 hours: + # Run CALPUFF for first 24 hours: echo "### RUNNING CALPUFF FOR FIRST 24 HOURS" ./CALPUFF_EXE/calpuff_intel.exe ./CALPUFF_INP/calpuff.inp echo " ---> FINISHED ###" - #Move output files from first 24 hours: + # Move output files from first 24 hours: echo -n "### MOVING CALPUFF OUTPUT FILES FROM FIRST 24 HOURS" mkdir ./CALPUFF_OUT/CALPUFF/${rundate} mv concrec*.dat restart_${middate}.dat ./CALPUFF_OUT/CALPUFF/${rundate}/. rm -rf *.con *.lst *.dat *.clr *.bna *.grd cp CALPUFF_OUT/CALPUFF/${rundate}/restart_${middate}.dat . echo " ---> FINISHED ###" - #Set up input file for second 24hrs: + # Set up input file for second 24hrs: echo -n "### SETTING UP CALPUFF INPUT FILE FOR SECOND 24 HOURS" sed -e "s/YYYYb/$midYear/g" -e "s/MMb/$midMonth/g" -e "s/DDb/$midDay/g" -e "s/YYYYe/$endYear/g" \ -e "s/MMe/$endMonth/g" -e "s/DDe/$endDay/g" -e "s/?METDAT?/calmet_${rundate}.dat/g" \ @@ -376,11 +602,11 @@ if [ "$runCALPUFF" = true ]; then -e "s/?MRES?/1/g" -e "s/?NX?/$NX/g" -e "s/?NY?/$NY/g" -e "s/?DGRIDKM?/$DGRIDKM/g" \ ./CALPUFF_INP/calpuff_template.inp > ./CALPUFF_INP/calpuff.inp echo " ---> FINISHED ###" - #Run CALPUFF for second 24 hours: + # Run CALPUFF for second 24 hours: echo "### RUNNING CALPUFF FOR SECOND 24 HOURS" ./CALPUFF_EXE/calpuff_intel.exe ./CALPUFF_INP/calpuff.inp echo " ---> FINISHED ###" - #Rename and move output files from second 24 hours: + # Rename and move output files from second 24 hours: echo -n "### RENAMING AND MOVING CALPUFF OUTPUT FILES FROM SECOND 24 HOURS" for i in `seq 1 24`; do let "j = i + 24" @@ -390,22 +616,23 @@ if [ "$runCALPUFF" = true ]; then mv concrec0200${i2}.dat concrec0200${j2}.dat done mv concrec*.dat ./CALPUFF_OUT/CALPUFF/${rundate}/. - rm -rf *.con *.lst *.dat *.clr *.bna *.grd + rm -f *.con *.lst *.dat *.clr *.bna *.grd echo " ---> FINISHED ###" fi -###VISUALISATION### -if [ "$runVIS" = true ]; then +# RUN VISUALIZATION # +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # +if [ ${runVIS} = true ]; then echo "### RUNNING VISUALISATION TOOLS" rm -rf ./vis/${rundate} mkdir ./vis/${rundate} cd Python - ./genmaps.py ${rundate} + python genmaps_test.py $rundate $vizopt $SOopt $googleopt cd .. cd vis/${rundate} if [ ${runffmpeg} = true ]; then - echo "Running ffmpeg" - ffmpeg -f image2 -r 4 -i SO2_static_concrec0100%02d.png -vcodec mpeg4 -y -s 7680x4320 movie_${rundate}.mp4 + echo "Running ffmpeg" + ffmpeg -i SO2_static_concrec0100%02d.png -c:v libx264 -crf 23 -profile:v baseline -level 3.0 -pix_fmt yuv420p -c:a aac -ac 2 -b:a 128k -r 4 -movflags faststart movie_${rundate}.mp4 fi cd ../.. echo " ---> FINISHED ###" @@ -416,13 +643,16 @@ if [ "$runVIS" = true ]; then echo "Reformatting png to jpg" mogrify -format jpg *.png rm -f *.png - setfacl -m other:r-x *.jpg + echo 'making readable by all' + setfacl -m other:r *.jpg chmod og+rx *.jpg if [ ! -e $VIZPATH${rundate} ] then + echo 'making folder' mkdir $VIZPATH${rundate} fi - # Check for google files + echo 'checking for google files' + # add in a check for goolge files incase missing API key count=`ls -1 *.html 2>/dev/null | wc -l` if [ $count != 0 ] then @@ -430,11 +660,25 @@ if [ "$runVIS" = true ]; then chmod og+rx *.html mv *.html $VIZPATH${rundate} fi + echo 'moving to public_html' mv *.jpg $VIZPATH${rundate} cd $VIZPATH + echo 'Linking run to Today' rm -f Today ln -sf $(date +%Y%m%d) Today cd $cwd + echo 'COMPLETED all visualisation steps' +fi + +#------------------------------------------------------------------------# +#------------------- BESPOKE LEEDS ARCHIVNG FLAGS------------------------# +#------------------------------------------------------------------------# + +# On the first day of each month archive last month. +day=`date '+%d'` +if [[ "$day" == 01 ]]; +then + echo "### WARNING: Time to Archive Previous month ###" fi if [ "$runmodel" = true ]; then echo "### SUCCESSFULLY COMPLETED FORECAST ###" diff --git a/tests/genmaps_test.py b/tests/genmaps_test.py new file mode 100755 index 0000000..fabd79e --- /dev/null +++ b/tests/genmaps_test.py @@ -0,0 +1,145 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- +"""genmaps +.. module:: genmaps + :platform: Unix + :synopis: +.. moduleauther: CEMAC (UoL) +.. description: This module was developed by CEMAC as part of the UNRESP + Project. This Script plots CALPUFF concrec data on a map. + :copyright: © 2019 University of Leeds. + :license: BSD-2 Clause. +Example: + To use:: + ./genemaps.py + - Date string, format YYYYMMDD, of the current CALPUFF run. + Used to locate directory containing the SO2 output files + (with assumed naming convention 'concrec0100**.dat', + where '**' goes from '01' through to '48') +.. CEMAC_UNRESPForcastingSystem: + https://github.com/cemac/UNRESPForcastingSystem +""" +from __future__ import print_function +import argparse +from dateutil.parser import parse +import maptoolkit as mtk +import sys + +# Set everything to off +TopoMaps = False +SatelliteMaps = False +GoogleMaps = False +SO2 = False +SO4 = False + + +# READ IN COMMAND LINE ARGUMENTS +dstring = ("Used to generate a series (48hrs) of static and interactive" + + "(google) maps \n showing SO2 concentrations around the Masaya " + + "volcano, as predicted by the CALPUFF dispersion model") +hstring = ("Date string, format YYYYMMDD, of the current CALPUFF run. Used " + + "to + locate \n directory containing the SO2 output files (with " + + "assumed naming convention 'concrec0100**.dat', \n where '**' " + + " goes from '01' through to '48'") +hstring = ("number of concrec files e.g. 24 or 48") +parser = argparse.ArgumentParser(description=dstring) +parser.add_argument("date", help=hstring, type=str) +parser.add_argument("--conc", help=hstring, type=str) +# Switches +parser.add_argument('--all', help='Plots all types of maps', + action='store_true') +parser.add_argument('--SO2', help=r'Plot SO$_2$', + action='store_true') +parser.add_argument('--SO4', help=r'Plot SO$_4$', + action='store_true') +parser.add_argument('--topo', help='Turn on basic maps', + action='store_true') +parser.add_argument('--satellite', help='Turn on satellite maps', + action='store_true') +parser.add_argument('--google', help='Turn on googlemaps', + action='store_true') +args = parser.parse_args() + +if args.SO2: + SO2 = True + +if args.SO4: + SO4 = True + +if args.satellite: + SatelliteMaps = True + +if args.topo: + TopoMaps = True + +if args.google: + GoogleMaps = True + +if args.all: + SO2 = True + SO4 = True + GoogleMaps = True + TopoMaps = True + SatelliteMaps = True + + +# echo what is being done +print('Generating Maps with following settings:') +print(r"SO$_2$ = ", SO2) +print(r"SO$_4$ = ", SO4) +print("Basic Maps =", TopoMaps) +print("Satallite Maps =", SatelliteMaps) +print("Gooogle Maps =", GoogleMaps) + +# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +date = args.date +if args.conc: + nconc = args.conc +else: + nconc = 48 + +try: + mpt = mtk.MasayaMaps(date, n_conc_files=int(nconc)) +except AssertionError: + print('CALPUFF output directory does not exist for' + date) + print('Stopping, please check output exists for ' + date) + +if TopoMaps: + if SO2 and SO4: + mpt.plot_staticmaps('topo', SOX='SO2') + mpt.plot_staticmaps('topo', SOX='SO4') + elif SO4: + mpt.plot_staticmaps('topo', SOX='SO4') + elif SO2: + mpt.plot_staticmaps('topo', SOX='SO2') + else: + print(r'Conc must be set to SO$_2$ or SO$_4$ or both (default)') + print(r'most likely the --custom flag has been used with out:') + print(' --SO2', 'or --SO4',) + +if SatelliteMaps: + if SO2 and SO4: + mpt.plot_staticmaps('satellite', SOX='SO2') + mpt.plot_staticmaps('satellite', SOX='SO4') + elif SO2: + mpt.plot_staticmaps('satellite', SOX='SO2') + elif SO4: + mpt.plot_staticmaps('satellite', SOX='SO4') + else: + print(r'Conc must be set to SO$_2$ or SO$_4$ or both (default)') + print(r'most likely the --custom flag has been used with out:') + print(' --SO24', ' --SO2', 'or --SO4',) + +if GoogleMaps: + if SO2 and SO4: + mpt.plot_google(SOX='SO2') + mpt.plot_google(SOX='SO4') + elif SO2: + mpt.plot_google(SOX='SO2') + elif SO4: + mpt.plot_google(SOX='SO4') + else: + print(r'Conc must be set to SO$_2$ and/or SO$_4$ ') + print(r'most likely the --custom flag has been used with out:') + print('--SO2', 'or --SO4',) diff --git a/tests/maptoolkit.py b/tests/maptoolkit.py new file mode 120000 index 0000000..1be1752 --- /dev/null +++ b/tests/maptoolkit.py @@ -0,0 +1 @@ +../Python/maptoolkit.py \ No newline at end of file diff --git a/tools/README.md b/tools/README.md new file mode 100644 index 0000000..42adf25 --- /dev/null +++ b/tools/README.md @@ -0,0 +1,36 @@ +# Tools for managing Forecasting System + +The unresp Forecasting system can be ran as a standalone system. + +# Tools for managing Forecasting System + +The unresp Forecasting system can be ran as a standalone system. +How ever this directory contains some tools to facilitate running as a smooth productions. + +## Production system Tools + +### Archiving: + +* generic_archiving.sh + +Takes output archives to set location in YYYY/mYYYYMM/folders. Takes input and output location. Defaults to current month with overrides to set month/year or bulk year. + +Examples on using archiving tools in Leeds system. + +* [NAMarchive.sh](example_archiving/NAMarchive.sh) +* [CALPUFFarchive.sh](example_archiving/CALPUFFarchive.sh) +* [VIZarchive.sh](example_archiving/VIZarchive.sh) + + +## Testing tools + +## CEMAC oneoff tools *to be removed in future* + +* [grabAQfile.sh](oneoff/grabAQfile.sh) +* [SensorSiteUpdate.sh](oneoff/SensorSiteUpdate.sh) updating typos +* [unittest.sh](oneoff/unittest.sh) + +## Added features *coming soon* + +* Bespoke options like wind field output *coming soon* +* Compare with sensor output *coming soon* diff --git a/tools/compact.sh b/tools/compact.sh new file mode 100755 index 0000000..554b041 --- /dev/null +++ b/tools/compact.sh @@ -0,0 +1,21 @@ +#!/bin/bash - +#title :compact.sh +#description :tar up concrec files in (folder saves a large amount of space!) +#author :CEMAC - helen +#date :20200921 +#version :1 +#usage :./compact.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +# Give it a year and this script will match folders mYYYYmm e.g. m201901 and compress +# them to a unresp_concrec_mYYYYmm.tbz file +year=2019 +for n in `seq 1 1 12`; do + no=`printf "%02d" $n` + if [ -e ${year}${no} ]; then + echo "compressing m"${year}${no} + tar jcvf unresp_concrec_m${year}${no}.tbz m${year}${no} + fi +done diff --git a/tools/example_archiving/CALPUFFarchive.sh b/tools/example_archiving/CALPUFFarchive.sh new file mode 100755 index 0000000..ac705cf --- /dev/null +++ b/tools/example_archiving/CALPUFFarchive.sh @@ -0,0 +1,24 @@ +#!/bin/bash - +#title :CALPUFFarchive.sh +#description :Archive CALPUFF data +#author :CEMAC - Helen +#date :20190404 +#version :0.1-beta +#usage :./CALPUFFarchive.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +# Archive CALPUFF_OUT +echo "Archiving CALPUFF OUTPUT" +in=~earmgr/CEMAC/UNRESPForecastingSystem/CALPUFF_OUT/CALPUFF/ +out="/ds/shared/Earth&Environment/Research/SEE/Research-1/UNRESP/UNRESPForecastingSystem/CALPUFF_OUT/CALPUFF/" +./generic_archiving.sh -i $in -o $out +echo "Archived CALPUFF OUTPUT" + +# Archive CALMET +echo "Archiving CALMET OUTPUT" +in=~earmgr/CEMAC/UNRESPForecastingSystem/CALPUFF_OUT/CALMET/ +out="/ds/shared/Earth&Environment/Research/SEE/Research-1/UNRESP/UNRESPForecastingSystem/CALPUFF_OUT/CALMET/" +./generic_archiving.sh -i $in -o $out +echo "Archived CALMET OUTPUT" diff --git a/tools/example_archiving/NAMarchive.sh b/tools/example_archiving/NAMarchive.sh new file mode 100755 index 0000000..f180af4 --- /dev/null +++ b/tools/example_archiving/NAMarchive.sh @@ -0,0 +1,24 @@ +#!/bin/bash - +#title :NAMarchive.sh +#description :Archive NAM data +#author :CEMAC - Helen +#date :20190404 +#version :0.1-beta +#usage :./NAMarchive.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +# Archive RAW +echo "Archiving Raw NAM data" +in=~earmgr/CEMAC/UNRESPForecastingSystem/NAM_data/raw +out="/ds/shared/Earth&Environment/Research/SEE/Research-1/UNRESP/UNRESPForecastingSystem/NAM_data/raw" +./generic_archiving.sh -i $in -o $out +echo "Archived Raw NAM data" + +# Archive Processed +echo "Archiving Processed NAM data" +in=~earmgr/CEMAC/UNRESPForecastingSystem/NAM_data/processed +out="/ds/shared/Earth&Environment/Research/SEE/Research-1/UNRESP/UNRESPForecastingSystem/NAM_data/processed" +./generic_archiving.sh -i $in -o $out -n +echo "Archived Processed NAM data" diff --git a/tools/example_archiving/VIZarchive.sh b/tools/example_archiving/VIZarchive.sh new file mode 100755 index 0000000..90f667b --- /dev/null +++ b/tools/example_archiving/VIZarchive.sh @@ -0,0 +1,17 @@ +#!/bin/bash - +#title :generic_archiving.sh +#description :Archive tool +#author :CEMAC - Helen +#date :20190404 +#version :0.1-beta +#usage :./generic_archiving.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +# Archive RAW +echo "Archiving Images" +in=~earunres/public_html/UNRESP_VIZ/ +out="/ds/shared/Earth&Environment/Research/SEE/Research-1/UNRESP/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/" +./generic_archiving.sh -i $in -o $out +echo "Archived Images" diff --git a/tools/example_archiving/generic_archiving.sh b/tools/example_archiving/generic_archiving.sh new file mode 120000 index 0000000..1110946 --- /dev/null +++ b/tools/example_archiving/generic_archiving.sh @@ -0,0 +1 @@ +../generic_archiving.sh \ No newline at end of file diff --git a/tools/generic_archiving.sh b/tools/generic_archiving.sh new file mode 100755 index 0000000..7525f98 --- /dev/null +++ b/tools/generic_archiving.sh @@ -0,0 +1,147 @@ +#!/bin/bash - +#title :generic_archiving.sh +#description :Archive tool +#author :CEMAC - Helen +#date :20190404 +#version :0.1-beta +#usage :./generic_archiving.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +print_usage() { + echo " + generic_archiving.sh + + A CEMAC script to create folder and move to + Usage: + .\generic_archiving.sh -i -o + Defaults to take current month in IN and archive to OUT + Write protected and metadata preserved + Optional arguments can adjust dates for archiving + + Options: + -i + -o + -b sets bulk archiving + -n set for nam processed (no daily folders) Req. for bulk setup + -m override month for month archive e.g 201801 + -y override year for bulk archive e.g. 2018 + " +} +## +## DEFAULTS +## +# Set current and archive location defaults +year=$(date +%Y) +# find previous month YYYYmm +m=$(date --date="$(date +%Y%m15) -1 month" +%Y%m) +# Bulk archiving for year +bulk=false +set_bulk() { + bulk=true +} +# A flag for NAM processed (files not folders) +nam=false +set_nam() { + nam=true +} +# GET ARGUMENTS +while getopts 'i:o:y:m:bnh' flag; do + case "${flag}" in + i) in="${OPTARG}" ;; + o) out="${OPTARG}" ;; + y) year="${OPTARG}" ;; + m) m="${OPTARG}" ;; + n) set_nam ;; + b) set_bulk ;; + h) print_usage + exit 1 ;; + *) print_usage + exit 1 ;; + esac +done +# +# IN and OUT are required +# +if [ "x" == "x$in" ]; then + echo "-i [input location] is required" + exit 1 +fi +if [ "x" == "x$out" ]; then + echo "-o [output location] is required" + exit 1 +fi +# +# DEFAULT Monthly Archiving +# +if [ "$bulk" = false ]; then + # Extract year + year=${m:(0):(-2)} + # Extract month + m=${m:(-2)} + echo "Archiving month: " $m " Year: " $year + # Check and create the year folder in the archive space + cd $out + if [ ! -e $year ] + then + echo $year "does not exist, creating folder" + mkdir $year + fi + cd $year + # Check and create the year month folders in the archive space + if [ ! -e m$year$m ] + then + echo $year$m "does not exist, creating folder" + mkdir m$year$m + fi + cd $in/ + for d in *$year$m*; do + # output folder full path + folder=$out/$year/m$year$m/ + # Don't overwrite files + if [ ! -e $folder/$d ]; + then + # If the days file or folder isn't there already put it there + rsync -a $d $folder/ + fi + done + echo "data copied to " $out + echo "write protecting chmod -R ogu-w " $folder + chmod -R ogu-w $folder + echo "run checks and delete duplicates from " $in +fi + +if [ "$bulk" = true ]; then + echo "Archiving year:" $year + # Check and create the year folder in the archive space + cd $out + if [ ! -e $year ] + then + echo $year "does not exist, creating folder" + mkdir $year + fi + cd $in/ + for d in *$year*; do + md=${d:(-5)} + m=${md:(1):(2)} + if [ "$nam" = true ]; then + m=${d:(8):(2)} + fi + folder=$out/$year/m$year$m + # Check and creating monthly folders in year folder + if [ ! -e $folder ] + then + mkdir $folder + fi + # If the days file or folder isn't there already put it there + if [ ! -e $folder/$d ]; + then + rsync -a $d $folder + fi + done + echo "data copied to " $out + echo "run checks and delete duplicates from " $in + echo "*Consider* using chmod -R ogu-w " $out/$year/m$year"*" + echo "To write protect completed archives" +fi diff --git a/tools/gribchopper.sh b/tools/gribchopper.sh new file mode 100755 index 0000000..e229a48 --- /dev/null +++ b/tools/gribchopper.sh @@ -0,0 +1,43 @@ +#!/bin/bash - +#title :gribchopper.sh +#description :Discard unwanted vars from grib files +#author :CEMAC - Helen +#date :20190617 +#version :1.0 +#usage :./gribchopper.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + + +# NAM FILES contain 712 Vars accross the whole of central america +# We want just 139 for a specific region +yearmnt=201703 +location="/nfs/earcemac/projects/unresp/nam_data" +cd $location +mkdir ${yearmnt}_small +echo "belt and braces copying data before chopping" +echo "this may take a few mins" +cp -rp $yearmnt/* ${yearmnt}_small +cd ${yearmnt}_small +d=$(ls) +for line in $d ; do + echo $line + cd $line + list=$(ls) + for f in $list ; do + echo "shrinking to region " $f + wgrib2 $f -small_grib 272.096000:277.928000 10.073999:15.905999 small.grb + echo "removing unwated variables" + wgrib2 small.grb -s | egrep '(:PRMSL:|:HGT:|:TMP:|:RH:|:DZDT:|:UGRD:|:VGRD:)' | wgrib2 -i small.grb -grib tiny.grb + echo "removing unwanted pressure levels" + wgrib2 tiny.grb -s | egrep -e '(:1000 mb:|:100 mb:|:150 mb:|:1000 mb:|:10 mb:|:200 mb:|:20 mb:|:250 mb:|:2 mb:|:300 mb:|:30 mb:|:400 mb:|:500 mb:|:50 mb:|:5 mb:|:600 mb:|:700 mb:|:75 mb:|:7 mb:|:800 mb:|:850 mb:|:900 mb:|:925 mb:|:950 mb:|:PRMSL:)' | wgrib2 -i tiny.grb -grib min.grb + rm -f $f + rm -f tiny.grb + rm -f small.grb + mv min.grb $f + done + cd .. +done +echo "complete.." +echo "check and delete" diff --git a/tools/linker.sh b/tools/linker.sh new file mode 100755 index 0000000..eff4996 --- /dev/null +++ b/tools/linker.sh @@ -0,0 +1,27 @@ +#!/bin/bash - +#title :linker.sh +#description :link grib files in correct format for processing +#author :CEMAC - Helen +#date :20190620 +#version :1.0 +#usage :./linker.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +month=201703 +root=/nfs/earcemac/projects/unresp/nam_data/${month}_small +namarea=/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/NAM_data/raw/ +cd $namarea +for d in $month*/; do + d1=${d:(-3):(-1)} + if [ $d1 == "31" ] ; then + echo "end" + exit 1 + fi + d1=${d:(-3):(-1)} + d1=$(( ${d1#0} )) + d2=$(( $d1 + 1 )) + d2="$( printf '%02d' "$d2" )" + ln -sf ${root}/$month$d2/nam.t00z.afwaca00.grb2.tm00 ${namarea}${d}nam.t24z.afwaca00.grb2.tm00 +done diff --git a/tools/oneoff/SensorSiteUpdate.sh b/tools/oneoff/SensorSiteUpdate.sh new file mode 100755 index 0000000..100cab7 --- /dev/null +++ b/tools/oneoff/SensorSiteUpdate.sh @@ -0,0 +1,20 @@ +#!/bin/bash +cwd=$(pwd) +cd ~earunres/public_html/UNRESP_VIZ/AQSensor +rm -f 785150_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/785150_index.html . +rm -f 861150_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/861150_index.html . +rm -f ElCrucero_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElCrucero_index.html . +rm -f ElPanama_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/ElPanama_index.html . +rm -f Pacaya_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Pacaya_index.html . +rm -f Rigoberto_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/Rigoberto_index.html . +rm -f SanJu1_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJu1_index.html . +rm -f SanJuan2_index.html +cp -p/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/UNRESP_VIZ/AQSensor/SanJuan2_index.html . +cd $cwd diff --git a/tools/oneoff/archiver_for_mark.sh b/tools/oneoff/archiver_for_mark.sh new file mode 100755 index 0000000..2c2ee99 --- /dev/null +++ b/tools/oneoff/archiver_for_mark.sh @@ -0,0 +1,17 @@ +#!/bin/bash - +#title :archiver_for_mark.sh +#description :A sctript to archive everything in a cron job +#author :CEMAC - Helen +#date :20190703 +#version :1.0 +#usage :./archiver_for_mark.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + + +cd ${HOME}/CEMAC/UNRESPForecastingSystem/tools/example_archiving/ +./CALPUFFarchive.sh +./NAMarchive.sh +./VIZarchive.sh +printf '%s\n %s\n %s\n %s\n' 'Hello Mark,' 'Please Check last months Unresp data has been archived' 'Cheers,' 'Cron Job'| mail -s "UNRESP Archiver" "M.G.Richardson@leeds.ac.uk" diff --git a/tools/oneoff/site_updater_for_mark.sh b/tools/oneoff/site_updater_for_mark.sh new file mode 100755 index 0000000..e1bd35d --- /dev/null +++ b/tools/oneoff/site_updater_for_mark.sh @@ -0,0 +1,24 @@ +#!/bin/bash - +#title :site_updater_for_mark.sh +#description :Implement changes to unresp site +#author :CEMAC - Helen +#date :20191021 +#version :1.0 +#usage :./site_updater_for_mark.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +newcodehome='/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/VIZ_SITE_CODE/public_html/' +oldcodehome='/home/earunres/public_html' + +cp ${newcodehome}/_includes/* ${oldcodehome}/_includes/ +cp ${newcodehome}/css/custom4.css ${oldcodehome}/css/custom4.css +cp ${newcodehome}/css/s*.css ${oldcodehome}/css/ +cp ${newcodehome}/js/anime.js ${oldcodehome}/js/ +cp ${newcodehome}/UNRESP_VIZ/*html ${oldcodehome}/UNRESP_VIZ/ +cp ${newcodehome}/UNRESP_VIZ/AQSensor/*html ${oldcodehome}/UNRESP_VIZ/AQSensor/ + +cd $oldcodehome + +chmod -R ogu+rX * diff --git a/tools/oneoff/unittest.sh b/tools/oneoff/unittest.sh new file mode 100755 index 0000000..ff0ade1 --- /dev/null +++ b/tools/oneoff/unittest.sh @@ -0,0 +1,44 @@ +#!/bin/bash - +#title :unittest.sh +#description :test archive add +#author :CEMAC - helen +#date :20190508 +#version :0 +#usage :./unittest.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + +day=`date '+%d'` +if [[ "$day" == 08 ]]; +then + echo "1 identified day as 08" + if [[ "$USER"==earhbu ]]; + then + echo '1 PASSED earhbu' + else + echo '1 FAILED for user lock accept' + fi +fi + +if [[ "$day" == 01 ]]; +then + echo "2 FAILED to lock for day" + if [ $USER=='earhbu' ]; + then + echo '2 FAIL shoulnt make it here' + else + echo '2 FAILED for user lock accept' + fi +fi + +if [[ "$day"==08 ]]; +then + echo "3 PASS day" + if [[ "$USER" == 'earmgr' ]]; + then + echo '3 FAILED for user lock deny' + else + echo '3 PASSED for user lock' + fi +fi diff --git a/tools/processgribs.sh b/tools/processgribs.sh new file mode 100755 index 0000000..4c82695 --- /dev/null +++ b/tools/processgribs.sh @@ -0,0 +1,21 @@ +#!/bin/bash - +#title :processgribs.sh +#description :proccess marhc 2017 +#author :CEMAC - helen +#date :20190620 +#version :1.0 +#usage :./processgribs.sh +#notes : +#bash_version :4.2.46(2)-release +#============================================================================ + + +month=201703 +namarea=/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/NAM_data/raw/ +pythonarea=/nfs/earcemac/projects/unresp/ForecastVisualized/UNRESPForecastingSystem/Python/ +cd $namarea +for d in $month*/; do + cd $pythonarea + d1=${d:0:(-1)} + ./nam23ddat.py $d1 +done diff --git a/unresp_analysis.yml b/unresp_analysis.yml new file mode 100644 index 0000000..346339d --- /dev/null +++ b/unresp_analysis.yml @@ -0,0 +1,137 @@ +name: unresp_analysis +channels: + - conda-forge + - defaults +dependencies: + - _libgcc_mutex=0.1 + - astroid=2.3.* + - backcall=0.1.* + - basemap=1.2.* + - blas=1.0 + - bzip2=1.0.8 + - ca-certificates=2019.8.* + - certifi=2019.9.* + - cftime=1.0.3.4 + - curl=7.65.* + - cycler=0.10.* + - dbus=1.13.6 + - decorator=4.4.* + - eccodes=2.10.0 + - expat=2.2.* + - fontconfig=2.13.* + - freetype=2.9.* + - geos=3.6.* + - glib=2.56.2 + - gst-plugins-base=1.14* + - gstreamer=1.14.0 + - hdf4=4.2.* + - hdf5=1.10.* + - icu=58.2 + - intel-openmp=2019.4 + - ipython=7.8.* + - ipython_genutils=0.2.* + - isort=4.3.* + - jasper=1.900.* + - jedi=0.15.* + - jinja2=2.10.* + - jpeg=9c + - kiwisolver=1.1.* + - krb5=1.16.1 + - lazy-object-proxy=1.4.* + - libaec=1.0.* + - libcurl=7.65.* + - libedit=3.1.20181209 + - libffi=3.2.* + - libgcc-ng=9.1.* + - libgfortran=3.0.* + - libgfortran-ng=7.3.* + - libnetcdf=4.6.* + - libpng=1.6.* + - libssh2=1.8.* + - libstdcxx-ng=9.1.* + - libuuid=1.0.* + - libxcb=1.13 + - libxml2=2.9.* + - markupsafe=1.1.* + - matplotlib=3.1.* + - mccabe=0.6.* + - mkl=2019.4 + - mkl-service=2.3.* + - mkl_fft=1.0.14 + - mkl_random=1.1.* + - ncurses=6.1 + - netcdf4=1.4.2 + - numpy=1.17.* + - numpy-base=1.17.* + - openssl=1.1.* + - pandas=0.5.* + - pandas-profiling=1.4.* + - parso=0.5.* + - pcre=8.43 + - pexpect=4.7.* + - pickleshare=0.7.* + - pip=19.2.3 + - proj4=5.2.0 + - prompt_toolkit=2.0.10 + - ptyprocess=0.6.* + - pygments=2.4.* + - pylint=2.4.* + - pyparsing=2.4.* + - pyproj=1.9.* + - pyqt=5.9.* + - pyshp=2.1.* + - python=3.6.* + - python-dateutil=2.8.* + - python-eccodes=2.10.* + - pytz=2019.3 + - qt=5.9.* + - readline=7.0 + - scipy=1.3.* + - setuptools=41.4.0 + - sip=4.19.* + - six=1.12.* + - sqlite=3.30.* + - tk=8.6.* + - tornado=6.0.* + - traitlets=4.3.* + - typed-ast=1.4.* + - utm=0.4.* + - wcwidth=0.1.* + - wheel=0.33.* + - wrapt=1.11.* + - xz=5.2.* + - zlib=1.2.11 + - pip: + - absl-py==0.7.* + - astor==0.8.* + - chardet==3.0.* + - cvxpy==1.0.* + - dill==0.3.* + - ecos==2.0.7.post1 + - fancyimpute==0.5.* + - future==0.17.* + - gast==0.2.* + - gmplot==1.2.* + - google-pasta==0.1.* + - grpcio==1.2.* + - h5py==2.9.* + - idna==2.8 + - joblib==0.13.* + - keras==2.2.* + - keras-applications==1.0.* + - keras-preprocessing==1.1.* + - knnimpute==0.1.* + - markdown==3.1.* + - multiprocess==0.70.* + - osqp==0.5.* + - protobuf==3.9.* + - pyyaml==5.1.* + - requests==2.1.* + - scikit-learn==0.1.* + - scs==2.1.1-2 + - tensorboard==1.14.* + - tensorflow==1.14.* + - tensorflow-estimator==1.14.* + - termcolor==1.1.* + - urllib3==1.4.* + - werkzeug==0.15.*