2025-09-05 09:42:21 +02:00

1026 lines
32 KiB
Fortran
Executable File

MODULE coords
IMPLICIT NONE
INTEGER, PARAMETER :: nsech = 167
CHARACTER(len=20), DIMENSION(nsech) :: cl_sech = (/ &
& 'global ', &
& 'nstrpac ', &
& 'sstrpac ', &
& 'npac ', &
& 'spac ', &
& 'trpac ', &
& 'natl ', &
& 'satl ', &
& 'tratl ', &
& 'nstratl ', &
& 'sstratl ', &
& 'neatl ', &
& 'nwatl ', &
& 'equa ', &
& 'nino1 ', &
& 'nino2 ', &
& 'nino12 ', &
& 'nino3 ', &
& 'nino4 ', &
& 'nino34 ', &
& 'ind1 ', &
& 'ind2 ', &
& 'ind3 ', &
& 'eq1 ', &
& 'eq2 ', &
& 'eq3 ', &
& 'eq4 ', &
& 'neq1 ', &
& 'neq2 ', &
& 'neq3 ', &
& 'neq4 ', &
& 'eqpac ', &
& 'eqind ', &
& 'atl1 ', &
& 'atl2 ', &
& 'atl3 ', &
& 'eqatl ', &
& 'trop ', &
& 'nxtrp ', &
& 'sxtrp ', &
& 'trind ', &
& 'sind ', &
& 'nepac ', &
& 'nwpac ', &
& 'trepac ', &
& 'trwpac ', &
& 'p15n38w ', &
& 'p12n38w ', &
& 'p8n38w ', &
& 'p4n38w ', &
& 'p0n35w ', &
& 'p21n23w ', &
& 'p12n23w ', &
& 'p4n23w ', &
& 'p0n23w ', &
& 'p0n10w ', &
& 'p0n0w ', &
& 'p5s10w ', &
& 'p10s10w ', &
& 't0n156e ', &
& 't0n165e ', &
& 't0n180e ', &
& 't0n170w ', &
& 't0n155w ', &
& 't0n140w ', &
& 't0n125w ', &
& 't0n110w ', &
& 't0n95w ', &
& 't5n156e ', &
& 't5s156e ', &
& 't5n165e ', &
& 't5n180e ', &
& 't5n170w ', &
& 't5n155w ', &
& 't5n140w ', &
& 't5n125w ', &
& 't5n110w ', &
& 't5n95w ', &
& 't5s165e ', &
& 't5s180e ', &
& 't5s170w ', &
& 't5s155w ', &
& 't5s140w ', &
& 't5s125w ', &
& 't5s110w ', &
& 't5s95w ', &
& 'r8s55e ', &
& 'r12s55e ', &
& 'r4s67e ', &
& 'r8s67e ', &
& 'r12s67e ', &
& 'r0n80e ', &
& 'r4s80e ', &
& 'r12s80e ', &
& 'r12n90e ', &
& 'r8n90e ', &
& 'r4n90e ', &
& 'r0n90e ', &
& 'r5s95e ', &
& 'r8s95e ', &
& 'r8s100e ', &
& 'NE_subtrop_pac ', &
& 'NW_subtrop_pac ', &
& 'NE_extratrop_pac ', &
& 'NW_extratrop_pac ', &
& 'SE_subtrop_pac ', &
& 'SW_subtrop_pac ', &
& 'NE_subtrop_atl ', &
& 'NW_subtrop_atl ', &
& 'NE_extratrop_atl ', &
& 'NW_extratrop_atl ', &
& 'SE_subtrop_atl ', &
& 'SW_subtrop_atl ', &
& 'SE_subtrop_ind ', &
& 'SW_subtrop_ind ', &
& 'Southern_ocean_pac ', &
& 'Southern_ocean_atl ', &
& 'Southern_ocean_ind ', &
& 'GLOBAL05 ', &
& 'GLOBAL10 ', &
& 'GLOBAL15 ', &
& 'GLOBAL20 ', &
& 'GLOBAL25 ', &
& 'GLOBAL30 ', &
& 'GLOBAL40 ', &
& 'GLOBAL50 ', &
& 'GLOBAL60 ', &
& 'ARCTIC ', &
& 'ATL60NA ', &
& 'ATL50NA ', &
& 'ATL40NA ', &
& 'ATL35NA ', &
& 'ATL30NA ', &
& 'ATL26NA ', &
& 'ATL10NA ', &
& 'ATLEQA ', &
& 'ATL10SA ', &
& 'ATL20SA ', &
& 'ATL30SA ', &
& 'PAC60NA ', &
& 'PAC50NA ', &
& 'PAC40NA ', &
& 'PAC35NA ', &
& 'PAC30NA ', &
& 'PAC20NA ', &
& 'PAC10NA ', &
& 'PACEQA ', &
& 'INP10SA ', &
& 'PAC20SA ', &
& 'PAC30SA ', &
& 'INDEQA ', &
& 'IND20SA ', &
& 'IND30SA ', &
& 'GLB60NA ', &
& 'GLB50NA ', &
& 'GLB40NA ', &
& 'GLB30NA ', &
& 'GLB20NA ', &
& 'GLB10NA ', &
& 'GLBEQA ', &
& 'GLB10SA ', &
& 'GLB20SA ', &
& 'GLB30SA ', &
& 'GLB40SA ', &
& 'GLB50SA ', &
& 'GLB60SA ', &
& 'npac25 ' &
& /)
! User defined areas
INTEGER :: nboxuser
CHARACTER(len=20), DIMENSION(:), ALLOCATABLE :: cl_boxes_user
REAL, DIMENSION(:,:), ALLOCATABLE :: areas
! zonal sections
INTEGER, PARAMETER :: nsecz = 50
CHARACTER(len=20), DIMENSION(nsecz) :: cl_secz = (/ &
& 'LOMBOK ', &
& 'BANDA ', &
& 'MAKASSAR ', &
& 'SAVU ', &
& 'MALACCAS ', &
& 'PHILIPINES ', &
& 'YUCATAN ', &
& 'GIN ', &
& 'LABRADOR ', &
& 'ATL60N ', &
& 'ATL50N ', &
& 'ATL40N ', &
& 'ATL35N ', &
& 'ATL30N ', &
& 'ATL27N ', &
& 'ATL26N ', &
& 'ATL10N ', &
& 'ATLEQ ', &
& 'ATL10S ', &
& 'ATL20S ', &
& 'ATL30S ', &
& 'PAC60N ', &
& 'PAC50N ', &
& 'PAC40N ', &
& 'PAC35N ', &
& 'PAC30N ', &
& 'PAC25N ', &
& 'PAC20N ', &
& 'PAC10N ', &
& 'PACEQ ', &
& 'INP10S ', &
& 'PAC20S ', &
& 'PAC30S ', &
& 'INDEQ ', &
& 'IND20S ', &
& 'IND30S ', &
& 'GLB60N ', &
& 'GLB50N ', &
& 'GLB40N ', &
& 'GLB30N ', &
& 'GLB20N ', &
& 'GLB10N ', &
& 'GLBEQ ', &
& 'GLB10S ', &
& 'GLB20S ', &
& 'GLB30S ', &
& 'GLB40S ', &
& 'GLB50S ', &
& 'GLB60S ', &
& 'SUM-DARWIN ' &
& /)
! meridional sections
INTEGER, PARAMETER :: nsecm = 10
CHARACTER(len=20), DIMENSION(nsecm) :: cl_secm = (/ &
& 'IT ', &
& 'ITA ', &
& 'TIMOR ', &
! & 'OMBAI ', &
! & 'SUMBA ', &
! & 'LUZON ', &
& 'DRAKE ', &
& 'TORRES ', &
& 'MED ', &
& 'FLORIDA ', &
& 'ANTILLAS ', &
& 'GOODHOPE ', &
& 'SOUTHAUS ' &
& /)
CONTAINS
SUBROUTINE coord_area( reg, area )
!-----------------------------------------------------------------------
!
! ROUTINE coord_area
! **********************
!
! Purpose :
! -------
! Define coordinates of different regions
!
! Modifications :
! -------------
!
! SEE: /home/rd/ocx/postp/NEWGRIB/regions.txt
! and /home/rd/nep/sms/verify/automat/include/regions.h
!
! modification : 04-09 (N. Daget)
! modification : 04-09 (N. Daget) add new regions
IMPLICIT NONE
!----------------------------------------------------------------------
! local declarations
!----------------------------------------------------------------------
!
CHARACTER(len=20), INTENT(inout) :: reg
REAL, DIMENSION(4), INTENT(out) :: area
!
reg=TRIM(reg)
!
SELECT CASE (reg)
CASE ('global')
area = (/0.,360.,-90.,90./)
CASE ('nstrpac')
area = (/105.,270.,10.,30./)
CASE ('sstrpac')
area = (/105.,270.,-30.,-10./)
CASE ('npac')
area = (/100.,260.,30.,70./)
CASE ('spac')
area = (/150.,290.,-70.,-30./)
CASE ('trpac')
area = (/125.,280.,-30.,30./)
CASE ('natl')
area = (/290.,15.,30.,70./)
CASE ('satl')
area = (/290.,20.,-70.,-30./)
CASE ('tratl')
area = (/280.,20.,-20.,30./)
CASE ('nstratl')
area = (/280.,20.,5.,28./)
CASE ('sstratl')
area = (/300.,20.,-20.,5./)
CASE ('neatl')
area = (/320.,15.,30.,70./)
CASE ('nwatl')
area = (/260.,320.,30.,70./)
CASE ('equa')
area = (/0.,360.,-2.,2./)
CASE ('nino1')
area = (/270.,280.,-10.,-5./)
CASE ('nino2')
area = (/270.,280.,-5.,0./)
CASE ('nino12')
area = (/270.,280.,-10.,0./)
CASE ('nino3')
area = (/210.,270.,-5.,5./)
CASE ('nino4')
area = (/160.,210.,-5.,5./)
CASE ('nino34')
area = (/190.,240.,-5.,5./)
CASE ('ind1')
area = (/50.,70.,-10.,10./)
CASE ('ind2')
area = (/90.,110.,-10.,0./)
CASE ('ind3')
area = (/50.,90.,-10.,0./)
CASE ('eq1')
area = (/230.,270.,-5.,5./)
CASE ('eq2')
area = (/190.,230.,-5.,5./)
CASE ('eq3')
area = (/150.,190.,-5.,5./)
CASE ('eq4')
area = (/120.,150.,-5.,5./)
CASE ('neq1')
area = (/230.,270.,5.,15./)
CASE ('neq2')
area = (/190.,230.,5.,15./)
CASE ('neq3')
area = (/150.,190.,5.,15./)
CASE ('neq4')
area = (/120.,150.,5.,15./)
CASE ('eqpac')
area = (/130.,280.,-5.,5./)
CASE ('eqind')
area = (/40.,120.,-5.,5./)
CASE ('atl1')
area = (/315.,340.,0.,10./)
CASE ('atl2')
area = (/0.,10.,-3.,3./)
CASE ('atl3')
area = (/340.,360.,-3.,3./)
CASE ('eqatl')
area = (/290.,30.,-5.,5./)
CASE ('trop')
area = (/0.,360.,-30.,30./) ! Tropics (second definition)
CASE ('nxtrp')
area = (/0.,360.,30.,70./) ! Northern Extratropics
CASE ('sxtrp')
area = (/0.,360.,-70.,-30./) ! Southern Extratropics
CASE ('trind')
area = (/40.,120.,-30.,30./)
CASE ('sind')
area = (/20.,150.,-70.,-30./)
CASE ('nepac')
area = (/210.,260.,30.,70./)
CASE ('nwpac')
area = (/100.,210.,30.,70./)
CASE ('trepac')
area = (/210.,270.,-30.,30./)
CASE ('trwpac')
area = (/100.,210.,-30.,30./)
! PIRATA
CASE ('p20n38w')
area = (/321.,323.,19.,21./)
CASE ('p15n38w')
area = (/321.,323.,14.,16./)
CASE ('p12n38w')
area = (/321.,323.,11.,13./)
CASE ('p8n38w')
area = (/321.,323.,7.,9./)
CASE ('p4n38w')
area = (/321.,323.,3.,5./)
CASE ('p0n35w')
area = (/324.,326.,-0.5,0.5/)
CASE ('p21n23w')
area = (/336.,338.,20.,22./)
CASE ('p12n23w')
area = (/336.,338.,11.,13./)
CASE ('p4n23w')
area = (/336.,338.,3.,5./)
CASE ('p0n23w')
area = (/336.,338.,-0.5,0.5/)
CASE ('p0n10w')
area = (/349.,351.,-0.5,0.5/)
CASE ('p0n0w')
area = (/359.,1.,-0.5,0.5/)
CASE ('p5s10w')
area = (/349.,351.,-6.,-4./)
CASE ('p10s10w')
area = (/349.,351.,-11.,-9./)
! TAO
CASE ('t0n156e')
area = (/155.,157.,-0.5,0.5/)
CASE ('t0n165e')
area = (/164.,166.,-0.5,0.5/)
CASE ('t0n180e')
area = (/179.,181.,-0.5,0.5/)
CASE ('t0n170w')
area = (/189.,191.,-0.5,0.5/)
CASE ('t0n155w')
area = (/204.,206.,-0.5,0.5/)
CASE ('t0n140w')
area = (/219.,221.,-0.5,0.5/)
CASE ('t0n125w')
area = (/234.,236.,-0.5,0.5/)
CASE ('t0n110w')
area = (/249.,251.,-0.5,0.5/)
CASE ('t0n95w')
area = (/264.,266.,-0.5,0.5/)
CASE ('t5n156e')
area = (/155.,157.,4.5,5.5/)
CASE ('t5n165e')
area = (/164.,166.,4.5,5.5/)
CASE ('t5n180e')
area = (/179.,181.,4.5,5.5/)
CASE ('t5n170w')
area = (/189.,191.,4.5,5.5/)
CASE ('t5n155w')
area = (/204.,206.,4.5,5.5/)
CASE ('t5n140w')
area = (/219.,221.,4.5,5.5/)
CASE ('t5n125w')
area = (/234.,236.,4.5,5.5/)
CASE ('t5n110w')
area = (/249.,251.,4.5,5.5/)
CASE ('t5n95w')
area = (/264.,266.,4.5,5.5/)
CASE ('t5s156e')
area = (/155.,157.,-5.5,-5.5/)
CASE ('t5s165e')
area = (/164.,166.,-5.5,4.5/)
CASE ('t5s180e')
area = (/179.,181.,-5.5,-4.5/)
CASE ('t5s170w')
area = (/189.,191.,-5.5,-4.5/)
CASE ('t5s155w')
area = (/204.,206.,-5.5,-4.5/)
CASE ('t5s140w')
area = (/219.,221.,-5.5,-4.5/)
CASE ('t5s125w')
area = (/234.,236.,-5.5,-4.5/)
CASE ('t5s110w')
area = (/249.,251.,-5.5,-4.5/)
CASE ('t5s95w')
area = (/264.,266.,-5.5,-4.5/)
!RAMA
CASE ('r8s55e')
area = (/54.,56.,-8.,-7./)
CASE ('r12s55e')
area = (/54.,56.,-13.,-11./)
CASE ('r4s67e')
area = (/66.,68.,-4.5,-3.5/)
CASE ('r8s67e')
area = (/66.,68.,-9.,-7./)
CASE ('r12s67e')
area = (/66.,68.,-13.,-11./)
CASE ('r0n80e')
area = (/79.,81.,-0.5,0.5/)
CASE ('r4s80e')
area = (/79.,81.,-4.5,-3.5/)
CASE ('r8s80e')
area = (/79.,81.,-9.,-7./)
CASE ('r12s80e')
area = (/79.,81.,-13.,-11./)
CASE ('r12n90e')
area = (/89.,91.,11.,13./)
CASE ('r8n90e')
area = (/89.,91.,7.,9./)
CASE ('r4n90e')
area = (/89.,91.,3.5,4.5/)
CASE ('r0n90e')
area = (/89.,91.,-0.5,0.5/)
CASE ('r5s95e')
area = (/94.,96.,-5.5,-4.5/)
CASE ('r8s95e')
area = (/94.,96.,-9.,-7./)
CASE ('r8s100e')
area = (/99.,101.,-9.,-7./)
! ENACT
CASE ('NE_subtrop_pac')
area = (/190.,260.,10.,30./)
CASE ('NW_subtrop_pac')
area = (/120.,190.,10.,30./)
CASE ('NE_extratrop_pac')
area = (/190.,250.,30.,60./)
CASE ('NW_extratrop_pac')
area = (/120.,190.,30.,60./)
CASE ('SE_subtrop_pac')
area = (/200.,300.,-30.,-10./)
CASE ('SW_subtrop_pac')
area = (/143.,200.,-30.,-10./)
CASE ('NE_subtrop_atl')
area = (/320.,355.,10.,30./)
CASE ('NW_subtrop_atl')
area = (/283.,320.,10.,30./)
CASE ('NE_extratrop_atl')
area = (/320.,360.,30.,60./)
CASE ('NW_extratrop_atl')
area = (/285.,320.,30.,60./)
CASE ('SE_subtrop_atl')
area = (/350.,20.,-30.,-10./)
CASE ('SW_subtrop_atl')
area = (/300.,350.,-30.,-10./)
CASE ('SE_subtrop_ind')
area = (/80.,120.,-30.,-10./)
CASE ('SW_subtrop_ind')
area = (/30.,80.,-30.,-10./)
CASE ('Southern_ocean_pac')
area = (/130.,290.,-80.,-30./)
CASE ('Southern_ocean_atl')
area = (/290.,20.,-80.,-30./)
CASE ('Southern_ocean_ind')
area = (/20.,130.,-80.,-30./)
! Global areas different latitudes
CASE ('GLOBAL05')
area = (/0.,360.,-5.,5./)
CASE ('GLOBAL10')
area = (/0.,360.,-10.,10./)
CASE ('GLOBAL15')
area = (/0.,360.,-15.,15./)
CASE ('GLOBAL20')
area = (/0.,360.,-20.,20./)
CASE ('GLOBAL25')
area = (/0.,360.,-25.,25./)
CASE ('GLOBAL30')
area = (/0.,360.,-30.,30./)
CASE ('GLOBAL40')
area = (/0.,360.,-40.,40./)
CASE ('GLOBAL50')
area = (/0.,360.,-50.,50./)
CASE ('GLOBAL60')
area = (/0.,360.,-60.,60./)
CASE ('ARCTIC')
area = (/0.,360.,65.,90./)
CASE ('ATL60NA')
area=(/260.,9.13,59.,61./)
CASE ('ATL50NA')
area=(/260.,5.,49.,51./)
CASE ('ATL40NA')
area=(/260.,358.,39.,41./)
CASE ('ATL35NA')
area=(/260.,360.,34.,36./)
CASE ('ATL30NA')
area=(/260.,360.,29.,31./)
CASE ('ATL26NA')
area=(/260.,360.,25.,27./)
CASE ('ATL20NA')
area=(/260.,360.,19.,21./)
CASE ('ATL10NA')
area=(/290.,360.,9.,11./)
CASE ('ATLEQA')
area=(/289.,11.,-1.,1./)
CASE ('ATL10SA')
area=(/320.,15.,-11.,-9./)
CASE ('ATL20SA')
area=(/318.,15.,-21.,-19./)
CASE ('ATL30SA')
area=(/310.,20.,-31.,-29./)
CASE ('PAC60NA')
area=(/140.,250.,59.,61./)
CASE ('PAC50NA')
area=(/130.,240.,49.,51./)
CASE ('PAC40NA')
area=(/125.,240.,39.,41./)
CASE ('PAC35NA')
area=(/115.,242.,34.,36./)
CASE ('PAC30NA')
area=(/115.,250.,29.,31./)
CASE ('PAC20NA')
area=(/100.,260.,19.,21./)
CASE ('PAC10NA')
area=(/105.,275.,9.,11./)
CASE ('PACEQA')
area=(/115.,282.,-1.,1./)
CASE ('INP10SA')
area=(/35.,290.,-11.,-9./)
CASE ('PAC20SA')
area=(/140.,292.,-21.,-19./)
CASE ('PAC30SA')
area=(/150.,292.,-31.,-29./)
CASE ('INDEQA')
area=(/40.,115.,-1.,1./)
CASE ('IND20SA')
area=(/30.,130.,-21.,-19./)
CASE ('IND30SA')
area=(/30.,120.,-31.,-29./)
CASE ('GLB60NA')
area=(/166.,9.13,59.,61./)
CASE ('GLB50NA')
area=(/0.,360.,49.,51./)
CASE ('GLB40NA')
area=(/0.,360.,39.,41./)
CASE ('GLB30NA')
area=(/0.,360.,29.,31./)
CASE ('GLB20NA')
area=(/0.,360.,19.,21./)
CASE ('GLB10NA')
area=(/0.,360.,9.,11./)
CASE ('GLBEQA')
area=(/0.,360.,-1.,1./)
CASE ('GLB10SA')
area=(/0.,360.,-11.,-9./)
CASE ('GLB20SA')
area=(/0.,360.,-21.,-19./)
CASE ('GLB30SA')
area=(/0.,360.,-31.,-29./)
CASE ('GLB40SA')
area=(/0.,360.,-41.,-39./)
CASE ('GLB50SA')
area=(/0.,360.,-51.,-49./)
CASE ('GLB60SA')
area=(/0.,360.,-61.,-59./)
CASE ('npac25')
area = (/100.,260.,25.,70./)
!Zonal sections
! Measurements of Indonesian Throughflow at
! http://www.ocean.washington.edu/people/faculty/susanh/spga/spga.htm
! INSTANT obserational program
CASE ('LOMBOK')
! area=(/114.,118.,-8.,-8./)
area=(/114.,120.,-8.,-9./) ! first/last point rather than min,max
CASE ('MAKASSAR')
! area=(/114.,120.,-3.,-3./)
area=(/114.,121.,-3.,-3./)
CASE ('MALACCAS')
! area=(/99.,102.,3.,3./)
area=(/103.,112.,-2.8,-2.8/)
CASE ('BANDA')
area=(/122.,140.,-4.,-4./)
CASE ('SAVU')
! area=(/122.,124.,-8.8,-8.8/)
area=(/120.,125.,-8.8,-9.4/)
CASE ('PHILIPINES')
area=(/106.,120.,10.985,10.985/)
CASE ('YUCATAN')
! area=(/273.,285.,20.,20./)
area=(/271.,283.,20.,21./)
CASE ('GIN')
! area=(/315.,7.,63.,63./)
area=(/315.,9.8,63.,63./)
CASE ('LABRADOR')
! area=(/290.,315.,61.,61./)
area=(/289.,310.,60.6,63.5/)
CASE ('ATL60N')
! area=(/260.,10.,57.,57./)
! area=(/260.,10.87,57.,57./)
! area=(/260.,11.2,57.,57./)
area=(/260.,9.13,60.,59.925/)
CASE ('ATL50N')
area=(/260.,5.,50.,50./)
CASE ('ATL40N')
area=(/260.,358.,40.,40./)
CASE ('ATL35N')
area=(/260.,360.,35.,35./)
CASE ('ATL30N')
area=(/260.,360.,30.,30./)
CASE ('ATL27N')
area=(/260.,360.,27.,27./)
CASE ('ATL26N')
area=(/260.,360.,26.,26./)
CASE ('ATL20N')
area=(/260.,360.,20.,20./)
CASE ('ATL10N')
! area=(/300.,360.,10.,10./)
area=(/290.,360.,10.,10./)
CASE ('ATLEQ')
! area=(/300.,10.,0.,0./)
area=(/289.,11.,0.,0./)
CASE ('ATL10S')
area=(/320.,15.,-10.,-10./)
CASE ('ATL20S')
area=(/318.,15.,-30.,-30./)
CASE ('ATL30S')
area=(/310.,20.,-30.,-30./)
CASE ('PAC60N')
area=(/140.,250.,60.,60./)
CASE ('PAC50N')
area=(/130.,240.,50.,50./)
CASE ('PAC40N')
area=(/125.,240.,40.,40./)
CASE ('PAC35N')
! area=(/115.,240.,35.,35./)
area=(/115.,242.,35.,35./)
CASE ('PAC30N')
area=(/115.,250.,30.,30./)
CASE ('PAC25N')
area=(/100.,260.,25.,25./)
CASE ('PAC20N')
area=(/100.,260.,20.,20./)
CASE ('PAC10N')
! area=(/98.,275.,10.,10./)
area=(/105.,275.,10.,10./)
CASE ('PACEQ')
area=(/115.,282.,0.,0./)
CASE ('INP10S')
area=(/35.,290.,-10.,-10./)
CASE ('PAC20S')
area=(/140.,292.,-20.,-20./)
CASE ('PAC30S')
area=(/150.,292.,-30.,-30./)
CASE ('INDEQ')
area=(/40.,115.,-0.,-0./)
CASE ('IND20S')
area=(/30.,130.,-20.,-20./)
CASE ('IND30S')
area=(/30.,120.,-30.,-30./)
CASE ('GLB60N')
! area=(/0.,360.,60.,60./)
! area=(/166.,10.,60.5,60./)
! area=(/166.,6.6,60.5,59.7/)
area=(/166.,9.13,60.5,59.925/)
CASE ('GLB50N')
area=(/0.,360.,50.,50./)
CASE ('GLB40N')
area=(/0.,360.,40.,40./)
CASE ('GLB30N')
area=(/0.,360.,30.,30./)
CASE ('GLB20N')
area=(/0.,360.,20.,20./)
CASE ('GLB10N')
area=(/0.,360.,10.,10./)
CASE ('GLBEQ')
area=(/0.,360.,0.,0./)
CASE ('GLB10S')
area=(/0.,360.,-10.,-10./)
CASE ('GLB20S')
area=(/0.,360.,-20.,-20./)
CASE ('GLB30S')
area=(/0.,360.,-30.,-30./)
CASE ('GLB40S')
area=(/0.,360.,-40.,-40./)
CASE ('GLB50S')
area=(/0.,360.,-50.,-50./)
CASE ('GLB60S')
area=(/0.,360.,-60.,-60./)
CASE ('SUM-DARWIN')
area=(/104.,131.,-4.9,-15.3/)
!Meridonal sections (for zonal transports)
CASE ('IT' ) !From Flores to Australia
! area=(/114.,114.,-22.,-8.5/)
area=(/126.,126.,-8.8,-16./)
CASE ('ITA' ) !From Sumatra to Australia
! area=(/115.,114.,-22.,-3./)
area=(/104.,115.,-4.9,-24.7/)
CASE ('TIMOR')
area=(/124.,124.,-17.,-9./)
! CASE ('OMBAI')
! area=(/124.5,124.5,-9.2,-8.2/)
! CASE ('SUMBA')
! area=(/120.,120.,-9.3,-8.3/)
! CASE ('LUZON')
! area=(/120.5,120.5,17.,23./)
CASE ('DRAKE')
! area=(/290.,290.,-75.,-52./)
! area=(/-69.,-64.,-55.2,-65.9/)
area=(/291.,296.,-54.6,-65.9/)
CASE ('TORRES')
area=(/143.,143.,-15.,-8./)
CASE ('MED')
area=(/356.,356.,32.,40./)
CASE ('FLORIDA')
! area=(/279.5,279.5,22.,28./)
! area=(/-81.,-79,26.5,21.9/)
area=(/-82.,-79.,28.2,22./)
CASE ('ANTILLAS')
! area=(/290.,290.,10.,18./)
area=(/-72.,-72.,19.1,8.2/)
CASE ('GOODHOPE')
! area=(/340.,340.,-80.,-30./)
area=(/23.,44.,-31.7,-68.2/)
CASE ('SOUTHAUS')
! area=(/140.,140.,-80.,-30./)
area=(/133.,133.,-30.,-67.5/)
CASE default
PRINT*,'area: ', reg, 'is not defined'
CALL abort
END SELECT
END SUBROUTINE coord_area
SUBROUTINE coord_user_init (sec)
CHARACTER(len=1), INTENT(IN) :: sec
CHARACTER(len=20), DIMENSION(:), ALLOCATABLE :: cl_boxes
INTEGER :: nbox
CHARACTER(len=32) :: cdnamelist = 'coords.nml'
LOGICAL :: lexists, lnodefaults
CHARACTER(len=20) :: carea
REAL :: lat1,lat2,lon1,lon2,dlat,dlon
LOGICAL :: lreg, lstd
INTEGER :: nlat,nlon
INTEGER :: i,j,k
NAMELIST/area/lstd,lreg,carea,lat1,lat2,lon1,lon2,dlat,dlon
lnodefaults=.TRUE.
nboxuser=0
SELECT CASE (sec)
CASE ('u')
nbox=nsecm
ALLOCATE(cl_boxes(nbox))
cl_boxes(:)=cl_secm(:)
CASE ('v')
nbox=nsecz
ALLOCATE(cl_boxes(nbox))
cl_boxes(:)=cl_secz(:)
CASE default
nbox=nsech
ALLOCATE(cl_boxes(nbox))
cl_boxes(:)=cl_sech(:)
END SELECT
INQUIRE(file=cdnamelist,exist=lexists)
IF (lexists) THEN
nboxuser=0
OPEN(20,file=cdnamelist)
DO
carea='undefined'
lat1=-90
lat2=90
lon1=0
lon2=360
dlat=10
dlon=10
lreg=.FALSE.
lstd=.FALSE.
READ(20,area,end=100)
DO
IF (lon1<0) lon1=lon1+360
IF (lon1>360) lon1=lon1-360
IF ((lon1>=0).AND.(lon1<=360)) EXIT
ENDDO
DO
IF (lon2<0) lon2=lon2+360
IF (lon2>360) lon2=lon2-360
IF ((lon2>=0).AND.(lon2<=360)) EXIT
ENDDO
WRITE(*,area)
IF (lreg.AND.(TRIM(carea)/='undefined')) THEN
WRITE(*,*)'coord_init: please specify either lreg=true '//&
& 'or carea/=undefined'
CALL abort
ENDIF
IF (TRIM(carea)/='undefined') THEN
nboxuser=nboxuser+1
ENDIF
IF (lreg) THEN
nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
nboxuser=nboxuser+nlat*nlon
ENDIF
IF (lstd) THEN
IF (lnodefaults) THEN
nboxuser=nboxuser+nbox
lnodefaults=.FALSE.
ENDIF
ENDIF
END DO
100 CONTINUE
WRITE(*,*)'Total areas = ',nboxuser
IF (nboxuser==0) THEN
CLOSE(20)
WRITE(*,*)'coord_init: no boxes defined!!'
CALL abort
ENDIF
ALLOCATE(cl_boxes_user(nboxuser))
ALLOCATE(areas(4,nboxuser))
nboxuser=0
IF (.NOT.lnodefaults) THEN
cl_boxes_user(1:nbox)=cl_boxes(1:nbox)
DO i=1,nbox
CALL coord_area( cl_boxes_user(i), areas(:,i) )
ENDDO
nboxuser=nboxuser+nbox
ENDIF
REWIND(20)
WRITE(*,*)'Reading areas'
DO
carea='undefined'
lat1=-90
lat2=90
lon1=0
lon2=360
dlat=10
dlon=10
lreg=.FALSE.
lstd=.FALSE.
READ(20,area,end=200)
DO
IF (lon1<0) lon1=lon1+360
IF (lon1>360) lon1=lon1-360
IF ((lon1>=0).AND.(lon1<=360)) EXIT
ENDDO
DO
IF (lon2<0) lon2=lon2+360
IF (lon2>360) lon2=lon2-360
IF ((lon2>=0).AND.(lon2<=360)) EXIT
ENDDO
IF (TRIM(carea)/='undefined') THEN
nboxuser=nboxuser+1
cl_boxes_user(nboxuser)=carea
areas(1,nboxuser)=MIN(lon1,lon2)
areas(2,nboxuser)=MAX(lon1,lon2)
areas(3,nboxuser)=MIN(lat1,lat2)
areas(4,nboxuser)=MAX(lat1,lat2)
ENDIF
IF (lreg) THEN
nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
k=0
DO j=1,nlat
DO i=1,nlon
k=k+1
areas(1,k+nboxuser)=MIN(lon1,lon2)+(i-1)*dlon
areas(2,k+nboxuser)=MIN(lon1,lon2)+i*dlon
areas(3,k+nboxuser)=MIN(lat1,lat2)+(j-1)*dlat
areas(4,k+nboxuser)=MIN(lat1,lat2)+j*dlat
WRITE(cl_boxes_user(k+nboxuser)(1:5),'(I4.4,A1)') &
& NINT(areas(1,k+nboxuser)*10),'e'
WRITE(cl_boxes_user(k+nboxuser)(6:10),'(I4.4,A1)') &
& NINT(areas(2,k+nboxuser)*10),'e'
IF (areas(3,k+nboxuser)<0) THEN
WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
& -NINT(areas(3,k+nboxuser)*10),'s'
ELSE
WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
& NINT(areas(3,k+nboxuser)*10),'n'
ENDIF
IF (areas(4,k+nboxuser)<0) THEN
WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
& -NINT(areas(4,k+nboxuser)*10),'s'
ELSE
WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
& NINT(areas(4,k+nboxuser)*10),'n'
ENDIF
ENDDO
ENDDO
nboxuser=nboxuser+nlat*nlon
ENDIF
END DO
200 CONTINUE
CLOSE(20)
ELSE
nboxuser=nbox
ALLOCATE(cl_boxes_user(nboxuser))
ALLOCATE(areas(4,nboxuser))
cl_boxes_user(:)=cl_boxes(:)
DO i=1,nbox
CALL coord_area( cl_boxes_user(i), areas(:,i) )
ENDDO
ENDIF
DO i=1,nboxuser
WRITE(*,'(A,4F12.2)')cl_boxes_user(i),areas(:,i)
DO j=i+1,nboxuser
IF (TRIM(cl_boxes_user(i))==TRIM(cl_boxes_user(j))) THEN
WRITE(*,*)'coord_user_init: dublicate boxes'
CALL abort
ENDIF
ENDDO
ENDDO
END SUBROUTINE coord_user_init
SUBROUTINE coord_area_user( reg, area, ldfail )
!-----------------------------------------------------------------------
!
! ROUTINE coord_area_user
! ****************************
!
! Purpose :
! -------
! Get coordinate of different regions
!
! Modifications :
! -------------
IMPLICIT NONE
!----------------------------------------------------------------------
! local declarations
!----------------------------------------------------------------------
!
CHARACTER(len=20), INTENT(inout) :: reg
REAL, DIMENSION(4), INTENT(out) :: area
LOGICAL, OPTIONAL, INTENT(out) :: ldfail
INTEGER :: i
LOGICAL :: lnotfound
!
reg=TRIM(reg)
lnotfound=.TRUE.
DO i=1,nboxuser
IF (reg==TRIM(cl_boxes_user(i))) THEN
area(:)=areas(:,i)
lnotfound=.FALSE.
EXIT
ENDIF
ENDDO
IF (PRESENT(ldfail)) THEN
ldfail=lnotfound
ELSE
IF (lnotfound) THEN
WRITE(*,*)'coord_area_user: area not found'
CALL abort
ENDIF
ENDIF
END SUBROUTINE coord_area_user
END MODULE coords