NADCON5-ng  0.0.2
NADCON5 Next Generation Documentation
makeplotfiles02.f
Go to the documentation of this file.
1 c> \ingroup doers
2 c> \if MANPAGE
3 c> \page makeplotfiles02
4 c> \endif
5 c>
6 c> Part of the NADCON5 process, generates `gmtbat03`
7 c>
8 c> Built upon the skeleton of "makeplotem.f" for GEOCON v2.0
9 c> But built specifically for NADCON v5.0. So different
10 c> in file names and expanded plot creation that it was
11 c> given the new name "makeplotfiles02.f" to align with
12 c> another NADCON5 program "makeplotfiles01.f"
13 c>
14 c> Creates a batch file called
15 c>
16 c> gmtbat03.(olddtm).(newdtm).(region).(igridsec)
17 c>
18 c> That batch file will create JPGs of:
19 c> 1. Color Plots of the dlat/dlon/deht grids at T=0.4
20 c> 2. Color Plots of the "method noise" grids (the "d3" grids, see DRU-11, p. 150) with thinned coverage overlaid
21 c> 3. B/W plots of thinned vectors that went into the T=0.4 transformation grid
22 c> 4. B/W plots of dropped vectors that did not go into the T=0.4 transformation grid
23 c> 5. B/W plots of thinned coverage of points that went into the T=0.4 transformation grid
24 c> 6. B/W plots of dropped coverage of points that did not go into the T=0.4 transformation grid
25 c>
26 c> ### Program arguments
27 c> Arguments are newline terminated and read from standard input
28 c>
29 c> They are enumerated here
30 c> \param oldtm Source Datum
31 c> \param newdtm Target Datum,region
32 c> \param region Conversion Region
33 c> \param agridsec Grid Spacing in arcsec
34 c>
35 c> Example:
36 c>
37 c> olddatum = 'ussd'
38 c> newdatum = 'nad27'
39 c> region = 'conus'
40 c> agridsec = '900'
41 c>
42 c> ### Program Inputs:
43 c>
44 c> ## Changelog
45 c>
46 c> ### 2016 08 26
47 c> Added new code to do reference vectors consistently
48 c> See DRU-12, p. 56-57
49 c> Also fixed a typo in reference vector length for vmtcdeht plots
50 c> Also changing the call to getmapbounds to give it `olddatum` and `newdatum`
51 c> to aide in filtering out things like the Saint regions in Alaska
52 c> for unsupported transformations.
53 c>
54 c> ### 2016 07 29:
55 c> Scrapped code about personalized reference vectors. Just put all
56 c> reference vectors outside/below plot
57 c> Also moved gridstats and vecstats out into the `/Subs` directory
58 c> to be used by other programs (like makeplotfiles03.f)
59 c>
60 c> ### 2016 07 28:
61 c> Changed code to build the color palette of the `d3` grids
62 c> around the median, and not ave or std.
63 c> See DRU-12, p. 48
64 c>
65 c> ### 2016 07 21:
66 c> Added code to allow for optional placement of reference vectors, coming from
67 c> `map.parameters` as read in subroutine getmapbounds
68 c>
69 c> ### 2016 01 21:
70 c> Updated to get the CPT values fixed in `d3` grids, so that
71 c> (cpthi - cptlo) is exactly divisible by `cptin` at (2 x csm)
72 c>
73 c> ### 2015 10 27:
74 c> Updated to work with the new naming scheme (see DRU-11, p. 150)
75 c>
76 c> ### 2015 10 05:
77 c> Updated to work with the new naming scheme (see DRU-11, p. 139)
79  implicit real*8(a-h,o-z)
80  parameter(maxplots=60)
81 
82  character*35 fname0
83  character*34 dirnam
84  character*10 olddtm,newdtm,od,nd
85  character*2 state,stdum
86  character*3 ele,elelat,elelon,eleeht,elehor,ele0
87 
88  character*5 agridsec
89  integer*4 igridsec
90  character*200 suffix1,suffix2,suffix3,suffix2d3
91  character*200 suffix2t04
92  character*200 wfname,gmtfile
93  character*200 gfncvtcdlat,gfncvtcdlon,gfncvtcdeht
94  character*200 gfncvdcdlat,gfncvdcdlon,gfncvdcdeht
95 
96  character*200 bfnvmtcdlat,bfnvmtcdlon,bfnvmtcdeht
97  character*200 bfnvstcdlat,bfnvstcdlon
98 
99 c - 10/27/2015: "sad" = "Scaled AbsoluteValue Differential", aka "d3" grids
100 c - See DRU-11, p. 150
101  character*200 sadbfnvmtcdlat,sadbfnvmtcdlon,sadbfnvmtcdeht
102  character*200 sadbfnvstcdlat,sadbfnvstcdlon
103 
104  character*200 gfnvmtcdlat,gfnvmtcdlon,gfnvmtcdeht,gfnvmtcdhor
105  character*200 gfnvstcdlat,gfnvstcdlon, gfnvstcdhor
106 
107  character*200 gfnvmdcdlat,gfnvmdcdlon,gfnvmdcdeht,gfnvmdcdhor
108  character*200 gfnvsdcdlat,gfnvsdcdlon, gfnvsdcdhor
109 
110 c - GMT stuff
111  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
112  real*4 jm(maxplots)
113  real*4 b1(maxplots),b2(maxplots)
114  character*10 fn(maxplots)
115 c - 2016 07 21:
116  logical lrv(maxplots)
117  real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
118 
119 c - Stuff that is in the work file records:
120  character*6 pid
121  character*2 state
122  character*1 rejlat,rejlon,rejeht
123  real*8 xlath,xlonh,xehth
124  real*8 dlatsec,dlonsec,dehtm,dhorsec,azhor
125  real*8 dlatm,dlonm,dhorm
126  character*10 olddtm,newdtm,region
127 c - Units to put on scale on GMT color plots
128  character*17 scunlat,scunlon,scuneht,scunhor
129  character*1 mapflag
130 
131 c - Plot/Scale stuff
132  real*8 lorvopc
133  real*8 lorvoghorm,lorvoghors
134  real*8 lorvogehtm
135 
136 
137 
138 c ------------------------------------------------------------------
139 c - BEGIN PROGRAM
140 c ------------------------------------------------------------------
141  write(6,1001)
142  1001 format('BEGIN program makeplotfiles02.f')
143 
144 c--------------------------------------------
145 c - Some necessary constants
146 c
147 c - "lorvopc" = Length of Reference Vector on Paper in **CM**
148 c - *** CRITICAL: The units of centimeters align with
149 c - the use, in .gmtdefaults4, of:
150 c - MEASURE_UNIT = cm
151 c - If you change that value, then the units of lorvopc
152 c - will be whatever you change it too, which may prove
153 c - displeasing.
154 c -
155 c - "csm" is the Color Sigma Multiplier...the
156 c - number of Standard Deviations away from
157 c - the average for the color palette to
158 c - span on color plots.
159 c--------------------------------------------
160  lorvopc = 1.d0
161  csm = 3.d0
162  pi = 2.d0*dasin(1.d0)
163  d2r = pi/180.d0
164  re = 6371000.d0
165  multiplierlorvog = 2
166 
167 c ------------------------------------------------------------------
168 c - User-supplied input
169 c ------------------------------------------------------------------
170  read(5,'(a)')olddtm
171  read(5,'(a)')newdtm
172  read(5,'(a)')region
173  read(5,'(a)')agridsec
174  read(5,'(a)')mapflag
175 
176 c ------------------------------------------------------------------
177 c - Generate the suffixes used in all our files
178 c ------------------------------------------------------------------
179  read(agridsec,*)igridsec
180  suffix1=trim(olddtm)//'.'//trim(newdtm)//'.'//trim(region)
181 
182  suffix2=trim(suffix1)//'.'//trim(agridsec)
183  suffix2t04=trim(suffix2)//'.04'
184  suffix2d3=trim(suffix2)//'.d3'
185 
186  suffix3=trim(suffix2)//'.'//trim(mapflag)
187 
188 c ------------------------------------------------------------------
189 c - LAZY CODING: Spin through work file, collecting stats
190 c - which we will use to scale the map and vectors, etc.
191 c ------------------------------------------------------------------
192 c ------------------------------------------------------------------
193 c - Open the work file
194 c ------------------------------------------------------------------
195  wfname='work.'//trim(suffix1)
196  open(1,file='Work/'//wfname,status='old',form='formatted')
197  write(6,1004)trim(wfname)
198  1004 format(6x,'makeplotfiles02.f: Opening work file ',a)
199 
200  ndhor = 0
201  ndeht = 0
202  avedhorm = 0.d0
203  avedhors = 0.d0
204  avedehtm = 0.d0
205  891 read(1,104,end=892)pid,state,rejlat,rejlon,rejeht,
206  *xlath,xlonh,xehth,
207  *dlatsec,dlonsec,dehtm,dhorsec,azhor,dlatm,dlonm,dhorm,
208  *olddtm,newdtm
209  if(rejlat.eq.' ' .and. rejlon.eq.' ')then
210  avedhorm = avedhorm + dhorm
211  avedhors = avedhors + dhorsec
212  ndhor = ndhor + 1
213  endif
214  if(rejeht.eq.' ')then
215 c - Because they can be +/-, we and this is JUST for scaling the map,
216 c - we want the average MAGNITUDE...use ABS.
217  avedehtm = avedehtm + dabs(dehtm)
218  ndeht = ndeht + 1
219  endif
220  goto 891
221  892 continue
222  if(ndhor .gt.0)then
223  avedhorm = avedhorm / dble(ndhor )
224  avedhors = avedhors / dble(ndhor )
225  else
226  avedhorm = 0.d0
227  avedhors = 0.d0
228  endif
229  if(ndeht .gt.0)then
230  avedehtm = avedehtm / dble(ndeht )
231  else
232  avedehtm = 0.d0
233  endif
234  write(6,893)ndhor ,avedhorm,avedhors,ndeht ,avedehtm
235  893 format(6x,'makeplotfiles02.f: Vector Stats: ',/,
236  *10x,'Number of Good Horizontal Vectors : ',i10,/,
237  *10x,'Average length (meters) : ',f10.3,/,
238  *10x,'Average length (arcseconds) : ',f10.6,/,
239  *10x,'Number of Good Ell. Ht. Vectors : ',i10,/,
240  *10x,'Average length (meters) : ',f10.3)
241  104 format(a6,1x,a2,a1,a1,a1,1x,f14.10,1x,f14.10,1x,f8.3,1x,
242  *f9.5,1x,f9.5,1x,f9.3,1x,f9.5,1x,f9.5,1x,f9.3,1x,f9.3,1x,f9.3,
243  *1x,a10,1x,a10)
244 c ------------------------------------------------------------------
245 c - END OF LAZY CODING
246 c ------------------------------------------------------------------
247 
248 
249 
250 c --------------------------------------------------------------
251 c - GMT Batch file: Determine Number of areas to plot (=nplots)
252 c - and Boundaries of plots and other stuff.
253 c - Report the information out.
254 c --------------------------------------------------------------
255 c - 2016 08 29:
256  call getmapbounds(mapflag,maxplots,region,nplots,
257  *olddtm,newdtm,
258  *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
259 
260 c - 2016 08 26, DRU-12, p.56-57
261 c call getmapbounds(mapflag,maxplots,region,nplots,
262 c *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
263 c - See DRU-11, p. 126 for choices on grid boundaries for NADCON v5.0
264 c - 2016 07 21:
265 c call getmapbounds(mapflag,maxplots,region,nplots,
266 c *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y)
267 c call getmapbounds(mapflag,maxplots,region,nplots,
268 c *bw,be,bs,bn,jm,b1,b2,fn)
269  write(6,1006)trim(region)
270  1006 format(6x,'makeplotfiles02.f: Calling getmapbounds for region ',a)
271 
272 
273 c ---------------------------------------------------------------
274 c - Compute and report various things about our coverage
275 c - and vector plots.
276 c ---------------------------------------------------------------
277 c - Reference vector set to length of the average
278 c - absolute value of horizontal or ell ht shift.
279 c - Note "gm2pc" = "ground meters to paper centimeters"
280 c - "gs2pc" = "ground arcseconds to paper centimeters"
281 c - "lorvog*s" = "length of reference vector on ground (element) in arcseconds"
282 c - "lorvog*m" = "length of reference vector on ground (element) in meters"
283 
284  if(ndhor.ne.0)then
285 c iqhorm = floor(log10(avedhorm))
286 c qqhorm = 10.d0**(iqhorm-1)
287 c lorvoghorm = MultiplierLorvog*qqhorm*nint(avedhorm/qqhorm)
288  lorvoghorm = onzd2(multiplierlorvog*avedhorm)
289  gm2pchor = lorvopc / lorvoghorm
290 
291 c iqhors = floor(log10(avedhors))
292 c qqhors = 10.d0**(iqhors-1)
293 c lorvoghors = MultiplierLorvog*qqhors*nint(avedhors/qqhors)
294  lorvoghors = onzd2(multiplierlorvog*avedhors)
295  gs2pchor = lorvopc / lorvoghors
296  endif
297 
298  if(ndeht.ne.0)then
299 c iqehtm = floor(log10(avedehtm))
300 c qqehtm = 10.d0**(iqehtm-1)
301 c lorvogehtm = MultiplierLorvog*qqehtm*nint(avedehtm/qqehtm)
302  lorvogehtm = onzd2(multiplierlorvog*avedehtm)
303  gm2pceht = lorvopc / lorvogehtm
304  endif
305 
306 c - Report:
307  write(6,894)nplots
308  894 format(6x,'makeplotfiles02.f: Info about plots:',/,
309  *8x,'Number of sub-region plot sets to cover this region: ',i2)
310 
311  do 895 i=1,nplots
312  dns = bn(i) - bs(i)
313  dew = be(i) - bw(i)
314  write(6,896)i,bs(i),bn(i),bw(i),be(i),dns,dew
315  if(ndhor .ne.0)then
316  write(6,897)lorvoghorm,lorvoghors,gm2pchor,gs2pchor
317  else
318  write(6,898)
319  endif
320 
321  if(ndeht .ne.0)then
322  write(6,899)lorvogehtm,gm2pceht
323  else
324  write(6,900)
325  endif
326 
327  895 continue
328 
329  896 format(
330  *8x,'Plot # ',i2,/,
331  *10x,'S/N/W/E/N-S/E-W = ',6f7.1)
332  897 format(
333  *10x,'Lat/Lon/Hor plots: ',/,
334  *12x,'Reference Vector ( m) = ',f10.2,/,
335  *12x,'Reference Vector ( s) = ',f10.6,/,
336  *12x,'Ground M to Paper cm = ',f20.10,/,
337  *12x,'Ground S to Paper cm = ',f20.10)
338  898 format(
339  *10x,'Lat/Lon/Hor plots: ',/,
340  *12x,'No horizontal data available for plotting')
341  899 format(
342  *10x,'Ell. Height plots: ',/,
343  *12x,'Reference Vector ( m) = ',f10.2,/,
344  *12x,'Ground M to Paper cm = ',f20.10)
345  900 format(
346  *10x,'Ell. Height plots: ',/,
347  *12x,'No ellipsoid height data available for plotting')
348 
349 c ------------------------------------------------------------------
350 c - pvlon and pvlat are the percentage of the total lon/lat
351 c - span of the plot, from which the reference vector
352 c - begins, starting with the Lower Left corner
353 c ------------------------------------------------------------------
354  pvlon = 10.d0
355  pvlat = 10.d0
356 
357  pvlat = (pvlat / 100.d0)
358  pvlon = (pvlon / 100.d0)
359 
360 
361 c ------------------------------------------------------------------
362 c - The output batch file full of all the GMT commands
363 c - needed to create the plots of interest
364 c ------------------------------------------------------------------
365  gmtfile = 'gmtbat03.'//trim(suffix3)
366  open(99,file=gmtfile,status='new',form='formatted')
367  write(6,1011)trim(gmtfile)
368  1011 format(6x,'makeplotfiles02.f: Creating GMT batch file ',a)
369  write(99,1030)trim(gmtfile)
370  1030 format('echo BEGIN batch file ',a)
371 
372 
373 
374 c ------------------------------------------------------------------
375 c - Because our color palette will depend upon the statistics of
376 c - our grids, we need to access those grids, and store a few
377 c - statistics.
378 c ------------------------------------------------------------------
379  bfnvmtcdlat = 'vmtcdlat.'//trim(suffix2t04)//'.b'
380  bfnvmtcdlon = 'vmtcdlon.'//trim(suffix2t04)//'.b'
381  bfnvmtcdeht = 'vmtcdeht.'//trim(suffix2t04)//'.b'
382  bfnvstcdlat = 'vstcdlat.'//trim(suffix2t04)//'.b'
383  bfnvstcdlon = 'vstcdlon.'//trim(suffix2t04)//'.b'
384 
385  sadbfnvmtcdlat = 'vmtcdlat.'//trim(suffix2d3)//'.b'
386  sadbfnvmtcdlon = 'vmtcdlon.'//trim(suffix2d3)//'.b'
387  sadbfnvmtcdeht = 'vmtcdeht.'//trim(suffix2d3)//'.b'
388  sadbfnvstcdlat = 'vstcdlat.'//trim(suffix2d3)//'.b'
389  sadbfnvstcdlon = 'vstcdlon.'//trim(suffix2d3)//'.b'
390 
391  gfnvmtcdlat = 'vmtcdlat.'//trim(suffix2)
392  gfnvmtcdlon = 'vmtcdlon.'//trim(suffix2)
393  gfnvmtcdeht = 'vmtcdeht.'//trim(suffix2)
394  gfnvmtcdhor = 'vmtcdhor.'//trim(suffix2)
395  gfnvstcdlat = 'vstcdlat.'//trim(suffix2)
396  gfnvstcdlon = 'vstcdlon.'//trim(suffix2)
397  gfnvstcdhor = 'vstcdhor.'//trim(suffix2)
398 
399  gfncvtcdlat = 'cvtcdlat.'//trim(suffix2)
400  gfncvtcdlon = 'cvtcdlon.'//trim(suffix2)
401  gfncvtcdeht = 'cvtcdeht.'//trim(suffix2)
402 
403  gfnvmdcdlat = 'vmdcdlat.'//trim(suffix2)
404  gfnvmdcdlon = 'vmdcdlon.'//trim(suffix2)
405  gfnvmdcdeht = 'vmdcdeht.'//trim(suffix2)
406  gfnvmdcdhor = 'vmdcdhor.'//trim(suffix2)
407  gfnvsdcdlat = 'vsdcdlat.'//trim(suffix2)
408  gfnvsdcdlon = 'vsdcdlon.'//trim(suffix2)
409  gfnvsdcdhor = 'vsdcdhor.'//trim(suffix2)
410 
411  gfncvdcdlat = 'cvdcdlat.'//trim(suffix2)
412  gfncvdcdlon = 'cvdcdlon.'//trim(suffix2)
413  gfncvdcdeht = 'cvdcdeht.'//trim(suffix2)
414 
415  call vecstats(gfnvmtcdhor,nthinhor)
416  call vecstats(gfnvmtcdeht,nthineht)
417 
418 c-------------------------------------
419 c - Stats of the TRANSFORMATION grids
420 c-------------------------------------
421 
422  if(nthinhor.ne.0)then
423  write(6,1012)trim(bfnvmtcdlat)
424  call gridstats(bfnvmtcdlat,ave,std,xmd)
425  avelatm = ave
426  stdlatm = std
427  write(6,1012)trim(bfnvmtcdlon)
428  call gridstats(bfnvmtcdlon,ave,std,xmd)
429  avelonm = ave
430  stdlonm = std
431 
432  write(6,1012)trim(bfnvstcdlat)
433  call gridstats(bfnvstcdlat,ave,std,xmd)
434  avelats = ave
435  stdlats = std
436  write(6,1012)trim(bfnvstcdlon)
437  call gridstats(bfnvstcdlon,ave,std,xmd)
438  avelons = ave
439  stdlons = std
440 
441 c - Get color palette, Lat, meters:
442  call cpt(avelatm,stdlatm,csm,cptlolatm,cpthilatm,cptinlatm)
443 
444 c - Get color palette, Lon, meters:
445  call cpt(avelonm,stdlonm,csm,cptlolonm,cpthilonm,cptinlonm)
446 
447 c - Get color palette, Lat, arcseconds:
448  call cpt(avelats,stdlats,csm,cptlolats,cpthilats,cptinlats)
449 
450 c - Get color palette, Lon, arcseconds:
451  call cpt(avelons,stdlons,csm,cptlolons,cpthilons,cptinlons)
452 
453  endif
454 
455  if(nthineht.ne.0)then
456  write(6,1012)trim(bfnvmtcdeht)
457  call gridstats(bfnvmtcdeht,ave,std,xmd)
458  aveehtm = ave
459  stdehtm = std
460 
461 c - Get color palette, Eht, meters:
462  call cpt(aveehtm,stdehtm,csm,cptloehtm,cpthiehtm,cptinehtm)
463 
464  endif
465 
466 
467 
468 c-------------------------------------
469 c - Stats of the METHOD NOISE ("d3") grids
470 c-------------------------------------
471  if(nthinhor.ne.0)then
472  write(6,1012)trim(sadbfnvmtcdlat)
473  call gridstats(sadbfnvmtcdlat,ave,std,xmd)
474  avelatmsad = ave
475  stdlatmsad = std
476  xmdlatmsad = xmd
477  write(6,1012)trim(sadbfnvmtcdlon)
478  call gridstats(sadbfnvmtcdlon,ave,std,xmd)
479  avelonmsad = ave
480  stdlonmsad = std
481  xmdlonmsad = xmd
482 
483  write(6,1012)trim(sadbfnvstcdlat)
484  call gridstats(sadbfnvstcdlat,ave,std,xmd)
485  avelatssad = ave
486  stdlatssad = std
487  xmdlatssad = xmd
488  write(6,1012)trim(sadbfnvstcdlon)
489  call gridstats(sadbfnvstcdlon,ave,std,xmd)
490  avelonssad = ave
491  stdlonssad = std
492  xmdlonssad = xmd
493 
494 c - Get color palette, Lat, meters:
495 c call cpt(avelatmsad,stdlatmsad,csm,
496 c * cptlolatmsad,cpthilatmsad,cptinlatmsad)
497 c cptlolatmsad = 0.d0
498 c - 2016 01 21:
499 c cpthilatmsad = 2 * csm * cptinlatmsad
500 c - 2016 07 28:
501  call cpt2(xmdlatmsad,2.d0,
502  * cptlolatmsad,cpthilatmsad,cptinlatmsad)
503 
504 
505 c - Get color palette, Lon, meters:
506 c call cpt(avelonmsad,stdlonmsad,csm,
507 c * cptlolonmsad,cpthilonmsad,cptinlonmsad)
508 c cptlolonmsad = 0.d0
509 c - 2016 01 21:
510 c cpthilonmsad = 2 * csm * cptinlonmsad
511 c - 2016 07 28:
512  call cpt2(xmdlonmsad,2.d0,
513  * cptlolonmsad,cpthilonmsad,cptinlonmsad)
514 
515 
516 c - Get color palette, Lat, arcseconds:
517 c call cpt(avelatssad,stdlatssad,csm,
518 c * cptlolatssad,cpthilatssad,cptinlatssad)
519 c cptlolatssad = 0.d0
520 c - 2016 01 21:
521 c cpthilatssad = 2 * csm * cptinlatssad
522 c - 2016 07 28:
523  call cpt2(xmdlatssad,2.d0,
524  * cptlolatssad,cpthilatssad,cptinlatssad)
525 
526 
527 c - Get color palette, Lon, arcseconds:
528 c call cpt(avelonssad,stdlonssad,csm,
529 c * cptlolonssad,cpthilonssad,cptinlonssad)
530 c cptlolonssad = 0.d0
531 c - 2016 01 21:
532 c cpthilonssad = 2 * csm * cptinlonssad
533 c - 2016 07 28:
534  call cpt2(xmdlonssad,2.d0,
535  * cptlolonssad,cpthilonssad,cptinlonssad)
536 
537  endif
538 
539  if(nthineht.ne.0)then
540  write(6,1012)trim(sadbfnvmtcdeht)
541  call gridstats(sadbfnvmtcdeht,ave,std,xmd)
542  aveehtmsad = ave
543  stdehtmsad = std
544  xmdehtmsad = xmd
545 
546 c - Get color palette, Eht, meters:
547 c call cpt(aveehtmsad,stdehtmsad,csm,
548 c * cptloehtmsad,cpthiehtmsad,cptinehtmsad)
549 c cptloehtmsad = 0.d0
550 c - 2016 01 21:
551 c cpthiehtmsad = 2 * csm * cptinehtmsad
552  call cpt2(xmdehtmsad,2.d0,
553  * cptloehtmsad,cpthiehtmsad,cptinehtmsad)
554 
555  endif
556 
557 
558 
559 
560 
561 
562 
563 
564 
565  1012 format(6x,'makeplotfiles02.f: Grabbing stats of grid: ',a)
566 
567 c ------------------------------------------------------------------
568 c ------------------------------------------------------------------
569 c ------------------------------------------------------------------
570 c - MAIN LOOP: Loop over number of sub-areas (nplots) I've chosen
571 c - for this region (see "getmapbounds.f" subroutine).
572 c ------------------------------------------------------------------
573 c ------------------------------------------------------------------
574 c ------------------------------------------------------------------
575  do 2001 ij=1,nplots
576  write(99,990)trim(region),trim(fn(ij)),
577  * trim(region),trim(fn(ij))
578 
579 c --------------------
580 c - B/W COVERAGE PLOTS
581 c --------------------
582 c - Make B/W Coverage Plots of Thinned data
583 c - Latitude
584  if(nthinhor.ne.0)
585  * call bwplotcv('lat',gfncvtcdlat,bw,be,bs,bn,jm,
586  * b1,b2,maxplots,olddtm,newdtm,region,'LAT',ij,
587  * igridsec,fn)
588 c - Longitude
589  if(nthinhor.ne.0)
590  * call bwplotcv('lon',gfncvtcdlon,bw,be,bs,bn,jm,
591  * b1,b2,maxplots,olddtm,newdtm,region,'LON',ij,
592  * igridsec,fn)
593 c - Ellipsoid Height
594  if(nthineht.ne.0)
595  * call bwplotcv('eht',gfncvtcdeht,bw,be,bs,bn,jm,
596  * b1,b2,maxplots,olddtm,newdtm,region,'EHT',ij,
597  * igridsec,fn)
598 
599 c - Make B/W Coverage Plots of Dropped data
600 c - Latitude
601  if(nthinhor.ne.0)
602  * call bwplotcv('lat',gfncvdcdlat,bw,be,bs,bn,jm,
603  * b1,b2,maxplots,olddtm,newdtm,region,'LAT',ij,
604  * igridsec,fn)
605 c - Longitude
606  if(nthinhor.ne.0)
607  * call bwplotcv('lon',gfncvdcdlon,bw,be,bs,bn,jm,
608  * b1,b2,maxplots,olddtm,newdtm,region,'LON',ij,
609  * igridsec,fn)
610 c - Ellipsoid Height
611  if(nthineht.ne.0)
612  * call bwplotcv('eht',gfncvdcdeht,bw,be,bs,bn,jm,
613  * b1,b2,maxplots,olddtm,newdtm,region,'EHT',ij,
614  * igridsec,fn)
615 
616 c ------------------
617 c - B/W VECTOR PLOTS
618 c ------------------
619 c - Where is the start of the reference vector:
620 c - 2016 07 29: Decided to scrap personalized locations
621 c - and just put all reference vectors outside/below
622 c - the plots
623 
624 c - 2016 08 26
625  xvlon = rv0x(ij)
626  xvlat = rv0y(ij)
627 
628  xllon = xvlon
629  xllat = rl0y(ij)
630 
631 c - 2016 07 21:
632 c if(lrv(ij))then
633 c xvlon = rv0x(ij)
634 c xvlat = rv0y(ij)
635 c else
636 cccc xvlon = bw(ij) + (pvlon*(be(ij)-bw(ij)))
637 c xvlat = bs(ij) + (pvlat*(bn(ij)-bs(ij)))
638 cccc xvlat = bs(ij) - (pvlat*(bn(ij)-bs(ij)))
639 c endif
640 c - Where is the start of the label for the ref vector:
641 cccc xllon = xvlon
642 c - To prevent the label from going off the page on
643 c - plots that have very little N/S span, put in a
644 c - failsafe
645 c - 2016 07 21:
646 c if(lrv(ij))then
647 c xllat = xvlat - 0.1d0
648 c else
649 cccc if(bn(ij)-bs(ij).lt.2.0)then
650 c xllat = bs(ij) + ((pvlat*0.75d0)*(bn(ij)-bs(ij)))
651 cccc xllat = bs(ij) - ((pvlat*1.25d0)*(bn(ij)-bs(ij)))
652 cccc else
653 c xllat = bs(ij) + (pvlat*(bn(ij)-bs(ij))) - 0.1d0
654 cccc xllat = bs(ij) - (pvlat*(bn(ij)-bs(ij))) - 0.1d0
655 cccc endif
656 c endif
657 
658 c - Make B/W Vector Plots of Thinned data
659 
660 c - Latitude
661  if(nthinhor.ne.0)then
662  call bwplotvc('lat',gfnvmtcdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
663  * olddtm,newdtm,region,'LAT',ij,xvlon,xvlat,xllon,xllat,
664  * lorvoghorm,lorvopc,igridsec,fn)
665  call bwplotvc('lat',gfnvstcdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
666  * olddtm,newdtm,region,'LAT',ij,xvlon,xvlat,xllon,xllat,
667  * lorvoghors,lorvopc,igridsec,fn)
668  endif
669 c - Longitude
670  if(nthinhor.ne.0)then
671  call bwplotvc('lon',gfnvmtcdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
672  * olddtm,newdtm,region,'LON',ij,xvlon,xvlat,xllon,xllat,
673  * lorvoghorm,lorvopc,igridsec,fn)
674  call bwplotvc('lon',gfnvstcdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
675  * olddtm,newdtm,region,'LON',ij,xvlon,xvlat,xllon,xllat,
676  * lorvoghors,lorvopc,igridsec,fn)
677  endif
678 c - Ellipsoid height
679  if(nthineht.ne.0)then
680  call bwplotvc('eht',gfnvmtcdeht,bw,be,bs,bn,jm,b1,b2,maxplots,
681  * olddtm,newdtm,region,'EHT',ij,xvlon,xvlat,xllon,xllat,
682  * lorvogehtm,lorvopc,igridsec,fn)
683  endif
684 c - Horizontal
685  if(nthinhor.ne.0)then
686  call bwplotvc('hor',gfnvmtcdhor,bw,be,bs,bn,jm,b1,b2,maxplots,
687  * olddtm,newdtm,region,'HOR',ij,xvlon,xvlat,xllon,xllat,
688  * lorvoghorm,lorvopc,igridsec,fn)
689  call bwplotvc('hor',gfnvstcdhor,bw,be,bs,bn,jm,b1,b2,maxplots,
690  * olddtm,newdtm,region,'HOR',ij,xvlon,xvlat,xllon,xllat,
691  * lorvoghors,lorvopc,igridsec,fn)
692  endif
693 
694 c - Make B/W Vector Plots of Dropped data
695 
696 c - Latitude
697  if(nthinhor.ne.0)then
698  call bwplotvc('lat',gfnvmdcdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
699  * olddtm,newdtm,region,'LAT',ij,xvlon,xvlat,xllon,xllat,
700  * lorvoghorm,lorvopc,igridsec,fn)
701  call bwplotvc('lat',gfnvsdcdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
702  * olddtm,newdtm,region,'LAT',ij,xvlon,xvlat,xllon,xllat,
703  * lorvoghors,lorvopc,igridsec,fn)
704  endif
705 c - Longitude
706  if(nthinhor.ne.0)then
707  call bwplotvc('lon',gfnvmdcdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
708  * olddtm,newdtm,region,'LON',ij,xvlon,xvlat,xllon,xllat,
709  * lorvoghorm,lorvopc,igridsec,fn)
710  call bwplotvc('lon',gfnvsdcdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
711  * olddtm,newdtm,region,'LON',ij,xvlon,xvlat,xllon,xllat,
712  * lorvoghors,lorvopc,igridsec,fn)
713  endif
714 c - Ellipsoid Height
715  if(nthineht.ne.0)then
716  call bwplotvc('eht',gfnvmdcdeht,bw,be,bs,bn,jm,b1,b2,maxplots,
717  * olddtm,newdtm,region,'EHT',ij,xvlon,xvlat,xllon,xllat,
718  * lorvogehtm,lorvopc,igridsec,fn)
719  endif
720 c - Horizontal
721  if(nthinhor.ne.0)then
722  call bwplotvc('hor',gfnvmdcdhor,bw,be,bs,bn,jm,b1,b2,maxplots,
723  * olddtm,newdtm,region,'HOR',ij,xvlon,xvlat,xllon,xllat,
724  * lorvoghorm,lorvopc,igridsec,fn)
725  call bwplotvc('hor',gfnvsdcdhor,bw,be,bs,bn,jm,b1,b2,maxplots,
726  * olddtm,newdtm,region,'HOR',ij,xvlon,xvlat,xllon,xllat,
727  * lorvoghors,lorvopc,igridsec,fn)
728  endif
729 
730 c --------------------
731 c - Color gridded data (Transformation grid)
732 c --------------------
733 c - Make color plots of gridded (T=0.4), thinned data, with no
734 c - points.
735 
736 c - Latitude
737  if(nthinhor.ne.0)then
738  call coplot('lat',bfnvmtcdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
739  * olddtm,newdtm,region,'LAT',ij,cptlolatm,cpthilatm,cptinlatm,
740  * suffix2t04,igridsec,fn)
741  call coplot('lat',bfnvstcdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
742  * olddtm,newdtm,region,'LAT',ij,cptlolats,cpthilats,cptinlats,
743  * suffix2t04,igridsec,fn)
744  endif
745 c - Longitude
746  if(nthinhor.ne.0)then
747  call coplot('lon',bfnvmtcdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
748  * olddtm,newdtm,region,'LON',ij,cptlolonm,cpthilonm,cptinlonm,
749  * suffix2t04,igridsec,fn)
750  call coplot('lon',bfnvstcdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
751  * olddtm,newdtm,region,'LON',ij,cptlolons,cpthilons,cptinlons,
752  * suffix2t04,igridsec,fn)
753  endif
754 c - Ellipsoid Height
755  if(nthineht.ne.0)then
756  call coplot('eht',bfnvmtcdeht,bw,be,bs,bn,jm,b1,b2,maxplots,
757  * olddtm,newdtm,region,'EHT',ij,cptloehtm,cpthiehtm,cptinehtm,
758  * suffix2t04,igridsec,fn)
759  endif
760 
761 c --------------------
762 c - Color gridded data ("method noise", AKA "d3" grid)
763 c --------------------
764 c - Make color plots of "method noise" *with* data overlain. See
765 c - DRU-11, p.150
766 
767 c - Latitude
768  if(nthinhor.ne.0)then
769  call coplotwcv('lat',sadbfnvmtcdlat,bw,be,bs,bn,jm,b1,b2,
770  * maxplots,olddtm,newdtm,region,'LAT',ij,cptlolatmsad,
771  * cpthilatmsad,cptinlatmsad,suffix2d3,igridsec,fn,
772  * gfncvtcdlat)
773 
774  call coplotwcv('lat',sadbfnvstcdlat,bw,be,bs,bn,jm,b1,b2,
775  * maxplots,olddtm,newdtm,region,'LAT',ij,cptlolatssad,
776  * cpthilatssad,cptinlatssad,suffix2d3,igridsec,fn,
777  * gfncvtcdlat)
778  endif
779 c - Longitude
780  if(nthinhor.ne.0)then
781  call coplotwcv('lon',sadbfnvmtcdlon,bw,be,bs,bn,jm,b1,b2,
782  * maxplots,olddtm,newdtm,region,'LON',ij,cptlolonmsad,
783  * cpthilonmsad,cptinlonmsad,suffix2d3,igridsec,fn,
784  * gfncvtcdlon)
785 
786  call coplotwcv('lon',sadbfnvstcdlon,bw,be,bs,bn,jm,b1,b2,
787  * maxplots,olddtm,newdtm,region,'LON',ij,cptlolonssad,
788  * cpthilonssad,cptinlonssad,suffix2d3,igridsec,fn,
789  * gfncvtcdlon)
790  endif
791 c - Ellipsoid Height
792  if(nthineht.ne.0)then
793  call coplotwcv('eht',sadbfnvmtcdeht,bw,be,bs,bn,jm,b1,b2,
794  * maxplots,olddtm,newdtm,region,'EHT',ij,cptloehtmsad,
795  * cpthiehtmsad,cptinehtmsad,suffix2d3,igridsec,fn,
796  * gfncvtcdeht)
797  endif
798 
799 
800  2001 continue
801 
802  990 format(
803  *'# ------------------------------',/,
804  *'# Plots for region: ',a,', sub-region: ',a,/,
805  *'# ------------------------------',/,
806  *'echo Creating plots for region: ',a,', sub-region: ',a)
807 
808  write(99,1031)trim(gmtfile)
809  1031 format('echo END batch file ',a)
810  close(99)
811 
812  write(6,9999)
813  9999 format('END program makeplotfiles02.f')
814 
815 
816  end
817 c
818 c ------------------------------------------------------
819 c
820  include 'Subs/bwplotvc.f'
821  include 'Subs/bwplotcv.f'
822  include 'Subs/coplot.f'
823  include 'Subs/coplotwcv.f'
824  include 'Subs/plotcoast.f'
825  include 'Subs/getmapbounds.f'
826  include 'Subs/getmag.f'
827  include 'Subs/cpt.f'
828  include 'Subs/select2_mod.for'
829  include 'Subs/cpt2.f'
830  include 'Subs/gridstats.f'
831  include 'Subs/vecstats.f'
subroutine coplotwcv(ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, cptlo, cpthi, cptin6, suffixused, igridsec, fn, cvfname)
Subroutine to make GMT calls to do a color raster rendering of gridded data, with coverage overlaid...
Definition: coplotwcv.f:72
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:37
subroutine cpt2(med, csm, xlo, xhi, xin)
This subroutine generates the color pallette variables for a GMT color plot.
Definition: cpt2.f:25
program makeplotfiles02
Part of the NADCON5 process, generates gmtbat03
real *8 function onzd2(x)
Function to round a digit to one significant figure (one non zero digit), double precision.
Definition: onzd2.f:36
subroutine coplot(ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, cptlo, cpthi, cptin6, suffixused, igridsec, fn)
Subroutine to make GMT calls to do Color Raster Rendering of Gridded Data.
Definition: coplot.f:74
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:77
subroutine gridstats(fname, ave, std, med)
Subroutine to print grid statistics to stdout.
Definition: gridstats.f:14
subroutine cpt(ave, std, csm, xlo, xhi, xin)
This subroutine generates the color pallette variables for a GMT color plot.
Definition: cpt.f:32
subroutine vecstats(fname, n)
Subroutine to tell us how many thinned vectors were used to make a grid.
Definition: vecstats.f:12
subroutine bwplotcv(ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, igridsec, fn)
Subroutine to make GMT calls to do a B/W coverage plot.
Definition: bwplotcv.f:30