DISPATCH
cooling_Shure.f90
1 FUNCTION cooling_shure (self, temp)
2  implicit none
3  class(cooling_t):: self
4  real(kind=dp) cooling_shure, temp
5  real(kind=dp), save:: ttab2(110), ttab3(76)
6  real(kind=dp), save, dimension(3,110):: table2
7  data table2 / &
8  -25.7331, -30.6104, 1.3264e-05, &
9  -25.0383, -29.4107, 4.2428e-05, &
10  -24.4059, -28.4601, 8.8276e-05, &
11  -23.8288, -27.5743, 1.7967e-04, &
12  -23.3027, -26.3766, 8.4362e-04, &
13  -22.8242, -25.2890, 3.4295e-03, &
14  -22.3917, -24.2684, 1.3283e-02, &
15  -22.0067, -23.3834, 4.2008e-02, &
16  -21.6818, -22.5977, 1.2138e-01, &
17  -21.4529, -21.9689, 3.0481e-01, &
18  -21.3246, -21.5972, 5.3386e-01, &
19  -21.3459, -21.4615, 7.6622e-01, &
20  -21.4305, -21.4789, 8.9459e-01, &
21  -21.5293, -21.5497, 9.5414e-01, &
22  -21.6138, -21.6211, 9.8342e-01, &
23  -21.6615, -21.6595, 1.0046e+00, &
24  -21.6551, -21.6426, 1.0291e+00, &
25  -21.5919, -21.5688, 1.0547e+00, &
26  -21.5092, -21.4771, 1.0767e+00, &
27  -21.4124, -21.3755, 1.0888e+00, &
28  -21.3085, -21.2693, 1.0945e+00, &
29  -21.2047, -21.1644, 1.0972e+00, &
30  -21.1067, -21.0658, 1.0988e+00, &
31  -21.0194, -20.9778, 1.1004e+00, &
32  -20.9413, -20.8986, 1.1034e+00, &
33  -20.8735, -20.8281, 1.1102e+00, &
34  -20.8205, -20.7700, 1.1233e+00, &
35  -20.7805, -20.7223, 1.1433e+00, &
36  -20.7547, -20.6888, 1.1638e+00, &
37  -20.7455, -20.6739, 1.1791e+00, &
38  -20.7565, -20.6815, 1.1885e+00, &
39  -20.7820, -20.7051, 1.1937e+00, &
40  -20.8008, -20.7229, 1.1966e+00, &
41  -20.7994, -20.7208, 1.1983e+00, &
42  -20.7847, -20.7058, 1.1993e+00, &
43  -20.7687, -20.6896, 1.1999e+00, &
44  -20.7590, -20.6797, 1.2004e+00, &
45  -20.7544, -20.6749, 1.2008e+00, &
46  -20.7505, -20.6709, 1.2012e+00, &
47  -20.7545, -20.6748, 1.2015e+00, &
48  -20.7888, -20.7089, 1.2020e+00, &
49  -20.8832, -20.8031, 1.2025e+00, &
50  -21.0450, -20.9647, 1.2030e+00, &
51  -21.2286, -21.1482, 1.2035e+00, &
52  -21.3737, -21.2932, 1.2037e+00, &
53  -21.4573, -21.3767, 1.2039e+00, &
54  -21.4935, -21.4129, 1.2040e+00, &
55  -21.5098, -21.4291, 1.2041e+00, &
56  -21.5345, -21.4538, 1.2042e+00, &
57  -21.5863, -21.5055, 1.2044e+00, &
58  -21.6548, -21.5740, 1.2045e+00, &
59  -21.7108, -21.6300, 1.2046e+00, &
60  -21.7424, -21.6615, 1.2047e+00, &
61  -21.7576, -21.6766, 1.2049e+00, &
62  -21.7696, -21.6886, 1.2050e+00, &
63  -21.7883, -21.7073, 1.2051e+00, &
64  -21.8115, -21.7304, 1.2053e+00, &
65  -21.8303, -21.7491, 1.2055e+00, &
66  -21.8419, -21.7607, 1.2056e+00, &
67  -21.8514, -21.7701, 1.2058e+00, &
68  -21.8690, -21.7877, 1.2060e+00, &
69  -21.9057, -21.8243, 1.2062e+00, &
70  -21.9690, -21.8875, 1.2065e+00, &
71  -22.0554, -21.9738, 1.2067e+00, &
72  -22.1488, -22.0671, 1.2070e+00, &
73  -22.2355, -22.1537, 1.2072e+00, &
74  -22.3084, -22.2265, 1.2075e+00, &
75  -22.3641, -22.2821, 1.2077e+00, &
76  -22.4033, -22.3213, 1.2078e+00, &
77  -22.4282, -22.3462, 1.2079e+00, &
78  -22.4408, -22.3587, 1.2080e+00, &
79  -22.4443, -22.3622, 1.2081e+00, &
80  -22.4411, -22.3590, 1.2082e+00, &
81  -22.4334, -22.3512, 1.2083e+00, &
82  -22.4242, -22.3420, 1.2083e+00, &
83  -22.4164, -22.3342, 1.2084e+00, &
84  -22.4134, -22.3312, 1.2084e+00, &
85  -22.4168, -22.3346, 1.2085e+00, &
86  -22.4267, -22.3445, 1.2085e+00, &
87  -22.4418, -22.3595, 1.2086e+00, &
88  -22.4603, -22.3780, 1.2086e+00, &
89  -22.4830, -22.4007, 1.2087e+00, &
90  -22.5112, -22.4289, 1.2087e+00, &
91  -22.5449, -22.4625, 1.2088e+00, &
92  -22.5819, -22.4995, 1.2088e+00, &
93  -22.6177, -22.5353, 1.2089e+00, &
94  -22.6483, -22.5659, 1.2089e+00, &
95  -22.6719, -22.5895, 1.2089e+00, &
96  -22.6883, -22.6059, 1.2089e+00, &
97  -22.6985, -22.6161, 1.2089e+00, &
98  -22.7032, -22.6208, 1.2090e+00, &
99  -22.7037, -22.6213, 1.2090e+00, &
100  -22.7008, -22.6184, 1.2090e+00, &
101  -22.6950, -22.6126, 1.2090e+00, &
102  -22.6869, -22.6045, 1.2090e+00, &
103  -22.6769, -22.5945, 1.2090e+00, &
104  -22.6655, -22.5831, 1.2090e+00, &
105  -22.6531, -22.5707, 1.2090e+00, &
106  -22.6397, -22.5573, 1.2090e+00, &
107  -22.6258, -22.5434, 1.2090e+00, &
108  -22.6111, -22.5287, 1.2090e+00, &
109  -22.5964, -22.5140, 1.2090e+00, &
110  -22.5816, -22.4992, 1.2090e+00, &
111  -22.5668, -22.4844, 1.2090e+00, &
112  -22.5519, -22.4695, 1.2090e+00, &
113  -22.5367, -22.4543, 1.2090e+00, &
114  -22.5216, -22.4392, 1.2090e+00, &
115  -22.5062, -22.4237, 1.2091e+00, &
116  -22.4912, -22.4087, 1.2091e+00, &
117  -22.4753, -22.3928, 1.2091e+00 /
118  real(kind=dp), save, dimension(4,76):: table3
119  data table3 / &
120  -31.0377, -30.0377, -29.0377, -28.0377, &
121  -30.7062, -29.7062, -28.7062, -27.7062, &
122  -30.4055, -29.4055, -28.4055, -27.4055, &
123  -30.1331, -29.1331, -28.1331, -27.1331, &
124  -29.8864, -28.8864, -27.8864, -26.8864, &
125  -29.6631, -28.6631, -27.6631, -26.6631, &
126  -29.4614, -28.4614, -27.4614, -26.4614, &
127  -29.2791, -28.2791, -27.2791, -26.2791, &
128  -29.1146, -28.1146, -27.1146, -26.1146, &
129  -28.9662, -27.9662, -26.9662, -25.9662, &
130  -28.8330, -27.8330, -26.8330, -25.8330, &
131  -28.7129, -27.7129, -26.7129, -25.7129, &
132  -28.6052, -27.6052, -26.6052, -25.6052, &
133  -28.5086, -27.5088, -26.5088, -25.5088, &
134  -28.4222, -27.4225, -26.4225, -25.4225, &
135  -28.3447, -27.3454, -26.3455, -25.3455, &
136  -28.2751, -27.2767, -26.2769, -25.2769, &
137  -28.2120, -27.2153, -26.2157, -25.2157, &
138  -28.1541, -27.1605, -26.1611, -25.1612, &
139  -28.0995, -27.1111, -26.1123, -25.1124, &
140  -28.0460, -27.0664, -26.0684, -25.0686, &
141  -27.9914, -27.0251, -26.0286, -25.0290, &
142  -27.9333, -26.9863, -25.9918, -24.9927, &
143  -27.8697, -26.9488, -25.9578, -24.9586, &
144  -27.7989, -26.9119, -25.9248, -24.9263, &
145  -27.7206, -26.8742, -25.8931, -24.8948, &
146  -27.6353, -26.8353, -25.8614, -24.8642, &
147  -27.5447, -26.7948, -25.8300, -24.8336, &
148  -27.4506, -26.7523, -25.7983, -24.8030, &
149  -27.3551, -26.7080, -25.7660, -24.7724, &
150  -27.2597, -26.6619, -25.7338, -24.7416, &
151  -27.1661, -26.6146, -25.7011, -24.7109, &
152  -27.0751, -26.5666, -25.6690, -24.6807, &
153  -26.9876, -26.5183, -25.6370, -24.6509, &
154  -26.9041, -26.4702, -25.6057, -24.6220, &
155  -26.8245, -26.4229, -25.5754, -24.5941, &
156  -26.7496, -26.3765, -25.5464, -24.5677, &
157  -26.6788, -26.3317, -25.5186, -24.5426, &
158  -26.6124, -26.2886, -25.4923, -24.5190, &
159  -26.5504, -26.2473, -25.4674, -24.4970, &
160  -26.4924, -26.2078, -25.4439, -24.4765, &
161  -26.4383, -26.1704, -25.4219, -24.4574, &
162  -26.3880, -26.1348, -25.4011, -24.4395, &
163  -26.3412, -26.1012, -25.3813, -24.4226, &
164  -26.2978, -26.0692, -25.3623, -24.4063, &
165  -26.2576, -26.0389, -25.3437, -24.3903, &
166  -26.2203, -26.0101, -25.3254, -24.3744, &
167  -26.1859, -25.9825, -25.3071, -24.3582, &
168  -26.1540, -25.9566, -25.2888, -24.3418, &
169  -26.1246, -25.9318, -25.2703, -24.3249, &
170  -26.0975, -25.9083, -25.2517, -24.3076, &
171  -26.0724, -25.8857, -25.2332, -24.2901, &
172  -26.0493, -25.8645, -25.2149, -24.2724, &
173  -26.0281, -25.8447, -25.1969, -24.2549, &
174  -26.0085, -25.8259, -25.1795, -24.2378, &
175  -25.9905, -25.8085, -25.1630, -24.2215, &
176  -25.9743, -25.7926, -25.1474, -24.2061, &
177  -25.9590, -25.7778, -25.1330, -24.1918, &
178  -25.9454, -25.7642, -25.1199, -24.1787, &
179  -25.9326, -25.7520, -25.1081, -24.1672, &
180  -25.9212, -25.7409, -25.0977, -24.1570, &
181  -25.9104, -25.7310, -25.0887, -24.1482, &
182  -25.9010, -25.7222, -25.0809, -24.1407, &
183  -25.8925, -25.7142, -25.0742, -24.1342, &
184  -25.8844, -25.7071, -25.0683, -24.1287, &
185  -25.8771, -25.7005, -25.0627, -24.1234, &
186  -25.8703, -25.6942, -25.0570, -24.1178, &
187  -25.8642, -25.6878, -25.0505, -24.1112, &
188  -25.8586, -25.6811, -25.0422, -24.1025, &
189  -25.8529, -25.6733, -25.0312, -24.0907, &
190  -25.8474, -25.6641, -25.0161, -24.0741, &
191  -25.8422, -25.6525, -24.9957, -24.0514, &
192  -25.8356, -25.6325, -24.9570, -24.0081, &
193  -25.8286, -25.6080, -24.9104, -23.9566, &
194  -25.8133, -25.5367, -24.7799, -23.8139, &
195  -25.7997, -25.4806, -24.6878, -23.7151 /
196  logical, save:: started=.false.
197  integer i
198  real p
199  !$omp threadprivate(started,Ttab2,Ttab3,table2,table3)
200 !...............................................................................
201  if (.not.started) then
202  started=.true.
203  do i=1,110
204  ttab2(i)=3.8+0.04*(i-1)
205  enddo
206  do i=1,76
207  ttab3(i)=1.0+0.04*(i-1)
208  enddo
209  endif
210 
211  if (temp < t_mc) then
212  cooling_shure=0.0
213  else if (temp > 1e4) then
214  p=1.0+(log10(temp)-ttab2(1))/0.04
215  i=p
216  p=p-i
217  i=min(max(i,1),109)
218  cooling_shure=10.**((1-p)*table2(2,i)+p*table2(2,i+1))
219  else
220  p=1.0+(log10(temp)-ttab3(1))/0.04
221  i=p
222  p=p-i
223  i=min(max(i,1),75)
224  cooling_shure=10.**((1-p)*table3(1,i)+p*table3(1,i+1))
225  endif
226 END