55 implicit double precision(a-h,o-z)
56 parameter(maxplots=60)
61 character*1 rejlat,rejlon,rejeht
62 real*8 xlath,xlonh,xehth
63 real*8 dlatsec,dlonsec,dehtm,dhorsec,azhor
64 real*8 dlatm,dlonm,dhorm
65 character*10 olddtm,newdtm,region
72 real*8 lorvoghorm,lorvoghors
77 character*200 gfncvacdlat
78 character*200 gfncvacdlon
79 character*200 gfncvacdeht
82 character*200 gfnvmacdlat
83 character*200 gfnvmacdlon
84 character*200 gfnvmacdeht
85 character*200 gfnvmacdhor
88 character*200 gfnvsacdlat
89 character*200 gfnvsacdlon
90 character*200 gfnvsacdhor
93 real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
95 real*4 b1(maxplots),b2(maxplots)
96 character*10 fn(maxplots)
99 real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
102 character*200 gmtfile
105 character*200 suffix1,suffix4
111 1001
format(
'BEGIN makeplotfiles01.f')
126 pi = 2.d0*dasin(1.d0)
143 suffix1=trim(olddtm)//
'.'//trim(newdtm)//
'.'//trim(region)
144 suffix4=trim(suffix1)//
'.'//trim(mapflag)
149 wfname=
'work.'//trim(suffix1)
150 open(1,file=
'Work/'//wfname,status=
'old',form=
'formatted')
151 write(6,1004)trim(wfname)
152 1004
format(6x,
'makeplotfiles01.f: Opening work file ',a)
157 gmtfile =
'gmtbat01.'//trim(suffix4)
158 open(99,file=gmtfile,status=
'new',form=
'formatted')
159 write(6,1011)trim(gmtfile)
160 1011
format(6x,
'makeplotfiles01.f: Creating GMT batch file ',a)
161 write(99,1030)trim(gmtfile)
162 1030
format(
'echo BEGIN batch file ',a)
168 gfncvacdlat =
'cvacdlat.'//trim(suffix1)
169 open(11,file=gfncvacdlat,status=
'new',form=
'formatted')
170 write(6,1010)trim(gfncvacdlat)
172 gfncvacdlon =
'cvacdlon.'//trim(suffix1)
173 open(12,file=gfncvacdlon,status=
'new',form=
'formatted')
174 write(6,1010)trim(gfncvacdlon)
176 gfncvacdeht =
'cvacdeht.'//trim(suffix1)
177 open(13,file=gfncvacdeht,status=
'new',form=
'formatted')
178 write(6,1010)trim(gfncvacdeht)
181 gfnvmacdlat =
'vmacdlat.'//trim(suffix1)
182 open(21,file=gfnvmacdlat,status=
'new',form=
'formatted')
183 write(6,1010)trim(gfnvmacdlat)
185 gfnvmacdlon =
'vmacdlon.'//trim(suffix1)
186 open(22,file=gfnvmacdlon,status=
'new',form=
'formatted')
187 write(6,1010)trim(gfnvmacdlon)
189 gfnvmacdeht =
'vmacdeht.'//trim(suffix1)
190 open(23,file=gfnvmacdeht,status=
'new',form=
'formatted')
191 write(6,1010)trim(gfnvmacdeht)
193 gfnvmacdhor =
'vmacdhor.'//trim(suffix1)
194 open(24,file=gfnvmacdhor,status=
'new',form=
'formatted')
195 write(6,1010)trim(gfnvmacdhor)
198 gfnvsacdlat =
'vsacdlat.'//trim(suffix1)
199 open(31,file=gfnvsacdlat,status=
'new',form=
'formatted')
200 write(6,1010)trim(gfnvsacdlat)
202 gfnvsacdlon =
'vsacdlon.'//trim(suffix1)
203 open(32,file=gfnvsacdlon,status=
'new',form=
'formatted')
204 write(6,1010)trim(gfnvsacdlon)
206 gfnvsacdhor =
'vsacdhor.'//trim(suffix1)
207 open(34,file=gfnvsacdhor,status=
'new',form=
'formatted')
208 write(6,1010)trim(gfnvsacdhor)
210 1010
format(6x,
'makeplotfiles01.f: Creating file ',a)
222 891
read(1,104,end=892)pid,state,rejlat,rejlon,rejeht,
224 *dlatsec,dlonsec,dehtm,dhorsec,azhor,dlatm,dlonm,dhorm,
226 if(rejlat.eq.
' ' .and. rejlon.eq.
' ')
then 227 avedhorm = avedhorm + dhorm
228 avedhors = avedhors + dhorsec
231 if(rejeht.eq.
' ')
then 236 avedehtm = avedehtm + dabs(dehtm)
242 avedhorm = avedhorm / dble(ndhor)
243 avedhors = avedhors / dble(ndhor)
249 avedehtm = avedehtm / dble(ndeht)
253 write(6,893)ndhor,avedhorm,avedhors,ndeht,avedehtm
254 893
format(6x,
'makeplotfiles01.f: Vector Stats: ',/,
255 *10x,
'Number of Good Horizontal Vectors : ',i10,/,
256 *10x,
'Average length (meters) : ',f10.3,/,
257 *10x,
'Average length (arcseconds) : ',f10.6,/,
258 *10x,
'Number of Good Ell. Ht. Vectors : ',i10,/,
259 *10x,
'Average length (meters) : ',f10.3)
271 *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
282 write(6,1006)trim(region)
283 1006
format(6x,
'makeplotfiles01.f: Calling getmapbounds for region ',a)
307 lorvoghorm =
onzd2(multiplierlorvog*avedhorm)
308 gm2pchor = lorvopc / lorvoghorm
313 lorvoghors =
onzd2(multiplierlorvog*avedhors)
314 gs2pchor = lorvopc / lorvoghors
321 lorvogehtm =
onzd2(multiplierlorvog*avedehtm)
322 gm2pceht = lorvopc / lorvogehtm
326 894
format(6x,
'makeplotfiles01.f: Info about plots:',/,
327 *8x,
'Number of sub-region plot sets ',
328 *
'being made for this region: ',i2)
333 write(6,896)i,region,fn(i),
334 * bs(i),bn(i),bw(i),be(i),dns,dew
336 write(6,897)lorvoghorm,lorvoghors,gm2pchor,gs2pchor
342 write(6,899)lorvogehtm,gm2pceht
349 896
format(50(
'-'),/,
352 *10x,
'S/N/W/E/N-S/E-W = ',6f7.1)
354 *10x,
'Lat/Lon/Hor plots: ',/,
355 *12x,
'Reference Vector ( m) = ',f10.2,/,
356 *12x,
'Reference Vector ( s) = ',f10.6,/,
357 *12x,
'Ground M to Paper cm = ',f20.10,/,
358 *12x,
'Ground S to Paper cm = ',f20.10)
360 *10x,
'Lat/Lon/Hor plots: ',/,
361 *12x,
'No horizontal data available for plotting')
363 *10x,
'Ell. Height plots: ',/,
364 *12x,
'Reference Vector ( m) = ',f10.2,/,
365 *12x,
'Ground M to Paper cm = ',f20.10)
367 *10x,
'Ell. Height plots: ',/,
368 *12x,
'No ellipsoid height data available for plotting')
376 pvlat = (pvlat / 100.d0)
377 pvlon = (pvlon / 100.d0)
400 1
read(1,104,end=2)pid,state,rejlat,rejlon,rejeht,xlath,xlonh,xehth,
401 *dlatsec,dlonsec,dehtm,dhorsec,azhor,dlatm,dlonm,dhorm,
404 104
format(a6,1x,a2,a1,a1,a1,1x,f14.10,1x,f14.10,1x,f8.3,1x,
405 *f9.5,1x,f9.5,1x,f9.3,1x,f9.5,1x,f9.5,1x,f9.3,1x,f9.3,1x,f9.3,
410 105
format(f16.10,1x,f15.10,1x,f6.2,1x,f12.2,1x,f5.1)
411 1105
format(f16.10,1x,f15.10,1x,f6.2,1x,a6)
414 1106
format(f16.10,1x,f15.10,1x,f6.2,1x,f12.2,1x,f9.5,1x,f9.3,1x,a6)
421 if(rejlat.eq.
' ')
then 427 vclatm = dabs(dlatm *gm2pchor)
428 vclats = dabs(dlatsec*gs2pchor)
429 write(11,1105)xlonh,xlath,sngl(1.0),pid
430 write(21,1106)xlonh,xlath,az,vclatm,dlatsec,dlatm,pid
431 write(31,1106)xlonh,xlath,az,vclats,dlatsec,dlatm,pid
440 if(rejlon.eq.
' ')
then 446 vclonm = dabs(dlonm *gm2pchor)
447 vclons = dabs(dlonsec*gs2pchor)
448 write(12,1105)xlonh,xlath,sngl(1.0),pid
449 write(22,1106)xlonh,xlath,az,vclonm,dlonsec,dlonm,pid
450 write(32,1106)xlonh,xlath,az,vclons,dlonsec,dlonm,pid
459 if(rejeht.eq.
' ')
then 465 vcehtm = dabs(dehtm*gm2pceht)
466 write(13,1105)xlonh,xlath,sngl(1.0),pid
467 write(23,1106)xlonh,xlath,az,vcehtm,0.d0,dehtm,pid
476 if(rejlat.eq.
' ' .and. rejlon.eq.
' ')
then 478 vchorm = dhorm *gm2pchor
479 vchors = dhorsec*gs2pchor
480 write(24,1106)xlonh,xlath,azhor,vchorm,dhorsec,dhorm,pid
481 write(34,1106)xlonh,xlath,azhor,vchors,dhorsec,dhorm,pid
502 write(6,778)n,ncvlat,ncvlon,ncveht,nvclat,nvclon,nvceht,nvchor
504 778
format(6x,
'makeplotfiles01.f: Statistics: ',/,
505 *10x,
'Number of total records read : ',i10,/,
506 *10x,
'Number of lat coverage records prepared: ',i10,/,
507 *10x,
'Number of lon coverage records prepared: ',i10,/,
508 *10x,
'Number of eht coverage records prepared: ',i10,/,
509 *10x,
'Number of lat vector records prepared: ',i10,/,
510 *10x,
'Number of lon vector records prepared: ',i10,/,
511 *10x,
'Number of eht vector records prepared: ',i10,/,
512 *10x,
'Number of hor vector records prepared: ',i10)
537 800
format(6x,
'makeplotfiles01.f: Preparing GMT batch file')
543 801
format(6x,
'makeplotfiles01.f: GMT: Write header')
546 901
format(
'gmtset GRID_PEN_PRIMARY 0.25p,-')
549 902
format(
'gmtset BASEMAP_TYPE fancy',/,
550 *
'gmtset HEADER_FONT Helvetica',/,
551 *
'gmtset HEADER_FONT_SIZE 12p',/,
552 *
'gmtset HEADER_OFFSET 0.5c')
556 802
format(6x,
'makeplotfiles01.f: GMT: Num Plots Analysis')
557 write(6,1005)trim(region)
558 1005
format(6x,
'makeplotfiles01.f: REGION = ',a)
592 write(99,990)trim(region),trim(fn(ij)),
593 * trim(region),trim(fn(ij))
600 call bwplotcv(
'lat',gfncvacdlat,bw,be,bs,bn,jm,
601 * b1,b2,maxplots,olddtm,newdtm,region,
'LAT',ij,
604 call bwplotcv(
'lon',gfncvacdlon,bw,be,bs,bn,jm,
605 * b1,b2,maxplots,olddtm,newdtm,region,
'LON',ij,
608 call bwplotcv(
'eht',gfncvacdeht,bw,be,bs,bn,jm,
609 * b1,b2,maxplots,olddtm,newdtm,region,
'EHT',ij,
655 call bwplotvc(
'lat',gfnvmacdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
656 * olddtm,newdtm,region,
'LAT',ij,xvlon,xvlat,xllon,xllat,
657 * lorvoghorm,lorvopc,igridsec,fn)
658 call bwplotvc(
'lat',gfnvsacdlat,bw,be,bs,bn,jm,b1,b2,maxplots,
659 * olddtm,newdtm,region,
'LAT',ij,xvlon,xvlat,xllon,xllat,
660 * lorvoghors,lorvopc,igridsec,fn)
670 call bwplotvc(
'lon',gfnvmacdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
671 * olddtm,newdtm,region,
'LON',ij,xvlon,xvlat,xllon,xllat,
672 * lorvoghorm,lorvopc,igridsec,fn)
673 call bwplotvc(
'lon',gfnvsacdlon,bw,be,bs,bn,jm,b1,b2,maxplots,
674 * olddtm,newdtm,region,
'LON',ij,xvlon,xvlat,xllon,xllat,
675 * lorvoghors,lorvopc,igridsec,fn)
684 call bwplotvc(
'eht',gfnvmacdeht,bw,be,bs,bn,jm,b1,b2,maxplots,
685 * olddtm,newdtm,region,
'EHT',ij,xvlon,xvlat,xllon,xllat,
686 * lorvogehtm,lorvopc,igridsec,fn)
692 call bwplotvc(
'hor',gfnvmacdhor,bw,be,bs,bn,jm,b1,b2,maxplots,
693 * olddtm,newdtm,region,
'HOR',ij,xvlon,xvlat,xllon,xllat,
694 * lorvoghorm,lorvopc,igridsec,fn)
695 call bwplotvc(
'hor',gfnvsacdhor,bw,be,bs,bn,jm,b1,b2,maxplots,
696 * olddtm,newdtm,region,
'HOR',ij,xvlon,xvlat,xllon,xllat,
697 * lorvoghors,lorvopc,igridsec,fn)
715 write(99,1031)trim(gmtfile)
716 1031
format(
'echo END batch file ',a)
720 9999
format(
'END makeplotfiles01.f')
725 *
'# ------------------------------',/,
726 *
'# Plots for region: ',a,
', sub-region: ',a,/,
727 *
'# ------------------------------',/,
728 *
'echo Creating plots for region: ',a,
', sub-region: ',a)
734 include
'Subs/getmapbounds.f' 735 include
'Subs/plotcoast.f' 736 include
'Subs/bwplotcv.f' 737 include
'Subs/bwplotvc.f' 738 include
'Subs/onzd2.f' 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.
real *8 function onzd2(x)
Function to round a digit to one significant figure (one non zero digit), double precision.
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 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.
program makeplotfiles01
Part of the NADCON5 process, generates gmtbat01.