85 implicit real*8(a-h,o-z)
86 parameter(maxplots=60)
90 character*10 olddtm,newdtm,od,nd
91 character*2 state,stdum
92 character*3 ele,elelat,elelon,eleeht,ele0
96 character*200 suffix1,suffix2,suffix3
97 character*200 suffix2t09,suffix2d3
98 character*200 wfname,gmtfile
101 character*200 bfnvsrddlat,bfnvsrddlon,bfnvmrddeht
102 character*200 bfnvmrddlat,bfnvmrddlon
105 character*200 rfnvsrddlat,rfnvsrddlon,rfnvmrddeht
106 character*200 rfnvmrddlat,rfnvmrddlon
109 character*200 gfncvrddlat,gfncvrddlon,gfncvrddeht
112 character*200 gfnvsrddlat,gfnvsrddlon,gfnvmrddeht
113 character*200 gfnvmrddlat,gfnvmrddlon
116 character*200 sadbfnvmtcdlat1000,sadbfnvmtcdlon1000
117 character*200 sadbfnvmtcdeht1000
118 character*200 sadbfnvstcdlat1000,sadbfnvstcdlon1000
121 character*200 bfnvsetelat,bfnvsetelon
122 character*200 bfnvmetelat,bfnvmetelon
123 character*200 bfnvmeteeht
128 character*200 bfnvsetelat0,bfnvsetelon0
129 character*200 bfnvmetelat0,bfnvmetelon0
130 character*200 bfnvmeteeht0
134 character*200 gfnvsrddhor,gfnvmrddhor
140 real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
142 real*4 b1(maxplots),b2(maxplots)
143 character*10 fn(maxplots)
145 logical lrv(maxplots)
146 real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
152 character*1 rejlat,rejlon,rejeht
153 real*8 xlath,xlonh,xehth
154 real*8 dlatsec,dlonsec,dehtm
156 character*10 olddtm,newdtm,region
158 character*17 scunlat,scunlon,scuneht
161 real*8 lorvopc,lorvoglats,lorvoglatm,lorvoglons,lorvoglonm
164 real*8 lorvoghors,lorvoghorm
170 1001
format(
'BEGIN program makeplotfiles03.f')
178 read(5,
'(a)')agridsec
186 pi = 2.d0*dasin(1.d0)
193 read(agridsec,*)igridsec
194 suffix1=trim(olddtm)//
'.'//trim(newdtm)//
'.'//trim(region)
195 suffix2=trim(suffix1)//
'.'//trim(agridsec)
196 suffix3=trim(suffix2)//
'.'//trim(mapflag)
198 suffix2d3=trim(suffix2)//
'.d3' 199 suffix2t09=trim(suffix2)//
'.09' 210 sfn =
'dvstats.'//trim(suffix2)
211 open(1,file=sfn,status=
'old',form=
'formatted')
213 1004
format(6x,
'makeplotfiles03.f: Acquiring vectors ',
214 *
'stats from the dvstats file')
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
231 write(6,893)nlat,rlats,rlatm,
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)
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)
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' 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' 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' 297 if(trim(olddtm).ne.
'nad83_harn')
then 298 write(6,1012)trim(bfnvmetelat)
301 bfnvmetelat0 = trim(bfnvmetelat)//
'.premask' 302 write(6,1012)trim(bfnvmetelat0)
309 call cpt2(xmdlatme,2.d0,
310 * cptlolatme,cpthilatme,cptinlatme)
321 if(trim(olddtm).ne.
'nad83_harn')
then 322 write(6,1012)trim(bfnvsetelat)
325 bfnvsetelat0 = trim(bfnvsetelat)//
'.premask' 326 write(6,1012)trim(bfnvsetelat0)
333 call cpt2(xmdlatse,2.d0,
334 * cptlolatse,cpthilatse,cptinlatse)
347 if(trim(olddtm).ne.
'nad83_harn')
then 348 write(6,1012)trim(bfnvmetelon)
351 bfnvmetelon0 = trim(bfnvmetelon)//
'.premask' 352 write(6,1012)trim(bfnvmetelon0)
359 call cpt2(xmdlonme,2.d0,
360 * cptlolonme,cpthilonme,cptinlonme)
370 if(trim(olddtm).ne.
'nad83_harn')
then 371 write(6,1012)trim(bfnvsetelon)
374 bfnvsetelon0 = trim(bfnvsetelon)//
'.premask' 375 write(6,1012)trim(bfnvsetelon0)
382 call cpt2(xmdlonse,2.d0,
383 * cptlolonse,cpthilonse,cptinlonse)
396 if(trim(olddtm).ne.
'nad83_harn')
then 397 write(6,1012)trim(bfnvmeteeht)
400 bfnvmeteeht0 = trim(bfnvmeteeht)//
'.premask' 401 write(6,1012)trim(bfnvmeteeht0)
408 call cpt2(xmdehtme,2.d0,
409 * cptloehtme,cpthiehtme,cptinehtme)
425 *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
437 write(6,1006)trim(region)
438 1006
format(6x,
'makeplotfiles03.f: Calling getmapbounds for region ',a)
451 lorvoglats =
onzd2(multiplierlorvog*rlats)
452 gs2pclat = lorvopc / lorvoglats
457 lorvoglatm =
onzd2(multiplierlorvog*rlatm)
458 gm2pclat = lorvopc / lorvoglatm
465 lorvoglons =
onzd2(multiplierlorvog*rlons)
466 gs2pclon = lorvopc / lorvoglons
471 lorvoglonm =
onzd2(multiplierlorvog*rlonm)
472 gm2pclon = lorvopc / lorvoglonm
479 lorvogehtm =
onzd2(multiplierlorvog*rehtm)
480 gm2pceht = lorvopc / lorvogehtm
483 if(nlon.ne.0 .and. nlat.ne.0)
then 487 lorvoghors =
onzd2(multiplierlorvog*rhors)
488 gs2pchor = lorvopc / lorvoghors
493 lorvoghorm =
onzd2(multiplierlorvog*rhorm)
494 gm2pchor = lorvopc / lorvoghorm
500 894
format(6x,
'makeplotfiles03.f: Info about plots:',/,
501 *8x,
'Number of sub-area plot sets to cover this region: ',i2)
506 write(6,896)i,bs(i),bn(i),bw(i),be(i),dns,dew
509 write(6,897)
'lat',lorvoglatm,lorvoglats,gm2pclat,gs2pclat
515 write(6,897)
'lon',lorvoglonm,lorvoglons,gm2pclon,gs2pclon
521 write(6,899)
'eht',lorvogehtm,gm2pceht
526 if(nlat.ne.0 .and. nlon.ne.0)
then 527 write(6,897)
'hor',lorvoghorm,lorvoghors,gm2pchor,gs2pchor
536 *10x,
'S/N/W/E/N-S/E-W = ',6f7.1)
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)
544 *10x,a3,
' plots',13x,
':',/,
545 *12x,
'Reference Vector ( m) = ',f10.2,/,
546 *12x,
'Ground M to Paper cm = ',f20.10)
548 *10x,a3,
' plots: No data available for plotting')
558 pvlat = (pvlat / 100.d0)
559 pvlon = (pvlon / 100.d0)
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' 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)
585 gfncvrddlat =
'cvrddlat.'//trim(suffix2)
586 gfncvrddlon =
'cvrddlon.'//trim(suffix2)
587 gfncvrddeht =
'cvrddeht.'//trim(suffix2)
598 write(6,1012)trim(bfnvsrddlat)
603 call cpt2(xmdlats,3.d0,
604 * cptlolats,cpthilats,cptinlats)
606 write(6,1012)trim(bfnvmrddlat)
611 call cpt2(xmdlatm,3.d0,
612 * cptlolatm,cpthilatm,cptinlatm)
617 write(6,1012)trim(bfnvsrddlon)
622 call cpt2(xmdlons,3.d0,
623 * cptlolons,cpthilons,cptinlons)
625 write(6,1012)trim(bfnvmrddlon)
630 call cpt2(xmdlonm,3.d0,
631 * cptlolonm,cpthilonm,cptinlonm)
636 write(6,1012)trim(bfnvmrddeht)
641 call cpt2(xmdehtm,3.d0,
642 * cptloehtm,cpthiehtm,cptinehtm)
647 1012
format(6x,
'makeplotfiles03.f: Grabbing stats of grid: ',a)
658 write(99,990)trim(region),trim(fn(ij)),
659 * trim(region),trim(fn(ij))
667 *
call bwplotcv(
'lat',gfncvrddlat,bw,be,bs,bn,jm,
668 * b1,b2,maxplots,olddtm,newdtm,region,
'LAT',ij,
672 *
call bwplotcv(
'lon',gfncvrddlon,bw,be,bs,bn,jm,
673 * b1,b2,maxplots,olddtm,newdtm,region,
'LON',ij,
677 *
call bwplotcv(
'eht',gfncvrddeht,bw,be,bs,bn,jm,
678 * b1,b2,maxplots,olddtm,newdtm,region,
'EHT',ij,
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)
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)
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)
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)
765 3101
format(
'echo Color Plots of RMS data...')
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)
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)
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)
796 3102
format(
'echo Color Plots of Total Error grids...')
799 call coplot(
'lat',bfnvsetelat,bw,be,bs,bn,jm,b1,b2,maxplots,
800 * olddtm,newdtm,region,
'LAT',ij,cptlolatse,cpthilatse,
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,
806 * suffix2,igridsec,fn)
810 call coplot(
'lon',bfnvsetelon,bw,be,bs,bn,jm,b1,b2,maxplots,
811 * olddtm,newdtm,region,
'LON',ij,cptlolonse,cpthilonse,
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,
817 * suffix2,igridsec,fn)
821 call coplot(
'eht',bfnvmeteeht,bw,be,bs,bn,jm,b1,b2,maxplots,
822 * olddtm,newdtm,region,
'EHT',ij,cptloehtme,cpthiehtme,
824 * suffix2,igridsec,fn)
829 *
'# ------------------------------',/,
830 *
'# Plots for region: ',a,
', sub-region: ',a,/,
831 *
'# ------------------------------',/,
832 *
'echo Creating plots for region: ',a,
', sub-region: ',a)
834 write(99,1031)trim(gmtfile)
835 1031
format(
'echo END batch file ',a)
839 9999
format(
'END program makeplotfiles03.f')
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.
subroutine cpt2(med, csm, xlo, xhi, xin)
This subroutine generates the color pallette variables for a GMT color plot.
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.
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.
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.
subroutine gridstats(fname, ave, std, med)
Subroutine to print grid statistics to stdout.
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.