NCEPLIBS-w3emc  2.11.0
w3ft32.f
Go to the documentation of this file.
1 C> @file
2 C> @brief General interpolator between nmc flds.
3 C> @author John Stackpole @date 1974-06-15
4 
5 C> Interpolate scalar quantity from any given nmc
6 C> field (in office note 84) to any other field. Can do bilinearly
7 C> or biquadratically. Will not rotate wind components.
8 C> Input and output fields are real*4 unpacked
9 C>
10 C> ### Program History Log:
11 C> Date | Programmer | Comment
12 C> -----|------------|--------
13 C> 1974-06-15 | John Stackpole |
14 C> 1987-07-15 | Bill Cavanaugh | Add grid type 100, 101 to tables.
15 C> 1990-08-08 | John. Stackpole | Correct rotation error wrt 100, 101
16 C> 1990-08-31 | Ralph Jones | Change name from polate to w3ft32
17 C> 1993-01-26 | Dennis Keyser | Added grid types 87, 105, 106, 107 to
18 C> tables (as both input and output).
19 C>
20 C> @param[in] FIELD REAL*4 Two dimensional array.
21 C> @param[in] MAPIN INTEGER*4 Nmc map number (k) for given input field.
22 C> @param[in] MAPOUT INTEGER*4 Nmc map number (k) for wanted output field.
23 C> @param[in] INTERP INTEGER*4 Set interpolation method:
24 C> - eq 1 - linear
25 C> - ne 1 - biquadratic
26 C> @param[out] DATA REAL*4 Array to hold output map (unpacked).
27 C> @param[out] IER INTEGER*4 Completion condition flag
28 C>
29 C> Return conditions:
30 C> - IER:
31 C> - 0 No difficulties
32 C> - 1 Mapin not recognized
33 C> - 2 Mapout not recognized
34 C> - 3 Particular pola mapout not recognized
35 C> - 4 Particular lola mapout not recognized
36 C> - 5 Particular lola mapin not recognized
37 C> - 6 Particular pola mapout not recognized
38 C> - 7 Particular lola mapin not recognized
39 C> - 8 Particular lola mapout not recognized
40 C> these flags are set at various test locations
41 C> please refer to the code listing for details
42 C>
43 C> @note See comment cards following for more detail
44 C> including recipes for adding more input and
45 C> output maps as the need arises.
46 C>
47 C> @author John Stackpole @date 1974-06-15
48  SUBROUTINE w3ft32(FIELD, MAPIN, DATA, MAPOUT, INTERP, IER)
49 C
50 C INTERPOLATE INFORMATION FROM FIELD (MAP TYPE K = MAPIN)
51 C TO DATA (MAP TYPE K = MAPOUT)
52 C INTERP SETS INTERPOLATION METHOD
53 C = 1 BILINEAR, OTHERWISE BIQUADRATIC
54 C
55  REAL DATA(*), FIELD(*)
56 C
57 C RESTRICTION AND RULES:
58 C
59 C AT PRESENT W3FT32 WILL ACCEPT ONLY THE FOLLOWING TYPES
60 C POLAR STEREOGRAPHIC
61 C K = 5 & 26 (LFM ANL & FCST RESPECTIVELY)
62 C 27 & 28 (65X65)
63 C 25 (53X57 SOUTHERN HEMISPHERE)
64 C 49 (129X129 NH; 190.5 KM)
65 C 50 (129X129 SH; 190.5 KM)
66 C 55 (87X71 NH; LFM ORIENT; 254 KM)
67 C 56 (87X71 NA; LFM ORIENT; 174 KM)
68 C 60 (57X57 ENLARGED LFM 'VLFM')
69 C 87 (81X62 MAPS ANAL/FCST GRID; 68.153 KM)
70 C 100 (83X83 NGM C-GRID; 91.452)
71 C 101 (113X91 NGM BIG C-GRID; 91.452)
72 C 105 (83X83 NGM SUPER C-GRID SUBSET; 90.75464 KM)
73 C 106 (165X117 HI RESOLUTION GRID; 45.37732 KM)
74 C 107 (120X92 HI RESOLUTION GRID SUBSET; 45.37732 KM)
75 C
76 C LONGITUDE/LATITUDE: ('LOLA')
77 C K = 29 & 30 (145X37)
78 C 33 & 34 (181X46)
79 C 45 & 46 (97X25 - 3.75 DEG LOLA)
80 C 21 & 22 (73X19 - 5 DEG LOLA)
81 C 21 & 22 (73X19 - 5 DEG LOLA)
82 C
83 C WILL OUTPUT:
84 C POLAR STEREO:
85 C K = 5 (53X57) LFM
86 C 25 (53X57 SOUTH HEMISPHERE)
87 C 26 (53X45) LFM
88 C 27 & 28 (65X65)
89 C 49 (129X129 NH POLA) (1/2 BEDIENT MESH;ORIENTED 80W)
90 C 50 (129X129 SH POLA) (1/2 BEDIENT MESH;ORINETED 80W)
91 C 51 (129X129 NH POLA) (SAME MESHL; ORIENTED AT 105W)
92 C 55 (NH 87X71 254 KM, LFM ORIENT)
93 C 56 (NA 87X71 127 KM, LFM ORIENT)
94 C 60 (57X57 ENLARGED LFM 'VLFM')
95 C 87 (81X62 MAPS ANAL/FCST GRID; 68.153 KM)
96 C 100 (83X83 NGM C-GRID)
97 C 101 (113X91 NGM BIG C-GRID)
98 C 105 (83X83 NGM SUPER C-GRID SUBSET; 90.75464 KM)
99 C 106 (165X117 HI RESOLUTION GRID; 45.37732 KM)
100 C 107 (120X92 HI RESOLUTION GRID SUBSET; 45.37732 KM)
101 C 400 (39X39 1:40MIL 80 DEG VERTICAL POLA)
102 C 401 (25X35 1:20MIL U.S. SECTION ROTATED)
103 C 402 (97X97 1-20MIL N.H. POLA ROTATED TO 105W VERT)
104 C 403 (97X97 1-20MIL S.H. POLA UNROTATED 80W TOP VERT)
105 C LOLA:
106 C K = 29 & 30 (145X37)
107 C 33 & 34 (181X46)
108 C 45 & 46 (97X25 - 3.75 DEG LOLA)
109 C 500 & 501 US SECTIONAL NEP 36 & 45
110 C
111 C FEEL FREE, GENTLE READER, TO AUGMENT THE LIST AS YOU WISH
112 C AND HERE IS A RECIPE FOR ADDING A NEW OUTPUT GRID
113 C (POLA IN THIS CASE, BUT I AM SURE YOU CAN DRAW THE ANALOGY)
114 C STEP1
115 C PUT NEW NUMBER IN COMMENT ABOVE
116 C STEP 2
117 C ADD IT TO MAPOUT LIST NEAR STMT 30
118 C STEP 3
119 C ADD SET OF PARAMETERS AT STMT 2000 (FOR POLA)
120 C STEP4
121 C ADD SET OF PARAMETERS AT STMT 6000 (FOR POLA)
122 C
123 C HERE TOO IS A RECIPE FOR ADDING A NEW (POLA) INPUT GRID
124 C
125 C STEP 1:
126 C PUT NEW NUMBER IN COMMENT ABOVE
127 C STEP2:
128 C ADD NUMBER TO IF(MAPIN.. ) TEST BELOW
129 C STEP 3:
130 C ADD INPUT MAP CHARACTERISTICS AT STMT 1000
131 C STEP 4:
132 C DITTO AT STMT 3000
133 C
134  LOGICAL LOLAIN, POLAIN, LOLAOU, POLAOU
135 C
136  SAVE
137 C
138 C BEGIN HERE - SET ERROR RETURN TO O.K.
139 C
140  ier = 0
141 C
142 C DETERMINE WHETHER INPUT GRID IS LOLA OR POLA
143 C
144 C THIS LIST CAN BE AUGMENTED ONLY AT THE COST OF A LOT OF
145 C WORK ELSEWHERE IN THE PROGRAM
146 C HAVE AT IT IF YOU WANT OTHER MAPS
147 C
148 C POLA MAPS
149 C
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
167 C
168 C LOLA MAPS
169 C
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
178 C
179 C IF NO MATCH - ERROR
180 C
181  ier = 1
182  RETURN
183 C
184 C SET LOGICAL FLAGS
185 C
186  10 lolain = .false.
187  polain = .true.
188  GO TO 30
189 C
190  20 lolain = .true.
191  polain = .false.
192 C
193 C DITTO FOR OUTPUT MAP TYPE
194 C
195 C POLA MAPS
196 C
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
218 C
219 C LOLA MAPS
220 C
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
231 C
232 C NO MATCH - ERROR
233 C
234  ier = 2
235  RETURN
236 C
237 C SET LOGICAL FLAGS
238 C
239  40 lolaou = .false.
240  polaou = .true.
241  GO TO 60
242 C
243  50 lolaou = .true.
244  polaou = .false.
245 C
246 C GO TO DIFFERENT SECTIONS FOR IN/OUT OPTIONS
247 C
248  60 IF (polain) GO TO 1000
249  IF (lolain) GO TO 5000
250 C
251 C ##################################################################
252 C ##################################################################
253 C
254 C THIS SECTION FOR POLAR STEREOGRAPHIC INPUT MAPS
255 C
256 C SUBDIVIDED FOR OUTPUT TYPE
257 C
258  1000 IF (lolaou) GO TO 3000
259 C
260 C POLAR STEREO TO POLAR STEREO
261 C USE HOWCROFTS FIELD TRANSFORMER
262 C ORIENT IS DEGREES OF ROTATION FROM NMC STANDARD
263 C (80 DEG CENTER VERTIVAL) TO INPUT GRID (POSITIVE ANTICLOCKWISE)
264 C
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
284 C
285  1005 imaxin =53
286  jmaxin = 57
287  comiin = 27.
288  comjin = 49.
289  orient = -25.
290  xmesh = 190.5
291  GO TO 2000
292 C
293  1025 imaxin = 53
294  jmaxin = 57
295  comiin = 27.
296  comjin = 29.
297  orient = 0.
298  xmesh = 381.
299  GO TO 2000
300 C
301  1026 imaxin = 53
302  jmaxin = 45
303  comiin = 27.
304  comjin = 49.
305  orient = -25.
306  xmesh = 190.5
307  GO TO 2000
308 C
309  1027 imaxin = 65
310  jmaxin = 65
311  comiin = 33.
312  comjin = 33.
313  orient = 0.
314  xmesh = 381.
315  GO TO 2000
316 C
317  1049 imaxin = 129
318  jmaxin = 129
319  comiin = 65.
320  comjin = 65.
321  orient = 0.
322  xmesh = 190.5
323  GOTO 2000
324 C
325  1051 imaxin = 129
326  jmaxin = 129
327  comiin = 65.
328  comjin = 65.
329  orient = -25.
330  xmesh = 190.5
331  GOTO 2000
332 C
333  1055 imaxin = 87
334  jmaxin = 71
335  comiin = 44.
336  comjin = 38.
337  orient = -25.
338  xmesh = 254.
339  GOTO 2000
340 C
341  1056 imaxin = 87
342  jmaxin = 71
343  comiin = 40.
344  comjin = 73.
345  orient = -25.
346  xmesh = 127.
347  GOTO 2000
348 C
349  1060 imaxin= 57
350  jmaxin = 57
351  comiin = 29.
352  comjin = 49.
353  orient = -25.
354  xmesh = 190.5
355  GO TO 2000
356 C
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
364 C
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
372 C
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
380 C
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
388 C
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
396 C
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
404 C
405 C SELECT I, J, DILATION, ROTATION, AND COMMON POINT (POLE) OUTPUT
406 C DILATE = XMESHOUT / XMESHIN
407 C IN THE FOLLOWING, ROT IS THE ROTATION FROM THE INPUT TO
408 C THE OUTPUT GRID - NOT THE ORIENTATION OF THE OUT-GRID
409 C
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
433 C
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
441 C
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
449 C
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
457 C
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
465 C
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
473 C
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
481 C
482  2055 imaxou = 87
483  jmaxou = 71
484  dilat = 254./xmesh
485  rot = -25. - orient
486  comiou = 44.
487  comjou = 38.
488  GOTO 2700
489 C
490  2056 imaxou = 87
491  jmaxou = 71
492  dilat = 127./xmesh
493  rot = -25. - orient
494  comiou = 40.
495  comjou = 73.
496  GOTO 2700
497 C
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
505 C
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
513 C
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
521 C
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
529 C
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
537 C
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
545 C
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
553 C
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
561 C
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
569 C
570  2402 imaxou = 97
571  jmaxou = 97
572  dilat = 254./xmesh
573  rot = -25. - orient
574  comiou = 49.
575  comjou = 49.
576  GOTO 2700
577 C
578  2403 imaxou = 97
579  jmaxou = 97
580  dilat = 254./xmesh
581  rot = 0. - orient
582  comiou = 49.
583  comjou = 49.
584  GOTO 2700
585 C
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
591 C
592 C ##################################################################
593 C
594 C HERE FOR POLAR STEREO TO LO/LA
595 C
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
613 C
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
622 C
623  3025 xmesh = 381.
624  imaxin = 53
625  jmaxin = 57
626  nthsth = 2
627  polei = 27.
628  polej = 29.
629  GO TO 4000
630 C
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
639 C
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
649 C
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
659 C
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
668 C
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
677 C
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
686 C
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
695 C
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
704 C
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
713 C
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
722 C
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
731 C
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
740 C
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
749 C
750 C SELECT OUTPUT LO/LA VARIATIONS
751 C
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
764 C
765  4021 iminou = 1
766  jminou = 1
767  imaxou = 73
768  jmaxou = 19
769  deg = 5.0
770  GO TO 4700
771 C
772  4029 iminou = 1
773  imaxou = 145
774  jminou = 1
775  jmaxou = 37
776  deg = 2.5
777  GO TO 4700
778 C
779  4033 iminou = 1
780  imaxou = 181
781  jminou = 1
782  jmaxou = 46
783  deg = 2.0
784  GO TO 4700
785 C
786  4045 iminou = 1
787  imaxou = 97
788  jminou = 1
789  jmaxou = 25
790  deg = 3.75
791  GOTO 4700
792 C
793  4500 iminou = 93
794  imaxou = 117
795  jminou = 1
796  jmaxou = 37
797  deg = 2.5
798  GO TO 4700
799 C
800  4501 iminou = 116
801  imaxou = 140
802  jminou = 1
803  jmaxou = 46
804  deg = 2.0
805  GO TO 4700
806 C
807 C FIND INPUT POLA I,J FOR DESIRED LOLA OUTPUT POINTS
808 C
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
822 C
823 C MACDONALDS SUPER GENERAL INTERPOLATOR
824 C IN WHICH D = FIELD(XIIN, XJIN)
825 C
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
832 C
833 C ##################################################################
834 C ##################################################################
835 C
836 C THIS SECTION FOR LOLA INPUT MAP
837 C
838 C SELCT OUTPUT TYPE
839 C
840  5000 IF (lolaou) GO TO 7000
841 C
842 C LOLA TO POLA
843 C SELECT INPUT INFO
844 C (THIS PATTERN CAN BE USED WITH POLA INPUT, TOO - TRY IT
845 C
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
856 C
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
863 C
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
870 C
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
877 C
878  5045 imaxin = 97
879  jmaxin = 25
880  deg = 3.75
881  nthsth = 1
882  IF (mapin.EQ.46) nthsth = 2
883  GOTO 6000
884 C
885 C SELECT OUTPUT POLA VARIETY
886 C ROT INDICATES HOW MANY DEGREES THE POLA GRID IS TO BE ROTATED
887 C (POSITIVE COUNTER-CLOCKWISE) FROM THE NMC 'STANDARD'
888 C OF 80 DEG WEST AT THE BOTTOM (OR TOP IF SOUTHERN HEMISPHERE)
889 C
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
913 C
914  6005 imaxou = 53
915  jmaxou = 57
916  xmesh = 190.5
917  rot = -25.
918  polei = 27.
919  polej = 49.
920  GO TO 6700
921 C
922  6025 imaxou = 53
923  jmaxou = 57
924  xmesh = 381.
925  rot = 0.
926  polei = 27.
927  polej = 29.
928  GO TO 6700
929 C
930  6026 imaxou = 53
931  jmaxou = 45
932  xmesh = 190.5
933  rot = -25.
934  polei = 27.
935  polej = 49.
936  GO TO 6700
937 C
938  6027 imaxou = 65
939  jmaxou = 65
940  xmesh = 381.
941  rot = 0.
942  polei = 33.
943  polej = 33.
944  GO TO 6700
945 C
946  6049 imaxou = 129
947  jmaxou = 129
948  xmesh = 190.5
949  rot = 0.
950  polei = 65.
951  polej = 65.
952  GOTO 6700
953 C
954  6051 imaxou = 129
955  jmaxou = 129
956  xmesh = 190.5
957  rot = -25.
958  polei = 65.
959  polej = 65.
960  GOTO 6700
961 C
962  6055 imaxou = 87
963  jmaxou = 71
964  xmesh = 254.
965  rot = -25.
966  polei = 44.
967  polej = 38.
968  GOTO 6700
969 C
970  6056 imaxou = 87
971  jmaxou = 71
972  xmesh = 127.
973  rot = -25.
974  polei = 40.
975  polej = 73.
976  GOTO 6700
977 C
978  6060 imaxou = 57
979  jmaxou = 57
980  xmesh = 190.5
981  rot = -25.
982  polei = 29.
983  polej = 49.
984  GO TO 6700
985 C
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
993 C
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
1001 C
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
1009 C
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
1017 C
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
1025 C
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
1033 C
1034  6400 imaxou = 39
1035  jmaxou = 39
1036  xmesh = 508.
1037  rot = 0.
1038  polei = 20.
1039  polej = 20.
1040  GO TO 6700
1041 C
1042 C THIS ONE GETS SPECIAL TREATMENT BECAUSE WE ARE
1043 C INTERCHANGING ROWS AND COLUMNS FOR GRIDPRINT AFTER INTERPOLATION
1044 C (ACTUALLY IT IS DONE ALL AT ONCE)
1045 C
1046  6401 imaxou = 25
1047  jmaxou = 35
1048  xmesh = 254.
1049  rot = -25.
1050  polei = 18.
1051  polej = 31.75
1052 C
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
1070 64011 CONTINUE
1071  RETURN
1072 C
1073  6402 imaxou = 97
1074  jmaxou = 97
1075  xmesh = 254.
1076  rot = -25.
1077  polei = 49.
1078  polej = 49.
1079  GOTO 6700
1080 C
1081  6403 imaxou = 97
1082  jmaxou = 97
1083  xmesh = 254.
1084  rot = 0.
1085  polei = 49.
1086  polej = 49.
1087  GOTO 6700
1088 C
1089 C FIND INPUT LOLA I,J FOR DESIRED POLA OUTPUT POINTS
1090 C
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
1113 C
1114 C ##################################################################
1115 C
1116 C LOLA TO LOLA
1117 C
1118 C SELECT INPUT GRID INFO
1119 C
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
1130 C
1131  7021 imaxin = 73
1132  jmaxin = 19
1133  degin = 5.0
1134  GO TO 8000
1135 C
1136  7029 imaxin = 145
1137  jmaxin = 37
1138  degin = 2.5
1139  GO TO 8000
1140 C
1141  7033 imaxin = 181
1142  jmaxin = 46
1143  degin = 2.0
1144  GO TO 8000
1145 C
1146  7045 imaxin = 97
1147  jmaxin = 25
1148  degin = 3.75
1149  GOTO 8000
1150 C
1151 C SELECT OUTPUT LOLA GRID
1152 C
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
1165 C
1166  8021 iminou = 1
1167  imaxou = 73
1168  jminou = 1
1169  jmaxou = 19
1170  degou = 5.
1171  GO TO 8700
1172 C
1173  8029 iminou = 1
1174  imaxou = 145
1175  jminou = 1
1176  jmaxou = 37
1177  degou = 2.5
1178  GO TO 8700
1179 C
1180  8033 iminou = 1
1181  imaxou = 181
1182  jminou = 1
1183  jmaxou = 46
1184  degou = 2.0
1185  GO TO 8700
1186 C
1187  8045 iminou = 1
1188  imaxou = 97
1189  jminou = 1
1190  jmaxou = 25
1191  degou = 3.75
1192  GOTO 8700
1193 C
1194  8500 iminou = 93
1195  imaxou = 117
1196  jminou = 1
1197  jmaxou = 37
1198  degou = 2.5
1199  GO TO 8700
1200 C
1201  8501 iminou = 116
1202  imaxou = 140
1203  jminou = 1
1204  jmaxou = 46
1205  degou = 2.0
1206  GO TO 8700
1207 C
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
1220 C
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