SUBROUTINE index_water(IUNIT, XLAM, T, INDX) ! DEFINES WAVELENGTH DEPENDENT COMPLEX INDEX OF REFRACTION FOR WATER ! ALLOWABLE WAVELENGTH RANGE EXTENDS FROM .2 MICRONS TO 1 M [BTJ] ! 10 CM - 1 M IS UNKNOWN, AND WAS ADDED DUE TO LIEBE MODEL ADDITION [BTJ] ! TEMPERATURE DEPENDENCE ONLY CONSIDERED BEYOND 0.1 CM ! ! ERIC A. SMITH ! DEPT OF ATMOSPHERIC SCIENCE ! COLORADO STATE UNIVERSITY ! FORT COLLINS,CO 80523 ! TEL 303-491-8533 ! ! > Modified by C.W.O'Dell Feb 2014 to remove unnecessary abs coefficient outputs. ! and to return the single complex refractive index INDX. ! ! > Modifications by Benjamin T. Johnson : August 1998 : Purdue ! > University Department of Earth and Atmospheric Sciences. ! > See comments with [BTJ] for changes/notes. ! > new email: jbenjam@aos.wisc.edu ! ! > Further modifications by Michael A. Walters, October 2002 ! > Microwave Group, Space Science and Engineering Center ! > University of Wisconsin - Madison ! > walters@aos.wisc.edu ! ! REFERENCES ! ! 0.2 UM - 0.69 UM ! ! HALE,G., AND M. QUERRY,1972. ! OPTICAL CONSTANTS OF WATER IN THE 200 NM TO 200 UM WAVELENGTH REGI ! APPLIED OPTICS,12,3,555-563. ! ! 0.69 UM - 2.0 UM ! ! PALMER,K.F., AND D. WILLIAMS,1974. ! OPTICAL PROPERTIES OF WATER IN THE NEAR INFRARED. ! JOURNAL OF THE OPTICAL SOCIETY OF AMERICA,64,8,1107-1110. ! ! 2.0 UM - 1000.0 UM ! ! DOWNING,H.D., AND D. WILLIAMS,1975. ! OPTICAL CONSTANTS OF WATER IN THE INFRARED. ! JOURNAL OF GEOPHYSICAL REVIEW,80,12,1656-1661. ! ! ------------------------------------------------------------------- ! See comments below for the 1.0 MM - 10.0 CM range. [~line 356] [BTJ] ! ------------------------------------------------------------------- ! 1.0 MM - 10.0 CM ! ! RAY,P.S.,1972. ! BROADBAND COMPLEX REFRACTIVE INDICES OF ICE AND WATER. ! APPLIED OPTICS,11,8,1836-1844. ! ! INPUT PARAMETERS ! ! IUNIT = 0 FOR WAVELENGTH SPECIFIED IN MICRONS ! = 1 FOR WAVELENGTH SPECIFIED IN MILLIMETERS ! = 2 FOR WAVELENGTH SPECIFIED IN CENTIMETERS ! = 3 FOR WAVELENGTH SPECIFIED IN INVERSE CENTIMETERS ( WAVE N ! XLAM = WAVELENGTH ( MICRONS OR MM OR CM OR CM**-1 ) ! T = TEMPERATURE ( DEGREES KELVIN ) ! ! OUTPUT PARAMETERS ! ! RN = REAL PORTION ( SCATTERING ) ! CN = COMPLEX PORTION ( ABSORPTION ) ! implicit none integer, intent (in) :: IUNIT real, intent (in) :: XLAM, T complex, intent(out):: INDX real, parameter :: PI = 3.14159265 real, parameter :: CC = 2.99792e+8 real :: RN, CN integer, parameter :: NUMWAT = 518 real :: WLTABW(NUMWAT), RNTABW(NUMWAT), CNTABW(NUMWAT) real :: TC, NU, WL, XL, FAC real :: WLMIN = 0.2 real :: WLMAX = 1000000.0 !!$ real :: CUTWAT = 1000.0 real :: CUTWAT = 100.0 ! modified BTJ 02/28/2002 to fit with epsw routine integer :: I, I1, I2 complex :: E, M complex :: eps_swd_l91dd data (WLTABW(I),I= 1, 66)/ & & .20000, .22500, .25000, .27500, .30000, .32500,& & .35001, .37500, .40000, .42501, .45000, .47499,& & .50000, .52499, .54999, .57501, .59999, .62500,& & .64998, .67499, .68966, .70175, .71429, .72464,& & .73529, .74627, .75188, .75758, .76923, .78125,& & .79365, .80645, .81301, .81967, .83333, .84746,& & .86207, .87719, .89286, .90909, .92593, .93458,& & .94340, .95238, .96154, .97276, .98039, .99010,& & 1.00000, 1.01010, 1.02041, 1.03093, 1.04167, 1.05263,& & 1.06952, 1.08696, 1.09890, 1.11111, 1.12360, 1.13636,& & 1.14943, 1.16279, 1.17647, 1.19048, 1.20482, 1.21951/ data (WLTABW(I),I= 67,132)/ & & 1.23457, 1.25000, 1.26582, 1.28205, 1.29870, 1.31579,& & 1.33333, 1.35135, 1.36986, 1.38889, 1.40845, 1.42857,& & 1.44300, 1.47059, 1.49254, 1.51515, 1.53846, 1.56250,& & 1.58730, 1.61290, 1.63934, 1.66667, 1.69492, 1.72414,& & 1.75439, 1.78571, 1.80180, 1.81818, 1.85185, 1.88679,& & 1.92678, 1.96078, 2.00000, 2.02020, 2.04082, 2.06186,& & 2.08333, 2.10526, 2.12766, 2.15054, 2.17391, 2.19780,& & 2.22222, 2.24719, 2.27273, 2.29885, 2.32558, 2.35294,& & 2.38095, 2.40964, 2.43902, 2.46914, 2.50000, 2.50627,& & 2.51256, 2.51889, 2.52525, 2.53165, 2.53807, 2.54453,& & 2.55102, 2.55754, 2.56410, 2.57069, 2.57732, 2.58398/ data (WLTABW(I),I=133,198)/ & & 2.59067, 2.59740, 2.60417, 2.61097, 2.61780, 2.62467,& & 2.63158, 2.63852, 2.64550, 2.65252, 2.65957, 2.66667,& & 2.67380, 2.68097, 2.68817, 2.69542, 2.70270, 2.71003,& & 2.71739, 2.72480, 2.73224, 2.73973, 2.74725, 2.75482,& & 2.76243, 2.77008, 2.77778, 2.78552, 2.79330, 2.80112,& & 2.80899, 2.81690, 2.82486, 2.83286, 2.84091, 2.84900,& & 2.85714, 2.86533, 2.87356, 2.88184, 2.89017, 2.89855,& & 2.90698, 2.91545, 2.92398, 2.93255, 2.94118, 2.94985,& & 2.95858, 2.96736, 2.97619, 2.98507, 2.99401, 3.00300,& & 3.01205, 3.02115, 3.03030, 3.03951, 3.04878, 3.05810,& & 3.06748, 3.07692, 3.08642, 3.09598, 3.10559, 3.11526/ data (WLTABW(I),I=199,264)/ & & 3.12500, 3.13480, 3.14465, 3.15457, 3.16456, 3.17460,& & 3.18471, 3.19489, 3.20513, 3.21543, 3.22581, 3.23625,& & 3.24675, 3.25733, 3.26797, 3.27869, 3.28947, 3.30033,& & 3.31126, 3.32226, 3.33333, 3.34448, 3.35570, 3.36700,& & 3.37838, 3.38983, 3.40136, 3.41297, 3.42466, 3.43643,& & 3.44828, 3.46021, 3.47222, 3.48432, 3.49650, 3.50877,& & 3.52113, 3.53357, 3.54610, 3.55872, 3.57143, 3.58423,& & 3.59712, 3.61011, 3.62319, 3.63636, 3.64964, 3.66300,& & 3.67647, 3.69004, 3.70370, 3.71747, 3.73134, 3.74532,& & 3.75940, 3.77358, 3.78788, 3.80228, 3.81679, 3.83142,& & 3.84615, 3.86100, 3.87597, 3.89105, 3.90625, 3.92157/ data (WLTABW(I),I=265,330)/ & & 3.93701, 3.95257, 3.96825, 3.98406, 4.00000, 4.01606,& & 4.03226, 4.04858, 4.06504, 4.08163, 4.09836, 4.11523,& & 4.13223, 4.14938, 4.16667, 4.18410, 4.20168, 4.21941,& & 4.23729, 4.25532, 4.27350, 4.29185, 4.31034, 4.32900,& & 4.34783, 4.36681, 4.38596, 4.40529, 4.42478, 4.44444,& & 4.46429, 4.48430, 4.50450, 4.52489, 4.54545, 4.56621,& & 4.58716, 4.60829, 4.62963, 4.65116, 4.67290, 4.69484,& & 4.71698, 4.73934, 4.76190, 4.78469, 4.80769, 4.83092,& & 4.85437, 4.87805, 4.90196, 4.92611, 4.95050, 4.97512,& & 5.00000, 5.02513, 5.05051, 5.07614, 5.10204, 5.12821,& & 5.15464, 5.18135, 5.20833, 5.23560, 5.26316, 5.29101/ data (WLTABW(I),I=331,396)/ & & 5.31915, 5.34759, 5.37634, 5.40541, 5.43478, 5.46448,& & 5.49451, 5.52486, 5.55556, 5.58659, 5.61798, 5.64972,& & 5.68182, 5.71429, 5.74713, 5.78035, 5.81395, 5.84795,& & 5.88235, 5.91716, 5.95238, 5.98802, 6.02410, 6.06061,& & 6.09756, 6.13497, 6.17284, 6.21118, 6.25000, 6.28931,& & 6.32911, 6.36943, 6.41026, 6.45161, 6.49351, 6.53595,& & 6.57895, 6.62252, 6.66667, 6.71141, 6.75676, 6.80272,& & 6.84932, 6.89655, 6.94444, 6.99301, 7.04225, 7.09220,& & 7.14286, 7.19424, 7.24638, 7.29927, 7.35294, 7.40741,& & 7.46269, 7.51880, 7.57576, 7.63359, 7.69231, 7.75194,& & 7.81250, 7.87402, 7.93651, 8.00000, 8.06452, 8.13008/ data (WLTABW(I),I=397,462)/ & & 8.19672, 8.26446, 8.33333, 8.40336, 8.47458, 8.54701,& & 8.62069, 8.69565, 8.77193, 8.84956, 8.92857, 9.00901,& & 9.09091, 9.17431, 9.25926, 9.34579, 9.43396, 9.52381,& & 9.61538, 9.70874, 9.80392, 9.90099, 10.00000, 10.10101,& & 10.20408, 10.30928, 10.41667, 10.52632, 10.63830, 10.75269,& & 10.86957, 10.98901, 11.11111, 11.23596, 11.36364, 11.49425,& & 11.62791, 11.76471, 11.90476, 12.04819, 12.19512, 12.34568,& & 12.50000, 12.65823, 12.82051, 12.98701, 13.15789, 13.33333,& & 13.51351, 13.69863, 13.88889, 14.08451, 14.28571, 14.49275,& & 14.70588, 14.92537, 15.15152, 15.38462, 15.62500, 15.87302,& & 16.12903, 16.39344, 16.66667, 16.94915, 17.24138, 17.54386/ data (WLTABW(I),I=463,518)/ & & 17.85714, 18.18182, 18.51852, 18.86792, 19.23077, 19.60784,& & 20.00000, 20.40816, 20.83333, 21.27660, 21.73913, 22.22222,& & 22.72727, 23.25581, 23.80952, 24.39024, 25.00000, 25.64103,& & 26.31579, 27.02703, 27.77778, 28.57143, 29.41176, 30.30303,& & 31.25000, 32.25806, 33.33333, 34.48276, 35.71429, 37.03704,& & 38.46154, 40.00000, 41.66667, 43.47826, 45.45455, 47.61905,& & 50.00000, 52.63158, 55.55556, 58.82353, 62.50000, 66.66667,& & 71.42857, 76.92308, 83.33333, 90.90909, 100.00000, 111.11111,& & 125.00000, 142.85714, 166.66667, 200.00000, 250.00000, 333.33333,& & 500.00000,1000.00000/ data (RNTABW(I),I= 1, 66)/ & &1.396,1.373,1.362,1.354,1.349,1.346,1.343,1.341,1.339,1.338,1.337,& &1.336,1.335,1.334,1.333,1.333,1.332,1.332,1.331,1.331,1.332,1.332,& &1.332,1.332,1.332,1.332,1.332,1.332,1.331,1.331,1.331,1.331,1.331,& &1.330,1.330,1.330,1.330,1.330,1.329,1.329,1.329,1.329,1.329,1.328,& &1.328,1.328,1.328,1.328,1.328,1.328,1.328,1.328,1.328,1.328,1.328,& &1.327,1.327,1.327,1.327,1.326,1.326,1.326,1.326,1.325,1.325,1.325/ data (RNTABW(I),I= 67,132)/ & &1.325,1.325,1.324,1.324,1.324,1.324,1.323,1.323,1.323,1.322,1.322,& &1.321,1.321,1.321,1.320,1.320,1.319,1.319,1.318,1.318,1.317,1.316,& &1.315,1.314,1.314,1.313,1.312,1.312,1.311,1.310,1.309,1.307,1.306,& &1.301,1.301,1.300,1.298,1.298,1.296,1.295,1.294,1.293,1.291,1.289,& &1.287,1.285,1.282,1.280,1.277,1.274,1.270,1.265,1.261,1.260,1.259,& &1.257,1.256,1.255,1.254,1.252,1.250,1.249,1.247,1.246,1.243,1.241/ data (RNTABW(I),I=133,198)/ & &1.240,1.238,1.235,1.232,1.230,1.227,1.224,1.221,1.218,1.214,1.210,& &1.205,1.200,1.195,1.191,1.185,1.179,1.172,1.166,1.157,1.149,1.144,& &1.139,1.138,1.138,1.139,1.141,1.144,1.149,1.154,1.158,1.161,1.165,& &1.171,1.177,1.183,1.191,1.199,1.212,1.220,1.233,1.246,1.258,1.271,& &1.282,1.293,1.305,1.317,1.329,1.342,1.353,1.364,1.376,1.386,1.398,& &1.407,1.417,1.426,1.434,1.442,1.450,1.457,1.465,1.471,1.476,1.480/ data (RNTABW(I),I=199,264)/ & &1.483,1.486,1.487,1.487,1.487,1.486,1.485,1.482,1.479,1.477,1.474,& &1.472,1.467,1.464,1.461,1.457,1.454,1.451,1.448,1.444,1.441,1.437,& &1.434,1.431,1.427,1.425,1.421,1.418,1.415,1.413,1.410,1.407,1.405,& &1.403,1.400,1.398,1.396,1.394,1.392,1.390,1.388,1.387,1.385,1.383,& &1.382,1.379,1.378,1.377,1.375,1.374,1.372,1.371,1.370,1.369,1.367,& &1.366,1.365,1.363,1.361,1.361,1.360,1.358,1.358,1.357,1.355,1.354/ data (RNTABW(I),I=265,330)/ & &1.353,1.352,1.351,1.350,1.349,1.348,1.348,1.347,1.346,1.345,1.344,& &1.344,1.343,1.342,1.341,1.340,1.340,1.338,1.337,1.337,1.335,1.334,& &1.334,1.333,1.332,1.332,1.331,1.330,1.330,1.330,1.329,1.329,1.329,& &1.328,1.328,1.327,1.327,1.327,1.327,1.327,1.326,1.326,1.326,1.325,& &1.325,1.325,1.325,1.325,1.325,1.324,1.324,1.323,1.322,1.322,1.321,& &1.320,1.319,1.318,1.318,1.317,1.316,1.314,1.313,1.311,1.310,1.308/ data (RNTABW(I),I=331,396)/ & &1.306,1.304,1.302,1.299,1.297,1.294,1.291,1.288,1.285,1.282,1.278,& &1.275,1.271,1.267,1.262,1.256,1.251,1.247,1.242,1.241,1.241,1.247,& &1.265,1.289,1.311,1.332,1.349,1.354,1.356,1.354,1.350,1.345,1.341,& &1.337,1.333,1.330,1.326,1.324,1.322,1.320,1.319,1.318,1.317,1.316,& &1.315,1.314,1.313,1.311,1.310,1.309,1.308,1.307,1.306,1.305,1.303,& &1.302,1.301,1.300,1.298,1.296,1.295,1.294,1.293,1.291,1.288,1.286/ data (RNTABW(I),I=397,462)/ & &1.285,1.283,1.281,1.279,1.276,1.274,1.271,1.269,1.267,1.264,1.261,& &1.259,1.256,1.253,1.249,1.246,1.242,1.238,1.234,1.230,1.224,1.220,& &1.214,1.208,1.202,1.194,1.189,1.181,1.174,1.168,1.162,1.156,1.149,& &1.143,1.139,1.135,1.132,1.132,1.131,1.132,1.130,1.130,1.134,1.138,& &1.142,1.157,1.171,1.182,1.189,1.201,1.213,1.223,1.236,1.249,1.264,& &1.277,1.289,1.303,1.313,1.324,1.335,1.348,1.361,1.372,1.385,1.396/ data (RNTABW(I),I=463,518)/ & &1.407,1.419,1.431,1.441,1.451,1.462,1.470,1.480,1.488,1.496,1.504,& &1.510,1.515,1.521,1.527,1.532,1.537,1.541,1.545,1.549,1.552,1.552,& &1.552,1.550,1.546,1.543,1.541,1.539,1.537,1.534,1.532,1.529,1.525,& &1.528,1.542,1.567,1.600,1.640,1.689,1.746,1.801,1.848,1.890,1.929,& &1.960,1.982,1.997,2.000,2.010,2.020,2.040,2.070,2.110,2.150,2.225,& &2.481/ data (CNTABW(I),I= 1, 66)/ & &1.1000E-07,4.9000E-08,3.4000E-08,2.4000E-08,1.6000E-08,1.1000E-08,& &6.5000E-09,3.5000E-09,1.9000E-09,1.3000E-09,1.0000E-09,9.4000E-10,& &1.0000E-09,1.3000E-09,2.0000E-09,3.6000E-09,1.1000E-08,1.4000E-08,& &1.6000E-08,2.2000E-08,2.7000E-08,3.8000E-08,5.6000E-08,7.7300E-08,& &1.3900E-07,1.6300E-07,1.6800E-07,1.6400E-07,1.5400E-07,1.4300E-07,& &1.3300E-07,1.2500E-07,1.2400E-07,1.3000E-07,2.0400E-07,2.6100E-07,& &2.9400E-07,3.5300E-07,4.3300E-07,5.4300E-07,8.7700E-07,1.1800E-06,& &1.6100E-06,2.4400E-06,3.6000E-06,3.9800E-06,3.9200E-06,3.7000E-06,& &3.3100E-06,2.8200E-06,2.3100E-06,1.9000E-06,1.5700E-06,1.3700E-06,& &1.2600E-06,1.4400E-06,1.6800E-06,2.0500E-06,2.8900E-06,4.9600E-06,& &8.8700E-06,1.0900E-05,1.1500E-05,1.1800E-05,1.2000E-05,1.1800E-05/ data (CNTABW(I),I= 67,132)/ & &1.1500E-05,1.1000E-05,1.0800E-05,1.1500E-05,1.3800E-05,1.7500E-05,& &2.3900E-05,4.1600E-05,5.9400E-05,1.0100E-04,2.4100E-04,3.5200E-04,& &3.6400E-04,3.3400E-04,2.5800E-04,1.8800E-04,1.4800E-04,1.2000E-04,& &1.0200E-04,8.7300E-05,7.9200E-05,7.4900E-05,7.6200E-05,8.5500E-05,& &1.0600E-04,1.3000E-04,1.3600E-04,1.3700E-04,1.5900E-04,8.6300E-04,& &1.9000E-03,1.7000E-03,1.1000E-03,9.0000E-04,7.3100E-04,6.1700E-04,& &5.1400E-04,4.5200E-04,4.0000E-04,3.5900E-04,3.4100E-04,3.3800E-04,& &3.4500E-04,3.7600E-04,4.1600E-04,4.6500E-04,5.4200E-04,6.5200E-04,& &7.9200E-04,9.6800E-04,1.2300E-03,1.5600E-03,1.9000E-03,1.9500E-03,& &2.0000E-03,2.0500E-03,2.0700E-03,2.1000E-03,2.1200E-03,2.1500E-03,& &2.1900E-03,2.2400E-03,2.2700E-03,2.3100E-03,2.3400E-03,2.3900E-03/ data (CNTABW(I),I=133,198)/ & &2.4300E-03,2.4800E-03,2.5700E-03,2.7000E-03,2.9800E-03,3.3000E-03,& &4.0200E-03,4.3700E-03,4.8200E-03,5.3600E-03,6.2700E-03,7.3200E-03,& &8.5500E-03,1.0500E-02,1.2700E-02,1.4500E-02,1.6400E-02,1.8600E-02,& &2.0500E-02,2.8200E-02,3.8000E-02,4.6200E-02,5.4800E-02,6.4900E-02,& &7.4400E-02,8.3600E-02,9.2700E-02,1.0200E-01,1.1200E-01,1.2100E-01,& &1.3100E-01,1.4200E-01,1.5400E-01,1.6700E-01,1.8000E-01,1.9400E-01,& &2.0600E-01,2.1800E-01,2.2900E-01,2.3900E-01,2.4900E-01,2.5800E-01,& &2.6500E-01,2.7100E-01,2.7600E-01,2.8000E-01,2.8100E-01,2.8200E-01,& &2.8200E-01,2.7900E-01,2.7600E-01,2.7200E-01,2.6700E-01,2.6200E-01,& &2.5500E-01,2.5000E-01,2.4300E-01,2.3600E-01,2.2800E-01,2.2000E-01,& &2.1200E-01,2.0400E-01,1.9500E-01,1.8300E-01,1.7300E-01,1.6300E-01/ data (CNTABW(I),I=199,264)/ & &1.5300E-01,1.4400E-01,1.3400E-01,1.2500E-01,1.1700E-01,1.1000E-01,& &9.9400E-02,9.2000E-02,8.5500E-02,7.8500E-02,7.1600E-02,6.5300E-02,& &6.0000E-02,5.5000E-02,5.0400E-02,4.6200E-02,4.2200E-02,3.8500E-02,& &3.4800E-02,3.1500E-02,2.9700E-02,2.7900E-02,2.6200E-02,2.5000E-02,& &2.2900E-02,2.1000E-02,1.9300E-02,1.7700E-02,1.6300E-02,1.5100E-02,& &1.3800E-02,1.2800E-02,1.1800E-02,1.1000E-02,1.0100E-02,9.4100E-03,& &8.6600E-03,8.0700E-03,7.3700E-03,6.8300E-03,6.2500E-03,5.7900E-03,& &5.3800E-03,5.0600E-03,4.7300E-03,4.4900E-03,4.2400E-03,4.0500E-03,& &3.8900E-03,3.7600E-03,3.6300E-03,3.5500E-03,3.4700E-03,3.4000E-03,& &3.3500E-03,3.3600E-03,3.3500E-03,3.3900E-03,3.4000E-03,3.4800E-03,& &3.5200E-03,3.6300E-03,3.7000E-03,3.7800E-03,3.8900E-03,3.9900E-03/ data (CNTABW(I),I=265,330)/ & &4.1000E-03,4.2200E-03,4.3300E-03,4.5000E-03,4.6500E-03,4.7900E-03,& &4.9400E-03,5.1200E-03,5.3100E-03,5.4900E-03,5.6800E-03,5.8600E-03,& &6.0800E-03,6.3100E-03,6.5300E-03,6.7300E-03,6.9600E-03,7.2200E-03,& &7.4900E-03,7.7900E-03,8.0600E-03,8.3300E-03,8.6400E-03,8.9600E-03,& &9.2700E-03,9.6600E-03,1.0000E-02,1.0400E-02,1.0800E-02,1.1200E-02,& &1.1700E-02,1.2200E-02,1.2600E-02,1.3100E-02,1.3600E-02,1.4000E-02,& &1.4500E-02,1.4900E-02,1.5200E-02,1.5400E-02,1.5600E-02,1.5700E-02,& &1.5700E-02,1.5700E-02,1.5500E-02,1.5300E-02,1.5100E-02,1.4800E-02,& &1.4600E-02,1.4300E-02,1.4000E-02,1.3700E-02,1.3300E-02,1.2900E-02,& &1.2600E-02,1.2200E-02,1.1800E-02,1.1500E-02,1.1000E-02,1.0800E-02,& &1.0500E-02,1.0300E-02,1.0100E-02,1.0000E-02,9.9300E-03,9.9000E-03/ data (CNTABW(I),I=331,396)/ & &9.9500E-03,1.0000E-02,1.0200E-02,1.0400E-02,1.0700E-02,1.1000E-02,& &1.1500E-02,1.2000E-02,1.2800E-02,1.3800E-02,1.5000E-02,1.6600E-02,& &1.8500E-02,2.0500E-02,2.4200E-02,2.9300E-02,3.3200E-02,4.2900E-02,& &5.4400E-02,6.8800E-02,8.4000E-02,1.0210E-01,1.1700E-01,1.3000E-01,& &1.3200E-01,1.2400E-01,1.0600E-01,8.8000E-02,7.4000E-02,6.1800E-02,& &5.3500E-02,4.8400E-02,4.4700E-02,4.2000E-02,3.9800E-02,3.8300E-02,& &3.7300E-02,3.7000E-02,3.6600E-02,3.6300E-02,3.6000E-02,3.5700E-02,& &3.5500E-02,3.5200E-02,3.5000E-02,3.4700E-02,3.4600E-02,3.4300E-02,& &3.4200E-02,3.4200E-02,3.4200E-02,3.4300E-02,3.4200E-02,3.4200E-02,& &3.4200E-02,3.4200E-02,3.4200E-02,3.4400E-02,3.4500E-02,3.4600E-02,& &3.4900E-02,3.5100E-02,3.5100E-02,3.5100E-02,3.5200E-02,3.5600E-02/ data (CNTABW(I),I=397,462)/ & &3.5900E-02,3.6100E-02,3.6200E-02,3.6600E-02,3.7000E-02,3.7400E-02,& &3.7800E-02,3.8300E-02,3.8700E-02,3.9200E-02,3.9800E-02,4.0500E-02,& &4.1100E-02,4.1700E-02,4.2400E-02,4.3400E-02,4.4300E-02,4.5300E-02,& &4.6700E-02,4.8100E-02,4.9700E-02,5.1500E-02,5.3400E-02,5.5700E-02,& &5.8900E-02,6.2200E-02,6.6100E-02,7.0700E-02,7.6400E-02,8.2800E-02,& &8.9800E-02,9.7300E-02,1.0700E-01,1.1800E-01,1.3000E-01,1.4400E-01,& &1.5900E-01,1.7600E-01,1.9200E-01,2.0800E-01,2.2600E-01,2.4300E-01,& &2.6000E-01,2.7700E-01,2.9200E-01,3.0500E-01,3.1700E-01,3.2800E-01,& &3.3800E-01,3.4700E-01,3.5600E-01,3.6500E-01,3.7300E-01,3.7900E-01,& &3.8600E-01,3.9200E-01,3.9700E-01,4.0300E-01,4.0800E-01,4.1200E-01,& &4.1700E-01,4.2000E-01,4.2300E-01,4.2500E-01,4.2700E-01,4.2800E-01/ data (CNTABW(I),I=463,518)/ & &4.2700E-01,4.2700E-01,4.2600E-01,4.2500E-01,4.2300E-01,4.2100E-01,& &4.1800E-01,4.1500E-01,4.1100E-01,4.0800E-01,4.0400E-01,4.0100E-01,& &3.9700E-01,3.9400E-01,3.9000E-01,3.8600E-01,3.8200E-01,3.7700E-01,& &3.7200E-01,3.6800E-01,3.6300E-01,3.5900E-01,3.5600E-01,3.5200E-01,& &3.5300E-01,3.5700E-01,3.6100E-01,3.6800E-01,3.7500E-01,3.8500E-01,& &3.9800E-01,4.1400E-01,4.3600E-01,4.6900E-01,5.0500E-01,5.3900E-01,& &5.7100E-01,5.9700E-01,6.1800E-01,6.2900E-01,6.2200E-01,6.0800E-01,& &5.9300E-01,5.7700E-01,5.5700E-01,5.3200E-01,5.0700E-01,4.8700E-01,& &4.6600E-01,4.5000E-01,4.4400E-01,4.3800E-01,4.6000E-01,5.2700E-01,& &7.1800E-01,8.4657E-01/ ! ! ZERO PARAMETERS ! RN = 0.0 CN = 0.0 ! ! CONVERT WAVELENGTH TO MICRONS ! WL = XLAM if (IUNIT .eq. 1) WL = 1000. * WL if (IUNIT .eq. 2) WL = 10000. * WL if (IUNIT .eq. 3) WL = 10000. * (1.0/WL) if ((WL .lt. WLMIN) .or. (WL .gt. WLMAX)) return ! ! REGION FROM 0.2 MICRON TO 1000.0 MICRON - TABLE LOOKUP ! ! This if block has been restructured to take advantage of ! new control features available in Fortran 90. [MAW] ! if (WL .gt. CUTWAT) then ! ! REGION FROM 0.1 CM TO 10 CM ! ! EXTENSION OF DEBYE THEOREY BASED ON THE WORK OF ! ! COLE,K.S.,AND R.H.COLE,1941.JOUR.CHEM.PHYS.,9,P 341. ! ! DEFINE TEMPERATURE TERMS AND WAVELENGTH IN CM ! ! --------------------------------------------------------------------- ! Note, the function eps_swd_l91dd is replacing this section of code. ! It is an updated version for the microwave region, using the model ! of Liebe et al. 1991. ! Old statements have been commented, yet retained. ! Some of the old statements were used, and contain lowercase ! letters. Compare to refwat.f by Eric A. Smith. ! July 1998: Benjamin T. Johnson - Purdue University [BTJ] ! --------------------------------------------------------------------- TC = T - 273.15 ! T1=TC+273.0 ! T2=TC-25.0 ! Converts wavelength(WL) from microns to centimeters. [BTJ] ! However, to replace this section with eps_swd_l91dd, we need to convert ! to Gigahertz. [BTJ] ! XL=WL/10000.0 ! Conversion to Gigahertz XL = WL * 1.0e-6 NU = CC / XL NU = NU * 1.0e-9 ! Call the eps_swd_l91dd subroutine, passing TC and NU as temperature ! in degrees celcius, and frequency in gigahertz (i.e. 85.5) [BTJ] ! --------------------------------------------------------------------- ! write (*, "('Nu = ', f10.3, ' [GHz], Tc = ', f10.3, ' [K].')") nu, tc E = eps_swd_l91dd(NU, TC) ! Replaced old function [MAW] ! write (*, "('Eps(water) = ', 2f10.3)") E ! --------------------------------------------------------------------- ! Most of the old stuff from here on is commented out. [BTJ] ! ! DEFINE FREQUENCY INDEPENDENT CONDUCTIVITY(SIGMA) AND ! SPREAD PARAMETER(ALPHA) ! ! IN CLASSICAL DEBYE THEOREY THESE TERMS ARE ZERO ! ! SIGMA GIVEN BY SAXTON,J.A.,1949.WIRELESS ENGINEER,26,P 288. ! ALPHA GIVEN BY RAY ( EQUATION 7B ) ! ! SIGMA=12.5664E8 ! ALPHA=-16.8129/T1+0.0609265 ! ! DEFINE STATIC DIELECTRIC CONSTANT(ES) - RAY EQN 4 ! HIGH FREQUENCY DIELECTRIC CONSTANT(E00) - RAY EQN 7A ! RELAXTION WAVELENGTH IN CM(XLAMS) - RAY EQN 7C ! ! TEMPERATURE DEPENDENCE OF ES GIVEN BY ! ! WYMAN,J.,AND E.N.INGALLS,1938.JOUR.AM.CHEM.SOC.,60,P 1182. ! ! ES=78.54*(1.0-4.579E-3*T2+1.19E-5*T2*T2-2.8E-8*T2*T2*T2) ! E00=5.27137+0.0216474*TC-0.00131198*TC*TC ! XLAMS=0.00033836*EXP(2513.98/T1) ! ! CALCULATE EXPRESSIONS USED FOR DIELECTRIC CONSTANT ! ! TERM=PI*ALPHA/2 ! SINT=SIN(TERM) ! COST=COS(TERM) ! XLRAT=XLAMS/XL ! POWTRM=XLRAT**(1-ALPHA) ! DENOM=1.0+2*POWTRM*SINT+XLRAT**(2.0*(1-ALPHA)) ! ! CALCULATION OF DIELECTRIC CONSTANT ! ! REAL PART - RAY EQN 5 ! ! ER=E00+(ES-E00)*(1.0+POWTRM*SINT)/DENOM ! ! IMAGINARY PART OR LOSS TERM - RAY EQN 6 ! ! EI=(SIGMA*XL/18.8496E10)+(ES-E00)*POWTRM*COST/DENOM ! ! COMPLEX PERMITTIVITY ! !!$ E = CMPLX(ER, -EI) ! ! COMPLEX INDEX OF REFRACTION - RAY EQN 1 ! M = sqrt(E) RN = real(M) CN = abs(aimag(M)) ! ! CORRECTION TO IMAGINARY INDEX TO ACCOUNT FOR THE ! REMAINING ABSORPTION BANDS - RAY EQN 8(TABLE 2) ! !!$ if (WL .le. 3000.0) CN = CN + ABSUM( 17.0,0.39,0.45,1.3) & !!$ + ABSUM( 62.0,0.41,0.35,1.7) & !!$ + ABSUM(300.0,0.25,0.47,3.0) ! ! This part no longer needed because of eps_swd_l91dd [MAW] ! ! ABSORPTIVE QUANITIES ! else do I = 2, NUMWAT if (WL .le. WLTABW(I)) exit enddo I1 = I - 1 I2 = I FAC = (WL - WLTABW(I1)) / (WLTABW(I2) - WLTABW(I1)) RN = RNTABW(I1) + FAC * (RNTABW(I2) - RNTABW(I1)) CN = CNTABW(I1) + FAC * (CNTABW(I2) - CNTABW(I1)) endif indx = CMPLX(rn,cn) return contains ! Function for treating absorption bands not considered in the ! Debye theory. Note: name changed from SUM, which is an F90 ! intrinsic function; moved to internal function [MAW] function ABSUM(WLCEN, BET, DEL, GAM) real :: ABSUM real, intent (IN) :: WLCEN, BET, DEL, GAM ABSUM = BET * exp( - abs(log10(WL/WLCEN)/DEL)**GAM) return end function ABSUM end SUBROUTINE index_water