79 implicit real*8(a-h,o-z)
80 parameter(maxplots=60)
84 character*10 olddtm,newdtm,od,nd
85 character*2 state,stdum
86 character*3 ele,elelat,elelon,eleeht,elehor,ele0
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
96 character*200 bfnvmtcdlat,bfnvmtcdlon,bfnvmtcdeht
97 character*200 bfnvstcdlat,bfnvstcdlon
101 character*200 sadbfnvmtcdlat,sadbfnvmtcdlon,sadbfnvmtcdeht
102 character*200 sadbfnvstcdlat,sadbfnvstcdlon
104 character*200 gfnvmtcdlat,gfnvmtcdlon,gfnvmtcdeht,gfnvmtcdhor
105 character*200 gfnvstcdlat,gfnvstcdlon, gfnvstcdhor
107 character*200 gfnvmdcdlat,gfnvmdcdlon,gfnvmdcdeht,gfnvmdcdhor
108 character*200 gfnvsdcdlat,gfnvsdcdlon, gfnvsdcdhor
111 real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
113 real*4 b1(maxplots),b2(maxplots)
114 character*10 fn(maxplots)
116 logical lrv(maxplots)
117 real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
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
128 character*17 scunlat,scunlon,scuneht,scunhor
133 real*8 lorvoghorm,lorvoghors
142 1001
format(
'BEGIN program makeplotfiles02.f')
162 pi = 2.d0*dasin(1.d0)
173 read(5,
'(a)')agridsec
179 read(agridsec,*)igridsec
180 suffix1=trim(olddtm)//
'.'//trim(newdtm)//
'.'//trim(region)
182 suffix2=trim(suffix1)//
'.'//trim(agridsec)
183 suffix2t04=trim(suffix2)//
'.04' 184 suffix2d3=trim(suffix2)//
'.d3' 186 suffix3=trim(suffix2)//
'.'//trim(mapflag)
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)
205 891
read(1,104,end=892)pid,state,rejlat,rejlon,rejeht,
207 *dlatsec,dlonsec,dehtm,dhorsec,azhor,dlatm,dlonm,dhorm,
209 if(rejlat.eq.
' ' .and. rejlon.eq.
' ')
then 210 avedhorm = avedhorm + dhorm
211 avedhors = avedhors + dhorsec
214 if(rejeht.eq.
' ')
then 217 avedehtm = avedehtm + dabs(dehtm)
223 avedhorm = avedhorm / dble(ndhor )
224 avedhors = avedhors / dble(ndhor )
230 avedehtm = avedehtm / dble(ndeht )
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,
258 *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
269 write(6,1006)trim(region)
270 1006
format(6x,
'makeplotfiles02.f: Calling getmapbounds for region ',a)
288 lorvoghorm =
onzd2(multiplierlorvog*avedhorm)
289 gm2pchor = lorvopc / lorvoghorm
294 lorvoghors =
onzd2(multiplierlorvog*avedhors)
295 gs2pchor = lorvopc / lorvoghors
302 lorvogehtm =
onzd2(multiplierlorvog*avedehtm)
303 gm2pceht = lorvopc / lorvogehtm
308 894
format(6x,
'makeplotfiles02.f: Info about plots:',/,
309 *8x,
'Number of sub-region plot sets to cover this region: ',i2)
314 write(6,896)i,bs(i),bn(i),bw(i),be(i),dns,dew
316 write(6,897)lorvoghorm,lorvoghors,gm2pchor,gs2pchor
322 write(6,899)lorvogehtm,gm2pceht
331 *10x,
'S/N/W/E/N-S/E-W = ',6f7.1)
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)
339 *10x,
'Lat/Lon/Hor plots: ',/,
340 *12x,
'No horizontal data available for plotting')
342 *10x,
'Ell. Height plots: ',/,
343 *12x,
'Reference Vector ( m) = ',f10.2,/,
344 *12x,
'Ground M to Paper cm = ',f20.10)
346 *10x,
'Ell. Height plots: ',/,
347 *12x,
'No ellipsoid height data available for plotting')
357 pvlat = (pvlat / 100.d0)
358 pvlon = (pvlon / 100.d0)
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)
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' 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' 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)
399 gfncvtcdlat =
'cvtcdlat.'//trim(suffix2)
400 gfncvtcdlon =
'cvtcdlon.'//trim(suffix2)
401 gfncvtcdeht =
'cvtcdeht.'//trim(suffix2)
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)
411 gfncvdcdlat =
'cvdcdlat.'//trim(suffix2)
412 gfncvdcdlon =
'cvdcdlon.'//trim(suffix2)
413 gfncvdcdeht =
'cvdcdeht.'//trim(suffix2)
422 if(nthinhor.ne.0)
then 423 write(6,1012)trim(bfnvmtcdlat)
427 write(6,1012)trim(bfnvmtcdlon)
432 write(6,1012)trim(bfnvstcdlat)
436 write(6,1012)trim(bfnvstcdlon)
442 call cpt(avelatm,stdlatm,csm,cptlolatm,cpthilatm,cptinlatm)
445 call cpt(avelonm,stdlonm,csm,cptlolonm,cpthilonm,cptinlonm)
448 call cpt(avelats,stdlats,csm,cptlolats,cpthilats,cptinlats)
451 call cpt(avelons,stdlons,csm,cptlolons,cpthilons,cptinlons)
455 if(nthineht.ne.0)
then 456 write(6,1012)trim(bfnvmtcdeht)
462 call cpt(aveehtm,stdehtm,csm,cptloehtm,cpthiehtm,cptinehtm)
471 if(nthinhor.ne.0)
then 472 write(6,1012)trim(sadbfnvmtcdlat)
473 call gridstats(sadbfnvmtcdlat,ave,std,xmd)
477 write(6,1012)trim(sadbfnvmtcdlon)
478 call gridstats(sadbfnvmtcdlon,ave,std,xmd)
483 write(6,1012)trim(sadbfnvstcdlat)
484 call gridstats(sadbfnvstcdlat,ave,std,xmd)
488 write(6,1012)trim(sadbfnvstcdlon)
489 call gridstats(sadbfnvstcdlon,ave,std,xmd)
501 call cpt2(xmdlatmsad,2.d0,
502 * cptlolatmsad,cpthilatmsad,cptinlatmsad)
512 call cpt2(xmdlonmsad,2.d0,
513 * cptlolonmsad,cpthilonmsad,cptinlonmsad)
523 call cpt2(xmdlatssad,2.d0,
524 * cptlolatssad,cpthilatssad,cptinlatssad)
534 call cpt2(xmdlonssad,2.d0,
535 * cptlolonssad,cpthilonssad,cptinlonssad)
539 if(nthineht.ne.0)
then 540 write(6,1012)trim(sadbfnvmtcdeht)
541 call gridstats(sadbfnvmtcdeht,ave,std,xmd)
552 call cpt2(xmdehtmsad,2.d0,
553 * cptloehtmsad,cpthiehtmsad,cptinehtmsad)
565 1012
format(6x,
'makeplotfiles02.f: Grabbing stats of grid: ',a)
576 write(99,990)trim(region),trim(fn(ij)),
577 * trim(region),trim(fn(ij))
585 *
call bwplotcv(
'lat',gfncvtcdlat,bw,be,bs,bn,jm,
586 * b1,b2,maxplots,olddtm,newdtm,region,
'LAT',ij,
590 *
call bwplotcv(
'lon',gfncvtcdlon,bw,be,bs,bn,jm,
591 * b1,b2,maxplots,olddtm,newdtm,region,
'LON',ij,
595 *
call bwplotcv(
'eht',gfncvtcdeht,bw,be,bs,bn,jm,
596 * b1,b2,maxplots,olddtm,newdtm,region,
'EHT',ij,
602 *
call bwplotcv(
'lat',gfncvdcdlat,bw,be,bs,bn,jm,
603 * b1,b2,maxplots,olddtm,newdtm,region,
'LAT',ij,
607 *
call bwplotcv(
'lon',gfncvdcdlon,bw,be,bs,bn,jm,
608 * b1,b2,maxplots,olddtm,newdtm,region,
'LON',ij,
612 *
call bwplotcv(
'eht',gfncvdcdeht,bw,be,bs,bn,jm,
613 * b1,b2,maxplots,olddtm,newdtm,region,
'EHT',ij,
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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,
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,
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,
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,
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,
803 *
'# ------------------------------',/,
804 *
'# Plots for region: ',a,
', sub-region: ',a,/,
805 *
'# ------------------------------',/,
806 *
'echo Creating plots for region: ',a,
', sub-region: ',a)
808 write(99,1031)trim(gmtfile)
809 1031
format(
'echo END batch file ',a)
813 9999
format(
'END program makeplotfiles02.f')
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' 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...
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 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.
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 cpt(ave, std, csm, xlo, xhi, xin)
This subroutine generates the color pallette variables for a GMT color plot.
subroutine vecstats(fname, n)
Subroutine to tell us how many thinned vectors were used to make a grid.
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.