New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

coords.F90 in branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/TOOLS/OBSTOOLS/src – NEMO

Context Navigation

source: branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90 @ 5500

Last change on this file since 5500 was 5500, checked in by dancopsey, 9 years ago
Removed SVN keywords.
File size: 32.3 KB

Line
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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: