99 implicit real*8(a-h,o-z)
104 parameter(max=280000)
109 parameter(maxppcell=5000)
112 character*80 cards(max)
113 real*8 xlat(max),xlon(max),z0(max),zm(max)
120 integer*4 ilapcell(max),ilopcell(max)
121 integer*4 poscode(max)
129 integer*4 whichcell(max)
134 integer*4 ppcell(max)
136 character*10 olddtm,newdtm,region
137 character*200 suffix1,suffix2
138 character*200 suffix2t04,suffix2t09,suffix2d3
141 character*200 gfnvmaddlat,gfnvmaddlon,gfnvmaddeht
142 character*200 gfnvsaddlat,gfnvsaddlon
143 character*200 gfnvsaddhor,gfnvmaddhor
145 character*200 gfnvmrddlat,gfnvmrddlon,gfnvmrddeht
146 character*200 gfnvsrddlat,gfnvsrddlon
147 character*200 gfnvsrddhor,gfnvmrddhor
149 character*200 gfnsmrddlat,gfnsmrddlon,gfnsmrddeht
150 character*200 gfnssrddlat,gfnssrddlon
152 character*200 gfncvrddlat,gfncvrddlon,gfncvrddeht
154 character*200 rfnvmrddlat,rfnvmrddlon,rfnvmrddeht
155 character*200 rfnvsrddlat,rfnvsrddlon
157 character*200 zfnvmrddlat,zfnvmrddlon,zfnvmrddeht
158 character*200 zfnvsrddlat,zfnvsrddlon
160 character*200 bfnvmrddlat,bfnvmrddlon,bfnvmrddeht
161 character*200 bfnvsrddlat,bfnvsrddlon
164 logical*1 nothinlat,nothinlon,nothineht
167 character*200 sadbfnvmtcdlat1000,sadbfnvmtcdlon1000
168 character*200 sadbfnvmtcdeht1000
169 character*200 sadbfnvstcdlat1000,sadbfnvstcdlon1000
171 character*200 bfnvsetelat,bfnvsetelon
172 character*200 bfnvmetelat,bfnvmetelon
173 character*200 bfnvmeteeht
175 character*200 rfnvsetelat,rfnvsetelon
176 character*200 rfnvmetelat,rfnvmetelon
177 character*200 rfnvmeteeht
181 character*200 fused,gfndv,gfnsu
183 character*200 gmtfile
194 real*8 lorvopc,lorvog0,lorvogm
195 real*8 lorvoghorddm,lorvoghordds
207 1001
format(
'BEGIN program myrms.f')
213 pi = 2.d0*dasin(1.d0)
216 s2m = (1/3600.d0)*d2r*re
225 read(5,
'(a)')agridsec
230 read(agridsec,*)igridsec
231 suffix1=trim(olddtm)//
'.'//trim(newdtm)//
'.'//trim(region)
232 suffix2=trim(suffix1)//
'.'//trim(agridsec)
233 suffix2t04=trim(suffix2)//
'.04' 234 suffix2t09=trim(suffix2)//
'.09' 235 suffix2d3=trim(suffix2)//
'.d3' 240 gmtfile =
'gmtbat05.'//trim(suffix2)
241 open(99,file=gmtfile,status=
'new',form=
'formatted')
242 write(6,1011)trim(gmtfile)
243 1011
format(6x,
'myrms.f: Creating GMT batch file ',a)
244 write(99,1030)trim(gmtfile)
245 1030
format(
'echo BEGIN batch file ',a)
252 sfn =
'dvstats.'//trim(suffix2)
253 open(2,file=sfn,status=
'old',form=
'formatted')
254 write(6,1003)trim(sfn)
255 1003
format(6x,
'myrms.f: Opening exisiting stats file ',a)
262 if(nlat.eq.0)nothinlat=.true.
263 if(nlon.eq.0)nothinlon=.true.
264 if(neht.eq.0)nothineht=.true.
272 if(.not.nothinlat)
then 273 gfnvsaddlat =
'vsaddlat.'//trim(suffix2)
274 open(21,file=gfnvsaddlat,status=
'old',form=
'formatted')
275 write(6,1010)trim(gfnvsaddlat)
277 gfnvmaddlat =
'vmaddlat.'//trim(suffix2)
278 open(26,file=gfnvmaddlat,status=
'old',form=
'formatted')
279 write(6,1010)trim(gfnvmaddlat)
282 if(.not.nothinlon)
then 283 gfnvsaddlon =
'vsaddlon.'//trim(suffix2)
284 open(22,file=gfnvsaddlon,status=
'old',form=
'formatted')
285 write(6,1010)trim(gfnvsaddlon)
287 gfnvmaddlon =
'vmaddlon.'//trim(suffix2)
288 open(27,file=gfnvmaddlon,status=
'old',form=
'formatted')
289 write(6,1010)trim(gfnvmaddlon)
292 if(.not.nothineht)
then 293 gfnvmaddeht =
'vmaddeht.'//trim(suffix2)
294 open(23,file=gfnvmaddeht,status=
'old',form=
'formatted')
295 write(6,1010)trim(gfnvmaddeht)
298 if(.not.nothinlat .and. .not.nothinlon)
then 299 gfnvsaddhor =
'vsaddhor.'//trim(suffix2)
300 open(24,file=gfnvsaddhor,status=
'old',form=
'formatted')
301 write(6,1010)trim(gfnvsaddhor)
303 gfnvmaddhor =
'vmaddhor.'//trim(suffix2)
304 open(25,file=gfnvmaddhor,status=
'old',form=
'formatted')
305 write(6,1010)trim(gfnvmaddhor)
308 1010
format(6x,
'myrms.f: ',
309 *
'Opening existing raw differential vector file ',a)
315 if(.not.nothinlat)
then 316 gfnvsrddlat =
'vsrddlat.'//trim(suffix2)
317 open(41,file=gfnvsrddlat,status=
'new',form=
'formatted')
318 write(6,1012)trim(gfnvsrddlat)
320 gfnvmrddlat =
'vmrddlat.'//trim(suffix2)
321 open(46,file=gfnvmrddlat,status=
'new',form=
'formatted')
322 write(6,1012)trim(gfnvmrddlat)
325 if(.not.nothinlon)
then 326 gfnvsrddlon =
'vsrddlon.'//trim(suffix2)
327 open(42,file=gfnvsrddlon,status=
'new',form=
'formatted')
328 write(6,1012)trim(gfnvsrddlon)
330 gfnvmrddlon =
'vmrddlon.'//trim(suffix2)
331 open(47,file=gfnvmrddlon,status=
'new',form=
'formatted')
332 write(6,1012)trim(gfnvmrddlon)
335 if(.not.nothineht)
then 336 gfnvmrddeht =
'vmrddeht.'//trim(suffix2)
337 open(43,file=gfnvmrddeht,status=
'new',form=
'formatted')
338 write(6,1012)trim(gfnvmrddeht)
341 if(.not.nothinlat .and. .not.nothinlon)
then 342 gfnvsrddhor =
'vsrddhor.'//trim(suffix2)
343 open(44,file=gfnvsrddhor,status=
'new',form=
'formatted')
344 write(6,1010)trim(gfnvsrddhor)
346 gfnvmrddhor =
'vmrddhor.'//trim(suffix2)
347 open(45,file=gfnvmrddhor,status=
'new',form=
'formatted')
348 write(6,1010)trim(gfnvmrddhor)
351 1012
format(6x,
'myrms.f: ',
352 *
'Opening output RMS differential vector file ',a)
358 if(.not.nothinlat)
then 359 gfncvrddlat =
'cvrddlat.'//trim(suffix2)
360 open(51,file=gfncvrddlat,status=
'new',form=
'formatted')
361 write(6,1013)trim(gfncvrddlat)
364 if(.not.nothinlon)
then 365 gfncvrddlon =
'cvrddlon.'//trim(suffix2)
366 open(52,file=gfncvrddlon,status=
'new',form=
'formatted')
367 write(6,1013)trim(gfncvrddlon)
370 if(.not.nothineht)
then 371 gfncvrddeht =
'cvrddeht.'//trim(suffix2)
372 open(53,file=gfncvrddeht,status=
'new',form=
'formatted')
373 write(6,1013)trim(gfncvrddeht)
376 1013
format(6x,
'myrms.f: ',
377 *
'Opening output RMS differential coverage file ',a)
384 if(.not.nothinlat)
then 385 gfnssrddlat =
'ssrddlat.'//trim(suffix2)
386 open(71,file=gfnssrddlat,status=
'new',form=
'formatted')
387 write(6,1014)trim(gfnssrddlat)
389 gfnsmrddlat =
'smrddlat.'//trim(suffix2)
390 open(76,file=gfnsmrddlat,status=
'new',form=
'formatted')
391 write(6,1014)trim(gfnsmrddlat)
394 if(.not.nothinlon)
then 395 gfnssrddlon =
'ssrddlon.'//trim(suffix2)
396 open(72,file=gfnssrddlon,status=
'new',form=
'formatted')
397 write(6,1014)trim(gfnssrddlon)
399 gfnsmrddlon =
'smrddlon.'//trim(suffix2)
400 open(77,file=gfnsmrddlon,status=
'new',form=
'formatted')
401 write(6,1014)trim(gfnsmrddlon)
404 if(.not.nothineht)
then 405 gfnsmrddeht =
'smrddeht.'//trim(suffix2)
406 open(73,file=gfnsmrddeht,status=
'new',form=
'formatted')
407 write(6,1014)trim(gfnsmrddeht)
410 1014
format(6x,
'myrms.f: ',
411 *
'Opening output RMS differential vector ',
412 *
'file (for surface):',a)
421 write(6,1004)trim(region),glamn,glamx,glomn,glomx
422 1004
format(6x,
'myrms.f: Region= ',a,/,
423 * 6x,
'myrms.f: North = ',f12.6,/,
424 * 6x,
'myrms.f: South = ',f12.6,/,
425 * 6x,
'myrms.f: West = ',f12.6,/,
426 * 6x,
'myrms.f: East = ',f12.6)
433 dgla = dble(igridsec)/3600.d0
434 dglo = dble(igridsec)/3600.d0
436 nla=idnint((glamx-glamn)/dgla)+1
437 nlo=idnint((glomx-glomn)/dglo)+1
439 write(6,3001)glamn,glamx,glomn,glomx,dgla,dglo,nla,nlo
440 3001
format(6x,
'myrms.f Cell Structure:',/,
441 *8x,
'North = ',f16.10,/,
442 *8x,
'South = ',f16.10,/,
443 *8x,
'West = ',f16.10,/,
444 *8x,
'East = ',f16.10,/,
445 *8x,
'DLat = ',f16.10,/,
446 *8x,
'DLon = ',f16.10,/,
447 *8x,
'NLat = ',i16 ,/,
483 write(6,2002)trim(gfnvsrddlat)
484 write(6,2002)trim(gfnvmrddlat)
487 write(6,2002)trim(gfnvsrddlon)
488 write(6,2002)trim(gfnvmrddlon)
491 write(6,2002)trim(gfnvmrddeht)
494 if(iloop.eq.1 .and. nothinlat)
goto 2001
495 if(iloop.eq.2 .and. nothinlon)
goto 2001
496 if(iloop.eq.3 .and. nothineht)
goto 2001
500 if(iloop.eq.1 .or. iloop.eq.3)az=0.d0
501 if(iloop.eq.2 )az=90.d0
503 2002
format(6x,
'myrms.f : RMS computing on file :',a)
508 101
format(f16.10,1x,f15.10,1x, 6x,1x, 12x,1x,f9.5,1x, 9x,1x,a6)
510 1101
format(f16.10,1x,f15.10,1x, 6x,1x, 12x,1x, 9x,1x,f9.3,1x,a6)
514 2003
format(6x,
'myrms.f : Point outside boundaries: ',
515 * f16.10,1x,f15.10,1x,f9.5,1x,a6)
536 100
read(lin,
'(a)',end=777)card
537 if(iloop.le.2)
read(card, 101)glo,gla,z,pid
538 if(iloop.eq.3)
read(card,1101)glo,gla,z,pid
549 elseif(iloop.eq.2)
then 550 coslat = dcos(gla*d2r)
551 zm(ikt) = z * s2m * coslat
555 rms0 = rms0 + z0(ikt)**2
556 rmsm = rmsm + zm(ikt)**2
560 if(gla.lt.glamn.or.gla.gt.glamx .or.
561 * glo.lt.glomn.or.glo.gt.glomx)
then 562 write(6,2003)gla,glo,z,pid
571 ila=idnint((gla-glamn)/dgla)+1
572 ilo=idnint((glo-glomn)/dglo)+1
582 if(ipos.eq.poscode(j))
then 583 ppcell(j) = ppcell(j) + 1
593 poscode(ncells) = ipos
594 ilapcell(ncells) = ila
595 ilopcell(ncells) = ilo
597 whichcell(ikt) = ncells
612 rms0 = dsqrt(rms0/nkt)
613 rmsm = dsqrt(rmsm/nkt)
615 if(iloop.eq.1)nrmslat = nkt
616 if(iloop.eq.2)nrmslon = nkt
617 if(iloop.eq.3)nrmseht = nkt
626 lorvog0 =
onzd2(multiplierlorvog*rms0)
627 g02pc = lorvopc / lorvog0
632 lorvogm =
onzd2(multiplierlorvog*rmsm)
633 gm2pc = lorvopc / lorvogm
646 write(6,2004) nkt,npid,igridsec,ncells
648 *6x,
'myrms.f: Done with file ',/,
649 *6x,
'myrms.f: Points in File : ',i10,/,
650 *6x,
'myrms.f: Points within Grid Bounds : ',i10,/,
651 *6x,
'myrms.f: Cell Size (Arcseconds) : ',i10,/,
652 *6x,
'myrms.f: Number of Cells with Data : ',i10)
654 2005
format(6x,
'myrms.f: Begin RMS computations')
658 2020
format(6x,
'myrms.f : Sorting data...')
659 call indexxi(nkt,max,whichcell,indx)
670 2010
format(i8,1x,a80,1x,4(i10))
688 write(6,2021)trim(gfnvsrddlat),trim(gfnssrddlat)
689 write(6,2021)trim(gfnvmrddlat),trim(gfnsmrddlat)
692 write(6,2021)trim(gfnvsrddlon),trim(gfnssrddlon)
693 write(6,2021)trim(gfnvmrddlon),trim(gfnsmrddlon)
696 write(6,2021)trim(gfnvmrddeht),trim(gfnsmrddeht)
699 2021
format(6x,
'myrms.f : ',
700 *
'Populating RMS diff vec file: ',a,/,
702 *
'Populating RMS diff vec surface-ready file: ',a)
708 do 401 icell=1,ncells
710 inumhi = inumlo + ppcell(icell) - 1
718 call getrms(z0,max,inumlo,inumhi,indx,
719 * maxppcell,xlat,xlon,alat,alon,rval0)
732 elseif(iloop.eq.2)
then 733 coslat = dcos(alat*d2r)
734 rvalm = rval0 * s2m * coslat
738 vc0 = dabs(rval0 * g02pc)
739 vcm = dabs(rvalm * gm2pc)
742 write(ifileout1 ,2101)alon,alat,az,vc0,rval0,rvalm
744 *
write(ifileout1+5,2101)alon,alat,az,vcm,rval0,rvalm
745 2101
format(f16.10,1x,f15.10,1x,f6.2,1x,
746 * f12.2,1x,f9.5,1x,f9.3)
749 write(ifileout3,2103)alon,alat,1.0
750 2103
format(f16.10,1x,f15.10,1x,f6.2)
753 write(ifileout2 ,2102)alon,alat,rval0
755 *
write(ifileout2+5,2102)alon,alat,rvalm
756 2102
format(f16.10,1x,f15.10,1x,f10.5)
773 baseddhors = sqrt(basedd(1)**2+basedd(2)**2)
774 baseddhorm = sqrt(basedd(4)**2+basedd(5)**2)
779 lorvoghorddm =
onzd2(multiplierlorvog*baseddhorm)
780 gm2pchordd = lorvopc / lorvoghorddm
785 lorvoghordds =
onzd2(multiplierlorvog*baseddhors)
786 gs2pchordd = lorvopc / lorvoghordds
790 *(6x,
'myrms.f: Populating RMS dd horizontal vector files')
801 2503
read(iflats,2101,end=2502)xlo1,xla1,az1,vc1,xs1,xm1
802 read(iflons,2101)xlo2,xla2,az2,vc2,xs2,xm2
803 if(xlo1.ne.xlo2)stop 10501
804 if(xla1.ne.xla2)stop 10502
807 azhor = datan2(xm2,xm1)/d2r
808 if(azhor.lt.0)azhor = azhor + 360.d0
809 xshor = dsqrt(xs1**2 + xs2**2)
810 xmhor = dsqrt(xm1**2 + xm2**2)
811 vchors = xshor * gs2pchordd
812 vchorm = xmhor * gm2pchordd
813 write(ifhors,2101)xlo1,xla1,azhor,vchors,xshor,xmhor
814 write(ifhorm,2101)xlo1,xla1,azhor,vchorm,xshor,xmhor
835 cmidlat=dcos(((glamn+glamx)/2.d0)*d2r)
836 rfnvsrddlat =
'vsrddlat.'//trim(suffix2t09)//
'.grd' 837 rfnvsrddlon =
'vsrddlon.'//trim(suffix2t09)//
'.grd' 838 rfnvmrddeht =
'vmrddeht.'//trim(suffix2t09)//
'.grd' 839 rfnvmrddlat =
'vmrddlat.'//trim(suffix2t09)//
'.grd' 840 rfnvmrddlon =
'vmrddlon.'//trim(suffix2t09)//
'.grd' 842 zfnvsrddlat =
'vsrddlat.'//trim(suffix2t09)//
'.xyz' 843 zfnvsrddlon =
'vsrddlon.'//trim(suffix2t09)//
'.xyz' 844 zfnvmrddeht =
'vmrddeht.'//trim(suffix2t09)//
'.xyz' 845 zfnvmrddlat =
'vmrddlat.'//trim(suffix2t09)//
'.xyz' 846 zfnvmrddlon =
'vmrddlon.'//trim(suffix2t09)//
'.xyz' 848 bfnvsrddlat =
'vsrddlat.'//trim(suffix2t09)//
'.b' 849 bfnvsrddlon =
'vsrddlon.'//trim(suffix2t09)//
'.b' 850 bfnvmrddeht =
'vmrddeht.'//trim(suffix2t09)//
'.b' 851 bfnvmrddlat =
'vmrddlat.'//trim(suffix2t09)//
'.b' 852 bfnvmrddlon =
'vmrddlon.'//trim(suffix2t09)//
'.b' 856 xgridmin = dble(igridsec)/60.d0
863 write(99,501)trim(gfnssrddlat),glomn,glomx,glamn,glamx,
864 * xgridmin,trim(rfnvsrddlat),cmidlat
865 write(99,501)trim(gfnsmrddlat),glomn,glomx,glamn,glamx,
866 * xgridmin,trim(rfnvmrddlat),cmidlat
871 write(99,501)trim(gfnssrddlon),glomn,glomx,glamn,glamx,
872 * xgridmin,trim(rfnvsrddlon),cmidlat
873 write(99,501)trim(gfnsmrddlon),glomn,glomx,glamn,glamx,
874 * xgridmin,trim(rfnvmrddlon),cmidlat
879 *
write(99,501)trim(gfnsmrddeht),glomn,glomx,glamn,glamx,
880 *xgridmin,trim(rfnvmrddeht),cmidlat
884 write(99,502)trim(rfnvsrddlat),trim(zfnvsrddlat)
885 write(99,502)trim(rfnvmrddlat),trim(zfnvmrddlat)
889 write(99,502)trim(rfnvsrddlon),trim(zfnvsrddlon)
890 write(99,502)trim(rfnvmrddlon),trim(zfnvmrddlon)
893 *
write(99,502)trim(rfnvmrddeht),trim(zfnvmrddeht)
897 write(99,503)trim(zfnvsrddlat),trim(bfnvsrddlat)
898 write(99,503)trim(zfnvmrddlat),trim(bfnvmrddlat)
901 write(99,503)trim(zfnvsrddlon),trim(bfnvsrddlon)
902 write(99,503)trim(zfnvmrddlon),trim(bfnvmrddlon)
905 *
write(99,503)trim(zfnvmrddeht),trim(bfnvmrddeht)
909 *
'surface ',a,
' -R',f9.5,
'/',f9.5,
'/',sp,f9.5,
'/',f9.5,s,
910 *
' -I',f0.2,
'm -G',a,
' -T0.9 -A',s,f6.4,
' -C0.01 -V -Lld')
919 *
'grd2xyz ',a,
' -bo3f > ',a)
953 sadbfnvmtcdlat1000 =
'vmtcdlat.'//trim(suffix2d3)//
'.b' 954 sadbfnvstcdlat1000 =
'vstcdlat.'//trim(suffix2d3)//
'.b' 955 sadbfnvmtcdlon1000 =
'vmtcdlon.'//trim(suffix2d3)//
'.b' 956 sadbfnvstcdlon1000 =
'vstcdlon.'//trim(suffix2d3)//
'.b' 957 sadbfnvmtcdeht1000 =
'vmtcdeht.'//trim(suffix2d3)//
'.b' 960 bfnvsetelat =
'vsetelat.'//trim(suffix2)//
'.b' 961 bfnvsetelon =
'vsetelon.'//trim(suffix2)//
'.b' 962 bfnvmetelat =
'vmetelat.'//trim(suffix2)//
'.b' 963 bfnvmetelon =
'vmetelon.'//trim(suffix2)//
'.b' 964 bfnvmeteeht =
'vmeteeht.'//trim(suffix2)//
'.b' 967 rfnvsetelat =
'vsetelat.'//trim(suffix2)//
'.grd' 968 rfnvsetelon =
'vsetelon.'//trim(suffix2)//
'.grd' 969 rfnvmetelat =
'vmetelat.'//trim(suffix2)//
'.grd' 970 rfnvmetelon =
'vmetelon.'//trim(suffix2)//
'.grd' 971 rfnvmeteeht =
'vmeteeht.'//trim(suffix2)//
'.grd' 979 write(99,801)trim(sadbfnvmtcdlat1000),
980 * trim(sadbfnvmtcdlat1000),
981 * trim(sadbfnvmtcdlat1000)
983 write(99,802)trim(bfnvmrddlat),trim(bfnvmrddlat),
988 write(99,804)trim(bfnvmetelat),trim(bfnvmetelat),
996 write(99,801)trim(sadbfnvstcdlat1000),
997 * trim(sadbfnvstcdlat1000),
998 * trim(sadbfnvstcdlat1000)
1000 write(99,802)trim(bfnvsrddlat),trim(bfnvsrddlat),
1005 write(99,804)trim(bfnvsetelat),trim(bfnvsetelat),
1016 write(99,801)trim(sadbfnvmtcdlon1000),
1017 * trim(sadbfnvmtcdlon1000),
1018 * trim(sadbfnvmtcdlon1000)
1020 write(99,802)trim(bfnvmrddlon),trim(bfnvmrddlon),
1025 write(99,804)trim(bfnvmetelon),trim(bfnvmetelon),
1033 write(99,801)trim(sadbfnvstcdlon1000),
1034 * trim(sadbfnvstcdlon1000),
1035 * trim(sadbfnvstcdlon1000)
1037 write(99,802)trim(bfnvsrddlon),trim(bfnvsrddlon),
1042 write(99,804)trim(bfnvsetelon),trim(bfnvsetelon),
1053 write(99,801)trim(sadbfnvmtcdeht1000),
1054 * trim(sadbfnvmtcdeht1000),
1055 * trim(sadbfnvmtcdeht1000)
1057 write(99,802)trim(bfnvmrddeht),trim(bfnvmrddeht),
1062 write(99,804)trim(bfnvmeteeht),trim(bfnvmeteeht),
1070 *
'# ------------------------------',/,
1071 *
'# Squaring the Method Noise Grid: ',a,
' = dummy1',/,
1072 *
'# ------------------------------',/,
1073 *
'echo Squaring the Method Noise Grid: ',a,
' = dummy1',/,
1075 *a,/,
'dummy1',/,
'!')
1078 *
'# ------------------------------',/,
1079 *
'# Squaring the Data Noise Grid: ',a,
' = dummy2',/,
1080 *
'# ------------------------------',/,
1081 *
'echo Squaring the Data Noise Grid: ',a,
' = dummy2',/,
1083 *a,/,
'dummy2',/,
'!')
1085 *
'# ------------------------------',/,
1086 *
'# Adding dummy1 and dummy2 = dummy3',/,
1087 *
'# ------------------------------',/,
1088 *
'echo Adding dummy1 and dummy2 = dummy3',/,
1090 *
'dummy1',/,
'dummy2',/,
'dummy3',/,
'!')
1092 *
'# ------------------------------',/,
1093 *
'# SquareRoot dummy3 to get Trans. Error Grid: ',a,/,
1094 *
'# ------------------------------',/,
1095 *
'echo SquareRoot dummy3 to get Trans. Error Grid: ',a,/,
1097 *
'dummy3',/,a,/,
'!')
1099 *
'# ------------------------------',/,
1100 *
'# Removing dummy1, dummy2, dummy3',/,
1101 *
'# ------------------------------',/,
1102 *
'echo Removing dummy1, dummy2, dummy3',/,
1119 if(trim(olddtm).eq.
'nad83_harn' .and.
1120 * trim(newdtm).eq.
'nad83_fbn' .and.
1121 * trim(region).eq.
'conus' )
then 1126 write(99,602)trim(bfnvmetelat),
1127 * trim(bfnvmetelat)//
'.premask',
1128 * trim(bfnvmetelat)//
'.premask',
1129 * trim(bfnvmetelat),
1130 * igridsec/30,igridsec/30
1132 write(99,602)trim(bfnvsetelat),
1133 * trim(bfnvsetelat)//
'.premask',
1134 * trim(bfnvsetelat)//
'.premask',
1135 * trim(bfnvsetelat),
1136 * igridsec/30,igridsec/30
1140 write(99,602)trim(bfnvmetelon),
1141 * trim(bfnvmetelon)//
'.premask',
1142 * trim(bfnvmetelon)//
'.premask',
1143 * trim(bfnvmetelon),
1144 * igridsec/30,igridsec/30
1146 write(99,602)trim(bfnvsetelon),
1147 * trim(bfnvsetelon)//
'.premask',
1148 * trim(bfnvsetelon)//
'.premask',
1149 * trim(bfnvsetelon),
1150 * igridsec/30,igridsec/30
1154 write(99,602)trim(bfnvmeteeht),
1155 * trim(bfnvmeteeht)//
'.premask',
1156 * trim(bfnvmeteeht)//
'.premask',
1157 * trim(bfnvmeteeht),
1158 * igridsec/30,igridsec/30
1164 601
format(
'echo Applying MASK for HARN FBN CONUS ete grids')
1175 *
'Masks/mask.harnfbn.30.b',/,
1184 *
'rm -f dummy1.b',/,
1193 write(99,507)trim(bfnvmetelat)
1194 * ,glomn,glomx,glamn,glamx,xgridmin,trim(rfnvmetelat)
1195 write(99,507)trim(bfnvsetelat)
1196 * ,glomn,glomx,glamn,glamx,xgridmin,trim(rfnvsetelat)
1200 write(99,507)trim(bfnvmetelon)
1201 * ,glomn,glomx,glamn,glamx,xgridmin,trim(rfnvmetelon)
1202 write(99,507)trim(bfnvsetelon)
1203 * ,glomn,glomx,glamn,glamx,xgridmin,trim(rfnvsetelon)
1207 write(99,507)trim(bfnvmeteeht)
1208 * ,glomn,glomx,glamn,glamx,xgridmin,trim(rfnvmeteeht)
1212 *
'b2xyz << !',/,a,/,
'!',/,
1213 *
'xyz2grd temp.xyz -R',f9.5,
'/',f9.5,
'/',sp,f9.5,
'/',f9.5,s,
1214 *
' -I',f0.2,
'm -bi3f -G',a,/,
1231 write(99,1031)trim(gmtfile)
1232 1031
format(
'echo END batch file ',a)
1236 9999
format(
'END program myrms.f')
1240 2006
format(
'Cell ',i8,
' Poscode: ',i12)
1241 2007
format(6x,
'Pt : ',i5)
1246 subroutine getrms(zs,max,inumlo,inumhi,indx,
1247 *maxppcell,xlat,xlon,alat,alon,rval)
1253 real*8 xlat(max),xlon(max),zs(max)
1254 integer*4 indx(max),indx2(maxppcell)
1255 integer*4 inumlo,inumhi
1257 real*8 alat,alon,rval
1260 1
format(
'Inside getrms',/,
1261 *
'inumlo,inumhi = ',i8,1x,i8)
1285 nval = inumhi-inumlo+1
1287 do 4 i=inumlo,inumhi
1289 rval = rval + zs(indx(i))**2
1290 alat = alat + xlat(indx(i))
1291 alon = alon + xlon(indx(i))
1293 rval = dsqrt(rval/nval)
1300 include
'Subs/getgridbounds.f' 1301 include
'Subs/indexxi.for' 1302 include
'Subs/onzd2.f' subroutine indexxi(n, nd, arr, indx)
Subroutine to perform ?? indexing on integer data.
real *8 function onzd2(x)
Function to round a digit to one significant figure (one non zero digit), double precision.
subroutine getrms(zs, max, inumlo, inumhi, indx, maxppcell, xlat, xlon, alat, alon, rval)
subroutine getgridbounds(region, xn, xs, xw, xe)
Subroutine to collect up the GRID boundaries for use in creating NADCON 5.
program myrms
Part of the NADCON5 build process, generates gmtbat05