| 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 |
|---|
