1 | MODULE coords |
---|
2 | |
---|
3 | IMPLICIT NONE |
---|
4 | |
---|
5 | INTEGER, PARAMETER :: nsech = 167 |
---|
6 | CHARACTER(len=20), DIMENSION(nsech) :: cl_sech = (/ & |
---|
7 | & 'global ', & |
---|
8 | & 'nstrpac ', & |
---|
9 | & 'sstrpac ', & |
---|
10 | & 'npac ', & |
---|
11 | & 'spac ', & |
---|
12 | & 'trpac ', & |
---|
13 | & 'natl ', & |
---|
14 | & 'satl ', & |
---|
15 | & 'tratl ', & |
---|
16 | & 'nstratl ', & |
---|
17 | & 'sstratl ', & |
---|
18 | & 'neatl ', & |
---|
19 | & 'nwatl ', & |
---|
20 | & 'equa ', & |
---|
21 | & 'nino1 ', & |
---|
22 | & 'nino2 ', & |
---|
23 | & 'nino12 ', & |
---|
24 | & 'nino3 ', & |
---|
25 | & 'nino4 ', & |
---|
26 | & 'nino34 ', & |
---|
27 | & 'ind1 ', & |
---|
28 | & 'ind2 ', & |
---|
29 | & 'ind3 ', & |
---|
30 | & 'eq1 ', & |
---|
31 | & 'eq2 ', & |
---|
32 | & 'eq3 ', & |
---|
33 | & 'eq4 ', & |
---|
34 | & 'neq1 ', & |
---|
35 | & 'neq2 ', & |
---|
36 | & 'neq3 ', & |
---|
37 | & 'neq4 ', & |
---|
38 | & 'eqpac ', & |
---|
39 | & 'eqind ', & |
---|
40 | & 'atl1 ', & |
---|
41 | & 'atl2 ', & |
---|
42 | & 'atl3 ', & |
---|
43 | & 'eqatl ', & |
---|
44 | & 'trop ', & |
---|
45 | & 'nxtrp ', & |
---|
46 | & 'sxtrp ', & |
---|
47 | & 'trind ', & |
---|
48 | & 'sind ', & |
---|
49 | & 'nepac ', & |
---|
50 | & 'nwpac ', & |
---|
51 | & 'trepac ', & |
---|
52 | & 'trwpac ', & |
---|
53 | & 'p15n38w ', & |
---|
54 | & 'p12n38w ', & |
---|
55 | & 'p8n38w ', & |
---|
56 | & 'p4n38w ', & |
---|
57 | & 'p0n35w ', & |
---|
58 | & 'p21n23w ', & |
---|
59 | & 'p12n23w ', & |
---|
60 | & 'p4n23w ', & |
---|
61 | & 'p0n23w ', & |
---|
62 | & 'p0n10w ', & |
---|
63 | & 'p0n0w ', & |
---|
64 | & 'p5s10w ', & |
---|
65 | & 'p10s10w ', & |
---|
66 | & 't0n156e ', & |
---|
67 | & 't0n165e ', & |
---|
68 | & 't0n180e ', & |
---|
69 | & 't0n170w ', & |
---|
70 | & 't0n155w ', & |
---|
71 | & 't0n140w ', & |
---|
72 | & 't0n125w ', & |
---|
73 | & 't0n110w ', & |
---|
74 | & 't0n95w ', & |
---|
75 | & 't5n156e ', & |
---|
76 | & 't5s156e ', & |
---|
77 | & 't5n165e ', & |
---|
78 | & 't5n180e ', & |
---|
79 | & 't5n170w ', & |
---|
80 | & 't5n155w ', & |
---|
81 | & 't5n140w ', & |
---|
82 | & 't5n125w ', & |
---|
83 | & 't5n110w ', & |
---|
84 | & 't5n95w ', & |
---|
85 | & 't5s165e ', & |
---|
86 | & 't5s180e ', & |
---|
87 | & 't5s170w ', & |
---|
88 | & 't5s155w ', & |
---|
89 | & 't5s140w ', & |
---|
90 | & 't5s125w ', & |
---|
91 | & 't5s110w ', & |
---|
92 | & 't5s95w ', & |
---|
93 | & 'r8s55e ', & |
---|
94 | & 'r12s55e ', & |
---|
95 | & 'r4s67e ', & |
---|
96 | & 'r8s67e ', & |
---|
97 | & 'r12s67e ', & |
---|
98 | & 'r0n80e ', & |
---|
99 | & 'r4s80e ', & |
---|
100 | & 'r12s80e ', & |
---|
101 | & 'r12n90e ', & |
---|
102 | & 'r8n90e ', & |
---|
103 | & 'r4n90e ', & |
---|
104 | & 'r0n90e ', & |
---|
105 | & 'r5s95e ', & |
---|
106 | & 'r8s95e ', & |
---|
107 | & 'r8s100e ', & |
---|
108 | & 'NE_subtrop_pac ', & |
---|
109 | & 'NW_subtrop_pac ', & |
---|
110 | & 'NE_extratrop_pac ', & |
---|
111 | & 'NW_extratrop_pac ', & |
---|
112 | & 'SE_subtrop_pac ', & |
---|
113 | & 'SW_subtrop_pac ', & |
---|
114 | & 'NE_subtrop_atl ', & |
---|
115 | & 'NW_subtrop_atl ', & |
---|
116 | & 'NE_extratrop_atl ', & |
---|
117 | & 'NW_extratrop_atl ', & |
---|
118 | & 'SE_subtrop_atl ', & |
---|
119 | & 'SW_subtrop_atl ', & |
---|
120 | & 'SE_subtrop_ind ', & |
---|
121 | & 'SW_subtrop_ind ', & |
---|
122 | & 'Southern_ocean_pac ', & |
---|
123 | & 'Southern_ocean_atl ', & |
---|
124 | & 'Southern_ocean_ind ', & |
---|
125 | & 'GLOBAL05 ', & |
---|
126 | & 'GLOBAL10 ', & |
---|
127 | & 'GLOBAL15 ', & |
---|
128 | & 'GLOBAL20 ', & |
---|
129 | & 'GLOBAL25 ', & |
---|
130 | & 'GLOBAL30 ', & |
---|
131 | & 'GLOBAL40 ', & |
---|
132 | & 'GLOBAL50 ', & |
---|
133 | & 'GLOBAL60 ', & |
---|
134 | & 'ARCTIC ', & |
---|
135 | & 'ATL60NA ', & |
---|
136 | & 'ATL50NA ', & |
---|
137 | & 'ATL40NA ', & |
---|
138 | & 'ATL35NA ', & |
---|
139 | & 'ATL30NA ', & |
---|
140 | & 'ATL26NA ', & |
---|
141 | & 'ATL10NA ', & |
---|
142 | & 'ATLEQA ', & |
---|
143 | & 'ATL10SA ', & |
---|
144 | & 'ATL20SA ', & |
---|
145 | & 'ATL30SA ', & |
---|
146 | & 'PAC60NA ', & |
---|
147 | & 'PAC50NA ', & |
---|
148 | & 'PAC40NA ', & |
---|
149 | & 'PAC35NA ', & |
---|
150 | & 'PAC30NA ', & |
---|
151 | & 'PAC20NA ', & |
---|
152 | & 'PAC10NA ', & |
---|
153 | & 'PACEQA ', & |
---|
154 | & 'INP10SA ', & |
---|
155 | & 'PAC20SA ', & |
---|
156 | & 'PAC30SA ', & |
---|
157 | & 'INDEQA ', & |
---|
158 | & 'IND20SA ', & |
---|
159 | & 'IND30SA ', & |
---|
160 | & 'GLB60NA ', & |
---|
161 | & 'GLB50NA ', & |
---|
162 | & 'GLB40NA ', & |
---|
163 | & 'GLB30NA ', & |
---|
164 | & 'GLB20NA ', & |
---|
165 | & 'GLB10NA ', & |
---|
166 | & 'GLBEQA ', & |
---|
167 | & 'GLB10SA ', & |
---|
168 | & 'GLB20SA ', & |
---|
169 | & 'GLB30SA ', & |
---|
170 | & 'GLB40SA ', & |
---|
171 | & 'GLB50SA ', & |
---|
172 | & 'GLB60SA ', & |
---|
173 | & 'npac25 ' & |
---|
174 | & /) |
---|
175 | |
---|
176 | ! User defined areas |
---|
177 | INTEGER :: nboxuser |
---|
178 | CHARACTER(len=20), DIMENSION(:), ALLOCATABLE :: cl_boxes_user |
---|
179 | REAL, DIMENSION(:,:), ALLOCATABLE :: areas |
---|
180 | |
---|
181 | ! zonal sections |
---|
182 | INTEGER, PARAMETER :: nsecz = 50 |
---|
183 | CHARACTER(len=20), DIMENSION(nsecz) :: cl_secz = (/ & |
---|
184 | & 'LOMBOK ', & |
---|
185 | & 'BANDA ', & |
---|
186 | & 'MAKASSAR ', & |
---|
187 | & 'SAVU ', & |
---|
188 | & 'MALACCAS ', & |
---|
189 | & 'PHILIPINES ', & |
---|
190 | & 'YUCATAN ', & |
---|
191 | & 'GIN ', & |
---|
192 | & 'LABRADOR ', & |
---|
193 | & 'ATL60N ', & |
---|
194 | & 'ATL50N ', & |
---|
195 | & 'ATL40N ', & |
---|
196 | & 'ATL35N ', & |
---|
197 | & 'ATL30N ', & |
---|
198 | & 'ATL27N ', & |
---|
199 | & 'ATL26N ', & |
---|
200 | & 'ATL10N ', & |
---|
201 | & 'ATLEQ ', & |
---|
202 | & 'ATL10S ', & |
---|
203 | & 'ATL20S ', & |
---|
204 | & 'ATL30S ', & |
---|
205 | & 'PAC60N ', & |
---|
206 | & 'PAC50N ', & |
---|
207 | & 'PAC40N ', & |
---|
208 | & 'PAC35N ', & |
---|
209 | & 'PAC30N ', & |
---|
210 | & 'PAC25N ', & |
---|
211 | & 'PAC20N ', & |
---|
212 | & 'PAC10N ', & |
---|
213 | & 'PACEQ ', & |
---|
214 | & 'INP10S ', & |
---|
215 | & 'PAC20S ', & |
---|
216 | & 'PAC30S ', & |
---|
217 | & 'INDEQ ', & |
---|
218 | & 'IND20S ', & |
---|
219 | & 'IND30S ', & |
---|
220 | & 'GLB60N ', & |
---|
221 | & 'GLB50N ', & |
---|
222 | & 'GLB40N ', & |
---|
223 | & 'GLB30N ', & |
---|
224 | & 'GLB20N ', & |
---|
225 | & 'GLB10N ', & |
---|
226 | & 'GLBEQ ', & |
---|
227 | & 'GLB10S ', & |
---|
228 | & 'GLB20S ', & |
---|
229 | & 'GLB30S ', & |
---|
230 | & 'GLB40S ', & |
---|
231 | & 'GLB50S ', & |
---|
232 | & 'GLB60S ', & |
---|
233 | & 'SUM-DARWIN ' & |
---|
234 | & /) |
---|
235 | |
---|
236 | ! meridional sections |
---|
237 | INTEGER, PARAMETER :: nsecm = 10 |
---|
238 | CHARACTER(len=20), DIMENSION(nsecm) :: cl_secm = (/ & |
---|
239 | & 'IT ', & |
---|
240 | & 'ITA ', & |
---|
241 | & 'TIMOR ', & |
---|
242 | ! & 'OMBAI ', & |
---|
243 | ! & 'SUMBA ', & |
---|
244 | ! & 'LUZON ', & |
---|
245 | & 'DRAKE ', & |
---|
246 | & 'TORRES ', & |
---|
247 | & 'MED ', & |
---|
248 | & 'FLORIDA ', & |
---|
249 | & 'ANTILLAS ', & |
---|
250 | & 'GOODHOPE ', & |
---|
251 | & 'SOUTHAUS ' & |
---|
252 | & /) |
---|
253 | |
---|
254 | CONTAINS |
---|
255 | |
---|
256 | SUBROUTINE coord_area( reg, area ) |
---|
257 | !----------------------------------------------------------------------- |
---|
258 | ! |
---|
259 | ! ROUTINE coord_area |
---|
260 | ! ********************** |
---|
261 | ! |
---|
262 | ! Purpose : |
---|
263 | ! ------- |
---|
264 | ! Define coordinates of different regions |
---|
265 | ! |
---|
266 | ! Modifications : |
---|
267 | ! ------------- |
---|
268 | ! |
---|
269 | ! SEE: /home/rd/ocx/postp/NEWGRIB/regions.txt |
---|
270 | ! and /home/rd/nep/sms/verify/automat/include/regions.h |
---|
271 | ! |
---|
272 | ! modification : 04-09 (N. Daget) |
---|
273 | ! modification : 04-09 (N. Daget) add new regions |
---|
274 | IMPLICIT NONE |
---|
275 | !---------------------------------------------------------------------- |
---|
276 | ! local declarations |
---|
277 | !---------------------------------------------------------------------- |
---|
278 | ! |
---|
279 | CHARACTER(len=20), INTENT(inout) :: reg |
---|
280 | REAL, DIMENSION(4), INTENT(out) :: area |
---|
281 | ! |
---|
282 | reg=TRIM(reg) |
---|
283 | ! |
---|
284 | SELECT CASE (reg) |
---|
285 | CASE ('global') |
---|
286 | area = (/0.,360.,-90.,90./) |
---|
287 | CASE ('nstrpac') |
---|
288 | area = (/105.,270.,10.,30./) |
---|
289 | CASE ('sstrpac') |
---|
290 | area = (/105.,270.,-30.,-10./) |
---|
291 | CASE ('npac') |
---|
292 | area = (/100.,260.,30.,70./) |
---|
293 | CASE ('spac') |
---|
294 | area = (/150.,290.,-70.,-30./) |
---|
295 | CASE ('trpac') |
---|
296 | area = (/125.,280.,-30.,30./) |
---|
297 | CASE ('natl') |
---|
298 | area = (/290.,15.,30.,70./) |
---|
299 | CASE ('satl') |
---|
300 | area = (/290.,20.,-70.,-30./) |
---|
301 | CASE ('tratl') |
---|
302 | area = (/280.,20.,-20.,30./) |
---|
303 | CASE ('nstratl') |
---|
304 | area = (/280.,20.,5.,28./) |
---|
305 | CASE ('sstratl') |
---|
306 | area = (/300.,20.,-20.,5./) |
---|
307 | CASE ('neatl') |
---|
308 | area = (/320.,15.,30.,70./) |
---|
309 | CASE ('nwatl') |
---|
310 | area = (/260.,320.,30.,70./) |
---|
311 | CASE ('equa') |
---|
312 | area = (/0.,360.,-2.,2./) |
---|
313 | CASE ('nino1') |
---|
314 | area = (/270.,280.,-10.,-5./) |
---|
315 | CASE ('nino2') |
---|
316 | area = (/270.,280.,-5.,0./) |
---|
317 | CASE ('nino12') |
---|
318 | area = (/270.,280.,-10.,0./) |
---|
319 | CASE ('nino3') |
---|
320 | area = (/210.,270.,-5.,5./) |
---|
321 | CASE ('nino4') |
---|
322 | area = (/160.,210.,-5.,5./) |
---|
323 | CASE ('nino34') |
---|
324 | area = (/190.,240.,-5.,5./) |
---|
325 | CASE ('ind1') |
---|
326 | area = (/50.,70.,-10.,10./) |
---|
327 | CASE ('ind2') |
---|
328 | area = (/90.,110.,-10.,0./) |
---|
329 | CASE ('ind3') |
---|
330 | area = (/50.,90.,-10.,0./) |
---|
331 | CASE ('eq1') |
---|
332 | area = (/230.,270.,-5.,5./) |
---|
333 | CASE ('eq2') |
---|
334 | area = (/190.,230.,-5.,5./) |
---|
335 | CASE ('eq3') |
---|
336 | area = (/150.,190.,-5.,5./) |
---|
337 | CASE ('eq4') |
---|
338 | area = (/120.,150.,-5.,5./) |
---|
339 | CASE ('neq1') |
---|
340 | area = (/230.,270.,5.,15./) |
---|
341 | CASE ('neq2') |
---|
342 | area = (/190.,230.,5.,15./) |
---|
343 | CASE ('neq3') |
---|
344 | area = (/150.,190.,5.,15./) |
---|
345 | CASE ('neq4') |
---|
346 | area = (/120.,150.,5.,15./) |
---|
347 | CASE ('eqpac') |
---|
348 | area = (/130.,280.,-5.,5./) |
---|
349 | CASE ('eqind') |
---|
350 | area = (/40.,120.,-5.,5./) |
---|
351 | CASE ('atl1') |
---|
352 | area = (/315.,340.,0.,10./) |
---|
353 | CASE ('atl2') |
---|
354 | area = (/0.,10.,-3.,3./) |
---|
355 | CASE ('atl3') |
---|
356 | area = (/340.,360.,-3.,3./) |
---|
357 | CASE ('eqatl') |
---|
358 | area = (/290.,30.,-5.,5./) |
---|
359 | CASE ('trop') |
---|
360 | area = (/0.,360.,-30.,30./) ! Tropics (second definition) |
---|
361 | CASE ('nxtrp') |
---|
362 | area = (/0.,360.,30.,70./) ! Northern Extratropics |
---|
363 | CASE ('sxtrp') |
---|
364 | area = (/0.,360.,-70.,-30./) ! Southern Extratropics |
---|
365 | CASE ('trind') |
---|
366 | area = (/40.,120.,-30.,30./) |
---|
367 | CASE ('sind') |
---|
368 | area = (/20.,150.,-70.,-30./) |
---|
369 | CASE ('nepac') |
---|
370 | area = (/210.,260.,30.,70./) |
---|
371 | CASE ('nwpac') |
---|
372 | area = (/100.,210.,30.,70./) |
---|
373 | CASE ('trepac') |
---|
374 | area = (/210.,270.,-30.,30./) |
---|
375 | CASE ('trwpac') |
---|
376 | area = (/100.,210.,-30.,30./) |
---|
377 | ! PIRATA |
---|
378 | CASE ('p20n38w') |
---|
379 | area = (/321.,323.,19.,21./) |
---|
380 | CASE ('p15n38w') |
---|
381 | area = (/321.,323.,14.,16./) |
---|
382 | CASE ('p12n38w') |
---|
383 | area = (/321.,323.,11.,13./) |
---|
384 | CASE ('p8n38w') |
---|
385 | area = (/321.,323.,7.,9./) |
---|
386 | CASE ('p4n38w') |
---|
387 | area = (/321.,323.,3.,5./) |
---|
388 | CASE ('p0n35w') |
---|
389 | area = (/324.,326.,-0.5,0.5/) |
---|
390 | CASE ('p21n23w') |
---|
391 | area = (/336.,338.,20.,22./) |
---|
392 | CASE ('p12n23w') |
---|
393 | area = (/336.,338.,11.,13./) |
---|
394 | CASE ('p4n23w') |
---|
395 | area = (/336.,338.,3.,5./) |
---|
396 | CASE ('p0n23w') |
---|
397 | area = (/336.,338.,-0.5,0.5/) |
---|
398 | CASE ('p0n10w') |
---|
399 | area = (/349.,351.,-0.5,0.5/) |
---|
400 | CASE ('p0n0w') |
---|
401 | area = (/359.,1.,-0.5,0.5/) |
---|
402 | CASE ('p5s10w') |
---|
403 | area = (/349.,351.,-6.,-4./) |
---|
404 | CASE ('p10s10w') |
---|
405 | area = (/349.,351.,-11.,-9./) |
---|
406 | |
---|
407 | ! TAO |
---|
408 | CASE ('t0n156e') |
---|
409 | area = (/155.,157.,-0.5,0.5/) |
---|
410 | CASE ('t0n165e') |
---|
411 | area = (/164.,166.,-0.5,0.5/) |
---|
412 | CASE ('t0n180e') |
---|
413 | area = (/179.,181.,-0.5,0.5/) |
---|
414 | CASE ('t0n170w') |
---|
415 | area = (/189.,191.,-0.5,0.5/) |
---|
416 | CASE ('t0n155w') |
---|
417 | area = (/204.,206.,-0.5,0.5/) |
---|
418 | CASE ('t0n140w') |
---|
419 | area = (/219.,221.,-0.5,0.5/) |
---|
420 | CASE ('t0n125w') |
---|
421 | area = (/234.,236.,-0.5,0.5/) |
---|
422 | CASE ('t0n110w') |
---|
423 | area = (/249.,251.,-0.5,0.5/) |
---|
424 | CASE ('t0n95w') |
---|
425 | area = (/264.,266.,-0.5,0.5/) |
---|
426 | CASE ('t5n156e') |
---|
427 | area = (/155.,157.,4.5,5.5/) |
---|
428 | CASE ('t5n165e') |
---|
429 | area = (/164.,166.,4.5,5.5/) |
---|
430 | CASE ('t5n180e') |
---|
431 | area = (/179.,181.,4.5,5.5/) |
---|
432 | CASE ('t5n170w') |
---|
433 | area = (/189.,191.,4.5,5.5/) |
---|
434 | CASE ('t5n155w') |
---|
435 | area = (/204.,206.,4.5,5.5/) |
---|
436 | CASE ('t5n140w') |
---|
437 | area = (/219.,221.,4.5,5.5/) |
---|
438 | CASE ('t5n125w') |
---|
439 | area = (/234.,236.,4.5,5.5/) |
---|
440 | CASE ('t5n110w') |
---|
441 | area = (/249.,251.,4.5,5.5/) |
---|
442 | CASE ('t5n95w') |
---|
443 | area = (/264.,266.,4.5,5.5/) |
---|
444 | CASE ('t5s156e') |
---|
445 | area = (/155.,157.,-5.5,-5.5/) |
---|
446 | CASE ('t5s165e') |
---|
447 | area = (/164.,166.,-5.5,4.5/) |
---|
448 | CASE ('t5s180e') |
---|
449 | area = (/179.,181.,-5.5,-4.5/) |
---|
450 | CASE ('t5s170w') |
---|
451 | area = (/189.,191.,-5.5,-4.5/) |
---|
452 | CASE ('t5s155w') |
---|
453 | area = (/204.,206.,-5.5,-4.5/) |
---|
454 | CASE ('t5s140w') |
---|
455 | area = (/219.,221.,-5.5,-4.5/) |
---|
456 | CASE ('t5s125w') |
---|
457 | area = (/234.,236.,-5.5,-4.5/) |
---|
458 | CASE ('t5s110w') |
---|
459 | area = (/249.,251.,-5.5,-4.5/) |
---|
460 | CASE ('t5s95w') |
---|
461 | area = (/264.,266.,-5.5,-4.5/) |
---|
462 | !RAMA |
---|
463 | CASE ('r8s55e') |
---|
464 | area = (/54.,56.,-8.,-7./) |
---|
465 | CASE ('r12s55e') |
---|
466 | area = (/54.,56.,-13.,-11./) |
---|
467 | CASE ('r4s67e') |
---|
468 | area = (/66.,68.,-4.5,-3.5/) |
---|
469 | CASE ('r8s67e') |
---|
470 | area = (/66.,68.,-9.,-7./) |
---|
471 | CASE ('r12s67e') |
---|
472 | area = (/66.,68.,-13.,-11./) |
---|
473 | CASE ('r0n80e') |
---|
474 | area = (/79.,81.,-0.5,0.5/) |
---|
475 | CASE ('r4s80e') |
---|
476 | area = (/79.,81.,-4.5,-3.5/) |
---|
477 | CASE ('r8s80e') |
---|
478 | area = (/79.,81.,-9.,-7./) |
---|
479 | CASE ('r12s80e') |
---|
480 | area = (/79.,81.,-13.,-11./) |
---|
481 | CASE ('r12n90e') |
---|
482 | area = (/89.,91.,11.,13./) |
---|
483 | CASE ('r8n90e') |
---|
484 | area = (/89.,91.,7.,9./) |
---|
485 | CASE ('r4n90e') |
---|
486 | area = (/89.,91.,3.5,4.5/) |
---|
487 | CASE ('r0n90e') |
---|
488 | area = (/89.,91.,-0.5,0.5/) |
---|
489 | CASE ('r5s95e') |
---|
490 | area = (/94.,96.,-5.5,-4.5/) |
---|
491 | CASE ('r8s95e') |
---|
492 | area = (/94.,96.,-9.,-7./) |
---|
493 | CASE ('r8s100e') |
---|
494 | area = (/99.,101.,-9.,-7./) |
---|
495 | |
---|
496 | |
---|
497 | ! ENACT |
---|
498 | CASE ('NE_subtrop_pac') |
---|
499 | area = (/190.,260.,10.,30./) |
---|
500 | CASE ('NW_subtrop_pac') |
---|
501 | area = (/120.,190.,10.,30./) |
---|
502 | CASE ('NE_extratrop_pac') |
---|
503 | area = (/190.,250.,30.,60./) |
---|
504 | CASE ('NW_extratrop_pac') |
---|
505 | area = (/120.,190.,30.,60./) |
---|
506 | CASE ('SE_subtrop_pac') |
---|
507 | area = (/200.,300.,-30.,-10./) |
---|
508 | CASE ('SW_subtrop_pac') |
---|
509 | area = (/143.,200.,-30.,-10./) |
---|
510 | CASE ('NE_subtrop_atl') |
---|
511 | area = (/320.,355.,10.,30./) |
---|
512 | CASE ('NW_subtrop_atl') |
---|
513 | area = (/283.,320.,10.,30./) |
---|
514 | CASE ('NE_extratrop_atl') |
---|
515 | area = (/320.,360.,30.,60./) |
---|
516 | CASE ('NW_extratrop_atl') |
---|
517 | area = (/285.,320.,30.,60./) |
---|
518 | CASE ('SE_subtrop_atl') |
---|
519 | area = (/350.,20.,-30.,-10./) |
---|
520 | CASE ('SW_subtrop_atl') |
---|
521 | area = (/300.,350.,-30.,-10./) |
---|
522 | CASE ('SE_subtrop_ind') |
---|
523 | area = (/80.,120.,-30.,-10./) |
---|
524 | CASE ('SW_subtrop_ind') |
---|
525 | area = (/30.,80.,-30.,-10./) |
---|
526 | CASE ('Southern_ocean_pac') |
---|
527 | area = (/130.,290.,-80.,-30./) |
---|
528 | CASE ('Southern_ocean_atl') |
---|
529 | area = (/290.,20.,-80.,-30./) |
---|
530 | CASE ('Southern_ocean_ind') |
---|
531 | area = (/20.,130.,-80.,-30./) |
---|
532 | ! Global areas different latitudes |
---|
533 | CASE ('GLOBAL05') |
---|
534 | area = (/0.,360.,-5.,5./) |
---|
535 | CASE ('GLOBAL10') |
---|
536 | area = (/0.,360.,-10.,10./) |
---|
537 | CASE ('GLOBAL15') |
---|
538 | area = (/0.,360.,-15.,15./) |
---|
539 | CASE ('GLOBAL20') |
---|
540 | area = (/0.,360.,-20.,20./) |
---|
541 | CASE ('GLOBAL25') |
---|
542 | area = (/0.,360.,-25.,25./) |
---|
543 | CASE ('GLOBAL30') |
---|
544 | area = (/0.,360.,-30.,30./) |
---|
545 | CASE ('GLOBAL40') |
---|
546 | area = (/0.,360.,-40.,40./) |
---|
547 | CASE ('GLOBAL50') |
---|
548 | area = (/0.,360.,-50.,50./) |
---|
549 | CASE ('GLOBAL60') |
---|
550 | area = (/0.,360.,-60.,60./) |
---|
551 | CASE ('ARCTIC') |
---|
552 | area = (/0.,360.,65.,90./) |
---|
553 | CASE ('ATL60NA') |
---|
554 | area=(/260.,9.13,59.,61./) |
---|
555 | CASE ('ATL50NA') |
---|
556 | area=(/260.,5.,49.,51./) |
---|
557 | CASE ('ATL40NA') |
---|
558 | area=(/260.,358.,39.,41./) |
---|
559 | CASE ('ATL35NA') |
---|
560 | area=(/260.,360.,34.,36./) |
---|
561 | CASE ('ATL30NA') |
---|
562 | area=(/260.,360.,29.,31./) |
---|
563 | CASE ('ATL26NA') |
---|
564 | area=(/260.,360.,25.,27./) |
---|
565 | CASE ('ATL20NA') |
---|
566 | area=(/260.,360.,19.,21./) |
---|
567 | CASE ('ATL10NA') |
---|
568 | area=(/290.,360.,9.,11./) |
---|
569 | CASE ('ATLEQA') |
---|
570 | area=(/289.,11.,-1.,1./) |
---|
571 | CASE ('ATL10SA') |
---|
572 | area=(/320.,15.,-11.,-9./) |
---|
573 | CASE ('ATL20SA') |
---|
574 | area=(/318.,15.,-21.,-19./) |
---|
575 | CASE ('ATL30SA') |
---|
576 | area=(/310.,20.,-31.,-29./) |
---|
577 | CASE ('PAC60NA') |
---|
578 | area=(/140.,250.,59.,61./) |
---|
579 | CASE ('PAC50NA') |
---|
580 | area=(/130.,240.,49.,51./) |
---|
581 | CASE ('PAC40NA') |
---|
582 | area=(/125.,240.,39.,41./) |
---|
583 | CASE ('PAC35NA') |
---|
584 | area=(/115.,242.,34.,36./) |
---|
585 | CASE ('PAC30NA') |
---|
586 | area=(/115.,250.,29.,31./) |
---|
587 | CASE ('PAC20NA') |
---|
588 | area=(/100.,260.,19.,21./) |
---|
589 | CASE ('PAC10NA') |
---|
590 | area=(/105.,275.,9.,11./) |
---|
591 | CASE ('PACEQA') |
---|
592 | area=(/115.,282.,-1.,1./) |
---|
593 | CASE ('INP10SA') |
---|
594 | area=(/35.,290.,-11.,-9./) |
---|
595 | CASE ('PAC20SA') |
---|
596 | area=(/140.,292.,-21.,-19./) |
---|
597 | CASE ('PAC30SA') |
---|
598 | area=(/150.,292.,-31.,-29./) |
---|
599 | CASE ('INDEQA') |
---|
600 | area=(/40.,115.,-1.,1./) |
---|
601 | CASE ('IND20SA') |
---|
602 | area=(/30.,130.,-21.,-19./) |
---|
603 | CASE ('IND30SA') |
---|
604 | area=(/30.,120.,-31.,-29./) |
---|
605 | CASE ('GLB60NA') |
---|
606 | area=(/166.,9.13,59.,61./) |
---|
607 | CASE ('GLB50NA') |
---|
608 | area=(/0.,360.,49.,51./) |
---|
609 | CASE ('GLB40NA') |
---|
610 | area=(/0.,360.,39.,41./) |
---|
611 | CASE ('GLB30NA') |
---|
612 | area=(/0.,360.,29.,31./) |
---|
613 | CASE ('GLB20NA') |
---|
614 | area=(/0.,360.,19.,21./) |
---|
615 | CASE ('GLB10NA') |
---|
616 | area=(/0.,360.,9.,11./) |
---|
617 | CASE ('GLBEQA') |
---|
618 | area=(/0.,360.,-1.,1./) |
---|
619 | CASE ('GLB10SA') |
---|
620 | area=(/0.,360.,-11.,-9./) |
---|
621 | CASE ('GLB20SA') |
---|
622 | area=(/0.,360.,-21.,-19./) |
---|
623 | CASE ('GLB30SA') |
---|
624 | area=(/0.,360.,-31.,-29./) |
---|
625 | CASE ('GLB40SA') |
---|
626 | area=(/0.,360.,-41.,-39./) |
---|
627 | CASE ('GLB50SA') |
---|
628 | area=(/0.,360.,-51.,-49./) |
---|
629 | CASE ('GLB60SA') |
---|
630 | area=(/0.,360.,-61.,-59./) |
---|
631 | CASE ('npac25') |
---|
632 | area = (/100.,260.,25.,70./) |
---|
633 | !Zonal sections |
---|
634 | ! Measurements of Indonesian Throughflow at |
---|
635 | ! http://www.ocean.washington.edu/people/faculty/susanh/spga/spga.htm |
---|
636 | ! INSTANT obserational program |
---|
637 | |
---|
638 | CASE ('LOMBOK') |
---|
639 | ! area=(/114.,118.,-8.,-8./) |
---|
640 | area=(/114.,120.,-8.,-9./) ! first/last point rather than min,max |
---|
641 | CASE ('MAKASSAR') |
---|
642 | ! area=(/114.,120.,-3.,-3./) |
---|
643 | area=(/114.,121.,-3.,-3./) |
---|
644 | CASE ('MALACCAS') |
---|
645 | ! area=(/99.,102.,3.,3./) |
---|
646 | area=(/103.,112.,-2.8,-2.8/) |
---|
647 | CASE ('BANDA') |
---|
648 | area=(/122.,140.,-4.,-4./) |
---|
649 | CASE ('SAVU') |
---|
650 | ! area=(/122.,124.,-8.8,-8.8/) |
---|
651 | area=(/120.,125.,-8.8,-9.4/) |
---|
652 | CASE ('PHILIPINES') |
---|
653 | area=(/106.,120.,10.985,10.985/) |
---|
654 | CASE ('YUCATAN') |
---|
655 | ! area=(/273.,285.,20.,20./) |
---|
656 | area=(/271.,283.,20.,21./) |
---|
657 | CASE ('GIN') |
---|
658 | ! area=(/315.,7.,63.,63./) |
---|
659 | area=(/315.,9.8,63.,63./) |
---|
660 | CASE ('LABRADOR') |
---|
661 | ! area=(/290.,315.,61.,61./) |
---|
662 | area=(/289.,310.,60.6,63.5/) |
---|
663 | CASE ('ATL60N') |
---|
664 | ! area=(/260.,10.,57.,57./) |
---|
665 | ! area=(/260.,10.87,57.,57./) |
---|
666 | ! area=(/260.,11.2,57.,57./) |
---|
667 | area=(/260.,9.13,60.,59.925/) |
---|
668 | CASE ('ATL50N') |
---|
669 | area=(/260.,5.,50.,50./) |
---|
670 | CASE ('ATL40N') |
---|
671 | area=(/260.,358.,40.,40./) |
---|
672 | CASE ('ATL35N') |
---|
673 | area=(/260.,360.,35.,35./) |
---|
674 | CASE ('ATL30N') |
---|
675 | area=(/260.,360.,30.,30./) |
---|
676 | CASE ('ATL27N') |
---|
677 | area=(/260.,360.,27.,27./) |
---|
678 | CASE ('ATL26N') |
---|
679 | area=(/260.,360.,26.,26./) |
---|
680 | CASE ('ATL20N') |
---|
681 | area=(/260.,360.,20.,20./) |
---|
682 | CASE ('ATL10N') |
---|
683 | ! area=(/300.,360.,10.,10./) |
---|
684 | area=(/290.,360.,10.,10./) |
---|
685 | CASE ('ATLEQ') |
---|
686 | ! area=(/300.,10.,0.,0./) |
---|
687 | area=(/289.,11.,0.,0./) |
---|
688 | CASE ('ATL10S') |
---|
689 | area=(/320.,15.,-10.,-10./) |
---|
690 | CASE ('ATL20S') |
---|
691 | area=(/318.,15.,-30.,-30./) |
---|
692 | CASE ('ATL30S') |
---|
693 | area=(/310.,20.,-30.,-30./) |
---|
694 | CASE ('PAC60N') |
---|
695 | area=(/140.,250.,60.,60./) |
---|
696 | CASE ('PAC50N') |
---|
697 | area=(/130.,240.,50.,50./) |
---|
698 | CASE ('PAC40N') |
---|
699 | area=(/125.,240.,40.,40./) |
---|
700 | CASE ('PAC35N') |
---|
701 | ! area=(/115.,240.,35.,35./) |
---|
702 | area=(/115.,242.,35.,35./) |
---|
703 | CASE ('PAC30N') |
---|
704 | area=(/115.,250.,30.,30./) |
---|
705 | CASE ('PAC25N') |
---|
706 | area=(/100.,260.,25.,25./) |
---|
707 | CASE ('PAC20N') |
---|
708 | area=(/100.,260.,20.,20./) |
---|
709 | CASE ('PAC10N') |
---|
710 | ! area=(/98.,275.,10.,10./) |
---|
711 | area=(/105.,275.,10.,10./) |
---|
712 | CASE ('PACEQ') |
---|
713 | area=(/115.,282.,0.,0./) |
---|
714 | CASE ('INP10S') |
---|
715 | area=(/35.,290.,-10.,-10./) |
---|
716 | CASE ('PAC20S') |
---|
717 | area=(/140.,292.,-20.,-20./) |
---|
718 | CASE ('PAC30S') |
---|
719 | area=(/150.,292.,-30.,-30./) |
---|
720 | CASE ('INDEQ') |
---|
721 | area=(/40.,115.,-0.,-0./) |
---|
722 | CASE ('IND20S') |
---|
723 | area=(/30.,130.,-20.,-20./) |
---|
724 | CASE ('IND30S') |
---|
725 | area=(/30.,120.,-30.,-30./) |
---|
726 | CASE ('GLB60N') |
---|
727 | ! area=(/0.,360.,60.,60./) |
---|
728 | ! area=(/166.,10.,60.5,60./) |
---|
729 | ! area=(/166.,6.6,60.5,59.7/) |
---|
730 | area=(/166.,9.13,60.5,59.925/) |
---|
731 | CASE ('GLB50N') |
---|
732 | area=(/0.,360.,50.,50./) |
---|
733 | CASE ('GLB40N') |
---|
734 | area=(/0.,360.,40.,40./) |
---|
735 | CASE ('GLB30N') |
---|
736 | area=(/0.,360.,30.,30./) |
---|
737 | CASE ('GLB20N') |
---|
738 | area=(/0.,360.,20.,20./) |
---|
739 | CASE ('GLB10N') |
---|
740 | area=(/0.,360.,10.,10./) |
---|
741 | CASE ('GLBEQ') |
---|
742 | area=(/0.,360.,0.,0./) |
---|
743 | CASE ('GLB10S') |
---|
744 | area=(/0.,360.,-10.,-10./) |
---|
745 | CASE ('GLB20S') |
---|
746 | area=(/0.,360.,-20.,-20./) |
---|
747 | CASE ('GLB30S') |
---|
748 | area=(/0.,360.,-30.,-30./) |
---|
749 | CASE ('GLB40S') |
---|
750 | area=(/0.,360.,-40.,-40./) |
---|
751 | CASE ('GLB50S') |
---|
752 | area=(/0.,360.,-50.,-50./) |
---|
753 | CASE ('GLB60S') |
---|
754 | area=(/0.,360.,-60.,-60./) |
---|
755 | CASE ('SUM-DARWIN') |
---|
756 | area=(/104.,131.,-4.9,-15.3/) |
---|
757 | |
---|
758 | !Meridonal sections (for zonal transports) |
---|
759 | CASE ('IT' ) !From Flores to Australia |
---|
760 | ! area=(/114.,114.,-22.,-8.5/) |
---|
761 | area=(/126.,126.,-8.8,-16./) |
---|
762 | CASE ('ITA' ) !From Sumatra to Australia |
---|
763 | ! area=(/115.,114.,-22.,-3./) |
---|
764 | area=(/104.,115.,-4.9,-24.7/) |
---|
765 | CASE ('TIMOR') |
---|
766 | area=(/124.,124.,-17.,-9./) |
---|
767 | ! CASE ('OMBAI') |
---|
768 | ! area=(/124.5,124.5,-9.2,-8.2/) |
---|
769 | ! CASE ('SUMBA') |
---|
770 | ! area=(/120.,120.,-9.3,-8.3/) |
---|
771 | ! CASE ('LUZON') |
---|
772 | ! area=(/120.5,120.5,17.,23./) |
---|
773 | CASE ('DRAKE') |
---|
774 | ! area=(/290.,290.,-75.,-52./) |
---|
775 | ! area=(/-69.,-64.,-55.2,-65.9/) |
---|
776 | area=(/291.,296.,-54.6,-65.9/) |
---|
777 | CASE ('TORRES') |
---|
778 | area=(/143.,143.,-15.,-8./) |
---|
779 | CASE ('MED') |
---|
780 | area=(/356.,356.,32.,40./) |
---|
781 | CASE ('FLORIDA') |
---|
782 | ! area=(/279.5,279.5,22.,28./) |
---|
783 | ! area=(/-81.,-79,26.5,21.9/) |
---|
784 | area=(/-82.,-79.,28.2,22./) |
---|
785 | CASE ('ANTILLAS') |
---|
786 | ! area=(/290.,290.,10.,18./) |
---|
787 | area=(/-72.,-72.,19.1,8.2/) |
---|
788 | CASE ('GOODHOPE') |
---|
789 | ! area=(/340.,340.,-80.,-30./) |
---|
790 | area=(/23.,44.,-31.7,-68.2/) |
---|
791 | CASE ('SOUTHAUS') |
---|
792 | ! area=(/140.,140.,-80.,-30./) |
---|
793 | area=(/133.,133.,-30.,-67.5/) |
---|
794 | CASE default |
---|
795 | PRINT*,'area: ', reg, 'is not defined' |
---|
796 | CALL abort |
---|
797 | END SELECT |
---|
798 | |
---|
799 | END SUBROUTINE coord_area |
---|
800 | |
---|
801 | SUBROUTINE coord_user_init (sec) |
---|
802 | CHARACTER(len=1), INTENT(IN) :: sec |
---|
803 | CHARACTER(len=20), DIMENSION(:), ALLOCATABLE :: cl_boxes |
---|
804 | INTEGER :: nbox |
---|
805 | CHARACTER(len=32) :: cdnamelist = 'coords.nml' |
---|
806 | LOGICAL :: lexists, lnodefaults |
---|
807 | CHARACTER(len=20) :: carea |
---|
808 | REAL :: lat1,lat2,lon1,lon2,dlat,dlon |
---|
809 | LOGICAL :: lreg, lstd |
---|
810 | INTEGER :: nlat,nlon |
---|
811 | INTEGER :: i,j,k |
---|
812 | NAMELIST/area/lstd,lreg,carea,lat1,lat2,lon1,lon2,dlat,dlon |
---|
813 | |
---|
814 | lnodefaults=.TRUE. |
---|
815 | nboxuser=0 |
---|
816 | SELECT CASE (sec) |
---|
817 | CASE ('u') |
---|
818 | nbox=nsecm |
---|
819 | ALLOCATE(cl_boxes(nbox)) |
---|
820 | cl_boxes(:)=cl_secm(:) |
---|
821 | CASE ('v') |
---|
822 | nbox=nsecz |
---|
823 | ALLOCATE(cl_boxes(nbox)) |
---|
824 | cl_boxes(:)=cl_secz(:) |
---|
825 | CASE default |
---|
826 | nbox=nsech |
---|
827 | ALLOCATE(cl_boxes(nbox)) |
---|
828 | cl_boxes(:)=cl_sech(:) |
---|
829 | END SELECT |
---|
830 | INQUIRE(file=cdnamelist,exist=lexists) |
---|
831 | IF (lexists) THEN |
---|
832 | nboxuser=0 |
---|
833 | OPEN(20,file=cdnamelist) |
---|
834 | DO |
---|
835 | carea='undefined' |
---|
836 | lat1=-90 |
---|
837 | lat2=90 |
---|
838 | lon1=0 |
---|
839 | lon2=360 |
---|
840 | dlat=10 |
---|
841 | dlon=10 |
---|
842 | lreg=.FALSE. |
---|
843 | lstd=.FALSE. |
---|
844 | READ(20,area,end=100) |
---|
845 | DO |
---|
846 | IF (lon1<0) lon1=lon1+360 |
---|
847 | IF (lon1>360) lon1=lon1-360 |
---|
848 | IF ((lon1>=0).AND.(lon1<=360)) EXIT |
---|
849 | ENDDO |
---|
850 | DO |
---|
851 | IF (lon2<0) lon2=lon2+360 |
---|
852 | IF (lon2>360) lon2=lon2-360 |
---|
853 | IF ((lon2>=0).AND.(lon2<=360)) EXIT |
---|
854 | ENDDO |
---|
855 | WRITE(*,area) |
---|
856 | IF (lreg.AND.(TRIM(carea)/='undefined')) THEN |
---|
857 | WRITE(*,*)'coord_init: please specify either lreg=true '//& |
---|
858 | & 'or carea/=undefined' |
---|
859 | CALL abort |
---|
860 | ENDIF |
---|
861 | IF (TRIM(carea)/='undefined') THEN |
---|
862 | nboxuser=nboxuser+1 |
---|
863 | ENDIF |
---|
864 | IF (lreg) THEN |
---|
865 | nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat) |
---|
866 | nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon) |
---|
867 | nboxuser=nboxuser+nlat*nlon |
---|
868 | ENDIF |
---|
869 | IF (lstd) THEN |
---|
870 | IF (lnodefaults) THEN |
---|
871 | nboxuser=nboxuser+nbox |
---|
872 | lnodefaults=.FALSE. |
---|
873 | ENDIF |
---|
874 | ENDIF |
---|
875 | END DO |
---|
876 | 100 CONTINUE |
---|
877 | WRITE(*,*)'Total areas = ',nboxuser |
---|
878 | IF (nboxuser==0) THEN |
---|
879 | CLOSE(20) |
---|
880 | WRITE(*,*)'coord_init: no boxes defined!!' |
---|
881 | CALL abort |
---|
882 | ENDIF |
---|
883 | ALLOCATE(cl_boxes_user(nboxuser)) |
---|
884 | ALLOCATE(areas(4,nboxuser)) |
---|
885 | nboxuser=0 |
---|
886 | IF (.NOT.lnodefaults) THEN |
---|
887 | cl_boxes_user(1:nbox)=cl_boxes(1:nbox) |
---|
888 | DO i=1,nbox |
---|
889 | CALL coord_area( cl_boxes_user(i), areas(:,i) ) |
---|
890 | ENDDO |
---|
891 | nboxuser=nboxuser+nbox |
---|
892 | ENDIF |
---|
893 | REWIND(20) |
---|
894 | WRITE(*,*)'Reading areas' |
---|
895 | DO |
---|
896 | carea='undefined' |
---|
897 | lat1=-90 |
---|
898 | lat2=90 |
---|
899 | lon1=0 |
---|
900 | lon2=360 |
---|
901 | dlat=10 |
---|
902 | dlon=10 |
---|
903 | lreg=.FALSE. |
---|
904 | lstd=.FALSE. |
---|
905 | READ(20,area,end=200) |
---|
906 | DO |
---|
907 | IF (lon1<0) lon1=lon1+360 |
---|
908 | IF (lon1>360) lon1=lon1-360 |
---|
909 | IF ((lon1>=0).AND.(lon1<=360)) EXIT |
---|
910 | ENDDO |
---|
911 | DO |
---|
912 | IF (lon2<0) lon2=lon2+360 |
---|
913 | IF (lon2>360) lon2=lon2-360 |
---|
914 | IF ((lon2>=0).AND.(lon2<=360)) EXIT |
---|
915 | ENDDO |
---|
916 | IF (TRIM(carea)/='undefined') THEN |
---|
917 | nboxuser=nboxuser+1 |
---|
918 | cl_boxes_user(nboxuser)=carea |
---|
919 | areas(1,nboxuser)=MIN(lon1,lon2) |
---|
920 | areas(2,nboxuser)=MAX(lon1,lon2) |
---|
921 | areas(3,nboxuser)=MIN(lat1,lat2) |
---|
922 | areas(4,nboxuser)=MAX(lat1,lat2) |
---|
923 | ENDIF |
---|
924 | IF (lreg) THEN |
---|
925 | nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat) |
---|
926 | nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon) |
---|
927 | k=0 |
---|
928 | DO j=1,nlat |
---|
929 | DO i=1,nlon |
---|
930 | k=k+1 |
---|
931 | areas(1,k+nboxuser)=MIN(lon1,lon2)+(i-1)*dlon |
---|
932 | areas(2,k+nboxuser)=MIN(lon1,lon2)+i*dlon |
---|
933 | areas(3,k+nboxuser)=MIN(lat1,lat2)+(j-1)*dlat |
---|
934 | areas(4,k+nboxuser)=MIN(lat1,lat2)+j*dlat |
---|
935 | WRITE(cl_boxes_user(k+nboxuser)(1:5),'(I4.4,A1)') & |
---|
936 | & NINT(areas(1,k+nboxuser)*10),'e' |
---|
937 | WRITE(cl_boxes_user(k+nboxuser)(6:10),'(I4.4,A1)') & |
---|
938 | & NINT(areas(2,k+nboxuser)*10),'e' |
---|
939 | IF (areas(3,k+nboxuser)<0) THEN |
---|
940 | WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') & |
---|
941 | & -NINT(areas(3,k+nboxuser)*10),'s' |
---|
942 | ELSE |
---|
943 | WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') & |
---|
944 | & NINT(areas(3,k+nboxuser)*10),'n' |
---|
945 | ENDIF |
---|
946 | IF (areas(4,k+nboxuser)<0) THEN |
---|
947 | WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') & |
---|
948 | & -NINT(areas(4,k+nboxuser)*10),'s' |
---|
949 | ELSE |
---|
950 | WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') & |
---|
951 | & NINT(areas(4,k+nboxuser)*10),'n' |
---|
952 | ENDIF |
---|
953 | ENDDO |
---|
954 | ENDDO |
---|
955 | nboxuser=nboxuser+nlat*nlon |
---|
956 | ENDIF |
---|
957 | END DO |
---|
958 | 200 CONTINUE |
---|
959 | CLOSE(20) |
---|
960 | ELSE |
---|
961 | nboxuser=nbox |
---|
962 | ALLOCATE(cl_boxes_user(nboxuser)) |
---|
963 | ALLOCATE(areas(4,nboxuser)) |
---|
964 | cl_boxes_user(:)=cl_boxes(:) |
---|
965 | DO i=1,nbox |
---|
966 | CALL coord_area( cl_boxes_user(i), areas(:,i) ) |
---|
967 | ENDDO |
---|
968 | ENDIF |
---|
969 | DO i=1,nboxuser |
---|
970 | WRITE(*,'(A,4F12.2)')cl_boxes_user(i),areas(:,i) |
---|
971 | DO j=i+1,nboxuser |
---|
972 | IF (TRIM(cl_boxes_user(i))==TRIM(cl_boxes_user(j))) THEN |
---|
973 | WRITE(*,*)'coord_user_init: dublicate boxes' |
---|
974 | CALL abort |
---|
975 | ENDIF |
---|
976 | ENDDO |
---|
977 | ENDDO |
---|
978 | |
---|
979 | END SUBROUTINE coord_user_init |
---|
980 | |
---|
981 | SUBROUTINE coord_area_user( reg, area, ldfail ) |
---|
982 | !----------------------------------------------------------------------- |
---|
983 | ! |
---|
984 | ! ROUTINE coord_area_user |
---|
985 | ! **************************** |
---|
986 | ! |
---|
987 | ! Purpose : |
---|
988 | ! ------- |
---|
989 | ! Get coordinate of different regions |
---|
990 | ! |
---|
991 | ! Modifications : |
---|
992 | ! ------------- |
---|
993 | IMPLICIT NONE |
---|
994 | !---------------------------------------------------------------------- |
---|
995 | ! local declarations |
---|
996 | !---------------------------------------------------------------------- |
---|
997 | ! |
---|
998 | CHARACTER(len=20), INTENT(inout) :: reg |
---|
999 | REAL, DIMENSION(4), INTENT(out) :: area |
---|
1000 | LOGICAL, OPTIONAL, INTENT(out) :: ldfail |
---|
1001 | INTEGER :: i |
---|
1002 | LOGICAL :: lnotfound |
---|
1003 | ! |
---|
1004 | reg=TRIM(reg) |
---|
1005 | |
---|
1006 | lnotfound=.TRUE. |
---|
1007 | DO i=1,nboxuser |
---|
1008 | IF (reg==TRIM(cl_boxes_user(i))) THEN |
---|
1009 | area(:)=areas(:,i) |
---|
1010 | lnotfound=.FALSE. |
---|
1011 | EXIT |
---|
1012 | ENDIF |
---|
1013 | ENDDO |
---|
1014 | IF (PRESENT(ldfail)) THEN |
---|
1015 | ldfail=lnotfound |
---|
1016 | ELSE |
---|
1017 | IF (lnotfound) THEN |
---|
1018 | WRITE(*,*)'coord_area_user: area not found' |
---|
1019 | CALL abort |
---|
1020 | ENDIF |
---|
1021 | ENDIF |
---|
1022 | |
---|
1023 | END SUBROUTINE coord_area_user |
---|
1024 | |
---|
1025 | END MODULE coords |
---|