NCEPLIBS-w3emc 2.12.0
Loading...
Searching...
No Matches
w3ft32.f
Go to the documentation of this file.
1C> @file
2C> @brief General interpolator between nmc flds.
3C> @author John Stackpole @date 1974-06-15
4
5C> Interpolate scalar quantity from any given nmc
6C> field (in office note 84) to any other field. Can do bilinearly
7C> or biquadratically. Will not rotate wind components.
8C> Input and output fields are real*4 unpacked
9C>
10C> ### Program History Log:
11C> Date | Programmer | Comment
12C> -----|------------|--------
13C> 1974-06-15 | John Stackpole |
14C> 1987-07-15 | Bill Cavanaugh | Add grid type 100, 101 to tables.
15C> 1990-08-08 | John. Stackpole | Correct rotation error wrt 100, 101
16C> 1990-08-31 | Ralph Jones | Change name from polate to w3ft32
17C> 1993-01-26 | Dennis Keyser | Added grid types 87, 105, 106, 107 to
18C> tables (as both input and output).
19C>
20C> @param[in] FIELD REAL*4 Two dimensional array.
21C> @param[in] MAPIN INTEGER*4 Nmc map number (k) for given input field.
22C> @param[in] MAPOUT INTEGER*4 Nmc map number (k) for wanted output field.
23C> @param[in] INTERP INTEGER*4 Set interpolation method:
24C> - eq 1 - linear
25C> - ne 1 - biquadratic
26C> @param[out] DATA REAL*4 Array to hold output map (unpacked).
27C> @param[out] IER INTEGER*4 Completion condition flag
28C>
29C> Return conditions:
30C> - IER:
31C> - 0 No difficulties
32C> - 1 Mapin not recognized
33C> - 2 Mapout not recognized
34C> - 3 Particular pola mapout not recognized
35C> - 4 Particular lola mapout not recognized
36C> - 5 Particular lola mapin not recognized
37C> - 6 Particular pola mapout not recognized
38C> - 7 Particular lola mapin not recognized
39C> - 8 Particular lola mapout not recognized
40C> these flags are set at various test locations
41C> please refer to the code listing for details
42C>
43C> @note See comment cards following for more detail
44C> including recipes for adding more input and
45C> output maps as the need arises.
46C>
47C> @author John Stackpole @date 1974-06-15
48 SUBROUTINE w3ft32(FIELD, MAPIN, DATA, MAPOUT, INTERP, IER)
49C
50C INTERPOLATE INFORMATION FROM FIELD (MAP TYPE K = MAPIN)
51C TO DATA (MAP TYPE K = MAPOUT)
52C INTERP SETS INTERPOLATION METHOD
53C = 1 BILINEAR, OTHERWISE BIQUADRATIC
54C
55 REAL DATA(*), FIELD(*)
56C
57C RESTRICTION AND RULES:
58C
59C AT PRESENT W3FT32 WILL ACCEPT ONLY THE FOLLOWING TYPES
60C POLAR STEREOGRAPHIC
61C K = 5 & 26 (LFM ANL & FCST RESPECTIVELY)
62C 27 & 28 (65X65)
63C 25 (53X57 SOUTHERN HEMISPHERE)
64C 49 (129X129 NH; 190.5 KM)
65C 50 (129X129 SH; 190.5 KM)
66C 55 (87X71 NH; LFM ORIENT; 254 KM)
67C 56 (87X71 NA; LFM ORIENT; 174 KM)
68C 60 (57X57 ENLARGED LFM 'VLFM')
69C 87 (81X62 MAPS ANAL/FCST GRID; 68.153 KM)
70C 100 (83X83 NGM C-GRID; 91.452)
71C 101 (113X91 NGM BIG C-GRID; 91.452)
72C 105 (83X83 NGM SUPER C-GRID SUBSET; 90.75464 KM)
73C 106 (165X117 HI RESOLUTION GRID; 45.37732 KM)
74C 107 (120X92 HI RESOLUTION GRID SUBSET; 45.37732 KM)
75C
76C LONGITUDE/LATITUDE: ('LOLA')
77C K = 29 & 30 (145X37)
78C 33 & 34 (181X46)
79C 45 & 46 (97X25 - 3.75 DEG LOLA)
80C 21 & 22 (73X19 - 5 DEG LOLA)
81C 21 & 22 (73X19 - 5 DEG LOLA)
82C
83C WILL OUTPUT:
84C POLAR STEREO:
85C K = 5 (53X57) LFM
86C 25 (53X57 SOUTH HEMISPHERE)
87C 26 (53X45) LFM
88C 27 & 28 (65X65)
89C 49 (129X129 NH POLA) (1/2 BEDIENT MESH;ORIENTED 80W)
90C 50 (129X129 SH POLA) (1/2 BEDIENT MESH;ORINETED 80W)
91C 51 (129X129 NH POLA) (SAME MESHL; ORIENTED AT 105W)
92C 55 (NH 87X71 254 KM, LFM ORIENT)
93C 56 (NA 87X71 127 KM, LFM ORIENT)
94C 60 (57X57 ENLARGED LFM 'VLFM')
95C 87 (81X62 MAPS ANAL/FCST GRID; 68.153 KM)
96C 100 (83X83 NGM C-GRID)
97C 101 (113X91 NGM BIG C-GRID)
98C 105 (83X83 NGM SUPER C-GRID SUBSET; 90.75464 KM)
99C 106 (165X117 HI RESOLUTION GRID; 45.37732 KM)
100C 107 (120X92 HI RESOLUTION GRID SUBSET; 45.37732 KM)
101C 400 (39X39 1:40MIL 80 DEG VERTICAL POLA)
102C 401 (25X35 1:20MIL U.S. SECTION ROTATED)
103C 402 (97X97 1-20MIL N.H. POLA ROTATED TO 105W VERT)
104C 403 (97X97 1-20MIL S.H. POLA UNROTATED 80W TOP VERT)
105C LOLA:
106C K = 29 & 30 (145X37)
107C 33 & 34 (181X46)
108C 45 & 46 (97X25 - 3.75 DEG LOLA)
109C 500 & 501 US SECTIONAL NEP 36 & 45
110C
111C FEEL FREE, GENTLE READER, TO AUGMENT THE LIST AS YOU WISH
112C AND HERE IS A RECIPE FOR ADDING A NEW OUTPUT GRID
113C (POLA IN THIS CASE, BUT I AM SURE YOU CAN DRAW THE ANALOGY)
114C STEP1
115C PUT NEW NUMBER IN COMMENT ABOVE
116C STEP 2
117C ADD IT TO MAPOUT LIST NEAR STMT 30
118C STEP 3
119C ADD SET OF PARAMETERS AT STMT 2000 (FOR POLA)
120C STEP4
121C ADD SET OF PARAMETERS AT STMT 6000 (FOR POLA)
122C
123C HERE TOO IS A RECIPE FOR ADDING A NEW (POLA) INPUT GRID
124C
125C STEP 1:
126C PUT NEW NUMBER IN COMMENT ABOVE
127C STEP2:
128C ADD NUMBER TO IF(MAPIN.. ) TEST BELOW
129C STEP 3:
130C ADD INPUT MAP CHARACTERISTICS AT STMT 1000
131C STEP 4:
132C DITTO AT STMT 3000
133C
134 LOGICAL LOLAIN, POLAIN, LOLAOU, POLAOU
135C
136 SAVE
137C
138C BEGIN HERE - SET ERROR RETURN TO O.K.
139C
140 ier = 0
141C
142C DETERMINE WHETHER INPUT GRID IS LOLA OR POLA
143C
144C THIS LIST CAN BE AUGMENTED ONLY AT THE COST OF A LOT OF
145C WORK ELSEWHERE IN THE PROGRAM
146C HAVE AT IT IF YOU WANT OTHER MAPS
147C
148C POLA MAPS
149C
150 IF (mapin.EQ. 5) GO TO 10
151 IF (mapin.EQ.25) GO TO 10
152 IF (mapin.EQ.26) GO TO 10
153 IF (mapin.EQ.27) GO TO 10
154 IF (mapin.EQ.28) GO TO 10
155 IF (mapin.EQ.49) GO TO 10
156 IF (mapin.EQ.50) GO TO 10
157 IF (mapin.EQ.51) GO TO 10
158 IF (mapin.EQ.55) GO TO 10
159 IF (mapin.EQ.56) GO TO 10
160 IF (mapin.EQ.60) GO TO 10
161 IF (mapin.EQ.87) GO TO 10
162 IF (mapin.EQ.100) GO TO 10
163 IF (mapin.EQ.101) GO TO 10
164 IF (mapin.EQ.105) GO TO 10
165 IF (mapin.EQ.106) GO TO 10
166 IF (mapin.EQ.107) GO TO 10
167C
168C LOLA MAPS
169C
170 IF (mapin.EQ.21) GO TO 20
171 IF (mapin.EQ.22) GO TO 20
172 IF (mapin.EQ.29) GO TO 20
173 IF (mapin.EQ.30) GO TO 20
174 IF (mapin.EQ.33) GO TO 20
175 IF (mapin.EQ.34) GO TO 20
176 IF (mapin.EQ.45) GO TO 20
177 IF (mapin.EQ.46) GO TO 20
178C
179C IF NO MATCH - ERROR
180C
181 ier = 1
182 RETURN
183C
184C SET LOGICAL FLAGS
185C
186 10 lolain = .false.
187 polain = .true.
188 GO TO 30
189C
190 20 lolain = .true.
191 polain = .false.
192C
193C DITTO FOR OUTPUT MAP TYPE
194C
195C POLA MAPS
196C
197 30 IF (mapout.EQ. 5) GO TO 40
198 IF (mapout.EQ.25) GO TO 40
199 IF (mapout.EQ.26) GO TO 40
200 IF (mapout.EQ.27) GO TO 40
201 IF (mapout.EQ.28) GO TO 40
202 IF (mapout.EQ.49) GO TO 40
203 IF (mapout.EQ.50) GO TO 40
204 IF (mapout.EQ.51) GO TO 40
205 IF (mapout.EQ.55) GO TO 40
206 IF (mapout.EQ.56) GO TO 40
207 IF (mapout.EQ.60) GO TO 40
208 IF (mapout.EQ.87) GO TO 40
209 IF (mapout.EQ.100) GO TO 40
210 IF (mapout.EQ.101) GO TO 40
211 IF (mapout.EQ.105) GO TO 40
212 IF (mapout.EQ.106) GO TO 40
213 IF (mapout.EQ.107) GO TO 40
214 IF (mapout.EQ.400) GO TO 40
215 IF (mapout.EQ.401) GO TO 40
216 IF (mapout.EQ.402) GO TO 40
217 IF (mapout.EQ.403) GO TO 40
218C
219C LOLA MAPS
220C
221 IF (mapout.EQ.21) GO TO 50
222 IF (mapout.EQ.22) GO TO 50
223 IF (mapout.EQ.29) GO TO 50
224 IF (mapout.EQ.30) GO TO 50
225 IF (mapout.EQ.33) GO TO 50
226 IF (mapout.EQ.34) GO TO 50
227 IF (mapout.EQ.45) GO TO 50
228 IF (mapout.EQ.46) GO TO 50
229 IF (mapout.EQ.500) GO TO 50
230 IF (mapout.EQ.501) GO TO 50
231C
232C NO MATCH - ERROR
233C
234 ier = 2
235 RETURN
236C
237C SET LOGICAL FLAGS
238C
239 40 lolaou = .false.
240 polaou = .true.
241 GO TO 60
242C
243 50 lolaou = .true.
244 polaou = .false.
245C
246C GO TO DIFFERENT SECTIONS FOR IN/OUT OPTIONS
247C
248 60 IF (polain) GO TO 1000
249 IF (lolain) GO TO 5000
250C
251C ##################################################################
252C ##################################################################
253C
254C THIS SECTION FOR POLAR STEREOGRAPHIC INPUT MAPS
255C
256C SUBDIVIDED FOR OUTPUT TYPE
257C
258 1000 IF (lolaou) GO TO 3000
259C
260C POLAR STEREO TO POLAR STEREO
261C USE HOWCROFTS FIELD TRANSFORMER
262C ORIENT IS DEGREES OF ROTATION FROM NMC STANDARD
263C (80 DEG CENTER VERTIVAL) TO INPUT GRID (POSITIVE ANTICLOCKWISE)
264C
265 IF (mapin.EQ. 5) GO TO 1005
266 IF (mapin.EQ.25) GO TO 1025
267 IF (mapin.EQ.26) GO TO 1026
268 IF (mapin.EQ.27) GO TO 1027
269 IF (mapin.EQ.28) GO TO 1027
270 IF (mapin.EQ.49) GO TO 1049
271 IF (mapin.EQ.50) GO TO 1049
272 IF (mapin.EQ.51) GO TO 1051
273 IF (mapin.EQ.55) GO TO 1055
274 IF (mapin.EQ.56) GO TO 1056
275 IF (mapin.EQ.60) GO TO 1060
276 IF (mapin.EQ.87) GO TO 1087
277 IF (mapin.EQ.100) GO TO 1100
278 IF (mapin.EQ.101) GO TO 1101
279 IF (mapin.EQ.105) GO TO 1105
280 IF (mapin.EQ.106) GO TO 1106
281 IF (mapin.EQ.107) GO TO 1107
282 ier = 1
283 RETURN
284C
285 1005 imaxin =53
286 jmaxin = 57
287 comiin = 27.
288 comjin = 49.
289 orient = -25.
290 xmesh = 190.5
291 GO TO 2000
292C
293 1025 imaxin = 53
294 jmaxin = 57
295 comiin = 27.
296 comjin = 29.
297 orient = 0.
298 xmesh = 381.
299 GO TO 2000
300C
301 1026 imaxin = 53
302 jmaxin = 45
303 comiin = 27.
304 comjin = 49.
305 orient = -25.
306 xmesh = 190.5
307 GO TO 2000
308C
309 1027 imaxin = 65
310 jmaxin = 65
311 comiin = 33.
312 comjin = 33.
313 orient = 0.
314 xmesh = 381.
315 GO TO 2000
316C
317 1049 imaxin = 129
318 jmaxin = 129
319 comiin = 65.
320 comjin = 65.
321 orient = 0.
322 xmesh = 190.5
323 GOTO 2000
324C
325 1051 imaxin = 129
326 jmaxin = 129
327 comiin = 65.
328 comjin = 65.
329 orient = -25.
330 xmesh = 190.5
331 GOTO 2000
332C
333 1055 imaxin = 87
334 jmaxin = 71
335 comiin = 44.
336 comjin = 38.
337 orient = -25.
338 xmesh = 254.
339 GOTO 2000
340C
341 1056 imaxin = 87
342 jmaxin = 71
343 comiin = 40.
344 comjin = 73.
345 orient = -25.
346 xmesh = 127.
347 GOTO 2000
348C
349 1060 imaxin= 57
350 jmaxin = 57
351 comiin = 29.
352 comjin = 49.
353 orient = -25.
354 xmesh = 190.5
355 GO TO 2000
356C
357 1087 imaxin= 81
358 jmaxin = 62
359 comiin = 31.91
360 comjin = 112.53
361 orient = -25.
362 xmesh = 68.153
363 GO TO 2000
364C
365 1100 imaxin = 83
366 jmaxin = 83
367 comiin = 40.5
368 comjin = 88.5
369 orient = -25.
370 xmesh = 91.452
371 GO TO 2000
372C
373 1101 imaxin = 113
374 jmaxin = 91
375 comiin = 58.5
376 comjin = 92.5
377 orient = -25.
378 xmesh = 91.452
379 GO TO 2000
380C
381 1105 imaxin = 83
382 jmaxin = 83
383 comiin = 40.5
384 comjin = 88.5
385 orient = -25.
386 xmesh = 90.75464
387 GO TO 2000
388C
389 1106 imaxin = 165
390 jmaxin = 117
391 comiin = 80.0
392 comjin = 176.0
393 orient = -25.
394 xmesh = 45.37732
395 GO TO 2000
396C
397 1107 imaxin = 120
398 jmaxin = 92
399 comiin = 46.0
400 comjin = 167.0
401 orient = -25.
402 xmesh = 45.37732
403 GO TO 2000
404C
405C SELECT I, J, DILATION, ROTATION, AND COMMON POINT (POLE) OUTPUT
406C DILATE = XMESHOUT / XMESHIN
407C IN THE FOLLOWING, ROT IS THE ROTATION FROM THE INPUT TO
408C THE OUTPUT GRID - NOT THE ORIENTATION OF THE OUT-GRID
409C
410 2000 IF (mapout.EQ. 5) GO TO 2005
411 IF (mapout.EQ.25) GO TO 2025
412 IF (mapout.EQ.26) GO TO 2026
413 IF (mapout.EQ.27) GO TO 2027
414 IF (mapout.EQ.28) GO TO 2027
415 IF (mapout.EQ.49) GO TO 2049
416 IF (mapout.EQ.50) GO TO 2049
417 IF (mapout.EQ.51) GO TO 2051
418 IF (mapout.EQ.55) GO TO 2055
419 IF (mapout.EQ.56) GO TO 2056
420 IF (mapout.EQ.60) GO TO 2060
421 IF (mapout.EQ.87) GO TO 2087
422 IF (mapout.EQ.100) GO TO 2100
423 IF (mapout.EQ.101) GO TO 2101
424 IF (mapout.EQ.105) GO TO 2105
425 IF (mapout.EQ.106) GO TO 2106
426 IF (mapout.EQ.107) GO TO 2107
427 IF (mapout.EQ.400) GO TO 2400
428 IF (mapout.EQ.401) GO TO 2401
429 IF (mapout.EQ.402) GO TO 2402
430 IF (mapout.EQ.403) GO TO 2403
431 ier = 3
432 RETURN
433C
434 2005 imaxou = 53
435 jmaxou = 57
436 dilat = 190.5/xmesh
437 rot = -25. - orient
438 comiou = 27.
439 comjou = 49.
440 GO TO 2700
441C
442 2025 imaxou = 53
443 jmaxou = 57
444 dilat = 381./xmesh
445 rot = 0. - orient
446 comiou = 27.
447 comjou = 29.
448 GO TO 2700
449C
450 2026 imaxou = 53
451 jmaxou = 45
452 dilat = 190.5/xmesh
453 rot = -25. - orient
454 comiou = 27.
455 comjou = 49.
456 GO TO 2700
457C
458 2027 imaxou = 65
459 jmaxou = 65
460 dilat = 381./xmesh
461 rot = 0. - orient
462 comiou = 33.
463 comjou = 33.
464 GO TO 2700
465C
466 2049 imaxou = 129
467 jmaxou = 129
468 dilat = 190.5/xmesh
469 rot = 0. - orient
470 comiou = 65.
471 comjou = 65.
472 GOTO 2700
473C
474 2051 imaxou = 129
475 jmaxou = 129
476 dilat = 190.5/xmesh
477 rot = -25. - orient
478 comiou = 65.
479 comjou = 65.
480 GOTO 2700
481C
482 2055 imaxou = 87
483 jmaxou = 71
484 dilat = 254./xmesh
485 rot = -25. - orient
486 comiou = 44.
487 comjou = 38.
488 GOTO 2700
489C
490 2056 imaxou = 87
491 jmaxou = 71
492 dilat = 127./xmesh
493 rot = -25. - orient
494 comiou = 40.
495 comjou = 73.
496 GOTO 2700
497C
498 2060 imaxou = 57
499 jmaxou = 57
500 dilat = 190.5/xmesh
501 rot = -25. - orient
502 comiou = 29.
503 comjou = 49.
504 GO TO 2700
505C
506 2087 imaxou = 81
507 jmaxou = 62
508 dilat = 68.153/xmesh
509 rot = -25. - orient
510 comiou = 31.91
511 comjou = 112.53
512 GO TO 2700
513C
514 2100 imaxou = 83
515 jmaxou = 83
516 dilat = 91.452/xmesh
517 rot = -25. - orient
518 comiou = 40.5
519 comjou = 88.5
520 GO TO 2700
521C
522 2101 imaxou = 113
523 jmaxou = 91
524 dilat = 91.452/xmesh
525 rot = -25. - orient
526 comiou = 58.5
527 comjou = 92.5
528 GO TO 2700
529C
530 2105 imaxou = 83
531 jmaxou = 83
532 dilat = 90.75464/xmesh
533 rot = -25. - orient
534 comiou = 40.5
535 comjou = 88.5
536 GO TO 2700
537C
538 2106 imaxou = 165
539 jmaxou = 117
540 dilat = 45.37732/xmesh
541 rot = -25. - orient
542 comiou = 80.0
543 comjou = 176.0
544 GO TO 2700
545C
546 2107 imaxou = 120
547 jmaxou = 92
548 dilat = 45.37732/xmesh
549 rot = -25. - orient
550 comiou = 46.0
551 comjou = 167.0
552 GO TO 2700
553C
554 2400 imaxou = 39
555 jmaxou = 39
556 dilat = 508./ xmesh
557 rot = 0. - orient
558 comiou = 20.
559 comjou = 20.
560 GO TO 2700
561C
562 2401 imaxou = 25
563 jmaxou = 35
564 dilat = 254./xmesh
565 rot = -25. + 90. - orient
566 comiou =31.75
567 comjou = 18.
568 GO TO 2700
569C
570 2402 imaxou = 97
571 jmaxou = 97
572 dilat = 254./xmesh
573 rot = -25. - orient
574 comiou = 49.
575 comjou = 49.
576 GOTO 2700
577C
578 2403 imaxou = 97
579 jmaxou = 97
580 dilat = 254./xmesh
581 rot = 0. - orient
582 comiou = 49.
583 comjou = 49.
584 GOTO 2700
585C
586 2700 CALL w3ft00
587 1 (field, DATA, imaxin, jmaxin, imaxou, jmaxou,
588 2 comiin, comjin, comiou, comjou,
589 3 dilat, rot, interp)
590 RETURN
591C
592C ##################################################################
593C
594C HERE FOR POLAR STEREO TO LO/LA
595C
596 3000 IF (mapin.EQ. 5) GO TO 3005
597 IF (mapin.EQ.25) GO TO 3025
598 IF (mapin.EQ.26) GO TO 3026
599 IF (mapin.EQ.27) GO TO 3027
600 IF (mapin.EQ.28) GO TO 3027
601 IF (mapin.EQ.49) GO TO 3049
602 IF (mapin.EQ.50) GO TO 3049
603 IF (mapin.EQ.51) GO TO 3051
604 IF (mapin.EQ.55) GO TO 3055
605 IF (mapin.EQ.56) GO TO 3056
606 IF (mapin.EQ.60) GO TO 3060
607 IF (mapin.EQ.87) GO TO 3087
608 IF (mapin.EQ.100) GO TO 3100
609 IF (mapin.EQ.101) GO TO 3101
610 IF (mapin.EQ.105) GO TO 3105
611 IF (mapin.EQ.106) GO TO 3106
612 IF (mapin.EQ.107) GO TO 3107
613C
614 3005 xmesh = 190.5
615 imaxin = 53
616 jmaxin = 57
617 nthsth = 1
618 polei = 27.
619 polej = 49.
620 orient = 105.
621 GO TO 4000
622C
623 3025 xmesh = 381.
624 imaxin = 53
625 jmaxin = 57
626 nthsth = 2
627 polei = 27.
628 polej = 29.
629 GO TO 4000
630C
631 3026 xmesh = 190.5
632 imaxin = 53
633 jmaxin = 45
634 nthsth = 1
635 polei = 27.
636 polej = 49.
637 orient = 105.
638 GO TO 4000
639C
640 3027 xmesh = 381.
641 imaxin = 65
642 jmaxin = 65
643 nthsth = 1
644 IF (mapin.EQ.28) nthsth = 2
645 polei = 33.
646 polej = 33.
647 orient = 80.
648 GO TO 4000
649C
650 3049 xmesh = 190.5
651 imaxin = 129
652 jmaxin = 129
653 nthsth = 1
654 IF (mapin.EQ.50) nthsth=2
655 polei = 65.
656 polej = 65.
657 orient = 80.
658 GOTO 4000
659C
660 3051 xmesh = 190.5
661 imaxin = 129
662 jmaxin = 129
663 nthsth = 1
664 polei = 65.
665 polej = 65.
666 orient = 105.
667 GOTO 4000
668C
669 3055 xmesh = 254.
670 imaxin = 87
671 jmaxin = 71
672 nthsth = 1
673 polei = 44.
674 polej = 38.
675 orient = 105.
676 GOTO 4000
677C
678 3056 xmesh = 127.
679 imaxin = 87
680 jmaxin = 71
681 nthsth = 1
682 polei = 40.
683 polej = 73.
684 orient = 105.
685 GOTO 4000
686C
687 3060 xmesh = 190.5
688 imaxin = 57
689 jmaxin = 57
690 nthsth = 1
691 polei = 29.
692 polej = 49.
693 orient = 105.
694 GO TO 4000
695C
696 3087 xmesh = 68.153
697 imaxin = 81
698 jmaxin = 62
699 nthsth = 1
700 polei = 31.91
701 polej = 112.53
702 orient = 105.
703 GO TO 4000
704C
705 3100 xmesh = 91.452
706 imaxin = 83
707 jmaxin = 83
708 nthsth = 1
709 polei = 40.5
710 polej = 88.5
711 orient = 105.
712 GO TO 4000
713C
714 3101 xmesh = 91.452
715 imaxin = 113
716 jmaxin = 91
717 nthsth = 1
718 polei = 58.5
719 polej = 92.5
720 orient = 105.
721 GO TO 4000
722C
723 3105 xmesh = 90.75464
724 imaxin = 83
725 jmaxin = 83
726 nthsth = 1
727 polei = 40.5
728 polej = 88.5
729 orient = 105.
730 GO TO 4000
731C
732 3106 xmesh = 45.37732
733 imaxin = 165
734 jmaxin = 117
735 nthsth = 1
736 polei = 80.0
737 polej = 176.0
738 orient = 105.
739 GO TO 4000
740C
741 3107 xmesh = 45.37732
742 imaxin = 120
743 jmaxin = 92
744 nthsth = 1
745 polei = 46.0
746 polej = 167.0
747 orient = 105.
748 GO TO 4000
749C
750C SELECT OUTPUT LO/LA VARIATIONS
751C
752 4000 IF (mapout.EQ.21) GO TO 4021
753 IF (mapout.EQ.22) GO TO 4021
754 IF (mapout.EQ.29) GO TO 4029
755 IF (mapout.EQ.30) GO TO 4029
756 IF (mapout.EQ.33) GO TO 4033
757 IF (mapout.EQ.34) GO TO 4033
758 IF (mapout.EQ.45) GO TO 4045
759 IF (mapout.EQ.46) GO TO 4045
760 IF (mapout.EQ.500) GO TO 4500
761 IF (mapout.EQ.501) GO TO 4501
762 ier = 4
763 RETURN
764C
765 4021 iminou = 1
766 jminou = 1
767 imaxou = 73
768 jmaxou = 19
769 deg = 5.0
770 GO TO 4700
771C
772 4029 iminou = 1
773 imaxou = 145
774 jminou = 1
775 jmaxou = 37
776 deg = 2.5
777 GO TO 4700
778C
779 4033 iminou = 1
780 imaxou = 181
781 jminou = 1
782 jmaxou = 46
783 deg = 2.0
784 GO TO 4700
785C
786 4045 iminou = 1
787 imaxou = 97
788 jminou = 1
789 jmaxou = 25
790 deg = 3.75
791 GOTO 4700
792C
793 4500 iminou = 93
794 imaxou = 117
795 jminou = 1
796 jmaxou = 37
797 deg = 2.5
798 GO TO 4700
799C
800 4501 iminou = 116
801 imaxou = 140
802 jminou = 1
803 jmaxou = 46
804 deg = 2.0
805 GO TO 4700
806C
807C FIND INPUT POLA I,J FOR DESIRED LOLA OUTPUT POINTS
808C
809 4700 ijout = 0
810 DO 4740 j = jminou, jmaxou
811 xlat = (j-1) * deg
812 IF (nthsth.EQ.2) xlat = xlat - 90.
813 DO 4740 i = iminou, imaxou
814 elon = (i-1) * deg
815 wlon = amod(360. - elon, 360.)
816 GO TO (4710, 4720), nthsth
817 4710 CALL w3fb04(xlat, wlon, xmesh, orient, xi, xj)
818 GO TO 4730
819 4720 CALL w3fb02(xlat, wlon, xmesh, xi, xj)
820 4730 xiin = xi + polei
821 xjin = xj + polej
822C
823C MACDONALDS SUPER GENERAL INTERPOLATOR
824C IN WHICH D = FIELD(XIIN, XJIN)
825C
826 CALL w3ft01
827 1 (xiin, xjin, field, d, imaxin, jmaxin, 0, interp)
828 ijout = ijout + 1
829 DATA(ijout) = d
830 4740 CONTINUE
831 RETURN
832C
833C ##################################################################
834C ##################################################################
835C
836C THIS SECTION FOR LOLA INPUT MAP
837C
838C SELCT OUTPUT TYPE
839C
840 5000 IF (lolaou) GO TO 7000
841C
842C LOLA TO POLA
843C SELECT INPUT INFO
844C (THIS PATTERN CAN BE USED WITH POLA INPUT, TOO - TRY IT
845C
846 IF (mapin.EQ.21) GO TO 5021
847 IF (mapin.EQ.22) GO TO 5021
848 IF (mapin.EQ.29) GO TO 5029
849 IF (mapin.EQ.30) GO TO 5029
850 IF (mapin.EQ.33) GO TO 5033
851 IF (mapin.EQ.34) GO TO 5033
852 IF (mapin.EQ.45) GO TO 5045
853 IF (mapin.EQ.46) GO TO 5045
854 ier = 5
855 RETURN
856C
857 5021 imaxin = 73
858 jmaxin = 19
859 deg = 5.0
860 nthsth = 1
861 IF (mapin.EQ.22) nthsth = 2
862 GO TO 6000
863C
864 5029 imaxin = 145
865 jmaxin = 37
866 deg = 2.5
867 nthsth = 1
868 IF (mapin.EQ.30) nthsth = 2
869 GO TO 6000
870C
871 5033 imaxin = 181
872 jmaxin = 46
873 deg = 2.0
874 nthsth = 1
875 IF (mapin.EQ.34) nthsth = 2
876 GO TO 6000
877C
878 5045 imaxin = 97
879 jmaxin = 25
880 deg = 3.75
881 nthsth = 1
882 IF (mapin.EQ.46) nthsth = 2
883 GOTO 6000
884C
885C SELECT OUTPUT POLA VARIETY
886C ROT INDICATES HOW MANY DEGREES THE POLA GRID IS TO BE ROTATED
887C (POSITIVE COUNTER-CLOCKWISE) FROM THE NMC 'STANDARD'
888C OF 80 DEG WEST AT THE BOTTOM (OR TOP IF SOUTHERN HEMISPHERE)
889C
890 6000 IF (mapout.EQ. 5) GO TO 6005
891 IF (mapout.EQ.25) GO TO 6025
892 IF (mapout.EQ.26) GO TO 6026
893 IF (mapout.EQ.27) GO TO 6027
894 IF (mapout.EQ.28) GO TO 6027
895 IF (mapout.EQ.49) GO TO 6049
896 IF (mapout.EQ.50) GO TO 6049
897 IF (mapout.EQ.51) GO TO 6051
898 IF (mapout.EQ.55) GO TO 6055
899 IF (mapout.EQ.56) GO TO 6056
900 IF (mapout.EQ.60) GO TO 6060
901 IF (mapout.EQ.87) GO TO 6087
902 IF (mapout.EQ.100) GO TO 6100
903 IF (mapout.EQ.101) GO TO 6101
904 IF (mapout.EQ.105) GO TO 6105
905 IF (mapout.EQ.106) GO TO 6106
906 IF (mapout.EQ.107) GO TO 6107
907 IF (mapout.EQ.400) GO TO 6400
908 IF (mapout.EQ.401) GO TO 6401
909 IF (mapout.EQ.402) GO TO 6402
910 IF (mapout.EQ.403) GO TO 6403
911 ier = 6
912 RETURN
913C
914 6005 imaxou = 53
915 jmaxou = 57
916 xmesh = 190.5
917 rot = -25.
918 polei = 27.
919 polej = 49.
920 GO TO 6700
921C
922 6025 imaxou = 53
923 jmaxou = 57
924 xmesh = 381.
925 rot = 0.
926 polei = 27.
927 polej = 29.
928 GO TO 6700
929C
930 6026 imaxou = 53
931 jmaxou = 45
932 xmesh = 190.5
933 rot = -25.
934 polei = 27.
935 polej = 49.
936 GO TO 6700
937C
938 6027 imaxou = 65
939 jmaxou = 65
940 xmesh = 381.
941 rot = 0.
942 polei = 33.
943 polej = 33.
944 GO TO 6700
945C
946 6049 imaxou = 129
947 jmaxou = 129
948 xmesh = 190.5
949 rot = 0.
950 polei = 65.
951 polej = 65.
952 GOTO 6700
953C
954 6051 imaxou = 129
955 jmaxou = 129
956 xmesh = 190.5
957 rot = -25.
958 polei = 65.
959 polej = 65.
960 GOTO 6700
961C
962 6055 imaxou = 87
963 jmaxou = 71
964 xmesh = 254.
965 rot = -25.
966 polei = 44.
967 polej = 38.
968 GOTO 6700
969C
970 6056 imaxou = 87
971 jmaxou = 71
972 xmesh = 127.
973 rot = -25.
974 polei = 40.
975 polej = 73.
976 GOTO 6700
977C
978 6060 imaxou = 57
979 jmaxou = 57
980 xmesh = 190.5
981 rot = -25.
982 polei = 29.
983 polej = 49.
984 GO TO 6700
985C
986 6087 imaxou = 81
987 jmaxou = 62
988 xmesh = 68.153
989 rot = -25.
990 polei = 31.91
991 polej = 112.53
992 GO TO 6700
993C
994 6100 imaxou = 83
995 jmaxou = 83
996 xmesh = 91.452
997 rot = -25.
998 polei = 40.5
999 polej = 88.5
1000 GO TO 6700
1001C
1002 6101 imaxou = 113
1003 jmaxou = 91
1004 xmesh = 91.452
1005 rot = -25.
1006 polei = 58.5
1007 polej = 92.5
1008 GO TO 6700
1009C
1010 6105 imaxou = 83
1011 jmaxou = 83
1012 xmesh = 90.75464
1013 rot = -25.
1014 polei = 40.5
1015 polej = 88.5
1016 GO TO 6700
1017C
1018 6106 imaxou = 165
1019 jmaxou = 117
1020 xmesh = 45.37732
1021 rot = -25.
1022 polei = 80.0
1023 polej = 176.0
1024 GO TO 6700
1025C
1026 6107 imaxou = 120
1027 jmaxou = 92
1028 xmesh = 45.37732
1029 rot = -25.
1030 polei = 46.0
1031 polej = 167.0
1032 GO TO 6700
1033C
1034 6400 imaxou = 39
1035 jmaxou = 39
1036 xmesh = 508.
1037 rot = 0.
1038 polei = 20.
1039 polej = 20.
1040 GO TO 6700
1041C
1042C THIS ONE GETS SPECIAL TREATMENT BECAUSE WE ARE
1043C INTERCHANGING ROWS AND COLUMNS FOR GRIDPRINT AFTER INTERPOLATION
1044C (ACTUALLY IT IS DONE ALL AT ONCE)
1045C
1046 6401 imaxou = 25
1047 jmaxou = 35
1048 xmesh = 254.
1049 rot = -25.
1050 polei = 18.
1051 polej = 31.75
1052C
1053 ijout = 0
1054 DO 64011 j=1,jmaxou
1055 xi = jmaxou - j + 1
1056 xxi = xi - polei
1057 DO 64011 i = 1,imaxou
1058 xj = i
1059 xxj = xj - polej
1060 CALL w3fb01(xxi, xxj, xmesh, xlat, wlon)
1061 wlon = wlon - rot
1062 IF (wlon.GT.360.) wlon = wlon - 360.
1063 IF (wlon.LT.0.) wlon = wlon + 360.
1064 xiin = (360.-wlon)/deg + 1.
1065 xjin = xlat/deg + 1.
1066 CALL w3ft01
1067 1 (xiin, xjin, field, d, imaxin, jmaxin, 1, interp)
1068 ijout = ijout + 1
1069 DATA(ijout) = d
107064011 CONTINUE
1071 RETURN
1072C
1073 6402 imaxou = 97
1074 jmaxou = 97
1075 xmesh = 254.
1076 rot = -25.
1077 polei = 49.
1078 polej = 49.
1079 GOTO 6700
1080C
1081 6403 imaxou = 97
1082 jmaxou = 97
1083 xmesh = 254.
1084 rot = 0.
1085 polei = 49.
1086 polej = 49.
1087 GOTO 6700
1088C
1089C FIND INPUT LOLA I,J FOR DESIRED POLA OUTPUT POINTS
1090C
1091 6700 ijout = 0
1092 DO 6740 j=1,jmaxou
1093 xj = j - polej
1094 DO 6740 i=1,imaxou
1095 xi = i - polei
1096 GOTO (6710, 6720), nthsth
1097 6710 CALL w3fb01(xi, xj, xmesh, xlat, wlon)
1098 wlon = wlon - rot
1099 GO TO 6730
1100 6720 CALL w3fb03(xi, xj, xmesh, xlat, wlon)
1101 wlon = wlon + rot
1102 xlat = xlat + 90.
1103 6730 IF (wlon.GT.360.) wlon = wlon - 360.
1104 IF (wlon.LT.0.) wlon = wlon + 360.
1105 xiin = (360.-wlon)/deg + 1.
1106 xjin = xlat/deg + 1.
1107 CALL w3ft01
1108 1 (xiin, xjin, field, d, imaxin, jmaxin, 1, interp)
1109 ijout = ijout + 1
1110 DATA(ijout) = d
1111 6740 CONTINUE
1112 RETURN
1113C
1114C ##################################################################
1115C
1116C LOLA TO LOLA
1117C
1118C SELECT INPUT GRID INFO
1119C
1120 7000 IF (mapin.EQ.21) GO TO 7021
1121 IF (mapin.EQ.22) GO TO 7021
1122 IF (mapin.EQ.29) GO TO 7029
1123 IF (mapin.EQ.30) GO TO 7029
1124 IF (mapin.EQ.33) GO TO 7033
1125 IF (mapin.EQ.34) GO TO 7033
1126 IF (mapin.EQ.45) GOTO 7045
1127 IF (mapin.EQ.46) GOTO 7045
1128 ier = 7
1129 RETURN
1130C
1131 7021 imaxin = 73
1132 jmaxin = 19
1133 degin = 5.0
1134 GO TO 8000
1135C
1136 7029 imaxin = 145
1137 jmaxin = 37
1138 degin = 2.5
1139 GO TO 8000
1140C
1141 7033 imaxin = 181
1142 jmaxin = 46
1143 degin = 2.0
1144 GO TO 8000
1145C
1146 7045 imaxin = 97
1147 jmaxin = 25
1148 degin = 3.75
1149 GOTO 8000
1150C
1151C SELECT OUTPUT LOLA GRID
1152C
1153 8000 IF (mapout.EQ.21) GO TO 8021
1154 IF (mapout.EQ.22) GO TO 8021
1155 IF (mapout.EQ.29) GO TO 8029
1156 IF (mapout.EQ.30) GO TO 8029
1157 IF (mapout.EQ.33) GO TO 8033
1158 IF (mapout.EQ.34) GO TO 8033
1159 IF (mapout.EQ.45) GO TO 8045
1160 IF (mapout.EQ.46) GO TO 8045
1161 IF (mapout.EQ.500) GO TO 8500
1162 IF (mapout.EQ.501) GO TO 8501
1163 ier = 8
1164 RETURN
1165C
1166 8021 iminou = 1
1167 imaxou = 73
1168 jminou = 1
1169 jmaxou = 19
1170 degou = 5.
1171 GO TO 8700
1172C
1173 8029 iminou = 1
1174 imaxou = 145
1175 jminou = 1
1176 jmaxou = 37
1177 degou = 2.5
1178 GO TO 8700
1179C
1180 8033 iminou = 1
1181 imaxou = 181
1182 jminou = 1
1183 jmaxou = 46
1184 degou = 2.0
1185 GO TO 8700
1186C
1187 8045 iminou = 1
1188 imaxou = 97
1189 jminou = 1
1190 jmaxou = 25
1191 degou = 3.75
1192 GOTO 8700
1193C
1194 8500 iminou = 93
1195 imaxou = 117
1196 jminou = 1
1197 jmaxou = 37
1198 degou = 2.5
1199 GO TO 8700
1200C
1201 8501 iminou = 116
1202 imaxou = 140
1203 jminou = 1
1204 jmaxou = 46
1205 degou = 2.0
1206 GO TO 8700
1207C
1208 8700 ijout = 0
1209 rdeg = degou/degin
1210 DO 8710 j=jminou, jmaxou
1211 xjin = (j-1)*rdeg + 1.
1212 DO 8710 i=iminou, imaxou
1213 xiin = (i-1)*rdeg + 1.
1214 CALL w3ft01
1215 1 (xiin, xjin, field, d, imaxin, jmaxin, 1, interp)
1216 ijout = ijout + 1
1217 DATA(ijout) = d
1218 8710 CONTINUE
1219 RETURN
1220C
1221 END
w3fb01
subroutine w3fb01(xi, xj, xmeshl, alat, along)
Converts the coordinates of a location from the grid(i,j) coordinate system overlaid on the polar ste...
Definition w3fb01.f:31
w3fb02
subroutine w3fb02(alat, along, xmeshl, xi, xj)
Computes i and j coordinates for a latitude/longitude point on the southern hemisphere polar stereogr...
Definition w3fb02.f:21
w3fb03
subroutine w3fb03(xi, xj, xmeshl, tlat, tlong)
Converts i,j grid coordinates to the corresponding latitude/longitude on a southern hemisphere polar ...
Definition w3fb03.f:21
w3fb04
subroutine w3fb04(alat, along, xmeshl, orient, xi, xj)
Converts the coordinates of a location on earth from the natural coordinate system of latitude/longit...
Definition w3fb04.f:40
w3ft00
subroutine w3ft00(fld, b, ia, ja, ib, jb, cip, cjp, fipb, fjpb, sc, arg, lin)
Transforms data contained in a grid array by translation, rotation about a common point and dilatatio...
Definition w3ft00.f:40
w3ft01
subroutine w3ft01(sti, stj, fld, hi, ii, jj, ncyclk, lin)
For a given grid coordinate in a data array, estimates a data value for that point using either a lin...
Definition w3ft01.f:36
w3ft32
subroutine w3ft32(field, mapin, data, mapout, interp, ier)
Interpolate scalar quantity from any given nmc field (in office note 84) to any other field.
Definition w3ft32.f:49