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