NADCON5-ng  0.0.1
NADCON5 Next Generation
makeplotfiles03.f
Go to the documentation of this file.
1 c> \ingroup doers
2 c> Part of the NADCON5 process, generates `gmtbat06`
3 c>
4 c> Creates a batch file called
5 c>
6 c> gmtbat06.(olddtm).(newdtm).(region).(igridsec).(mapflag)
7 c>
8 c> That batch file will create JPGs of:
9 c> 1. Color Plots of the rddlat/rddlon/rddeht grids
10 c> 2. B/W plots of coverage of RMS'd differential vectors that went into the grid
11 c> 3. B/W plots of RMS'd differential vectors that went into the grid
12 c>
13 c> ### Program arguments
14 c> Arguments are newline terminated and read from standard input
15 c>
16 c> They are enumerated here
17 c> \param oldtm Source Datum
18 c> \param newdtm Target Datum,region
19 c> \param region Conversion Region
20 c> \param agridsec Grid Spacing in arcsec
21 c> \param mapflag Map Generation Level
22 c>
23 c> Example:
24 c>
25 c> olddatum = 'ussd'
26 c> newdatum = 'nad27'
27 c> region = 'conus'
28 c> agridsec = '900'
29 c> mapflag = '0'
30 c>
31 c> ### Program Inputs:
32 c>
33 c> ## Changelog
34 c>
35 c> ### 2016 10 19:
36 c> FIX for the HARN/FBN transformation. As it stood, the "gridstats" was
37 c> returning "0.0" as the median of the post-masked "ete" grid (which
38 c> is true, but unfortunate.) I've changed the call to "gridstats"
39 c> to send it the "PREMASKED" version of the "ete" grid, so the median
40 c> won't be zero.
41 c>
42 c> ### 2016 08 26
43 c> Added new code to do reference vectors consistently
44 c> See DRU-12, p. 56-57
45 c>
46 c> Fixed an error where "lorvogehtm" was declared real*8 but past 72 column,
47 c> so defaulting to integer*4 and coming out as "0.000" on plots
48 c>
49 c> Also changing the call to "getmapbounds" to give it "olddatum" and "newdatum"
50 c> to aide in filtering out things like the Saint regions in Alaska
51 c> for unsupported transformations.
52 c>
53 c> ### 2016 08 02:
54 c> Changed the color palette for "09" grids from 2xMedian to 3xMedian
55 c>
56 c> ### 2016 07 29:
57 c> Dropped code about personalized reference vectors and just
58 c> let them be below/outside map
59 c>
60 c> ### 2016 08 01:
61 c> Moved "gridstats" to subroutines
62 c> Also, completely removed the in-program computations of
63 c> the color palette, and instead relied on "cpt" and "cpt2"
64 c> as per "makeplotfiles02"
65 c>
66 c> ### 2016 07 21:
67 c> Added code to allow for optional placement of reference vectors, coming from
68 c> `map.parameters` as read in subroutine getmapbounds
69 c>
70 c> ### 2016 01 21:
71 c> Updated to fix the CPT for the "09" (data noise)
72 c> grids so that (cpthi - cptin) is exactly divisible by cptin
73 c>
74 c> ### 2015 11 09:
75 c> Updated to adopt new naming scheme (yes, again)
76 c> (See DRU-11, p. 150), as well as creating plots of the
77 c> total error grid.
78 c>
79 c> ### 2015 10 07:
80 c> Latest Version which had new naming scheme and
81 c> dual-computations of arcseconds and meters for lat/lon
82 c> See DRU-11, pl. 139.
83 c>
85  implicit real*8(a-h,o-z)
86  parameter(maxplots=60)
87 
88  character*35 fname0
89  character*34 dirnam
90  character*10 olddtm,newdtm,od,nd
91  character*2 state,stdum
92  character*3 ele,elelat,elelon,eleeht,ele0
93 
94  character*5 agridsec
95  integer*4 igridsec
96  character*200 suffix1,suffix2,suffix3
97  character*200 suffix2t09,suffix2d3
98  character*200 wfname,gmtfile
99 
100 c - ".b" of RMS'd double difference data
101  character*200 bfnvsrddlat,bfnvsrddlon,bfnvmrddeht
102  character*200 bfnvmrddlat,bfnvmrddlon
103 
104 c - "grd" of RMS'd double difference data
105  character*200 rfnvsrddlat,rfnvsrddlon,rfnvmrddeht
106  character*200 rfnvmrddlat,rfnvmrddlon
107 
108 c - "coverage" of RMS'd data (needs to be created in "myrms.f")
109  character*200 gfncvrddlat,gfncvrddlon,gfncvrddeht
110 
111 c - RMS'd double difference vectors
112  character*200 gfnvsrddlat,gfnvsrddlon,gfnvmrddeht
113  character*200 gfnvmrddlat,gfnvmrddlon
114 
115 c - "Method Noise" grids:
116  character*200 sadbfnvmtcdlat1000,sadbfnvmtcdlon1000
117  character*200 sadbfnvmtcdeht1000
118  character*200 sadbfnvstcdlat1000,sadbfnvstcdlon1000
119 
120 c -" Total Error" grids:
121  character*200 bfnvsetelat,bfnvsetelon
122  character*200 bfnvmetelat,bfnvmetelon
123  character*200 bfnvmeteeht
124 
125 c - 2016 10 19:
126 c - For the HARN/FBN situation *only*
127 c - "Total Error" grids, pre-mask:
128  character*200 bfnvsetelat0,bfnvsetelon0
129  character*200 bfnvmetelat0,bfnvmetelon0
130  character*200 bfnvmeteeht0
131 
132 
133 c - 2015 10 09:
134  character*200 gfnvsrddhor,gfnvmrddhor
135 
136 c - Stats file
137  character*200 sfn
138 
139 c - GMT stuff
140  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
141  real*4 jm(maxplots)
142  real*4 b1(maxplots),b2(maxplots)
143  character*10 fn(maxplots)
144 c - 2016 07 21:
145  logical lrv(maxplots)
146  real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
147 
148 
149 c - Stuff that is in the work file records:
150  character*6 pid
151  character*2 state
152  character*1 rejlat,rejlon,rejeht
153  real*8 xlath,xlonh,xehth
154  real*8 dlatsec,dlonsec,dehtm
155  real*8 dlatm,dlonm
156  character*10 olddtm,newdtm,region
157 c - Units to put on scale on GMT color plots
158  character*17 scunlat,scunlon,scuneht
159  character*1 mapflag
160 
161  real*8 lorvopc,lorvoglats,lorvoglatm,lorvoglons,lorvoglonm
162  real*8 lorvogehtm
163 c - 2015 10 09
164  real*8 lorvoghors,lorvoghorm
165 
166 c ------------------------------------------------------------------
167 c - BEGIN PROGRAM
168 c ------------------------------------------------------------------
169  write(6,1001)
170  1001 format('BEGIN program makeplotfiles03.f')
171 
172 c ------------------------------------------------------------------
173 c - User-supplied input
174 c ------------------------------------------------------------------
175  read(5,'(a)')olddtm
176  read(5,'(a)')newdtm
177  read(5,'(a)')region
178  read(5,'(a)')agridsec
179  read(5,'(a)')mapflag
180 
181 c ------------------------------------------------------------------
182 c - Some necessary constants
183 c ------------------------------------------------------------------
184  lorvopc = 1.d0
185  csm = 3.d0
186  pi = 2.d0*dasin(1.d0)
187  d2r = pi/180.d0
188  multiplierlorvog = 2
189 
190 c ------------------------------------------------------------------
191 c - Generate the suffixes used in all our files
192 c ------------------------------------------------------------------
193  read(agridsec,*)igridsec
194  suffix1=trim(olddtm)//'.'//trim(newdtm)//'.'//trim(region)
195  suffix2=trim(suffix1)//'.'//trim(agridsec)
196  suffix3=trim(suffix2)//'.'//trim(mapflag)
197 
198  suffix2d3=trim(suffix2)//'.d3'
199  suffix2t09=trim(suffix2)//'.09'
200 
201 c ------------------------------------------------------------------
202 c - Got clever here...I stored # of double differences and the RMS of those
203 c - vectors into "dvstats...." back in the running of "checkgrid.f".
204 c - Now let's re-acquire this data and use it to scale double differenced vectors
205 c - in this program. Granted, this won't be EXACTLY the same
206 c - as what is in the data (the RMS'd DD vectors are RMS'd in cells/bins,
207 c - but what is in "dvstats" is just an area-wide RMS value) but it's
208 c - good enough to scale things in the ballpark.
209 
210  sfn = 'dvstats.'//trim(suffix2)
211  open(1,file=sfn,status='old',form='formatted')
212  write(6,1004)
213  1004 format(6x,'makeplotfiles03.f: Acquiring vectors ',
214  *'stats from the dvstats file')
215 
216  read(1,*)nlat,rlats
217  read(1,*)nlon,rlons
218  read(1,*)neht,rehtm
219  read(1,*)nlat0,rlatm
220  read(1,*)nlon0,rlonm
221 c - 2015 10 09
222  read(1,*)nhor ,rhors
223  read(1,*)nhor0,rhorm
224 
225  if(nlat0.ne.nlat)stop 10001
226  if(nlon0.ne.nlon)stop 10002
227  if(nhor0.ne.nhor)stop 10003
228  if(nhor.ne.nlat)stop 10004
229  if(nhor.ne.nlon)stop 10005
230 
231  write(6,893)nlat,rlats,rlatm,
232  *nlon,rlons,rlonm,
233  *nhor,rhors,rhorm,
234  *neht,rehtm
235 
236  893 format(6x,'makeplotfiles03.f: Vector Stats: ',/,
237  *10x,'Number of Double Differenced Vectors in LAT: ',i10,/,
238  *10x,'RMS length (arcseconds) : ',f10.3,/,
239  *10x,'RMS length (meters) : ',f10.3,/,
240  *10x,'Number of Double Differenced Vectors in LON: ',i10,/,
241  *10x,'RMS length (arcseconds) : ',f10.3,/,
242  *10x,'RMS length (meters) : ',f10.3,/,
243  *10x,'Number of Double Differenced Vectors in HOR: ',i10,/,
244  *10x,'RMS length (arcseconds) : ',f10.3,/,
245  *10x,'RMS length (meters) : ',f10.3,/,
246  *10x,'Number of Double Differenced Vectors in EHT: ',i10,/,
247  *10x,'RMS length (arcseconds) : ',f10.3)
248 c ------------------------------------------------------------------
249 
250 
251 c --------------------------------------------------------------
252 c - GMT Batch file: Open the file
253 c --------------------------------------------------------------
254  gmtfile = 'gmtbat06.'//trim(suffix3)
255  open(99,file=gmtfile,status='new',form='formatted')
256  write(6,1011)trim(gmtfile)
257  1011 format(6x,'makeplotfiles03.f: Creating GMT batch file ',a)
258  write(99,1030)trim(gmtfile)
259  1030 format('echo BEGIN batch file ',a)
260 
261 
262 c - The "method noise" grids
263  sadbfnvmtcdlat1000 = 'vmtcdlat.'//trim(suffix2d3)//'.b'
264  sadbfnvstcdlat1000 = 'vstcdlat.'//trim(suffix2d3)//'.b'
265  sadbfnvmtcdlon1000 = 'vmtcdlon.'//trim(suffix2d3)//'.b'
266  sadbfnvstcdlon1000 = 'vstcdlon.'//trim(suffix2d3)//'.b'
267  sadbfnvmtcdeht1000 = 'vmtcdeht.'//trim(suffix2d3)//'.b'
268 
269 c - The "data noise" grids
270  bfnvsrddlat = 'vsrddlat.'//trim(suffix2t09)//'.b'
271  bfnvsrddlon = 'vsrddlon.'//trim(suffix2t09)//'.b'
272  bfnvmrddeht = 'vmrddeht.'//trim(suffix2t09)//'.b'
273  bfnvmrddlat = 'vmrddlat.'//trim(suffix2t09)//'.b'
274  bfnvmrddlon = 'vmrddlon.'//trim(suffix2t09)//'.b'
275 
276 c - The "total noise" grids
277  bfnvsetelat ='vsetelat.'//trim(suffix2)//'.b'
278  bfnvsetelon ='vsetelon.'//trim(suffix2)//'.b'
279  bfnvmetelat ='vmetelat.'//trim(suffix2)//'.b'
280  bfnvmetelon ='vmetelon.'//trim(suffix2)//'.b'
281  bfnvmeteeht ='vmeteeht.'//trim(suffix2)//'.b'
282 
283 c --------------------------------------------------------------
284 c - GMT Batch file: Get color palatte for the "total error"
285 c - grids. Keep this separate from the color palette for
286 c - the "data noise" grids.
287 c --------------------------------------------------------------
288 
289 c - 2016 08 01: All below changed to rely on "cpt2" for "ete" grids
290 
291  if(nlat.ne.0)then
292 
293 c - 2016 10 19
294 c - Lazy coding here: You can ONLY have "olddtm" = "nad83_harn" if
295 c - you also have "nad83_fbn" as "newdtm" and "conus"
296 c - as "region", so I won't bother checking all 3:
297  if(trim(olddtm).ne.'nad83_harn')then
298  write(6,1012)trim(bfnvmetelat)
299  call gridstats(bfnvmetelat,ave,std,xmd)
300  else
301  bfnvmetelat0 = trim(bfnvmetelat)//'.premask'
302  write(6,1012)trim(bfnvmetelat0)
303  call gridstats(bfnvmetelat0,ave,std,xmd)
304  endif
305 
306  avelatme = ave
307  stdlatme = std
308  xmdlatme = xmd
309  call cpt2(xmdlatme,2.d0,
310  * cptlolatme,cpthilatme,cptinlatme)
311 c cptinlatmE=onzd2(std)
312 c scaledave =onzd2(ave)
313 c cptlolatmE = 0.d0
314 c cpthilatmE = scaledave + csm*cptinlatmE
315 
316 
317 c - 2016 10 19
318 c - Lazy coding here: You can ONLY have "olddtm" = "nad83_harn" if
319 c - you also have "nad83_fbn" as "newdtm" and "conus"
320 c - as "region", so I won't bother checking all 3:
321  if(trim(olddtm).ne.'nad83_harn')then
322  write(6,1012)trim(bfnvsetelat)
323  call gridstats(bfnvsetelat,ave,std,xmd)
324  else
325  bfnvsetelat0 = trim(bfnvsetelat)//'.premask'
326  write(6,1012)trim(bfnvsetelat0)
327  call gridstats(bfnvsetelat0,ave,std,xmd)
328  endif
329 
330  avelatse = ave
331  stdlatse = std
332  xmdlatse = xmd
333  call cpt2(xmdlatse,2.d0,
334  * cptlolatse,cpthilatse,cptinlatse)
335 c cptinlatsE=onzd2(std)
336 c scaledave =onzd2(ave)
337 c cptlolatsE = 0.d0
338 c cpthilatsE = scaledave + csm*cptinlatsE
339  endif
340 
341  if(nlon.ne.0)then
342 
343 c - 2016 10 19
344 c - Lazy coding here: You can ONLY have "olddtm" = "nad83_harn" if
345 c - you also have "nad83_fbn" as "newdtm" and "conus"
346 c - as "region", so I won't bother checking all 3:
347  if(trim(olddtm).ne.'nad83_harn')then
348  write(6,1012)trim(bfnvmetelon)
349  call gridstats(bfnvmetelon,ave,std,xmd)
350  else
351  bfnvmetelon0 = trim(bfnvmetelon)//'.premask'
352  write(6,1012)trim(bfnvmetelon0)
353  call gridstats(bfnvmetelon0,ave,std,xmd)
354  endif
355 
356  avelonme = ave
357  stdlonme = std
358  xmdlonme = xmd
359  call cpt2(xmdlonme,2.d0,
360  * cptlolonme,cpthilonme,cptinlonme)
361 c cptinlonmE=onzd2(std)
362 c scaledave =onzd2(ave)
363 c cptlolonmE = 0.d0
364 c cpthilonmE = scaledave + csm*cptinlonmE
365 
366 c - 2016 10 19
367 c - Lazy coding here: You can ONLY have "olddtm" = "nad83_harn" if
368 c - you also have "nad83_fbn" as "newdtm" and "conus"
369 c - as "region", so I won't bother checking all 3:
370  if(trim(olddtm).ne.'nad83_harn')then
371  write(6,1012)trim(bfnvsetelon)
372  call gridstats(bfnvsetelon,ave,std,xmd)
373  else
374  bfnvsetelon0 = trim(bfnvsetelon)//'.premask'
375  write(6,1012)trim(bfnvsetelon0)
376  call gridstats(bfnvsetelon0,ave,std,xmd)
377  endif
378 
379  avelonse = ave
380  stdlonse = std
381  xmdlonse = xmd
382  call cpt2(xmdlonse,2.d0,
383  * cptlolonse,cpthilonse,cptinlonse)
384 c cptinlonsE=onzd2(std)
385 c scaledave =onzd2(ave)
386 c cptlolonsE = 0.d0
387 c cpthilonsE = scaledave + csm*cptinlonsE
388  endif
389 
390  if(neht.ne.0)then
391 
392 c - 2016 10 19
393 c - Lazy coding here: You can ONLY have "olddtm" = "nad83_harn" if
394 c - you also have "nad83_fbn" as "newdtm" and "conus"
395 c - as "region", so I won't bother checking all 3:
396  if(trim(olddtm).ne.'nad83_harn')then
397  write(6,1012)trim(bfnvmeteeht)
398  call gridstats(bfnvmeteeht,ave,std,xmd)
399  else
400  bfnvmeteeht0 = trim(bfnvmeteeht)//'.premask'
401  write(6,1012)trim(bfnvmeteeht0)
402  call gridstats(bfnvmeteeht0,ave,std,xmd)
403  endif
404 
405  aveehtme = ave
406  stdehtme = std
407  xmdehtme = xmd
408  call cpt2(xmdehtme,2.d0,
409  * cptloehtme,cpthiehtme,cptinehtme)
410 c cptinehtmE=onzd2(std)
411 c scaledave =onzd2(ave)
412 c cptloehtmE = 0.d0
413 c cpthiehtmE = scaledave + csm*cptinehtmE
414  endif
415 
416 
417 c --------------------------------------------------------------
418 c - GMT Batch file: Determine Number of areas to plot (=nplots)
419 c - and Boundaries of plots and other stuff.
420 c - Report the information out.
421 c --------------------------------------------------------------
422 c - 2016 08 29:
423  call getmapbounds(mapflag,maxplots,region,nplots,
424  *olddtm,newdtm,
425  *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
426 
427 
428 c - 2016 08 26, DRU-12, p.56-57
429 c call getmapbounds(mapflag,maxplots,region,nplots,
430 c *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
431 c - See DRU-11, p. 126 for choices on grid boundaries for NADCON v5.0
432 c - 2016 07 21
433 c call getmapbounds(mapflag,maxplots,region,nplots,
434 c *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y)
435 c call getmapbounds(mapflag,maxplots,region,nplots,
436 c *bw,be,bs,bn,jm,b1,b2,fn)
437  write(6,1006)trim(region)
438  1006 format(6x,'makeplotfiles03.f: Calling getmapbounds for region ',a)
439 
440 c ---------------------------------------------------------------
441 c - Compute and report various things about our coverage
442 c - and vector plots.
443 c ---------------------------------------------------------------
444 c - How many centimeters long will our reference arrows be?
445 c - Base this on the actual data
446 
447  if(nlat.ne.0)then
448 c iqlats = floor(log10(rlats))
449 c qqlats = 10.d0**(iqlats-1)
450 c lorvoglats = MultiplierLorvog*qqlats*nint(rlats/qqlats)
451  lorvoglats = onzd2(multiplierlorvog*rlats)
452  gs2pclat = lorvopc / lorvoglats
453 
454 c iqlatm = floor(log10(rlatm))
455 c qqlatm = 10.d0**(iqlatm-1)
456 c lorvoglatm = MultiplierLorvog*qqlatm*nint(rlatm/qqlatm)
457  lorvoglatm = onzd2(multiplierlorvog*rlatm)
458  gm2pclat = lorvopc / lorvoglatm
459  endif
460 
461  if(nlon.ne.0)then
462 c iqlons = floor(log10(rlons))
463 c qqlons = 10.d0**(iqlons-1)
464 c lorvoglons = MultiplierLorvog*qqlons*nint(rlons/qqlons)
465  lorvoglons = onzd2(multiplierlorvog*rlons)
466  gs2pclon = lorvopc / lorvoglons
467 
468 c iqlonm = floor(log10(rlonm))
469 c qqlonm = 10.d0**(iqlonm-1)
470 c lorvoglonm = MultiplierLorvog*qqlonm*nint(rlonm/qqlonm)
471  lorvoglonm = onzd2(multiplierlorvog*rlonm)
472  gm2pclon = lorvopc / lorvoglonm
473  endif
474 
475  if(neht.ne.0)then
476 c iqehtm = floor(log10(rehtm))
477 c qqehtm = 10.d0**(iqehtm-1)
478 c lorvogehtm = MultiplierLorvog*qqehtm*nint(rehtm/qqehtm)
479  lorvogehtm = onzd2(multiplierlorvog*rehtm)
480  gm2pceht = lorvopc / lorvogehtm
481  endif
482 
483  if(nlon.ne.0 .and. nlat.ne.0)then
484 c iqhors = floor(log10(rhors))
485 c qqhors = 10.d0**(iqhors-1)
486 c lorvoghors = MultiplierLorvog*qqhors*nint(rhors/qqhors)
487  lorvoghors = onzd2(multiplierlorvog*rhors)
488  gs2pchor = lorvopc / lorvoghors
489 
490 c iqhorm = floor(log10(rhorm))
491 c qqhorm = 10.d0**(iqhorm-1)
492 c lorvoghorm = MultiplierLorvog*qqhorm*nint(rhorm/qqhorm)
493  lorvoghorm = onzd2(multiplierlorvog*rhorm)
494  gm2pchor = lorvopc / lorvoghorm
495  endif
496 
497 
498 c - Report:
499  write(6,894)nplots
500  894 format(6x,'makeplotfiles03.f: Info about plots:',/,
501  *8x,'Number of sub-area plot sets to cover this region: ',i2)
502 
503  do 895 i=1,nplots
504  dns = bn(i) - bs(i)
505  dew = be(i) - bw(i)
506  write(6,896)i,bs(i),bn(i),bw(i),be(i),dns,dew
507 
508  if(nlat.ne.0)then
509  write(6,897)'lat',lorvoglatm,lorvoglats,gm2pclat,gs2pclat
510  else
511  write(6,898)'lat'
512  endif
513 
514  if(nlon.ne.0)then
515  write(6,897)'lon',lorvoglonm,lorvoglons,gm2pclon,gs2pclon
516  else
517  write(6,898)'lon'
518  endif
519 
520  if(neht.ne.0)then
521  write(6,899)'eht',lorvogehtm,gm2pceht
522  else
523  write(6,898)'eht'
524  endif
525 
526  if(nlat.ne.0 .and. nlon.ne.0)then
527  write(6,897)'hor',lorvoghorm,lorvoghors,gm2pchor,gs2pchor
528  else
529  write(6,898)'hor'
530  endif
531 
532  895 continue
533 
534  896 format(
535  *8x,'Plot # ',i2,/,
536  *10x,'S/N/W/E/N-S/E-W = ',6f7.1)
537  897 format(
538  *10x,a3,' plots',13x,':',/,
539  *12x,'Reference Vector ( m) = ',f10.2,/,
540  *12x,'Reference Vector ( s) = ',f10.6,/,
541  *12x,'Ground M to Paper cm = ',f20.10,/,
542  *12x,'Ground S to Paper cm = ',f20.10)
543  899 format(
544  *10x,a3,' plots',13x,':',/,
545  *12x,'Reference Vector ( m) = ',f10.2,/,
546  *12x,'Ground M to Paper cm = ',f20.10)
547  898 format(
548  *10x,a3,' plots: No data available for plotting')
549 
550 c ------------------------------------------------------------------
551 c - pvlon and pvlat are the percentage of the total lon/lat
552 c - span of the plot, from which the reference vector
553 c - begins, starting with the Lower Left corner
554 c ------------------------------------------------------------------
555  pvlon = 10.d0
556  pvlat = 10.d0
557 
558  pvlat = (pvlat / 100.d0)
559  pvlon = (pvlon / 100.d0)
560 
561 
562 c --------------------------------------------------------------
563 c - GMT Batch file: Get color palatte for the "data noise", aka "09"
564 c - grids.
565 c --------------------------------------------------------------
566 c ------------------------------------------------------------------
567 c - Because our color palette will depend upon the statistics of
568 c - our grids, we need to access those grids, and store a few
569 c - statistics.
570 c ------------------------------------------------------------------
571  rfnvsrddlat = 'vsrddlat.'//trim(suffix2t09)//'.grd'
572  rfnvsrddlon = 'vsrddlon.'//trim(suffix2t09)//'.grd'
573  rfnvmrddeht = 'vmrddeht.'//trim(suffix2t09)//'.grd'
574  rfnvmrddlat = 'vmrddlat.'//trim(suffix2t09)//'.grd'
575  rfnvmrddlon = 'vmrddlon.'//trim(suffix2t09)//'.grd'
576 
577  gfnvsrddlat = 'vsrddlat.'//trim(suffix2)
578  gfnvsrddlon = 'vsrddlon.'//trim(suffix2)
579  gfnvmrddeht = 'vmrddeht.'//trim(suffix2)
580  gfnvmrddlat = 'vmrddlat.'//trim(suffix2)
581  gfnvmrddlon = 'vmrddlon.'//trim(suffix2)
582  gfnvsrddhor = 'vsrddhor.'//trim(suffix2)
583  gfnvmrddhor = 'vmrddhor.'//trim(suffix2)
584 
585  gfncvrddlat = 'cvrddlat.'//trim(suffix2)
586  gfncvrddlon = 'cvrddlon.'//trim(suffix2)
587  gfncvrddeht = 'cvrddeht.'//trim(suffix2)
588 
589 c - NOTE ON COLOR PALLETTES, BELOW:
590 c - Because all of the differential vectors are RMS'd values at
591 c - this point, they will have a minimum value of zero. As such,
592 c - set the "cptlo" values to zero.
593 
594 c - 2016 08 01: Changed to use "cpt2" for "09" (RMS) grids
595 c - 2016 08 02: Changed the multiplier in the 09 grids from 2 to 3
596 
597  if(nlat.ne.0)then
598  write(6,1012)trim(bfnvsrddlat)
599  call gridstats(bfnvsrddlat,ave,std,xmd)
600  avelats = ave
601  stdlats = std
602  xmdlats = xmd
603  call cpt2(xmdlats,3.d0,
604  * cptlolats,cpthilats,cptinlats)
605 
606  write(6,1012)trim(bfnvmrddlat)
607  call gridstats(bfnvmrddlat,ave,std,xmd)
608  avelatm = ave
609  stdlatm = std
610  xmdlatm = xmd
611  call cpt2(xmdlatm,3.d0,
612  * cptlolatm,cpthilatm,cptinlatm)
613 
614  endif
615 
616  if(nlon.ne.0)then
617  write(6,1012)trim(bfnvsrddlon)
618  call gridstats(bfnvsrddlon,ave,std,xmd)
619  avelons = ave
620  stdlons = std
621  xmdlons = xmd
622  call cpt2(xmdlons,3.d0,
623  * cptlolons,cpthilons,cptinlons)
624 
625  write(6,1012)trim(bfnvmrddlon)
626  call gridstats(bfnvmrddlon,ave,std,xmd)
627  avelonm = ave
628  stdlonm = std
629  xmdlonm = xmd
630  call cpt2(xmdlonm,3.d0,
631  * cptlolonm,cpthilonm,cptinlonm)
632 
633  endif
634 
635  if(neht.ne.0)then
636  write(6,1012)trim(bfnvmrddeht)
637  call gridstats(bfnvmrddeht,ave,std,xmd)
638  aveehtm = ave
639  stdehtm = std
640  xmdehtm = xmd
641  call cpt2(xmdehtm,3.d0,
642  * cptloehtm,cpthiehtm,cptinehtm)
643 
644  endif
645 
646 
647  1012 format(6x,'makeplotfiles03.f: Grabbing stats of grid: ',a)
648 
649 c ------------------------------------------------------------------
650 c ------------------------------------------------------------------
651 c ------------------------------------------------------------------
652 c - MAIN LOOP: Loop over number of sub-areas (nplots) I've chosen
653 c - for this region (see "getmapbounds.f" subroutine).
654 c ------------------------------------------------------------------
655 c ------------------------------------------------------------------
656 c ------------------------------------------------------------------
657  do 2001 ij=1,nplots
658  write(99,990)trim(region),trim(fn(ij)),
659  * trim(region),trim(fn(ij))
660 
661 c --------------------
662 c - B/W COVERAGE PLOTS
663 c --------------------
664 c - Make B/W Coverage Plots of RMS'd data
665 c - Latitude
666  if(nlat.ne.0)
667  * call bwplotcv('lat',gfncvrddlat,bw,be,bs,bn,jm,
668  * b1,b2,maxplots,olddtm,newdtm,region,'LAT',ij,
669  * igridsec,fn)
670 c - Longitude
671  if(nlon.ne.0)
672  * call bwplotcv('lon',gfncvrddlon,bw,be,bs,bn,jm,
673  * b1,b2,maxplots,olddtm,newdtm,region,'LON',ij,
674  * igridsec,fn)
675 c - Ellipsoid Height
676  if(neht.ne.0)
677  * call bwplotcv('eht',gfncvrddeht,bw,be,bs,bn,jm,
678  * b1,b2,maxplots,olddtm,newdtm,region,'EHT',ij,
679  * igridsec,fn)
680 
681 c ------------------
682 c - B/W VECTOR PLOTS
683 c ------------------
684 c - Where is the start of the reference vector:
685 c - 2016 07 29: Decided to scrap personalized locations
686 c - and just put all reference vectors outside/below
687 c - the plots
688 
689 c - 2016 08 26
690  xvlon = rv0x(ij)
691  xvlat = rv0y(ij)
692 
693  xllon = xvlon
694  xllat = rl0y(ij)
695 
696 c - 2016 07 21:
697 c if(lrv(ij))then
698 c xvlon = rv0x(ij)
699 c xvlat = rv0y(ij)
700 c else
701 cccc xvlon = bw(ij) + (pvlon*(be(ij)-bw(ij)))
702 c xvlat = bs(ij) + (pvlat*(bn(ij)-bs(ij)))
703 cccc xvlat = bs(ij) - (pvlat*(bn(ij)-bs(ij)))
704 c endif
705 c - Where is the start of the label for the ref vector:
706 cccc xllon = xvlon
707 c - To prevent the label from going off the page on
708 c - plots that have very little N/S span, put in a
709 c - failsafe
710 c if(lrv(ij))then
711 c xllat = xvlat - 0.1d0
712 c else
713 cccc if(bn(ij)-bs(ij).lt.2.0)then
714 c xllat = bs(ij) + ((pvlat*0.75d0)*(bn(ij)-bs(ij)))
715 cccc xllat = bs(ij) - ((pvlat*1.25d0)*(bn(ij)-bs(ij)))
716 cccc else
717 c xllat = bs(ij) + (pvlat*(bn(ij)-bs(ij))) - 0.1d0
718 cccc xllat = bs(ij) - (pvlat*(bn(ij)-bs(ij))) - 0.1d0
719 cccc endif
720 c endif
721 
722 c - Make B/W Vector Plots of RMS'd data
723 
724 c - Latitude
725  if(nlat.ne.0)then
726  call bwplotvc('lat',gfnvsrddlat,bw,be,bs,bn,jm,b1,b2,maxplots,
727  * olddtm,newdtm,region,'LAT',ij,xvlon,xvlat,xllon,xllat,
728  * lorvoglats,lorvopc,igridsec,fn)
729  call bwplotvc('lat',gfnvmrddlat,bw,be,bs,bn,jm,b1,b2,maxplots,
730  * olddtm,newdtm,region,'LAT',ij,xvlon,xvlat,xllon,xllat,
731  * lorvoglatm,lorvopc,igridsec,fn)
732  endif
733 c - Longitude
734  if(nlon.ne.0)then
735  call bwplotvc('lon',gfnvsrddlon,bw,be,bs,bn,jm,b1,b2,maxplots,
736  * olddtm,newdtm,region,'LON',ij,xvlon,xvlat,xllon,xllat,
737  * lorvoglons,lorvopc,igridsec,fn)
738  call bwplotvc('lon',gfnvmrddlon,bw,be,bs,bn,jm,b1,b2,maxplots,
739  * olddtm,newdtm,region,'LON',ij,xvlon,xvlat,xllon,xllat,
740  * lorvoglonm,lorvopc,igridsec,fn)
741  endif
742 c - Ellipsoid height
743  if(neht.ne.0)then
744  call bwplotvc('eht',gfnvmrddeht,bw,be,bs,bn,jm,b1,b2,maxplots,
745  * olddtm,newdtm,region,'EHT',ij,xvlon,xvlat,xllon,xllat,
746  * lorvogehtm,lorvopc,igridsec,fn)
747  endif
748 c - Horizontal
749  if(nlon.ne.0 .and. nlat.ne.0)then
750  call bwplotvc('hor',gfnvsrddhor,bw,be,bs,bn,jm,b1,b2,maxplots,
751  * olddtm,newdtm,region,'HOR',ij,xvlon,xvlat,xllon,xllat,
752  * lorvoghors,lorvopc,igridsec,fn)
753  call bwplotvc('hor',gfnvmrddhor,bw,be,bs,bn,jm,b1,b2,maxplots,
754  * olddtm,newdtm,region,'HOR',ij,xvlon,xvlat,xllon,xllat,
755  * lorvoghorm,lorvopc,igridsec,fn)
756  endif
757 
758 c ------------------------------------------------
759 c - Color gridded data of RMS grids ("data noise")
760 c ------------------------------------------------
761 c - Make color plots of gridded, RMS'd data, with no
762 c - points.
763 
764  write(99,3101)
765  3101 format('echo Color Plots of RMS data...')
766 c - Latitude
767  if(nlat.ne.0)then
768  call coplot('lat',bfnvsrddlat,bw,be,bs,bn,jm,b1,b2,maxplots,
769  * olddtm,newdtm,region,'LAT',ij,cptlolats,cpthilats,cptinlats,
770  * suffix2t09,igridsec,fn)
771  call coplot('lat',bfnvmrddlat,bw,be,bs,bn,jm,b1,b2,maxplots,
772  * olddtm,newdtm,region,'LAT',ij,cptlolatm,cpthilatm,cptinlatm,
773  * suffix2t09,igridsec,fn)
774  endif
775 c - Longitude
776  if(nlon.ne.0)then
777  call coplot('lon',bfnvsrddlon,bw,be,bs,bn,jm,b1,b2,maxplots,
778  * olddtm,newdtm,region,'LON',ij,cptlolons,cpthilons,cptinlons,
779  * suffix2t09,igridsec,fn)
780  call coplot('lon',bfnvmrddlon,bw,be,bs,bn,jm,b1,b2,maxplots,
781  * olddtm,newdtm,region,'LON',ij,cptlolonm,cpthilonm,cptinlonm,
782  * suffix2t09,igridsec,fn)
783  endif
784 c - Ellipsoid Height
785  if(neht.ne.0)then
786  call coplot('eht',bfnvmrddeht,bw,be,bs,bn,jm,b1,b2,maxplots,
787  * olddtm,newdtm,region,'EHT',ij,cptloehtm,cpthiehtm,cptinehtm,
788  * suffix2t09,igridsec,fn)
789  endif
790 
791 c ------------------------------------------------
792 c - Color gridded data of "Total Error" grids
793 c ------------------------------------------------
794 
795  write(99,3102)
796  3102 format('echo Color Plots of Total Error grids...')
797 c - Latitude
798  if(nlat.ne.0)then
799  call coplot('lat',bfnvsetelat,bw,be,bs,bn,jm,b1,b2,maxplots,
800  * olddtm,newdtm,region,'LAT',ij,cptlolatse,cpthilatse,
801  * cptinlatse,
802  * suffix2,igridsec,fn)
803  call coplot('lat',bfnvmetelat,bw,be,bs,bn,jm,b1,b2,maxplots,
804  * olddtm,newdtm,region,'LAT',ij,cptlolatme,cpthilatme,
805  * cptinlatme,
806  * suffix2,igridsec,fn)
807  endif
808 c - Longitude
809  if(nlon.ne.0)then
810  call coplot('lon',bfnvsetelon,bw,be,bs,bn,jm,b1,b2,maxplots,
811  * olddtm,newdtm,region,'LON',ij,cptlolonse,cpthilonse,
812  * cptinlonse,
813  * suffix2,igridsec,fn)
814  call coplot('lon',bfnvmetelon,bw,be,bs,bn,jm,b1,b2,maxplots,
815  * olddtm,newdtm,region,'LON',ij,cptlolonme,cpthilonme,
816  * cptinlonme,
817  * suffix2,igridsec,fn)
818  endif
819 c - Ellipsoid Height
820  if(neht.ne.0)then
821  call coplot('eht',bfnvmeteeht,bw,be,bs,bn,jm,b1,b2,maxplots,
822  * olddtm,newdtm,region,'EHT',ij,cptloehtme,cpthiehtme,
823  * cptinehtme,
824  * suffix2,igridsec,fn)
825  endif
826 
827  2001 continue
828  990 format(
829  *'# ------------------------------',/,
830  *'# Plots for region: ',a,', sub-region: ',a,/,
831  *'# ------------------------------',/,
832  *'echo Creating plots for region: ',a,', sub-region: ',a)
833 
834  write(99,1031)trim(gmtfile)
835  1031 format('echo END batch file ',a)
836  close(99)
837 
838  write(6,9999)
839  9999 format('END program makeplotfiles03.f')
840 
841  end
842 c
843 c ----------------------------------------------------
844 c
845  include 'Subs/getmapbounds.f'
846  include 'Subs/getmag.f'
847  include 'Subs/coplot.f'
848  include 'Subs/bwplotvc.f'
849  include 'Subs/bwplotcv.f'
850  include 'Subs/plotcoast.f'
851  include 'Subs/onzd2.f'
852  include 'Subs/gridstats.f'
853  include 'Subs/cpt2.f'
854  include 'Subs/select2_mod.for'
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 cpt2(med, csm, xlo, xhi, xin)
This subroutine generates the color pallette variables for a GMT color plot.
Definition: cpt2.f:21
program makeplotfiles03
Part of the NADCON5 process, generates gmtbat06
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 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:70
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 gridstats(fname, ave, std, med)
Subroutine to print grid statistics to stdout.
Definition: gridstats.f:10
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:26