NADCON5-ng  0.0.1
NADCON5 Next Generation
checkgrid.f
Go to the documentation of this file.
1 c> \ingroup doers
2 c> Part of the NADCON5 build process, generates `gmtbat04`
3 c>
4 c> Creates a batch file called
5 c>
6 c> gmtbat04.(olddtm).(newdtm).(region).(igridsec)
7 c>
8 c> This Program:
9 c>
10 c> 1) Compare grids of dlat, dlon and deht
11 c> to vectors of dlat, dlon and deht.
12 c> 2) Spit out interpolated (from grid) vectors
13 c> 3) Spit out differential (interpolated minus original) vectors.
14 c> 4) Create a GMT batch file to plot said vectors.
15 c>
16 c> The input vectors:
17 c>
18 c> Represent *all* (outlier removed)
19 c> vectors of dlat/dlon/deht for the
20 c> olddatum/newdatum/region combination
21 c>
22 c> However, for the sake of understanding, the
23 c> vectors will be read in from their "thinned"
24 c> and "dropped" files, so that we can generate
25 c> statistics of:
26 c>
27 c> thinned-versus-gridded
28 c> dropped-versus-gridded
29 c> all-versus-gridded
30 c>
31 c> This is important, since ONLY the thinned
32 c> vectors went into the grid and it seems
33 c> that their statistics should be better against
34 c> the grid than the dropped vectors. Additionally,
35 c> one might argue that the only independent check
36 c> on the grid is the dropped agreement. We'll see.
37 c>
38 c> The input grids:
39 c>
40 c> dlat/dlon/deht grids based on thinning
41 c> all of the vectors (see above) using
42 c> a median thinning at some block spacing
43 c> in arcseconds, and gridding to that same
44 c> block spacing.
45 c>
46 c> ### Program arguments
47 c> Arguments are newline terminated and read from standard input
48 c>
49 c> They are enumerated here
50 c> \param oldtm Source Datum
51 c> \param newdtm Target Datum,region
52 c> \param region Conversion Region
53 c> \param agridsec Grid Spacing in arcsec
54 c>
55 c> Example:
56 c>
57 c> olddatum = 'ussd'
58 c> newdatum = 'nad27'
59 c> region = 'conus'
60 c> agridsec = '900'
61 c>
62 c> ### Program Inputs:
63 c>
64 c> ## Changelog
65 c>
66 c> ### 2016 08 26:
67 c> Changed "getmapbounds" to bring in a better way
68 c> of computing the reference vector location and added a new
69 c> variable for its label
70 c>
71 c> Also changing the call to "getmapbounds" to give it "olddatum" and "newdatum"
72 c> to aide in filtering out things like the Saint regions in Alaska
73 c> for unsupported transformations.
74 c>
75 c> ### 2016 07 29:
76 c> Scrapped personal placement of vectors and just let them
77 c> sit outside/below the map
78 c>
79 c> ### 2016 07 21:
80 c> Added code to allow for optional placement of reference vectors, coming from
81 c> "map.parameters" as read in subroutine "getmapbounds"
82 c>
83 c> ### 2015 10 08:
84 c> Added HOR output in M and S for Lat/Lon to both "gi" and "dd" vector output.
85 c>
86 c> Combined: v(m/s)(a/t/d)(gi/dd)lat...
87 c> v(m/s)(a/t/d)(gi/dd)lon...
88 c> into : v(m/s)(a/t/d)(gi/dd)hor...
89 c>
90 c>
91 c> ### 2015 9 10:
92 c> Initial Release
93 c> For use in creating NADCON5
94 c> Built by Dru Smith
95 c>
96  program checkgrid
97  implicit real*8(a-h,o-z)
98  parameter(maxlat=5000,maxlon=5000,maxpts=300000)
99  parameter(maxplots=60)
100 
101  character*10 olddtm,newdtm,region
102 c - Grid spacing, converted to characters for file names
103 c - Presumes:
104 c - 1) igridsec is an integer
105 c - 2) 1 <= igridsec <= 99999
106  integer*4 igridsec
107  character*5 agridsec
108  character*1 mapflag
109  character*200 suffix1,suffix2,suffix3
110  character*200 suffix2t04
111  character*200 gmtfile
112  character*3 ele(7),el0(7)
113 
114 c - GMT stuff
115  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
116  real*4 jm(maxplots)
117  real*4 b1(maxplots),b2(maxplots)
118  character*10 fn(maxplots)
119  character*200 gfn
120  real*8 lorvopc
121  real*8 lorvog(7),lorvoggi(7)
122  real*8 scaledd(7),scalegi(7)
123  real*8 basedd(7),basegi(7)
124  real*8 lorvogprime,lorvogmeters
125  real*8 lorvogprimegi,lorvogmetersgi
126  real*8 lorvoghorgis,lorvoghorgim
127  real*8 lorvoghordds,lorvoghorddm
128 
129 c - 2016 07 21:
130  logical lrv(maxplots)
131  real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
132 
133 c - Input original THINNED vectors (outliers must be
134 c - removed)
135  character*200 gfnvmtcdlat,gfnvstcdlat
136  character*200 gfnvmtcdlon,gfnvstcdlon
137  character*200 gfnvmtcdeht
138  character*200 gfnvmtcdhor,gfnvstcdhor
139 c - Input original DROPPED vectors (outliers must be
140 c - removed)
141  character*200 gfnvmdcdlat,gfnvsdcdlat
142  character*200 gfnvmdcdlon,gfnvsdcdlon
143  character*200 gfnvmdcdeht
144  character*200 gfnvmdcdhor,gfnvsdcdhor
145 c - Input ".b" files created from the thinned vectors
146  character*200 bfnvmtcdlat,bfnvstcdlat
147  character*200 bfnvmtcdlon,bfnvstcdlon
148  character*200 bfnvmtcdeht
149 
150 c - Logical arguments to tell me if there are no values in files
151  logical*1 nothinlat,nothinlon,nothineht
152 
153 c - Output grid-interpolated coordinate difference vector files:
154 c - For the sake of completeness, we'll create grid-interpolated vectors
155 c - for all of these combinations in meters (thus 15 files):
156 c - thin, drop, all
157 c - by
158 c - lat(m),lat(s),lon(m),lon(s),eht(m)
159  character*200 gfnvmagilat,gfnvmtgilat,gfnvmdgilat
160  character*200 gfnvsagilat,gfnvstgilat,gfnvsdgilat
161  character*200 gfnvmagilon,gfnvmtgilon,gfnvmdgilon
162  character*200 gfnvsagilon,gfnvstgilon,gfnvsdgilon
163  character*200 gfnvmagieht,gfnvmtgieht,gfnvmdgieht
164 c - Added 2015 10 08
165  character*200 gfnvmagihor,gfnvmtgihor,gfnvmdgihor
166  character*200 gfnvsagihor,gfnvstgihor,gfnvsdgihor
167 
168 c - Output double differenced (differences of coordinate differences,
169 c - aka DDlat, DDlon or DDeht) GMT-ready files:
170 c
171 c - For the sake of completeness, we'll create differential vectors
172 c - for all of these combinations in meters (thus 15 files):
173 c - thin, drop, all
174 c - by
175 c - lat(m),lat(s),lon(m),lon(s),eht(m)
176 c -
177 
178 c - Stats will be generated for thin, drop or all.
179 c - We will create a batch file to plot thin, drop or all.
180 
181 c - Naming scheme is:
182 
183 c - 1-2: "vm" or "vs" for "vectors in meters" or "vectos in arcseconds"
184 c - 3: "a","t","d" or "r" for All, Thinned, Dropped or RMS'd
185 c - 4-5: "cd" or "gi" or "dd" for Coordinate Differences, Grid-Interpolated coordinate differences, or Double Differences
186 c - 6-8: "lat", "lon" or "eht"
187 
188 c - Thus, by way of example:
189 c - vmacdlat = Vectors in meters, All Coordinate Differences, Latitude
190 c - vmagilat = Vectors in meters, All Grid-Interpolated coordinate differences, Latitude
191 c - and their difference would be:
192 c - vmaddlat = Vectors in meters, Double Differences (Grid minus original), Latitude
193 c
194 c - Other examples, in general:
195 c - vstcdlon = Vectors in arcseconds, Thinned Coordinate Differences, Longitude
196 c - vmrddeht = Vectors in meters, RMS'd Double Differences, Ellipsoid Height (not used in this program)
197 c -
198 c - On the use of RMS: The RMS'd values only are applied to Double Differences
199 c - (that is, Differences of Coordinate Differences). As such, we should
200 c - not see an "r" in the 3rd position of the file name without "dd" in
201 c - positions 4-5. These Double Differenes represent the difference
202 c - between a Coordinate Difference interpolated off the GRID and a Coordinate
203 c - Difference directly computed from input data (aka "vectors").
204 c - The RMS'd data is compiled from ALL vectors compared against the
205 c - GRID, not just thinned vectors (which were used to MAKE the grid).
206 c - Doing it only on "thinned" causes overly optimistic statistics, while
207 c - doing it only on "dropped" ignores the fact that the thinned
208 c - and dropped vectors are both in the public domain and used by
209 c - the public.)
210 
211 c - Note, the "dropped" and "thinned" refer to those categories established
212 c - way back in "mymedian5.f", under doit3.bat.
213 
214 
215 c - Output double differenced vector files (all/thinned/dropped):
216  character*200 gfnvmaddlat,gfnvmtddlat,gfnvmdddlat
217  character*200 gfnvsaddlat,gfnvstddlat,gfnvsdddlat
218  character*200 gfnvmaddlon,gfnvmtddlon,gfnvmdddlon
219  character*200 gfnvsaddlon,gfnvstddlon,gfnvsdddlon
220  character*200 gfnvmaddeht,gfnvmtddeht,gfnvmdddeht
221 c - Added 2015 10 08
222  character*200 gfnvmaddhor,gfnvmtddhor,gfnvmdddhor
223  character*200 gfnvsaddhor,gfnvstddhor,gfnvsdddhor
224 
225 c - Stats file name
226  character*200 sfn
227 
228 c - The gridded data
229  real*8 glamn,glomn,dla,dlo
230  integer*4 nla,nlo,ikind
231  real*4 datlats(maxlat,maxlon)
232  real*4 datlons(maxlat,maxlon)
233  real*4 datehtm(maxlat,maxlon)
234 
235 c - The vector data
236  character*80 card
237 
238 c - All statistical data
239 c i,j,k,l:
240  real*8 stat(5,5,3,3)
241 c j,k:
242  integer*4 kstat(5,3)
243 c j:
244  character*20 units(5)
245 
246 c - stat(i,j,k,l) :
247 c - kstat(j,k) :
248 c
249 c i = 1 => Average
250 c i = 2 => RMS
251 c i = 3 => Min
252 c i = 4 => Max
253 c i = 5 => Standard Deviation
254 c
255 c j = 1 => LAT, arcseconds
256 c j = 2 => LON, arcseconds
257 c j = 3 => EHT, meters
258 c j = 4 => LAT, meters
259 c j = 4 => LON, meters
260 c
261 c k = 1 => Thinned vectors
262 c k = 2 => Dropped vectors
263 c k = 3 => All vectors
264 c
265 c l = 1 => Bilinear Interpolation
266 c l = 2 => Biquadratic Interpolation
267 c l = 3 => Not currently used
268 
269 c l:
270  real*8 vgrd(3),vgrdm(3),dd(3),ddm(3)
271 
272  character*4 type(3)
273 c - Note that "dd" means arcsec/arcsec/meters for lat/lon/eht
274 c - while "ddm" means meters/meters/meters for lat/lon/eht
275 
276  character*20 coord(3)
277 
278  real*8 fac(3,3)
279 
280 c - The output data
281  real*8 xla0(maxpts),xlo0(maxpts)
282  real*8 dd0(maxpts),ddm0(maxpts),gi0(maxpts),gim0(maxpts)
283  character*6 pid0(maxpts)
284 
285 c --------------------------------------
286 c --------------------------------------
287 c --------------------------------------
288 c -------BEGIN GUTS OF PROGRAM----------
289 c --------------------------------------
290 c --------------------------------------
291 c --------------------------------------
292  write(6,1001)
293  1001 format('BEGIN program checkgrid.f')
294 
295 c ------------------------------------------------------------------
296 c - Some required constants.
297 c ------------------------------------------------------------------
298 c - Length of Reference Vector on Paper, in CM (lorvopc). Depends
299 c - on having the "MEASURE_UNITS" in .gmtdefaults set to "cm"
300  lorvopc = 1.d0
301  pi = 2.d0*dasin(1.d0)
302  d2r = pi/180.d0
303  re = 6371000.d0
304  s2m = (1.d0/3600.d0)*d2r*re
305  multiplierlorvog = 2
306 
307  coord(1) = 'LATITUDE'
308  coord(2) = 'LONGITUDE'
309  coord(3) = 'ELLIPSOID HEIGHT'
310 
311  units(1) = 'arcseconds'
312  units(2) = 'arcseconds'
313  units(3) = 'meters'
314  units(4) = 'meters'
315  units(5) = 'meters'
316 
317 c ------------------------------------------------------------------
318 c - Read in arguments from batch file
319 c ------------------------------------------------------------------
320  read(5,'(a)')olddtm
321  read(5,'(a)')newdtm
322  read(5,'(a)')region
323  read(5,'(a)')agridsec
324  read(5,'(a)')mapflag
325 
326 c ------------------------------------------------------------------
327 c - Generate the suffixes used in all our files
328 c ------------------------------------------------------------------
329  read(agridsec,*)igridsec
330  suffix1=trim(olddtm)//'.'//trim(newdtm)//'.'//trim(region)
331  suffix2=trim(suffix1)//'.'//trim(agridsec)
332 
333  suffix2t04=trim(suffix2)//'.04'
334 
335  suffix3=trim(suffix2)//'.'//trim(mapflag)
336 
337 c ------------------------------------------------------------------
338 c - Open the input, thinned, GMT-ready files
339 c - "t" meaning "thinned". Briefly snoop the
340 c - first line of each file. If it is empty,
341 c - then skip using that particular component.
342 c ------------------------------------------------------------------
343 
344 c - Always maintain THIS order:
345 c - Lat/Seconds 1
346 c - Lon/Seconds 2
347 c - Eht/Meters 3
348 c - (Hor/Seconds 4)
349 c - (Hor/Meters 5)
350 c - Lat/Meters 6
351 c - Lon/Meters 7
352 
353  gfnvstcdlat = 'vstcdlat.'//trim(suffix2)
354  open(21,file=gfnvstcdlat,status='old',form='formatted')
355  write(6,1012)trim(gfnvstcdlat)
356 
357  gfnvstcdlon = 'vstcdlon.'//trim(suffix2)
358  open(22,file=gfnvstcdlon,status='old',form='formatted')
359  write(6,1012)trim(gfnvstcdlon)
360 
361  gfnvmtcdeht = 'vmtcdeht.'//trim(suffix2)
362  open(23,file=gfnvmtcdeht,status='old',form='formatted')
363  write(6,1012)trim(gfnvmtcdeht)
364 
365  gfnvmtcdlat = 'vmtcdlat.'//trim(suffix2)
366  open(26,file=gfnvmtcdlat,status='old',form='formatted')
367  write(6,1012)trim(gfnvmtcdlat)
368 
369  gfnvmtcdlon = 'vmtcdlon.'//trim(suffix2)
370  open(27,file=gfnvmtcdlon,status='old',form='formatted')
371  write(6,1012)trim(gfnvmtcdlon)
372 
373 
374 c - Note: "nothinlat" means there were no thinned lat vectors,
375 c - and thus no ".b" grid made from thinned vectors. As such,
376 c - anything having to do with latitude grids is skipped.
377 c - Same for lon or eht.
378  call nlines(21,nthinlat,nothinlat)
379  call nlines(22,nthinlon,nothinlon)
380  call nlines(23,nthineht,nothineht)
381 c - No need to do this for files 26/27 as the parallel 21 and 22
382 
383  1012 format(6x,'checkgrid.f: ',
384  *'Opening input thinned vector file ',a)
385 
386 c ------------------------------------------------------------------
387 c - Open the input, dropped, GMT-ready files
388 c - "d" meaning "dropped"
389 c ------------------------------------------------------------------
390  gfnvsdcdlat = 'vsdcdlat.'//trim(suffix2)
391  open(31,file=gfnvsdcdlat,status='old',form='formatted')
392  write(6,1013)trim(gfnvsdcdlat)
393 
394  gfnvsdcdlon = 'vsdcdlon.'//trim(suffix2)
395  open(32,file=gfnvsdcdlon,status='old',form='formatted')
396  write(6,1013)trim(gfnvsdcdlon)
397 
398  gfnvmdcdeht = 'vmdcdeht.'//trim(suffix2)
399  open(33,file=gfnvmdcdeht,status='old',form='formatted')
400  write(6,1013)trim(gfnvmdcdeht)
401 
402  gfnvmdcdlat = 'vmdcdlat.'//trim(suffix2)
403  open(36,file=gfnvmdcdlat,status='old',form='formatted')
404  write(6,1013)trim(gfnvmdcdlat)
405 
406  gfnvmdcdlon = 'vmdcdlon.'//trim(suffix2)
407  open(37,file=gfnvmdcdlon,status='old',form='formatted')
408  write(6,1013)trim(gfnvmdcdlon)
409 
410  1013 format(6x,'checkgrid.f: ',
411  *'Opening input dropped vector file ',a)
412 
413 c ------------------------------------------------------------------
414 c - Open the input, gridded-from-thinned .b files. If the
415 c - thinned vector file is empty, skip trying to open the
416 c - related ".b" file.
417 c ------------------------------------------------------------------
418  if(.not.nothinlat)then
419  bfnvstcdlat = 'vstcdlat.'//trim(suffix2t04)//'.b'
420  open(11,file=bfnvstcdlat,status='old',form='unformatted')
421  write(6,1015)trim(bfnvstcdlat)
422 
423  bfnvmtcdlat = 'vmtcdlat.'//trim(suffix2t04)//'.b'
424  open(16,file=bfnvmtcdlat,status='old',form='unformatted')
425  write(6,1015)trim(bfnvmtcdlat)
426  endif
427 
428  if(.not.nothinlon)then
429  bfnvstcdlon = 'vstcdlon.'//trim(suffix2t04)//'.b'
430  open(12,file=bfnvstcdlon,status='old',form='unformatted')
431  write(6,1015)trim(bfnvstcdlon)
432 
433  bfnvmtcdlon = 'vmtcdlon.'//trim(suffix2t04)//'.b'
434  open(17,file=bfnvmtcdlon,status='old',form='unformatted')
435  write(6,1015)trim(bfnvmtcdlon)
436  endif
437 
438  if(.not.nothineht)then
439  bfnvmtcdeht = 'vmtcdeht.'//trim(suffix2t04)//'.b'
440  open(13,file=bfnvmtcdeht,status='old',form='unformatted')
441  write(6,1015)trim(bfnvmtcdeht)
442  endif
443 
444  1015 format(6x,'checkgrid.f: ',
445  *'Opening input grid file ',a)
446 
447 c ------------------------------------------------------------------
448 c - Open the output, interpolated-from-grid coordinate difference
449 c - vector files, GMT-ready for plotting.
450 c - If the input thinned vector file is empty (aka there is
451 c - no grid), skip
452 c ------------------------------------------------------------------
453  if(.not.nothinlat)then
454  gfnvsagilat = 'vsagilat.'//trim(suffix2)
455  open(91,file=gfnvsagilat,status='new',form='formatted')
456  write(6,1017)'lat',trim(gfnvsagilat)
457 
458  gfnvmagilat = 'vmagilat.'//trim(suffix2)
459  open(96,file=gfnvmagilat,status='new',form='formatted')
460  write(6,1017)'lat',trim(gfnvmagilat)
461 
462  gfnvstgilat = 'vstgilat.'//trim(suffix2)
463  open(71,file=gfnvstgilat,status='new',form='formatted')
464  write(6,1017)'lat',trim(gfnvstgilat)
465 
466  gfnvmtgilat = 'vmtgilat.'//trim(suffix2)
467  open(76,file=gfnvmtgilat,status='new',form='formatted')
468  write(6,1017)'lat',trim(gfnvmtgilat)
469 
470  gfnvsdgilat = 'vsdgilat.'//trim(suffix2)
471  open(81,file=gfnvsdgilat,status='new',form='formatted')
472  write(6,1017)'lat',trim(gfnvsdgilat)
473 
474  gfnvmdgilat = 'vmdgilat.'//trim(suffix2)
475  open(86,file=gfnvmdgilat,status='new',form='formatted')
476  write(6,1017)'lat',trim(gfnvmdgilat)
477  endif
478 
479 
480 
481  if(.not.nothinlon)then
482  gfnvsagilon = 'vsagilon.'//trim(suffix2)
483  open(92,file=gfnvsagilon,status='new',form='formatted')
484  write(6,1017)'lon',trim(gfnvsagilon)
485 
486  gfnvmagilon = 'vmagilon.'//trim(suffix2)
487  open(97,file=gfnvmagilon,status='new',form='formatted')
488  write(6,1017)'lon',trim(gfnvmagilon)
489 
490  gfnvstgilon = 'vstgilon.'//trim(suffix2)
491  open(72,file=gfnvstgilon,status='new',form='formatted')
492  write(6,1017)'lon',trim(gfnvstgilon)
493 
494  gfnvmtgilon = 'vmtgilon.'//trim(suffix2)
495  open(77,file=gfnvmtgilon,status='new',form='formatted')
496  write(6,1017)'lon',trim(gfnvmtgilon)
497 
498  gfnvsdgilon = 'vsdgilon.'//trim(suffix2)
499  open(82,file=gfnvsdgilon,status='new',form='formatted')
500  write(6,1017)'lon',trim(gfnvsdgilon)
501 
502  gfnvmdgilon = 'vmdgilon.'//trim(suffix2)
503  open(87,file=gfnvmdgilon,status='new',form='formatted')
504  write(6,1017)'lon',trim(gfnvmdgilon)
505  endif
506 
507 
508 
509  if(.not.nothineht)then
510  gfnvmagieht = 'vmagieht.'//trim(suffix2)
511  open(93,file=gfnvmagieht,status='new',form='formatted')
512  write(6,1017)'eht',trim(gfnvmagieht)
513 
514  gfnvmtgieht = 'vmtgieht.'//trim(suffix2)
515  open(73,file=gfnvmtgieht,status='new',form='formatted')
516  write(6,1017)'eht',trim(gfnvmtgieht)
517 
518  gfnvmdgieht = 'vmdgieht.'//trim(suffix2)
519  open(83,file=gfnvmdgieht,status='new',form='formatted')
520  write(6,1017)'eht',trim(gfnvmdgieht)
521  endif
522 
523 c - Added 2015 10 08
524 
525  if(.not.nothinlat .and. .not.nothinlon)then
526  gfnvsagihor = 'vsagihor.'//trim(suffix2)
527  open(94,file=gfnvsagihor,status='new',form='formatted')
528  write(6,1017)'hor',trim(gfnvsagihor)
529 
530  gfnvmagihor = 'vmagihor.'//trim(suffix2)
531  open(95,file=gfnvmagihor,status='new',form='formatted')
532  write(6,1017)'hor',trim(gfnvmagihor)
533 
534  gfnvstgihor = 'vstgihor.'//trim(suffix2)
535  open(74,file=gfnvstgihor,status='new',form='formatted')
536  write(6,1017)'hor',trim(gfnvstgihor)
537 
538  gfnvmtgihor = 'vmtgihor.'//trim(suffix2)
539  open(75,file=gfnvmtgihor,status='new',form='formatted')
540  write(6,1017)'hor',trim(gfnvmtgihor)
541 
542  gfnvsdgihor = 'vsdgihor.'//trim(suffix2)
543  open(84,file=gfnvsdgihor,status='new',form='formatted')
544  write(6,1017)'hor',trim(gfnvsdgihor)
545 
546  gfnvmdgihor = 'vmdgihor.'//trim(suffix2)
547  open(85,file=gfnvmdgihor,status='new',form='formatted')
548  write(6,1017)'hor',trim(gfnvmdgihor)
549  endif
550 
551  1017 format(6x,'checkgrid.f: ',
552  *'Opening output grid-interpolated ',a,' vector file :',a)
553 
554 c ------------------------------------------------------------------
555 c - Open the output, differential, GMT-ready files for
556 c - plotting. THINNED. If the input thinned vector file
557 c - is empty, skip
558 c ------------------------------------------------------------------
559  if(.not.nothinlat)then
560  gfnvstddlat = 'vstddlat.'//trim(suffix2)
561  open(41,file=gfnvstddlat,status='new',form='formatted')
562  write(6,1014)'lat',trim(gfnvstddlat)
563 
564  gfnvmtddlat = 'vmtddlat.'//trim(suffix2)
565  open(46,file=gfnvmtddlat,status='new',form='formatted')
566  write(6,1014)'lat',trim(gfnvmtddlat)
567  endif
568 
569  if(.not.nothinlon)then
570  gfnvstddlon = 'vstddlon.'//trim(suffix2)
571  open(42,file=gfnvstddlon,status='new',form='formatted')
572  write(6,1014)'lon',trim(gfnvstddlon)
573 
574  gfnvmtddlon = 'vmtddlon.'//trim(suffix2)
575  open(47,file=gfnvmtddlon,status='new',form='formatted')
576  write(6,1014)'lon',trim(gfnvmtddlon)
577  endif
578 
579  if(.not.nothineht)then
580  gfnvmtddeht = 'vmtddeht.'//trim(suffix2)
581  open(43,file=gfnvmtddeht,status='new',form='formatted')
582  write(6,1014)'eht',trim(gfnvmtddeht)
583  endif
584 
585  if(.not.nothinlon .and. .not.nothinlat)then
586  gfnvstddhor = 'vstddhor.'//trim(suffix2)
587  open(44,file=gfnvstddhor,status='new',form='formatted')
588  write(6,1014)'hor',trim(gfnvstddhor)
589 
590  gfnvmtddhor = 'vmtddhor.'//trim(suffix2)
591  open(45,file=gfnvmtddhor,status='new',form='formatted')
592  write(6,1014)'hor',trim(gfnvmtddhor)
593  endif
594 
595 c ------------------------------------------------------------------
596 c - Open the output, differential, GMT-ready files for
597 c - plotting. DROPPED.
598 c ------------------------------------------------------------------
599  if(.not.nothinlat)then
600  gfnvsdddlat = 'vsdddlat.'//trim(suffix2)
601  open(51,file=gfnvsdddlat,status='new',form='formatted')
602  write(6,1014)'lat',trim(gfnvsdddlat)
603 
604  gfnvmdddlat = 'vmdddlat.'//trim(suffix2)
605  open(56,file=gfnvmdddlat,status='new',form='formatted')
606  write(6,1014)'lat',trim(gfnvmdddlat)
607  endif
608 
609  if(.not.nothinlon)then
610  gfnvsdddlon = 'vsdddlon.'//trim(suffix2)
611  open(52,file=gfnvsdddlon,status='new',form='formatted')
612  write(6,1014)'lon',trim(gfnvsdddlon)
613 
614  gfnvmdddlon = 'vmdddlon.'//trim(suffix2)
615  open(57,file=gfnvmdddlon,status='new',form='formatted')
616  write(6,1014)'lon',trim(gfnvmdddlon)
617  endif
618 
619  if(.not.nothineht)then
620  gfnvmdddeht = 'vmdddeht.'//trim(suffix2)
621  open(53,file=gfnvmdddeht,status='new',form='formatted')
622  write(6,1014)'eht',trim(gfnvmdddeht)
623  endif
624 
625  if(.not.nothinlat .and. .not.nothinlon)then
626  gfnvsdddhor = 'vsdddhor.'//trim(suffix2)
627  open(54,file=gfnvsdddhor,status='new',form='formatted')
628  write(6,1014)'hor',trim(gfnvsdddhor)
629 
630  gfnvmdddhor = 'vmdddhor.'//trim(suffix2)
631  open(55,file=gfnvmdddhor,status='new',form='formatted')
632  write(6,1014)'hor',trim(gfnvmdddhor)
633  endif
634 
635 c ------------------------------------------------------------------
636 c - Open the output, differential, GMT-ready files for
637 c - plotting. ALL.
638 c ------------------------------------------------------------------
639  if(.not.nothinlat)then
640  gfnvsaddlat = 'vsaddlat.'//trim(suffix2)
641  open(61,file=gfnvsaddlat,status='new',form='formatted')
642  write(6,1014)'lat',trim(gfnvsaddlat)
643 
644  gfnvmaddlat = 'vmaddlat.'//trim(suffix2)
645  open(66,file=gfnvmaddlat,status='new',form='formatted')
646  write(6,1014)'lat',trim(gfnvmaddlat)
647  endif
648 
649  if(.not.nothinlon)then
650  gfnvsaddlon = 'vsaddlon.'//trim(suffix2)
651  open(62,file=gfnvsaddlon,status='new',form='formatted')
652  write(6,1014)'lon',trim(gfnvsaddlon)
653 
654  gfnvmaddlon = 'vmaddlon.'//trim(suffix2)
655  open(67,file=gfnvmaddlon,status='new',form='formatted')
656  write(6,1014)'lon',trim(gfnvmaddlon)
657  endif
658 
659  if(.not.nothineht)then
660  gfnvmaddeht = 'vmaddeht.'//trim(suffix2)
661  open(63,file=gfnvmaddeht,status='new',form='formatted')
662  write(6,1014)'eht',trim(gfnvmaddeht)
663  endif
664 
665  if(.not.nothinlat .and. .not.nothinlon)then
666  gfnvsaddhor = 'vsaddhor.'//trim(suffix2)
667  open(64,file=gfnvsaddhor,status='new',form='formatted')
668  write(6,1014)'hor',trim(gfnvsaddhor)
669 
670  gfnvmaddhor = 'vmaddhor.'//trim(suffix2)
671  open(65,file=gfnvmaddhor,status='new',form='formatted')
672  write(6,1014)'hor',trim(gfnvmaddhor)
673  endif
674 
675  1014 format(6x,'checkgrid.f: ',
676  *'Opening output differential ',a,' vector file :',a)
677 
678 c ------------------------------------------------------------------
679 c - Each region has officially chosen boundaries (which may
680 c - or may not agree with the MAP boundaries). Get the
681 c - official grid boundaries here. See DRU-11, p. 126
682 c ------------------------------------------------------------------
683  call getgridbounds(region,glamx,glamn,glomn,glomx)
684 
685  write(6,1004)trim(region),glamn,glamx,glomn,glomx
686  1004 format(6x,'checkgrid.f: Region= ',a,/,
687  * 6x,'checkgrid.f: North = ',f12.6,/,
688  * 6x,'checkgrid.f: South = ',f12.6,/,
689  * 6x,'checkgrid.f: West = ',f12.6,/,
690  * 6x,'checkgrid.f: East = ',f12.6)
691 
692  write(6,8002)
693  8002 format(50('*'),/,
694  *6x,'checkgrid.f: BEGIN STATISTICAL REPORT ',
695  *'(grid minus true vector diffs)')
696 
697 c -------------------------------------------------------
698 c - Read the ".b" grids into RAM
699 c -
700 c - See DRU-11, p. 140 for the following philosophy:
701 c
702 c Because the final grids in lat/lon will ONLY be
703 c in arcseconds, all statistics should be about
704 c arcseconds, with CONVERSION to meters on the fly,
705 c and NOT about meter vectors compared to meter grids.
706 c -------------------------------------------------------
707  do 1 i=1,3
708 
709  if(i.eq.1 .and. nothinlat)goto 1
710  if(i.eq.2 .and. nothinlon)goto 1
711  if(i.eq.3 .and. nothineht)goto 1
712 
713  ifil = 10+i
714  read(ifil)glamn,glomn,dla,dlo,nla,nlo,ikind
715  do 2 j=1,nla
716  if(i.eq.1)read(ifil)(datlats(j,k),k=1,nlo)
717  if(i.eq.2)read(ifil)(datlons(j,k),k=1,nlo)
718  if(i.eq.3)read(ifil)(datehtm(j,k),k=1,nlo)
719 
720  2 continue
721  1 continue
722  glamx = glamn + (nla-1)*dla
723  glomx = glomn + (nlo-1)*dlo
724 
725 c -------------------------------------------------------
726 c - Go through the vectors. Do lat first, then lon,
727 c - then eht. Compute DDlat, DDlon and DDeht.
728 c - Compute region-wide statistics for:
729 c - thinned-versus-gridded
730 c - dropped-versus-gridded
731 c - all-versus-gridded
732 c - Spit out the grid interpolated lat/lon/eht values,
733 c - as well as the double differences:
734 c - Spit out the DDlat, DDlon and DDeht values to
735 c - output files, for either thinned, dropped or all.
736 c -------------------------------------------------------
737 
738 c - stat(i,j,k,l) :
739 c - kstat(j,k) :
740 c
741 c i = 1 => Average
742 c i = 2 => RMS
743 c i = 3 => Min
744 c i = 4 => Max
745 c i = 5 => Standard Deviation
746 c
747 c j = 1 => LAT, arcseconds
748 c j = 2 => LON, arcseconds
749 c j = 3 => EHT, meters
750 c j = 4 => LAT, meters <- Computed by converting from arcseconds
751 c j = 4 => LON, meters <- Computed by converting from arcseconds
752 c
753 c k = 1 => Thinned vectors
754 c k = 2 => Dropped vectors
755 c k = 3 => All vectors
756 c
757 c l = 1 => Bilinear Interpolation
758 c l = 2 => Biquadratic Interpolation
759 c l = 3 => Bicubic Spline Interpolation
760 
761 c - Zero stats
762  do 3002 i=1,5
763 c do 3003 j=1,3
764  do 3003 j=1,5
765  do 3004 k=1,3
766  kstat(j,k) = 0
767  do 3005 l=1,3
768  stat(i,j,k,l) = 0.d0
769  if(i.eq.3)stat(i,j,k,l) = 99999.d0
770  if(i.eq.4)stat(i,j,k,l) =-99999.d0
771  3005 continue
772  3004 continue
773  3003 continue
774  3002 continue
775 
776  type(1) = 'THIN'
777  type(2) = 'DROP'
778  type(3) = 'ALL '
779 
780 
781 c -------------------------------------------------------------
782 c -------------------------------------------------------------
783 c -------------------------------------------------------------
784 c - MAIN LOOP
785 c -------------------------------------------------------------
786 c -------------------------------------------------------------
787 c -------------------------------------------------------------
788 
789 c In the loops below, for j,k=
790 c 1,1 = Lat(s)/Thinned
791 c 1,2 = Lat(s)/Dropped
792 c 2,1 = Lon(s)/Thinned
793 c 2,2 = Lon(s)/Dropped
794 c 3,1 = Eht(s)/Thinned
795 c 1,2 = Eht(s)/Dropped
796 
797 c - j=4 and 5, being Lat(m) and Lon(m) will be converted ON THE FLY
798 c - from j=1 and 2 values.
799 c 4,1 = Lat(s)/Thinned
800 c 4,2 = Lat(s)/Dropped
801 c 5,1 = Lon(s)/Thinned
802 c 5,2 = Lon(s)/Dropped
803 
804  do 2001 j=1,3
805 
806  avegiprime = 0.d0
807  avegimeter = 0.d0
808 
809  if(j.eq.1 .and. nothinlat)goto 2001
810  if(j.eq.2 .and. nothinlon)goto 2001
811  if(j.eq.3 .and. nothineht)goto 2001
812 
813 c - Now spin over thinned, then dropped vectors
814  itot = 0
815 
816  do 2002 k=1,2
817  if(k.eq.1)ifile = 20+j ! Thinned Vectors
818  if(k.eq.2)ifile = 30+j ! Dropped Vectors
819 
820  iread = 0
821  igood = 0
822  101 read(ifile,'(a)',end=103)card
823  iread = iread + 1
824 
825 c - CRITICAL, pull true values of ARCSECONDS for lat/lon
826 c - but METERS for eht
827  if(j.eq.1 .or. j.eq.2)read(card, 102)xlo,xla,vvec
828  if(j.eq.3 )read(card,1102)xlo,xla,vvec
829 
830 c - This shouldn't happen, but in case a vector
831 c - is not inside the grid, skip it
832  if(xla.gt.glamx .or. xla.lt.glamn .or.
833  * xlo.gt.glomx .or. xlo.lt.glomn)then
834  goto 101
835  endif
836  igood = igood + 1
837  itot = itot + 1
838 
839 c - Hold the lat, lon and PID in RAM until its time to
840 c - spit them out.
841  xla0(itot) = xla
842  xlo0(itot) = xlo
843  pid0(itot) = card(74:79)
844 
845 c - Do the interpolations
846 c - "vgrd()" stores sec/sec/met for lat/lon/eht
847 c - "vgrdm()" stores meters for everything
848 
849 c - Bilinear to get vgrd(1)
850  if(j.eq.1)call bilin(datlats,glamn,glomn,dla,dlo,
851  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(1))
852  if(j.eq.2)call bilin(datlons,glamn,glomn,dla,dlo,
853  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(1))
854  if(j.eq.3)call bilin(datehtm,glamn,glomn,dla,dlo,
855  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(1))
856 
857 c - Biquadratic to get vgrd(2)
858  if(j.eq.1)call biquad(datlats,glamn,glomn,dla,dlo,
859  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(2))
860  if(j.eq.2)call biquad(datlons,glamn,glomn,dla,dlo,
861  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(2))
862  if(j.eq.3)call biquad(datehtm,glamn,glomn,dla,dlo,
863  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(2))
864 
865 c - Biquadratic to get vgrd(2)
866  if(j.eq.1)call bicubic(datlats,glamn,glomn,dla,dlo,
867  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(3))
868  if(j.eq.2)call bicubic(datlons,glamn,glomn,dla,dlo,
869  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(3))
870  if(j.eq.3)call bicubic(datehtm,glamn,glomn,dla,dlo,
871  * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(3))
872 
873 c - Differences grd minus true (lat, lon in arcseconds; eht in meters)
874  do 808 l = 1,3
875  dd(l) = vgrd(l) - vvec
876 
877 c - Convert seconds to meters but don't lose the seconds either
878  if(j.eq.1)then
879  vgrdm(l) = vgrd(l) * s2m
880  ddm(l) = dd(l) * s2m
881  elseif(j.eq.2)then
882  coslat = dcos(xla*d2r)
883  vgrdm(l) = vgrd(l) * s2m * coslat
884  ddm(l) = dd(l) * s2m * coslat
885  else
886  vgrdm(l) = vgrd(l)
887  ddm(l) = dd(l)
888  endif
889 
890 c*********************************************************
891 c - ALL *STATISTICS* in their primary units
892 c - (arcsec for lat/lon, meters for eht), but then
893 c - converted to meters/meters for lat/lon after the
894 c - fact.
895 c - will be in arcseconds or meters appropriately.
896 c - These stats are all for DOUBLE DIFFERENCES
897 c
898 c - However, I do need to tally the average absolute
899 c - values of lat(sec), lat(m), lon(sec), lon(m) and eht(m) of
900 c - grid-interpolated vectors so I can scale their vector
901 c - plots correctly. We'll hack that into here...
902 c*********************************************************
903 
904 c - k=1,2 = thin/drop; k=3 = all
905 c - j=1,2,3 for lat-sec,lon-sec,eht-met
906 c - j=4,5 for lat-met, lon-met
907 
908 c - Tally average
909  stat(1,j,k,l) = stat(1,j,k,l) + dd(l)
910  stat(1,j,3,l) = stat(1,j,3,l) + dd(l)
911  if(j.lt.3)then
912  stat(1,j+3,k,l) = stat(1,j+3,k,l) + ddm(l)
913  stat(1,j+3,3,l) = stat(1,j+3,3,l) + ddm(l)
914  endif
915 
916 c - Tally RMS:
917  stat(2,j,k,l) = stat(2,j,k,l) + dd(l)**2
918  stat(2,j,3,l) = stat(2,j,3,l) + dd(l)**2
919  if(j.lt.3)then
920  stat(2,j+3,k,l) = stat(2,j+3,k,l) + ddm(l)**2
921  stat(2,j+3,3,l) = stat(2,j+3,3,l) + ddm(l)**2
922  endif
923 c - Tally Min:
924  if(dd(l).lt.stat(3,j,k,l))stat(3,j,k,l)=dd(l)
925  if(dd(l).lt.stat(3,j,3,l))stat(3,j,3,l)=dd(l)
926  if(j.lt.3)then
927  if(ddm(l).lt.stat(3,j+3,k,l))stat(3,j+3,k,l)=ddm(l)
928  if(ddm(l).lt.stat(3,j+3,3,l))stat(3,j+3,3,l)=ddm(l)
929  endif
930 
931 c - Tally Max:
932  if(dd(l).gt.stat(4,j,k,l))stat(4,j,k,l)=dd(l)
933  if(dd(l).gt.stat(4,j,3,l))stat(4,j,3,l)=dd(l)
934  if(j.lt.3)then
935  if(ddm(l).gt.stat(4,j+3,k,l))stat(4,j+3,k,l)=ddm(l)
936  if(ddm(l).gt.stat(4,j+3,3,l))stat(4,j+3,3,l)=ddm(l)
937  endif
938 
939  808 continue
940 
941 c - HACK / CHOICE: For now, use biquadratically interpolated
942 c - data as the official output. Note that
943 c - "dd0" stores ARCSECONDS for lat or lon and METERS for eht
944 c - but "ddm0" stores METERS for everything
945 c dd0(igood) = dd(2)
946 c ddm0(igood) = ddm(2)
947 
948 c - Double Differences:
949  dd0(itot) = dd(2)
950  ddm0(itot) = ddm(2)
951 c - Grid Interpolated:
952  gi0(itot) = vgrd(2)
953  gim0(itot) = vgrdm(2)
954 
955  avegiprime = avegiprime + dabs(gi0(itot))
956  avegimeter = avegimeter + dabs(gim0(itot))
957 
958 c - Tally counts
959 c - Either Thinned or Dropped:
960  kstat(j,k)=kstat(j,k) + 1
961  if(j.lt.3)then
962  kstat(j+3,k)=kstat(j+3,k) + 1
963  endif
964 c - All:
965  kstat(j,3)=kstat(j,3) + 1
966  if(j.lt.3)then
967  kstat(j+3,3)=kstat(j+3,3) + 1
968  endif
969 
970  goto 101
971  103 continue
972 
973  2002 continue
974 
975 c - Double check that the counts of thinned and dropped
976 c - add up to the count for all.
977  kthin = kstat(j,1)
978  kdrop = kstat(j,2)
979  kall = kstat(j,3)
980 c - Won't do this for j=4/5 as they should parallel j=1/2
981 
982  avegiprime = avegiprime / dble(kall)
983  avegimeter = avegimeter / dble(kall)
984 
985 c write(6,*) j,kthin
986 c write(6,*) j,kdrop
987 c write(6,*) j,kall
988  if(kall.ne.kthin+kdrop)then
989  write(6,*) ' Thin+Drop .DNE. All => STOP'
990  stop
991  endif
992  if(itot.ne.kall)then
993  write(6,*) ' itot .DNE. All => STOP'
994  stop
995  endif
996 
997 c - Finalize stats for k=1,3 (thin/drop/all)
998  do 809 k=1,3
999  fac(j,k) = dble(kstat(j,k))/dble(kstat(j,k)-1)
1000  if(j.lt.3)then
1001  fac(j+3,k) = dble(kstat(j+3,k))/dble(kstat(j+3,k)-1)
1002  endif
1003  do 810 l=1,3
1004  stat(1,j,k,l)=stat(1,j,k,l)/kstat(j,k)
1005  stat(2,j,k,l)=dsqrt(stat(2,j,k,l)/kstat(j,k))
1006  stat(5,j,k,l)=dsqrt(fac(j,k)*
1007  * (stat(2,j,k,l)**2 - stat(1,j,k,l)**2))
1008 
1009  if(j.lt.3)then
1010  stat(1,j+3,k,l)=stat(1,j+3,k,l)/kstat(j+3,k)
1011  stat(2,j+3,k,l)=dsqrt(stat(2,j+3,k,l)/kstat(j+3,k))
1012  stat(5,j+3,k,l)=dsqrt(fac(j+3,k)*
1013  * (stat(2,j+3,k,l)**2 - stat(1,j+3,k,l)**2))
1014  endif
1015 
1016  810 continue
1017  809 continue
1018 
1019 
1020 c -----------------------
1021 c - At this point we've finished collecting statistics for
1022 c - one type of coordinate (lat, lon or eht), and can spit
1023 c - out the data to files.
1024 c -
1025 c - OUTPUT the "vgrd" values to the appropriate VECTOR FILE
1026 c - OUTPUT the "vgrd-vvec" values to the appropriate VECTOR FILE
1027 c -
1028 c - Use the RMS value to compute scales needed for our output vector file.
1029 c - Why not AVE? Because the AVE is expected to be VERY close to zero
1030 c - but RMS better represents overall magnitude of disagreement.
1031 c -----------------------
1032 c
1033 c - 2,j,3,2 = rms , lat-sec/lon-sec/eht-met/lat-met/lon-met , all , biquad, double differenced
1034 c Convert the RMS to cm to go along with all over vector plots heretofore
1035  rms0prime = stat(2,j,3,2)
1036  lorvogprime = onzd2(multiplierlorvog*rms0prime)
1037 c iqprime = floor(log10(rms0prime))
1038 c qqprime = 10.d0**(iqprime )
1039 c lorvogprime = MultiplierLorvog*qqprime*nint(rms0prime/qqprime)
1040 
1041  gprime2pc = lorvopc / lorvogprime
1042  scaledd(j) = gprime2pc
1043  basedd(j) = rms0prime
1044  if(j.lt.3)then
1045  rms0meters = stat(2,j+3,3,2)
1046  lorvogmeters = onzd2(multiplierlorvog*rms0meters)
1047 c iqmeters = floor(log10(rms0meters))
1048 c qqmeters = 10.d0**(iqmeters )
1049 c lorvogmeters = MultiplierLorvog*
1050 c * qqmeters*nint(rms0meters/qqmeters)
1051  gmeters2pc = lorvopc / lorvogmeters
1052  scaledd(j+3) = gmeters2pc
1053  basedd(j+3) = rms0meters
1054  endif
1055  lorvog(j) = lorvogprime
1056  if(j.lt.3)lorvog(j+3) = lorvogmeters
1057 
1058 c - for the grid interpolated guys...
1059 c iqprimegi = floor(log10(avegiprime))
1060 c qqprimegi = 10.d0**(iqprimegi )
1061 c lorvogprimegi = MultiplierLorvog*
1062 c * qqprimegi*nint(avegiprime/qqprimegi)
1063  lorvogprimegi = onzd2(multiplierlorvog*avegiprime)
1064 c write(6,*)'MultiplierLorvog = ',MultiplierLorvog
1065 c write(6,*)'avegiprime = ',avegiprime
1066 c write(6,*)'lorvogprimegi = ',lorvogprimegi
1067  gprime2pcgi = lorvopc / lorvogprimegi
1068  scalegi(j) = gprime2pcgi
1069  basegi(j) = avegiprime
1070  if(j.lt.3)then
1071  lorvogmetersgi = onzd2(multiplierlorvog*avegimeter)
1072 c iqmetersgi = floor(log10(avegimeter))
1073 c qqmetersgi = 10.d0**(iqmetersgi )
1074 c lorvogmetersgi = MultiplierLorvog*
1075 c * qqmetersgi*nint(avegimeter/qqmetersgi)
1076  gmeters2pcgi = lorvopc / lorvogmetersgi
1077  scalegi(j+3) = gmeters2pcgi
1078  basegi(j+3) = avegimeter
1079  endif
1080  lorvoggi(j) = lorvogprimegi
1081  if(j.lt.3)lorvoggi(j+3) = lorvogmetersgi
1082 
1083 c ------------------------------------------------------------------
1084 c - pvlon and pvlat are the percentage of the total lon/lat
1085 c - span of the plot, from which the reference vector
1086 c - begins, starting with the Lower Left corner
1087 c ------------------------------------------------------------------
1088  pvlon = 10.d0
1089  pvlat = 10.d0
1090 
1091  pvlat = (pvlat / 100.d0)
1092  pvlon = (pvlon / 100.d0)
1093 
1094 c - Set the output file number
1095  ifthin = 40+j
1096  ifdrop = 50+j
1097  ifall = 60+j
1098 
1099 c - Spin over all "grid minus vector" values, and spit the differences
1100 c - into fresh vector files. Note that THIN data is first, then DROPPED
1101  do 813 ipt=1,kall
1102  if(ipt.le.kthin)then
1103  ifout1 = ifthin
1104  else
1105  ifout1 = ifdrop
1106  endif
1107  ifout2 = ifall
1108 
1109 c - Get the Azimuth for this point, double differenced version:
1110  if(j.eq.1 .or. j.eq.3)then
1111  if(dd0(ipt).lt.0)then
1112  az=180.d0
1113  else
1114  az=0.d0
1115  endif
1116  else
1117  if(dd0(ipt).lt.0)then
1118  az=270.d0
1119  else
1120  az=90.d0
1121  endif
1122  endif
1123 
1124 c - Get the Azimuth for this point, grid interpolated version:
1125  if(j.eq.1 .or. j.eq.3)then
1126  if(gi0(ipt).lt.0)then
1127  azgi=180.d0
1128  else
1129  azgi=0.d0
1130  endif
1131  else
1132  if(gi0(ipt).lt.0)then
1133  azgi=270.d0
1134  else
1135  azgi=90.d0
1136  endif
1137  endif
1138 
1139 c - Get the scaled value for this point
1140 c - Because we aren't looping over j through 4/5, we catch
1141 c - the j=4/5 values while hitting j=1/2:
1142  vcprime = dabs(dd0(ipt)*gprime2pc)
1143  if(j.lt.3)then
1144  vcmeters = dabs(ddm0(ipt) * gmeters2pc)
1145  endif
1146 
1147  giprime = dabs(gi0(ipt)*gprime2pcgi)
1148  if(j.lt.3)then
1149  gimeters = dabs(gim0(ipt) * gmeters2pcgi)
1150  endif
1151 
1152 c ------------------------
1153 c - Spit out fresh "grid interpolated" as well as "double difference" vectors
1154 c ------------------------
1155 
1156  if(j.eq.1 .or. j.eq.2)then
1157 c - Write out for j=1,2 to thinned/dropped in primary units, double differenced:
1158  write(ifout1 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1159  * dd0(ipt),ddm0(ipt),pid0(ipt)
1160 c - Write out for j=1,2 to thinned/dropped in primary units, grid-interpolated:
1161  write(ifout1+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1162  * gi0(ipt),gim0(ipt),pid0(ipt)
1163 
1164 
1165 c - Write out for j=1,2 to all in primary units, double differenced:
1166  write(ifout2 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1167  * dd0(ipt),ddm0(ipt),pid0(ipt)
1168 c - Write out for j=1,2 to all in primary units, grid-interpolated:
1169  write(ifout2+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1170  * gi0(ipt),gim0(ipt),pid0(ipt)
1171 
1172 
1173 c - Write out for j=4,5 to thinned/dropped in meters, double differenced:
1174  write(ifout1+5 ,140)xlo0(ipt),xla0(ipt),az,vcmeters,
1175  * dd0(ipt),ddm0(ipt),pid0(ipt)
1176 c - Write out for j=4,5 to thinned/dropped in meters, grid interpolated:
1177  write(ifout1+35,140)xlo0(ipt),xla0(ipt),azgi,gimeters,
1178  * gi0(ipt),gim0(ipt),pid0(ipt)
1179 
1180 
1181 c - Write out for j=4,5 to all in meters, double differenced:
1182  write(ifout2+5 ,140)xlo0(ipt),xla0(ipt),az,vcmeters,
1183  * dd0(ipt),ddm0(ipt),pid0(ipt)
1184 c - Write out for j=4,5 to all in meters, grid interpolated:
1185  write(ifout2+35,140)xlo0(ipt),xla0(ipt),azgi,gimeters,
1186  * gi0(ipt),gim0(ipt),pid0(ipt)
1187 
1188 
1189 
1190  endif
1191 
1192  if(j.eq.3)then
1193 c - Write out for j=3 to thinned/dropped in primary units, double differenced:
1194  write(ifout1 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1195  * 0.d0 ,ddm0(ipt),pid0(ipt)
1196 c - Write out for j=3 to thinned/dropped in primary units, grid interpolated:
1197  write(ifout1+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1198  * 0.d0 ,gim0(ipt),pid0(ipt)
1199 
1200 
1201 c - Write out for j=3 to all in primary units, double differenced:
1202  write(ifout2 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1203  * 0.d0 ,ddm0(ipt),pid0(ipt)
1204 c - Write out for j=3 to all in primary units, grid interpolated:
1205  write(ifout2+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1206  * 0.d0 ,gim0(ipt),pid0(ipt)
1207 
1208  endif
1209 
1210  813 continue
1211 
1212 c 140 format(f16.10,1x,f15.10,1x,f6.2,1x,f12.2,1x,f5.1,1x,f9.5,1x,a6)
1213  140 format(f16.10,1x,f15.10,1x,f6.2,1x,f12.2,1x,f9.5,1x,f9.3,1x,a6)
1214 
1215 
1216 c ------------------------------------------------------------------
1217 c - Write out a clear report.
1218 c ------------------------------------------------------------------
1219  write(6,8000)trim(coord(j)),units(j)
1220  do 2003 k=1,3
1221  write(6,8001)type(k),
1222  * (kstat(j,k),l=1,3),
1223  * (stat(1,j,k,l),l=1,3),
1224  * (stat(2,j,k,l),l=1,3),
1225  * (stat(5,j,k,l),l=1,3),
1226  * (stat(3,j,k,l),l=1,3),
1227  * (stat(4,j,k,l),l=1,3)
1228  2003 continue
1229 
1230  if(j.lt.3)then
1231  write(6,8000)trim(coord(j)),units(j+3)
1232  do 2004 k=1,3
1233  write(6,8001)type(k),
1234  * (kstat(j+3,k),l=1,3),
1235  * (stat(1,j+3,k,l),l=1,3),
1236  * (stat(2,j+3,k,l),l=1,3),
1237  * (stat(5,j+3,k,l),l=1,3),
1238  * (stat(3,j+3,k,l),l=1,3),
1239  * (stat(4,j+3,k,l),l=1,3)
1240  2004 continue
1241  endif
1242 
1243  2001 continue
1244 
1245 c 102 format(f16.10,1x,f15.10,1x, 6x,1x, 12x,1x, 5x,1x,f9.5,1x,6x)
1246 
1247 c - To pull arcseconds:
1248  102 format(f16.10,1x,f15.10,1x, 6x,1x, 12x,1x,f9.5,1x, 9x,1x,a6)
1249 c - To pull meters:
1250  1102 format(f16.10,1x,f15.10,1x, 6x,1x, 12x,1x, 9x,1x,f9.3,1x,a6)
1251 
1252 
1253  8000 format(
1254  *//,25x,a,' in ',a,/,
1255  *'Type',1x,'Stat',
1256  *7x,'Bilinear',5x,'Biquadratic',
1257  *9x,'Bicubic ')
1258  8001 format(a4,1x,
1259  *'Num:',3(i15 ,1x),/,
1260  *5x,'Ave:',3(f15.6,1x),/,
1261  *5x,'RMS:',3(f15.6,1x),/,
1262  *5x,'STD:',3(f15.6,1x),/,
1263  *5x,'MIN:',3(f15.6,1x),/,
1264  *5x,'MAX:',3(f15.6,1x),/,
1265  *50('-'))
1266 
1267  write(6,8003)
1268  8003 format(
1269  *6x,'checkgrid.f: END STATISTICAL REPORT ',
1270  *'(grid minus true vector diffs)',/,
1271  *50('*'))
1272 
1273 
1274 c -----------------------------------------------
1275 c - CREATE THE HORIZONTAL VECTOR FILES
1276 c - 2015 10 08
1277 c -----------------------------------------------
1278  write(6,8004)
1279  8004 format(
1280  *6x,'checkgrid.f: Generating HORIZONTAL vector files',
1281  *' from lat/lon vector files')
1282  5072 format('FATAL in checkgrid: Mismatched PID for hor')
1283  5073 format('FATAL in checkgrid: Mismatched LON for hor')
1284  5074 format('FATAL in checkgrid: Mismatched LAT for hor')
1285 
1286  do 5080 i=1,5
1287  if(i.eq.3)goto 5080
1288 c write(6,*)i,'basedd() = ',basedd(i)
1289  5080 continue
1290  do 5081 i=1,5
1291  if(i.eq.3)goto 5081
1292 c write(6,*)i,'basegi() = ',basegi(i)
1293  5081 continue
1294 
1295  baseddhors = sqrt(basedd(1)**2+basedd(2)**2)
1296  baseddhorm = sqrt(basedd(4)**2+basedd(5)**2)
1297  basegihors = sqrt(basegi(1)**2+basegi(2)**2)
1298  basegihorm = sqrt(basegi(4)**2+basegi(5)**2)
1299 
1300 c lorvog(6) = baseddhors
1301 c lorvog(7) = baseddhorm
1302 
1303 c lorvoggi(6) = basegihors
1304 c lorvoggi(7) = basegihorm
1305 
1306 c write(6,*) ' baseddhors = ',baseddhors
1307 c write(6,*) ' baseddhorm = ',baseddhorm
1308 c write(6,*) ' basegihors = ',basegihors
1309 c write(6,*) ' basegihorm = ',basegihorm
1310 
1311  lorvoghorddm = onzd2(multiplierlorvog*baseddhorm)
1312 c iqhorddm = floor(log10(baseddhorm))
1313 c qqhorddm = 10.d0**(iqhorddm )
1314 c lorvoghorddm = MultiplierLorvog*qqhorddm*nint(baseddhorm/qqhorddm)
1315  gm2pchordd = lorvopc / lorvoghorddm
1316 
1317  lorvoghordds = onzd2(multiplierlorvog*baseddhors)
1318 c iqhordds = floor(log10(baseddhors))
1319 c qqhordds = 10.d0**(iqhordds )
1320 c lorvoghordds = MultiplierLorvog*qqhordds*nint(baseddhors/qqhordds)
1321  gs2pchordd = lorvopc / lorvoghordds
1322 
1323  lorvoghorgim = onzd2(multiplierlorvog*basegihorm)
1324 c iqhorgim = floor(log10(basegihorm))
1325 c qqhorgim = 10.d0**(iqhorgim )
1326 c lorvoghorgim = MultiplierLorvog*qqhorgim*nint(basegihorm/qqhorgim)
1327  gm2pchorgi = lorvopc / lorvoghorgim
1328 
1329  lorvoghorgis = onzd2(multiplierlorvog*basegihors)
1330 c iqhorgis = floor(log10(basegihors))
1331 c qqhorgis = 10.d0**(iqhorgis )
1332 c lorvoghorgis = MultiplierLorvog*qqhorgis*nint(basegihors/qqhorgis)
1333  gs2pchorgi = lorvopc / lorvoghorgis
1334 
1335  lorvog(6) = lorvoghordds
1336  lorvog(7) = lorvoghorddm
1337 
1338  lorvoggi(6) = lorvoghorgis
1339  lorvoggi(7) = lorvoghorgim
1340 
1341  convgs2pcddlat = lorvopc / lorvog(1)
1342  convgs2pcddlon = lorvopc / lorvog(2)
1343 
1344  convgm2pcddlat = lorvopc / lorvog(4)
1345  convgm2pcddlon = lorvopc / lorvog(5)
1346 
1347  convgs2pcgilat = lorvopc / lorvoggi(1)
1348  convgs2pcgilon = lorvopc / lorvoggi(2)
1349 
1350  convgm2pcgilat = lorvopc / lorvoggi(4)
1351  convgm2pcgilon = lorvopc / lorvoggi(5)
1352 
1353 c goto 8070
1354 c write(6,*) ' Way #1 : '
1355 c write(6,*) ' convgs2pcddlat = ',convgs2pcddlat
1356 c write(6,*) ' convgs2pcddlon = ',convgs2pcddlon
1357 c write(6,*) ' convgm2pcddlat = ',convgm2pcddlat
1358 c write(6,*) ' convgm2pcddlon = ',convgm2pcddlon
1359 c write(6,*) ' convgs2pcgilat = ',convgs2pcgilat
1360 c write(6,*) ' convgs2pcgilon = ',convgs2pcgilon
1361 c write(6,*) ' convgm2pcgilat = ',convgm2pcgilat
1362 c write(6,*) ' convgm2pcgilon = ',convgm2pcgilon
1363 c8070 continue
1364 
1365  convgs2pcddlat = scaledd(1)
1366  convgs2pcddlon = scaledd(2)
1367  convgm2pcddlat = scaledd(4)
1368  convgm2pcddlon = scaledd(5)
1369  convgs2pcgilat = scalegi(1)
1370  convgs2pcgilon = scalegi(2)
1371  convgm2pcgilat = scalegi(4)
1372  convgm2pcgilon = scalegi(5)
1373 
1374 c goto 8071
1375 c write(6,*) ' Way #2 : '
1376 c write(6,*) ' convgs2pcddlat = ',convgs2pcddlat
1377 c write(6,*) ' convgs2pcddlon = ',convgs2pcddlon
1378 c write(6,*) ' convgm2pcddlat = ',convgm2pcddlat
1379 c write(6,*) ' convgm2pcddlon = ',convgm2pcddlon
1380 c write(6,*) ' convgs2pcgilat = ',convgs2pcgilat
1381 c write(6,*) ' convgs2pcgilon = ',convgs2pcgilon
1382 c write(6,*) ' convgm2pcgilat = ',convgm2pcgilat
1383 c write(6,*) ' convgm2pcgilon = ',convgm2pcgilon
1384 c8071 continue
1385 
1386  convgs2pcddhor = dsqrt(convgs2pcddlat**2 + convgs2pcddlon**2)
1387  convgm2pcddhor = dsqrt(convgm2pcddlat**2 + convgm2pcddlon**2)
1388  convgs2pcgihor = dsqrt(convgs2pcgilat**2 + convgs2pcgilon**2)
1389  convgm2pcgihor = dsqrt(convgm2pcgilat**2 + convgm2pcgilon**2)
1390 
1391 c goto 8072
1392 c write(6,*) ' Ways #1 or 2 : '
1393 c write(6,*) ' convgs2pcddhor = ',convgs2pcddhor
1394 c write(6,*) ' convgm2pcddhor = ',convgm2pcddhor
1395 c write(6,*) ' convgs2pcgihor = ',convgs2pcgihor
1396 c write(6,*) ' convgm2pcgihor = ',convgm2pcgihor
1397 c8072 continue
1398 
1399  convgs2pcddhor = gs2pchordd
1400  convgm2pcddhor = gm2pchordd
1401  convgs2pcgihor = gs2pchorgi
1402  convgm2pcgihor = gm2pchorgi
1403 
1404 c goto 8073
1405 c write(6,*) ' Way #3:'
1406 c write(6,*) ' convgs2pcddhor = ',convgs2pcddhor
1407 c write(6,*) ' convgm2pcddhor = ',convgm2pcddhor
1408 c write(6,*) ' convgs2pcgihor = ',convgs2pcgihor
1409 c write(6,*) ' convgm2pcgihor = ',convgm2pcgihor
1410 c8073 continue
1411 
1412  do 5070 i=40,90,10
1413  do 5071 j=1,2
1414  if(i.le.60 .and. j.eq.1)conv = convgs2pcddhor
1415  if(i.le.60 .and. j.eq.2)conv = convgm2pcddhor
1416  if(i.ge.70 .and. j.eq.1)conv = convgs2pcgihor
1417  if(i.ge.70 .and. j.eq.2)conv = convgm2pcgihor
1418 
1419  ilat = i+1 + (j-1)*5
1420  ilon = i+2 + (j-1)*5
1421  ihor = i+4 + (j-1)*1
1422 c write(6,*) ilat,ilon,ihor
1423  rewind(ilat)
1424  rewind(ilon)
1425 
1426  5078 read(ilat,140,end=5071)ylo1,yla1,az1,vc1,sec1,xmet1,pid1
1427  read(ilon,140)ylo2,yla2,az2,vc2,sec2,xmet2,pid2
1428  if(pid1.ne.pid2)then
1429  write(6,5072)
1430  stop
1431  endif
1432  if(ylo1.ne.ylo2)then
1433  write(6,5073)
1434  stop
1435  endif
1436  if(yla1.ne.yla2)then
1437  write(6,5074)
1438  stop
1439  endif
1440  azhor = datan2(xmet2,xmet1)/d2r
1441  if(azhor.lt.0.d0)azhor=azhor+360.d0
1442  dhors = dsqrt(sec1**2 + sec2**2)
1443  dhorm = dsqrt(xmet1**2 + xmet2**2)
1444 
1445  if(j.eq.1)vchor = conv * dhors
1446  if(j.eq.2)vchor = conv * dhorm
1447 
1448  write(ihor,140)ylo1,yla1,azhor,vchor,dhors,dhorm,pid1
1449  goto 5078
1450 
1451  5071 continue
1452  5070 continue
1453 
1454 
1455 c ------------------------------------------------------------------
1456 c - Write out statistics that I'll pick up later when
1457 c - I run "makeplotfiles03.f" -- just the "rmslatm", "rmslonm"
1458 c - and "rmsehtm" values, used to scale vector plots.
1459 c ------------------------------------------------------------------
1460  sfn = 'dvstats.'//trim(suffix2)
1461  open(2,file=sfn,status='new',form='formatted')
1462 
1463 c 2,j,3,2 = RMS/j/All/Biquad,
1464 c - where j=1/2/3 => lat-sec/lon-sec/eht-met
1465 c - j=4/5 => lat-met/lon-met
1466  write(2,777)kstat(1,3),stat(2,1,3,2)
1467  write(2,777)kstat(2,3),stat(2,2,3,2)
1468  write(2,777)kstat(3,3),stat(2,3,3,2)
1469  write(2,777)kstat(1,3),stat(2,4,3,2)
1470  write(2,777)kstat(2,3),stat(2,5,3,2)
1471 c - 2015 10 09:
1472  rhors = sqrt(stat(2,1,3,2)**2 + stat(2,2,3,2)**2)
1473  rhorm = sqrt(stat(2,4,3,2)**2 + stat(2,5,3,2)**2)
1474  write(2,777)kstat(1,3),rhors
1475  write(2,777)kstat(2,3),rhorm
1476 
1477  close(2)
1478  777 format(i10,1x,f20.10)
1479 
1480 c ----------------------------------------------------------
1481 c ----------------------------------------------------------
1482 c ----------------------------------------------------------
1483 c - Create GMT file "gmtbat04..." and fill it full of
1484 c - calls to make vector plots of thinned/dropped/all
1485 c - "grid interpolated" vectors as well as
1486 c - "double differenced" vectors.
1487 c ----------------------------------------------------------
1488 c ----------------------------------------------------------
1489 c ----------------------------------------------------------
1490 
1491 c ------------------------------------------------------------------
1492 c - GMT Batch file: Open the file. The output batch file full
1493 c - of all the GMT commands needed to create
1494 c - the plots of interest
1495 c ------------------------------------------------------------------
1496  gmtfile = 'gmtbat04.'//trim(suffix3)
1497  open(99,file=gmtfile,status='new',form='formatted')
1498  write(6,1011)trim(gmtfile)
1499  1011 format(6x,'checkgrid.f: Creating GMT batch file ',a)
1500  write(99,1030)trim(gmtfile)
1501  1030 format('echo BEGIN batch file ',a)
1502 
1503 c --------------------------------------------------------------
1504 c - GMT Batch file: Determine Number of areas to plot (=nplots)
1505 c - and Boundaries of plots and other stuff.
1506 c - Report the information out.
1507 c --------------------------------------------------------------
1508 c - 2016 08 29
1509  call getmapbounds(mapflag,maxplots,region,nplots,
1510  *olddtm,newdtm,
1511  *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
1512 
1513 c - 2016 08 26, See DRU-12, p. 56-57:
1514 c call getmapbounds(mapflag,maxplots,region,nplots,
1515 c *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
1516 
1517 c - See DRU-11, p. 126 for choices on grid boundaries for NADCON v5.0
1518 c - 2016 07 21:
1519 c call getmapbounds(mapflag,maxplots,region,nplots,
1520 c *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y)
1521 c call getmapbounds(mapflag,maxplots,region,nplots,
1522 c *bw,be,bs,bn,jm,b1,b2,fn)
1523  write(6,1006)trim(region)
1524  1006 format(6x,'checkgrid.f: Calling getmapbounds for region ',a)
1525 
1526 c --------------------------------------------------------------
1527 c - GMT Batch file: Like "makeplotfiles02.f", I will
1528 c - spin over "nplots" as my main loop, inside of that though,
1529 c - I will spin over j,k (as above, but letting k go from 1 to 3)
1530 c - Remember: j=1,2,3 => lat,lon,eht
1531 c - k=1,2,3 => Thinned, Dropped, All
1532 c --------------------------------------------------------------
1533  ele(1) = 'lat'
1534  ele(2) = 'lon'
1535  ele(3) = 'eht'
1536  ele(4) = 'lat'
1537  ele(5) = 'lon'
1538  ele(6) = 'hor'
1539  ele(7) = 'hor'
1540 
1541  el0(1) = 'LAT'
1542  el0(2) = 'LON'
1543  el0(3) = 'EHT'
1544  el0(4) = 'LAT'
1545  el0(5) = 'LON'
1546  el0(6) = 'HOR'
1547  el0(7) = 'HOR'
1548 
1549  991 format(
1550  *'# ------------------------------',/,
1551  *'# Double Difference Vector Plots',/,
1552  *'# ------------------------------',/,
1553  *'echo Double Difference Vector Plots')
1554 
1555  992 format(
1556  *'# ------------------------------',/,
1557  *'# Grid Interpolated Vector Plots',/,
1558  *'# ------------------------------',/,
1559  *'echo Grid Interpolated Vector Plots')
1560 
1561  990 format(
1562  *'# ------------------------------',/,
1563  *'# Plots for region: ',a,', sub-region: ',a,/,
1564  *'# ------------------------------',/,
1565  *'echo Creating plots for region: ',a,', sub-region: ',a)
1566 
1567 
1568 c----------------------------------
1569 c - Grid-Interpolated Vector Plots
1570 c----------------------------------
1571 
1572  write(99,992)
1573  do 4011 ij=1,nplots
1574  write(99,990)trim(region),trim(fn(ij)),
1575  * trim(region),trim(fn(ij))
1576 
1577 c - 2016 08 26:
1578  xvlon = rv0x(ij)
1579  xvlat = rv0y(ij)
1580 
1581  xllat = rl0y(ij)
1582  xllon = xvlon
1583 
1584 c - Where is the start of the reference vector:
1585 c - 2016 07 29: Decided to scrap personalized locations
1586 c - and just put all reference vectors outside/below
1587 c - the plots
1588 c - 2016 07 21:
1589 c if(lrv(ij))then
1590 c xvlon = rv0x(ij)
1591 c xvlat = rv0y(ij)
1592 c else
1593 c - 2016 08 26
1594 cccc xvlon = bw(ij) + (pvlon*(be(ij)-bw(ij)))
1595 c xvlat = bs(ij) + (pvlat*(bn(ij)-bs(ij)))
1596 cccc xvlat = bs(ij) - (pvlat*(bn(ij)-bs(ij)))
1597 c endif
1598 c - Where is the start of the label for the ref vector:
1599 c xllon = xvlon
1600 c - To prevent the label from going off the page on
1601 c - plots that have very little N/S span, put in a
1602 c - failsafe
1603 c - 2016 07 21: This may take some tweaking...
1604 c if(lrv(ij))then
1605 ccccc xllat = xvlat - 0.1d0
1606 c else
1607 cccc if(bn(ij)-bs(ij).lt.2.0)then
1608 c xllat = bs(ij) + ((pvlat*0.75d0)*(bn(ij)-bs(ij)))
1609 cccc xllat = bs(ij) - ((pvlat*1.25d0)*(bn(ij)-bs(ij)))
1610 cccc else
1611 c xllat = bs(ij) + (pvlat*(bn(ij)-bs(ij))) - 0.1d0
1612 cccc xllat = bs(ij) - (pvlat*(bn(ij)-bs(ij))) - 0.1d0
1613 cccc endif
1614 c endif
1615 
1616 
1617 c do 4012 j = 1,5
1618  do 4012 j = 1,7
1619  do 4013 k = 1,3
1620  if(j.eq.1.and.k.eq.1)gfn = gfnvstgilat
1621  if(j.eq.1.and.k.eq.2)gfn = gfnvsdgilat
1622  if(j.eq.1.and.k.eq.3)gfn = gfnvsagilat
1623 
1624  if(j.eq.2.and.k.eq.1)gfn = gfnvstgilon
1625  if(j.eq.2.and.k.eq.2)gfn = gfnvsdgilon
1626  if(j.eq.2.and.k.eq.3)gfn = gfnvsagilon
1627 
1628  if(j.eq.3.and.k.eq.1)gfn = gfnvmtgieht
1629  if(j.eq.3.and.k.eq.2)gfn = gfnvmdgieht
1630  if(j.eq.3.and.k.eq.3)gfn = gfnvmagieht
1631 
1632  if(j.eq.4.and.k.eq.1)gfn = gfnvmtgilat
1633  if(j.eq.4.and.k.eq.2)gfn = gfnvmdgilat
1634  if(j.eq.4.and.k.eq.3)gfn = gfnvmagilat
1635 
1636  if(j.eq.5.and.k.eq.1)gfn = gfnvmtgilon
1637  if(j.eq.5.and.k.eq.2)gfn = gfnvmdgilon
1638  if(j.eq.5.and.k.eq.3)gfn = gfnvmagilon
1639 
1640  if(j.eq.6.and.k.eq.1)gfn = gfnvstgihor
1641  if(j.eq.6.and.k.eq.2)gfn = gfnvsdgihor
1642  if(j.eq.6.and.k.eq.3)gfn = gfnvsagihor
1643 
1644  if(j.eq.7.and.k.eq.1)gfn = gfnvmtgihor
1645  if(j.eq.7.and.k.eq.2)gfn = gfnvmdgihor
1646  if(j.eq.7.and.k.eq.3)gfn = gfnvmagihor
1647 
1648  if(j.le.5)then
1649  if(kstat(j,k).ne.0)
1650  * call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1651  * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1652  * xvlat,xllon,xllat,lorvoggi(j),lorvopc,igridsec,fn)
1653  else
1654  if(kstat(1,k).ne.0 .and. kstat(2,k).ne.0)
1655  * call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1656  * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1657  * xvlat,xllon,xllat,lorvoggi(j),lorvopc,igridsec,fn)
1658  endif
1659 
1660 
1661  4013 continue
1662  4012 continue
1663  4011 continue
1664 
1665 c----------------------------------
1666 c - Double-Difference Vector Plots
1667 c----------------------------------
1668 
1669 
1670  write(99,991)
1671  do 3011 ij=1,nplots
1672  write(99,990)trim(region),trim(fn(ij)),
1673  * trim(region),trim(fn(ij))
1674 
1675 c - Where is the start of the reference vector:
1676 c - 2016 07 29: Decided to scrap personalized locations
1677 c - and just put all reference vectors outside/below
1678 c - the plots
1679 
1680 c - 2016 08 26
1681  xvlon = rv0x(ij)
1682  xvlat = rv0y(ij)
1683 
1684  xllon = xvlon
1685  xllat = rl0y(ij)
1686 
1687 c - 2016 07 21:
1688 c if(lrv(ij))then
1689 c xvlon = rv0x(ij)
1690 c xvlat = rv0y(ij)
1691 c else
1692 cccc xvlon = bw(ij) + (pvlon*(be(ij)-bw(ij)))
1693 c xvlat = bs(ij) + (pvlat*(bn(ij)-bs(ij)))
1694 cccc xvlat = bs(ij) - (pvlat*(bn(ij)-bs(ij)))
1695 c endif
1696 c - Where is the start of the label for the ref vector:
1697 cccc xllon = xvlon
1698 c - To prevent the label from going off the page on
1699 c - plots that have very little N/S span, put in a
1700 c - failsafe
1701 c - 2016 07 21:
1702 c if(lrv(ij))then
1703 c xllat = xvlat - 0.1d0
1704 c else
1705 cccc if(bn(ij)-bs(ij).lt.2.0)then
1706 c xllat = bs(ij) + ((pvlat*0.75d0)*(bn(ij)-bs(ij)))
1707 cccc xllat = bs(ij) - ((pvlat*1.25d0)*(bn(ij)-bs(ij)))
1708 cccc else
1709 c xllat = bs(ij) + (pvlat*(bn(ij)-bs(ij))) - 0.1d0
1710 cccc xllat = bs(ij) - (pvlat*(bn(ij)-bs(ij))) - 0.1d0
1711 cccc endif
1712 c endif
1713 
1714 
1715 c do 3012 j = 1,3
1716 c do 3012 j = 1,5
1717  do 3012 j = 1,7
1718  do 3013 k = 1,3
1719  if(j.eq.1.and.k.eq.1)gfn = gfnvstddlat
1720  if(j.eq.1.and.k.eq.2)gfn = gfnvsdddlat
1721  if(j.eq.1.and.k.eq.3)gfn = gfnvsaddlat
1722 
1723  if(j.eq.2.and.k.eq.1)gfn = gfnvstddlon
1724  if(j.eq.2.and.k.eq.2)gfn = gfnvsdddlon
1725  if(j.eq.2.and.k.eq.3)gfn = gfnvsaddlon
1726 
1727  if(j.eq.3.and.k.eq.1)gfn = gfnvmtddeht
1728  if(j.eq.3.and.k.eq.2)gfn = gfnvmdddeht
1729  if(j.eq.3.and.k.eq.3)gfn = gfnvmaddeht
1730 
1731  if(j.eq.4.and.k.eq.1)gfn = gfnvmtddlat
1732  if(j.eq.4.and.k.eq.2)gfn = gfnvmdddlat
1733  if(j.eq.4.and.k.eq.3)gfn = gfnvmaddlat
1734 
1735  if(j.eq.5.and.k.eq.1)gfn = gfnvmtddlon
1736  if(j.eq.5.and.k.eq.2)gfn = gfnvmdddlon
1737  if(j.eq.5.and.k.eq.3)gfn = gfnvmaddlon
1738 
1739  if(j.eq.6.and.k.eq.1)gfn = gfnvstddhor
1740  if(j.eq.6.and.k.eq.2)gfn = gfnvsdddhor
1741  if(j.eq.6.and.k.eq.3)gfn = gfnvsaddhor
1742 
1743  if(j.eq.7.and.k.eq.1)gfn = gfnvmtddhor
1744  if(j.eq.7.and.k.eq.2)gfn = gfnvmdddhor
1745  if(j.eq.7.and.k.eq.3)gfn = gfnvmaddhor
1746 
1747  if(j.le.5)then
1748  if(kstat(j,k).ne.0)
1749  * call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1750  * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1751  * xvlat,xllon,xllat,lorvog(j),lorvopc,igridsec,fn)
1752  else
1753  if(kstat(1,k).ne.0 .and. kstat(2,k).ne.0)
1754  * call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1755  * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1756  * xvlat,xllon,xllat,lorvog(j),lorvopc,igridsec,fn)
1757  endif
1758 
1759  3013 continue
1760  3012 continue
1761  3011 continue
1762 
1763 
1764 
1765 
1766 
1767 
1768  write(99,1031)trim(gmtfile)
1769  1031 format('echo END batch file ',a)
1770  close(99)
1771 
1772  write(6,9999)
1773  9999 format('END program checkgrid.f')
1774 
1775  end
1776 c
1777 c --------------------------------------------------------------
1778 c
1779  subroutine nlines(ifile,num,ilogic)
1780  integer*4 ifile,num
1781  logical*1 ilogic
1782  character*1 dummy
1783 
1784  ilogic = .false.
1785  num = 0
1786  1 read(ifile,'(a)',end=2)dummy
1787  num = num + 1
1788  goto 1
1789  2 if(num.eq.0)ilogic = .true.
1790  rewind(ifile)
1791  return
1792  end
1793 c
1794 c --------------------------------------------------------------
1795 c
1796  include 'Subs/getmapbounds.f'
1797  include 'Subs/getgridbounds.f'
1798  include 'Subs/bwplotvc.f'
1799  include 'Subs/plotcoast.f'
1800 c
1801  include 'Subs/bilin.f'
1802  include 'Subs/biquad.f'
1803  include 'Subs/bicubic.f'
1804  include 'Subs/onzd2.f'
1805 
subroutine bwplotvc(ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, xvlon, xvlat, xllon, xllat, lorvog, lorvopc, igridsec, fn)
Subroutine to make GMT calls to do a B/W vector plot.
Definition: bwplotvc.f:33
subroutine nlines(ifile, num, ilogic)
Definition: checkgrid.f:1780
subroutine bilin(data, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
Subroutine to perform bilinear interpolation.
Definition: bilin.f:23
real *8 function onzd2(x)
Function to round a digit to one significant figure (one non zero digit), double precision.
Definition: onzd2.f:32
subroutine getmapbounds(mapflag, maxplots, region, nplots, olddtm, newdtm, bw, be, bs, bn, jm, b1, b2, fn, lrv, rv0x, rv0y, rl0y)
Subroutine to collect up the MAP boundaries for use in creating NADCON 5.
Definition: getmapbounds.f:73
subroutine bicubic(z, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
Subroutine to perform a 2-D cubic ("bicubic") interpolation.
Definition: bicubic.f:37
subroutine getgridbounds(region, xn, xs, xw, xe)
Subroutine to collect up the GRID boundaries for use in creating NADCON 5.
Definition: getgridbounds.f:26
program checkgrid
Part of the NADCON5 build process, generates gmtbat04
Definition: checkgrid.f:96
subroutine biquad(z, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
Subroutine to perform a 2-D quadratic ("biquadratic") interpolation.
Definition: biquad.f:29