SUBROUTINE REFWAT(IUNIT,XLAM,T,RN,CN,ABSIND,ABSCOF) C C DEFINES WAVELENGTH DEPENDENT COMPLEX INDEX OF REFRACTION FOR WATER C ALLOWABLE WAVELENGTH RANGE EXTENDS FROM .2 MICRONS TO 10 CM C TEMPERATURE DEPENDENCE ONLY CONSIDERED BEYOND 0.1 CM C C ERIC A. SMITH C DEPT OF ATMOSPHERIC SCIENCE C COLORADO STATE UNIVERSITY C FORT COLLINS,CO 80523 C TEL 303-491-8533 C C REFERENCES C C 0.2 UM - 0.69 UM C C HALE,G., AND M. QUERRY,1972. C OPTICAL CONSTANTS OF WATER IN THE 200 NM TO 200 UM WAVELENGTH REGI C APPLIED OPTICS,12,3,555-563. C C 0.69 UM - 2.0 UM C C PALMER,K.F., AND D. WILLIAMS,1974. C OPTICAL PROPERTIES OF WATER IN THE NEAR INFRARED. C JOURNAL OF THE OPTICAL SOCIETY OF AMERICA,64,8,1107-1110. C C 2.0 UM - 1000.0 UM C C DOWNING,H.D., AND D. WILLIAMS,1975. C OPTICAL CONSTANTS OF WATER IN THE INFRARED. C JOURNAL OF GEOPHYSICAL REVIEW,80,12,1656-1661. C C 1.0 MM - 10.0 CM C C RAY,P.S.,1972. C BROADBAND COMPLEX REFRACTIVE INDICES OF ICE AND WATER. C APPLIED OPTICS,11,8,1836-1844. C C INPUT PARAMETERS C C IUNIT = 0 FOR WAVELENGTH SPECIFIED IN MICRONS C = 1 FOR WAVELENGTH SPECIFIED IN MILLIMETERS C = 2 FOR WAVELENGTH SPECIFIED IN CENTIMETERS C = 3 FOR WAVELENGTH SPECIFIED IN INVERSE CENTIMETERS ( WAVE N C XLAM = WAVELENGTH ( MICRONS OR MM OR CM OR CM**-1 ) C T = TEMPERATURE ( DEGREES KELVIN ) C C OUTPUT PARAMETERS C C RN = REAL PORTION ( SCATTERING ) C CN = COMPLEX PORTION ( ABSORPTION ) C ABSIND = ABSORPTIVE INDEX ( CN/RN ) C ABSCOF = ABORPTION COEFFICIENT ( 4*PI*CN/XLAM ) C COMPLEX E,M DIMENSION WLTABW(518),RNTABW(518),CNTABW(518) DATA NUMWAT/518/ DATA WLMIN,WLMAX/0.2,100000.0/ DATA CUTWAT/1000.0/ 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/ DATA PI/3.14159265/ C C FUNCTION FOR TREATING ABSORPTION BANDS NOT CONSIDERED IN THE C DEBYE THEOREY C SUM(WL,WLCEN,BET,DEL,GAM)=BET*EXP(-ABS(ALOG10(WL/WLCEN)/DEL)**GAM) C C ZERO PARAMETERS C RN=0.0 CN=0.0 ABSIND=0.0 ABSCOF=0.0 C C CONVERT WAVELENGTH TO MICRONS C 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 C C REGION FROM 0.2 MICRON TO 1000.0 MICRON - TABLE LOOKUP C IF(WL.GT.CUTWAT)GO TO 3 DO 1 I=2,NUMWAT IF(WL.GT.WLTABW(I))GO TO 1 I1=I-1 I2=I GO TO 2 1 CONTINUE I1=NUMWAT-1 I2=NUMWAT 2 FAC=(WL-WLTABW(I1))/(WLTABW(I2)-WLTABW(I1)) RN=RNTABW(I1)+FAC*(RNTABW(I2)-RNTABW(I1)) CN=CNTABW(I1)+FAC*(CNTABW(I2)-CNTABW(I1)) GO TO 5 C C REGION FROM 0.1 CM TO 10 CM C C EXTENSION OF DEBYE THEOREY BASED ON THE WORK OF C C COLE,K.S.,AND R.H.COLE,1941.JOUR.CHEM.PHYS.,9,P 341. C C DEFINE TEMPERATURE TERMS AND WAVELENGTH IN CM C 3 TC=T-273.15 T1=TC+273.0 T2=TC-25.0 XL=WL/10000.0 C C DEFINE FREQUENCY INDEPENDENT CONDUCTIVITY(SIGMA) AND C SPREAD PARAMETER(ALPHA) C C IN CLASSICAL DEBYE THEOREY THESE TERMS ARE ZERO C C SIGMA GIVEN BY SAXTON,J.A.,1949.WIRELESS ENGINEER,26,P 288. C ALPHA GIVEN BY RAY ( EQUATION 7B ) C SIGMA=12.5664E8 ALPHA=-16.8129/T1+0.0609265 C C DEFINE STATIC DIELECTRIC CONSTANT(ES) - RAY EQN 4 C HIGH FREQUENCY DIELECTRIC CONSTANT(E00) - RAY EQN 7A C RELAXTION WAVELENGTH IN CM(XLAMS) - RAY EQN 7C C C TEMPERATURE DEPENDENCE OF ES GIVEN BY C C WYMAN,J.,AND E.N.INGALLS,1938.JOUR.AM.CHEM.SOC.,60,P 1182. C 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) C C CALCULATE EXPRESSIONS USED FOR DIELECTRIC CONSTANT C 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)) C C CALCULATION OF DIELECTRIC CONSTANT C C REAL PART - RAY EQN 5 C ER=E00+(ES-E00)*(1.0+POWTRM*SINT)/DENOM C C IMAGINARY PART OR LOSS TERM - RAY EQN 6 C EI=(SIGMA*XL/18.8496E10)+(ES-E00)*POWTRM*COST/DENOM C C COMPLEX PERMITTIVITY C E=CMPLX(ER,-EI) C C COMPLEX INDEX OF REFRACTION - RAY EQN 1 C M=CSQRT(E) RN=REAL(M) CN=-AIMAG(M) C C CORRECTION TO IMAGINARY INDEX TO ACCOUNT FOR THE C REMAINING ABSORPTION BANDS - RAY EQN 8(TABLE 2) C IF(WL.GT.3000.0)GO TO 5 CN=CN+SUM(WL, 17.0,0.39,0.45,1.3) * +SUM(WL, 62.0,0.41,0.35,1.7) * +SUM(WL,300.0,0.25,0.47,3.0) C C ABSORPTIVE QUANITIES C 5 ABSIND=CN/RN ABSCOF=4.0*PI*CN/WL RETURN END SUBROUTINE ROT2(A,THETA,RM) C*********************************************************************** C This subroutine finds the (3 by 3) rotation matrix for the C given axis (vector) --- a and the rotation angle --- theta. C On input: C a(3) --- axis of rotation (vector, any length) C theta --- angle of rotation (in radians) around vector a C On output: C rm(3,3) --- rotation matrix such that new vector v2 is obtained C from the old vector v1 by the transformation: C v2 = rm \dot v1 C (If more rotations are needed: generate matrices rm with the C help of this subroutine and (matrix) multiply them before C performing v2 = rm \dot v1.) C C Reference: C Leubner, C., 1977, Coordinate-free rotation operator, C Am. J. Phys. 47, 727---729. C C History: C Written by PJF, May 1989, for use in the rotation-averaged C DDA calculations. C C Copyright (C) 1993, B.T. Draine and P.J. Flatau C This code is covered by the GNU General Public License. C*********************************************************************** C pre-calculate some stuff: C .. Scalar Arguments .. REAL THETA C .. C .. Array Arguments .. REAL A(3), RM(3,3) C .. C .. Local Scalars .. REAL ANORM, CT, ST INTEGER I, J C .. C .. Local Arrays .. REAL AHAT(3) C .. C .. External Subroutines .. EXTERNAL XNORM3 C .. C .. Intrinsic Functions .. INTRINSIC COS, SIN C .. CT = COS(THETA) ST = SIN(THETA) CALL XNORM3(A,ANORM) AHAT(1) = A(1)/ANORM AHAT(2) = A(2)/ANORM AHAT(3) = A(3)/ANORM C cos(\theta) {\bf 1} term: RM(1,1) = CT RM(2,2) = CT RM(3,3) = CT C Skew-term a \times {\bf 1}: RM(1,2) = -ST*AHAT(3) RM(1,3) = ST*AHAT(2) RM(2,1) = ST*AHAT(3) RM(2,3) = -ST*AHAT(1) RM(3,1) = -ST*AHAT(2) RM(3,2) = ST*AHAT(1) C aa-dyadic (outer-product): DO 20 I = 1, 3 DO 10 J = 1, 3 RM(I,J) = RM(I,J) + (1.-CT)*AHAT(J)*AHAT(I) 10 CONTINUE 20 CONTINUE RETURN END SUBROUTINE ROTATE(A1,A2,AK1,CXE01,CXE02,BETA,THETA,PHI, $ EN0R,CXE01R,CXE02R,MXSCA,NSCAT,ENSC,EM1,EM2, $ AKSR,EM1R,EM2R) C Arguments: INTEGER MXSCA,NSCAT REAL AK1, BETA, THETA, PHI REAL A1(3), A2(3), AKSR(3,MXSCA), $ EM1(3,MXSCA), EM1R(3,MXSCA), EM2(3,MXSCA), $ EM2R(3,MXSCA), EN0R(3), ENSC(3,MXSCA) COMPLEX CXE01(3),CXE02(3),CXE01R(3),CXE02R(3) C Local variables INTEGER I REAL BETA0, PHI0, SINTHE, THETA0 REAL RM1(3,3),RM2(3,3),RM3(3,3),VEC(3) C Given: C A1(1-3)=axis 1 of (original, unrotated) target C A2(1-3)=axis 2 of (original, unrotated) target C AK1=magnitude of k vector C CXE01(1-3)=original incident polarization vector 1 C CXE02(1-3)=original incident polarization vector 2 C BETA=angle (radians) through which target is to be rotated C around target axis A1 C THETA=angle (radians)which target axis A1 is to make with C Lab x-axis C PHI=angle (radians) which axis A2 is to make with A1-x plane C in Lab frame. C ENSC(1-3,1-NSCAT)=scattering directions in Lab Frame C EM1(1-3,1-NSCAT)=scattering polarization vector 1 in Lab Frame C EM2(1-3,1-NSCAT)=scattering polarization vector 2 in Lab Frame C Returns: C EN0R(1-3)=incident propagation vector in Target Frame C CXE01R(1-3)=incident polariz. vector 1 in Target Frame C CXE02R(1-3)=incident polariz. vector 2 in Target Frame C AKSR(1-3,1-NSCAT)=scattering k vectors in Target Frame C EM1R(1-3,1-NSCAT)=scattering pol. vector 1 in Target Frame C EM2R(1-3,1-NSCAT)=scattering pol. vector 2 in Target Frame C C Purpose: C In the Lab Frame, we hold the propagation direction (x-axis) C and incident polarization vectors (CXE01 and CXE02) fixed, C and rotate target to an orientation specified by the three C angles BETA,THETA,PHI. C However, computations in the main program DDSCAT are carried out C in the Target Frame, in which the target is held fixed and the C propagation vectors and polarization vectors are rotated. C Hence, this routine computes the incident propagation vector, C scattering propagation vectors, and associated polarization C vectors in the Target Frame. C C B. T. Draine, Princeton Univ. Obs., 89/11/20 C History: C 91/04/22 (BTD) Eliminated vector A1R and removed superfluous line C computing A1R C C** Determine the orientation angles for original unrotated target: THETA0=ACOS(A1(1)) SINTHE=SIN(THETA0) IF(SINTHE.NE.0.)THEN PHI0=ACOS(A1(2)/SIN(THETA0)) ELSE C** If sin(THETA0)=0, we will arbitrarily assume PHI0=0 PHI0=0. ENDIF IF(SINTHE.NE.0.)THEN BETA0=ACOS(-A2(1)/SINTHE) ELSE BETA0=ACOS(A2(2)) ENDIF C C**** First rotate the target through angle PHI-PHI0 around x axis C (i.e., rotate the lab through angle PHI0-PHI around x axis) C** obtain rotation matrix: VEC(1)=1. VEC(2)=0. VEC(3)=0. CALL ROT2(VEC,PHI0-PHI,RM1) C C**** Now rotate the target through angle THETA-THETA0 around axis C VEC = xaxis cross a1 C (i.e., rotate the lab through angle THETA0-THETA around C xaxis cross a1 ) C** first compute rotation axis VEC(1)=0. VEC(2)=-A1(3) VEC(3)=A1(2) C*** For special case where a1=xaxis, we want rotation axis=a1 cross a2 IF((VEC(2)**2+VEC(3)**2).LT.1.E-10)THEN VEC(2)=A1(3)*A2(1)-A1(1)*A2(3) VEC(3)=A1(1)*A2(2)-A1(2)*A2(1) ENDIF CALL ROT2(VEC,THETA0-THETA,RM2) CALL MULT3(RM2,RM1,RM3) C**** Now rotate the target through angle BETA-BETA0 around a1 C (i.e., rotate the lab through angle BETA0-BETA around a1) CALL ROT2(A1,BETA0-BETA,RM1) CALL MULT3(RM1,RM3,RM2) C C**** RM2 is now the full rotation matrix C C**** Now rotate all required vectors: C Incident propagation vector: VEC(1)=1. VEC(2)=0. VEC(3)=0. CALL PROD3(RM2,VEC,EN0R) C Incident polarization vectors: CALL PROD3C(RM2,CXE01,CXE01R) CALL PROD3C(RM2,CXE02,CXE02R) C Scattering vectors: CALL PROD3V(RM2,ENSC,AKSR,NSCAT,MXSCA) DO 50 I=1,NSCAT AKSR(1,I)=AK1*AKSR(1,I) AKSR(2,I)=AK1*AKSR(2,I) AKSR(3,I)=AK1*AKSR(3,I) 50 CONTINUE C Scattering polarization vectors: CALL PROD3V(RM2,EM1,EM1R,NSCAT,MXSCA) CALL PROD3V(RM2,EM2,EM2R,NSCAT,MXSCA) RETURN END