97 implicit real*8(a-h,o-z)
98 parameter(maxlat=5000,maxlon=5000,maxpts=300000)
99 parameter(maxplots=60)
101 character*10 olddtm,newdtm,region
109 character*200 suffix1,suffix2,suffix3
110 character*200 suffix2t04
111 character*200 gmtfile
112 character*3 ele(7),el0(7)
115 real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
117 real*4 b1(maxplots),b2(maxplots)
118 character*10 fn(maxplots)
121 real*8 lorvog(7),lorvoggi(7)
122 real*8 scaledd(7),scalegi(7)
123 real*8 basedd(7),basegi(7)
124 real*8 lorvogprime,lorvogmeters
125 real*8 lorvogprimegi,lorvogmetersgi
126 real*8 lorvoghorgis,lorvoghorgim
127 real*8 lorvoghordds,lorvoghorddm
130 logical lrv(maxplots)
131 real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
135 character*200 gfnvmtcdlat,gfnvstcdlat
136 character*200 gfnvmtcdlon,gfnvstcdlon
137 character*200 gfnvmtcdeht
138 character*200 gfnvmtcdhor,gfnvstcdhor
141 character*200 gfnvmdcdlat,gfnvsdcdlat
142 character*200 gfnvmdcdlon,gfnvsdcdlon
143 character*200 gfnvmdcdeht
144 character*200 gfnvmdcdhor,gfnvsdcdhor
146 character*200 bfnvmtcdlat,bfnvstcdlat
147 character*200 bfnvmtcdlon,bfnvstcdlon
148 character*200 bfnvmtcdeht
151 logical*1 nothinlat,nothinlon,nothineht
159 character*200 gfnvmagilat,gfnvmtgilat,gfnvmdgilat
160 character*200 gfnvsagilat,gfnvstgilat,gfnvsdgilat
161 character*200 gfnvmagilon,gfnvmtgilon,gfnvmdgilon
162 character*200 gfnvsagilon,gfnvstgilon,gfnvsdgilon
163 character*200 gfnvmagieht,gfnvmtgieht,gfnvmdgieht
165 character*200 gfnvmagihor,gfnvmtgihor,gfnvmdgihor
166 character*200 gfnvsagihor,gfnvstgihor,gfnvsdgihor
216 character*200 gfnvmaddlat,gfnvmtddlat,gfnvmdddlat
217 character*200 gfnvsaddlat,gfnvstddlat,gfnvsdddlat
218 character*200 gfnvmaddlon,gfnvmtddlon,gfnvmdddlon
219 character*200 gfnvsaddlon,gfnvstddlon,gfnvsdddlon
220 character*200 gfnvmaddeht,gfnvmtddeht,gfnvmdddeht
222 character*200 gfnvmaddhor,gfnvmtddhor,gfnvmdddhor
223 character*200 gfnvsaddhor,gfnvstddhor,gfnvsdddhor
229 real*8 glamn,glomn,dla,dlo
230 integer*4 nla,nlo,ikind
231 real*4 datlats(maxlat,maxlon)
232 real*4 datlons(maxlat,maxlon)
233 real*4 datehtm(maxlat,maxlon)
244 character*20 units(5)
270 real*8 vgrd(3),vgrdm(3),dd(3),ddm(3)
276 character*20 coord(3)
281 real*8 xla0(maxpts),xlo0(maxpts)
282 real*8 dd0(maxpts),ddm0(maxpts),gi0(maxpts),gim0(maxpts)
283 character*6 pid0(maxpts)
293 1001
format(
'BEGIN program checkgrid.f')
301 pi = 2.d0*dasin(1.d0)
304 s2m = (1.d0/3600.d0)*d2r*re
307 coord(1) =
'LATITUDE' 308 coord(2) =
'LONGITUDE' 309 coord(3) =
'ELLIPSOID HEIGHT' 311 units(1) =
'arcseconds' 312 units(2) =
'arcseconds' 323 read(5,
'(a)')agridsec
329 read(agridsec,*)igridsec
330 suffix1=trim(olddtm)//
'.'//trim(newdtm)//
'.'//trim(region)
331 suffix2=trim(suffix1)//
'.'//trim(agridsec)
333 suffix2t04=trim(suffix2)//
'.04' 335 suffix3=trim(suffix2)//
'.'//trim(mapflag)
353 gfnvstcdlat =
'vstcdlat.'//trim(suffix2)
354 open(21,file=gfnvstcdlat,status=
'old',form=
'formatted')
355 write(6,1012)trim(gfnvstcdlat)
357 gfnvstcdlon =
'vstcdlon.'//trim(suffix2)
358 open(22,file=gfnvstcdlon,status=
'old',form=
'formatted')
359 write(6,1012)trim(gfnvstcdlon)
361 gfnvmtcdeht =
'vmtcdeht.'//trim(suffix2)
362 open(23,file=gfnvmtcdeht,status=
'old',form=
'formatted')
363 write(6,1012)trim(gfnvmtcdeht)
365 gfnvmtcdlat =
'vmtcdlat.'//trim(suffix2)
366 open(26,file=gfnvmtcdlat,status=
'old',form=
'formatted')
367 write(6,1012)trim(gfnvmtcdlat)
369 gfnvmtcdlon =
'vmtcdlon.'//trim(suffix2)
370 open(27,file=gfnvmtcdlon,status=
'old',form=
'formatted')
371 write(6,1012)trim(gfnvmtcdlon)
378 call nlines(21,nthinlat,nothinlat)
379 call nlines(22,nthinlon,nothinlon)
380 call nlines(23,nthineht,nothineht)
383 1012
format(6x,
'checkgrid.f: ',
384 *
'Opening input thinned vector file ',a)
390 gfnvsdcdlat =
'vsdcdlat.'//trim(suffix2)
391 open(31,file=gfnvsdcdlat,status=
'old',form=
'formatted')
392 write(6,1013)trim(gfnvsdcdlat)
394 gfnvsdcdlon =
'vsdcdlon.'//trim(suffix2)
395 open(32,file=gfnvsdcdlon,status=
'old',form=
'formatted')
396 write(6,1013)trim(gfnvsdcdlon)
398 gfnvmdcdeht =
'vmdcdeht.'//trim(suffix2)
399 open(33,file=gfnvmdcdeht,status=
'old',form=
'formatted')
400 write(6,1013)trim(gfnvmdcdeht)
402 gfnvmdcdlat =
'vmdcdlat.'//trim(suffix2)
403 open(36,file=gfnvmdcdlat,status=
'old',form=
'formatted')
404 write(6,1013)trim(gfnvmdcdlat)
406 gfnvmdcdlon =
'vmdcdlon.'//trim(suffix2)
407 open(37,file=gfnvmdcdlon,status=
'old',form=
'formatted')
408 write(6,1013)trim(gfnvmdcdlon)
410 1013
format(6x,
'checkgrid.f: ',
411 *
'Opening input dropped vector file ',a)
418 if(.not.nothinlat)
then 419 bfnvstcdlat =
'vstcdlat.'//trim(suffix2t04)//
'.b' 420 open(11,file=bfnvstcdlat,status=
'old',form=
'unformatted')
421 write(6,1015)trim(bfnvstcdlat)
423 bfnvmtcdlat =
'vmtcdlat.'//trim(suffix2t04)//
'.b' 424 open(16,file=bfnvmtcdlat,status=
'old',form=
'unformatted')
425 write(6,1015)trim(bfnvmtcdlat)
428 if(.not.nothinlon)
then 429 bfnvstcdlon =
'vstcdlon.'//trim(suffix2t04)//
'.b' 430 open(12,file=bfnvstcdlon,status=
'old',form=
'unformatted')
431 write(6,1015)trim(bfnvstcdlon)
433 bfnvmtcdlon =
'vmtcdlon.'//trim(suffix2t04)//
'.b' 434 open(17,file=bfnvmtcdlon,status=
'old',form=
'unformatted')
435 write(6,1015)trim(bfnvmtcdlon)
438 if(.not.nothineht)
then 439 bfnvmtcdeht =
'vmtcdeht.'//trim(suffix2t04)//
'.b' 440 open(13,file=bfnvmtcdeht,status=
'old',form=
'unformatted')
441 write(6,1015)trim(bfnvmtcdeht)
444 1015
format(6x,
'checkgrid.f: ',
445 *
'Opening input grid file ',a)
453 if(.not.nothinlat)
then 454 gfnvsagilat =
'vsagilat.'//trim(suffix2)
455 open(91,file=gfnvsagilat,status=
'new',form=
'formatted')
456 write(6,1017)
'lat',trim(gfnvsagilat)
458 gfnvmagilat =
'vmagilat.'//trim(suffix2)
459 open(96,file=gfnvmagilat,status=
'new',form=
'formatted')
460 write(6,1017)
'lat',trim(gfnvmagilat)
462 gfnvstgilat =
'vstgilat.'//trim(suffix2)
463 open(71,file=gfnvstgilat,status=
'new',form=
'formatted')
464 write(6,1017)
'lat',trim(gfnvstgilat)
466 gfnvmtgilat =
'vmtgilat.'//trim(suffix2)
467 open(76,file=gfnvmtgilat,status=
'new',form=
'formatted')
468 write(6,1017)
'lat',trim(gfnvmtgilat)
470 gfnvsdgilat =
'vsdgilat.'//trim(suffix2)
471 open(81,file=gfnvsdgilat,status=
'new',form=
'formatted')
472 write(6,1017)
'lat',trim(gfnvsdgilat)
474 gfnvmdgilat =
'vmdgilat.'//trim(suffix2)
475 open(86,file=gfnvmdgilat,status=
'new',form=
'formatted')
476 write(6,1017)
'lat',trim(gfnvmdgilat)
481 if(.not.nothinlon)
then 482 gfnvsagilon =
'vsagilon.'//trim(suffix2)
483 open(92,file=gfnvsagilon,status=
'new',form=
'formatted')
484 write(6,1017)
'lon',trim(gfnvsagilon)
486 gfnvmagilon =
'vmagilon.'//trim(suffix2)
487 open(97,file=gfnvmagilon,status=
'new',form=
'formatted')
488 write(6,1017)
'lon',trim(gfnvmagilon)
490 gfnvstgilon =
'vstgilon.'//trim(suffix2)
491 open(72,file=gfnvstgilon,status=
'new',form=
'formatted')
492 write(6,1017)
'lon',trim(gfnvstgilon)
494 gfnvmtgilon =
'vmtgilon.'//trim(suffix2)
495 open(77,file=gfnvmtgilon,status=
'new',form=
'formatted')
496 write(6,1017)
'lon',trim(gfnvmtgilon)
498 gfnvsdgilon =
'vsdgilon.'//trim(suffix2)
499 open(82,file=gfnvsdgilon,status=
'new',form=
'formatted')
500 write(6,1017)
'lon',trim(gfnvsdgilon)
502 gfnvmdgilon =
'vmdgilon.'//trim(suffix2)
503 open(87,file=gfnvmdgilon,status=
'new',form=
'formatted')
504 write(6,1017)
'lon',trim(gfnvmdgilon)
509 if(.not.nothineht)
then 510 gfnvmagieht =
'vmagieht.'//trim(suffix2)
511 open(93,file=gfnvmagieht,status=
'new',form=
'formatted')
512 write(6,1017)
'eht',trim(gfnvmagieht)
514 gfnvmtgieht =
'vmtgieht.'//trim(suffix2)
515 open(73,file=gfnvmtgieht,status=
'new',form=
'formatted')
516 write(6,1017)
'eht',trim(gfnvmtgieht)
518 gfnvmdgieht =
'vmdgieht.'//trim(suffix2)
519 open(83,file=gfnvmdgieht,status=
'new',form=
'formatted')
520 write(6,1017)
'eht',trim(gfnvmdgieht)
525 if(.not.nothinlat .and. .not.nothinlon)
then 526 gfnvsagihor =
'vsagihor.'//trim(suffix2)
527 open(94,file=gfnvsagihor,status=
'new',form=
'formatted')
528 write(6,1017)
'hor',trim(gfnvsagihor)
530 gfnvmagihor =
'vmagihor.'//trim(suffix2)
531 open(95,file=gfnvmagihor,status=
'new',form=
'formatted')
532 write(6,1017)
'hor',trim(gfnvmagihor)
534 gfnvstgihor =
'vstgihor.'//trim(suffix2)
535 open(74,file=gfnvstgihor,status=
'new',form=
'formatted')
536 write(6,1017)
'hor',trim(gfnvstgihor)
538 gfnvmtgihor =
'vmtgihor.'//trim(suffix2)
539 open(75,file=gfnvmtgihor,status=
'new',form=
'formatted')
540 write(6,1017)
'hor',trim(gfnvmtgihor)
542 gfnvsdgihor =
'vsdgihor.'//trim(suffix2)
543 open(84,file=gfnvsdgihor,status=
'new',form=
'formatted')
544 write(6,1017)
'hor',trim(gfnvsdgihor)
546 gfnvmdgihor =
'vmdgihor.'//trim(suffix2)
547 open(85,file=gfnvmdgihor,status=
'new',form=
'formatted')
548 write(6,1017)
'hor',trim(gfnvmdgihor)
551 1017
format(6x,
'checkgrid.f: ',
552 *
'Opening output grid-interpolated ',a,
' vector file :',a)
559 if(.not.nothinlat)
then 560 gfnvstddlat =
'vstddlat.'//trim(suffix2)
561 open(41,file=gfnvstddlat,status=
'new',form=
'formatted')
562 write(6,1014)
'lat',trim(gfnvstddlat)
564 gfnvmtddlat =
'vmtddlat.'//trim(suffix2)
565 open(46,file=gfnvmtddlat,status=
'new',form=
'formatted')
566 write(6,1014)
'lat',trim(gfnvmtddlat)
569 if(.not.nothinlon)
then 570 gfnvstddlon =
'vstddlon.'//trim(suffix2)
571 open(42,file=gfnvstddlon,status=
'new',form=
'formatted')
572 write(6,1014)
'lon',trim(gfnvstddlon)
574 gfnvmtddlon =
'vmtddlon.'//trim(suffix2)
575 open(47,file=gfnvmtddlon,status=
'new',form=
'formatted')
576 write(6,1014)
'lon',trim(gfnvmtddlon)
579 if(.not.nothineht)
then 580 gfnvmtddeht =
'vmtddeht.'//trim(suffix2)
581 open(43,file=gfnvmtddeht,status=
'new',form=
'formatted')
582 write(6,1014)
'eht',trim(gfnvmtddeht)
585 if(.not.nothinlon .and. .not.nothinlat)
then 586 gfnvstddhor =
'vstddhor.'//trim(suffix2)
587 open(44,file=gfnvstddhor,status=
'new',form=
'formatted')
588 write(6,1014)
'hor',trim(gfnvstddhor)
590 gfnvmtddhor =
'vmtddhor.'//trim(suffix2)
591 open(45,file=gfnvmtddhor,status=
'new',form=
'formatted')
592 write(6,1014)
'hor',trim(gfnvmtddhor)
599 if(.not.nothinlat)
then 600 gfnvsdddlat =
'vsdddlat.'//trim(suffix2)
601 open(51,file=gfnvsdddlat,status=
'new',form=
'formatted')
602 write(6,1014)
'lat',trim(gfnvsdddlat)
604 gfnvmdddlat =
'vmdddlat.'//trim(suffix2)
605 open(56,file=gfnvmdddlat,status=
'new',form=
'formatted')
606 write(6,1014)
'lat',trim(gfnvmdddlat)
609 if(.not.nothinlon)
then 610 gfnvsdddlon =
'vsdddlon.'//trim(suffix2)
611 open(52,file=gfnvsdddlon,status=
'new',form=
'formatted')
612 write(6,1014)
'lon',trim(gfnvsdddlon)
614 gfnvmdddlon =
'vmdddlon.'//trim(suffix2)
615 open(57,file=gfnvmdddlon,status=
'new',form=
'formatted')
616 write(6,1014)
'lon',trim(gfnvmdddlon)
619 if(.not.nothineht)
then 620 gfnvmdddeht =
'vmdddeht.'//trim(suffix2)
621 open(53,file=gfnvmdddeht,status=
'new',form=
'formatted')
622 write(6,1014)
'eht',trim(gfnvmdddeht)
625 if(.not.nothinlat .and. .not.nothinlon)
then 626 gfnvsdddhor =
'vsdddhor.'//trim(suffix2)
627 open(54,file=gfnvsdddhor,status=
'new',form=
'formatted')
628 write(6,1014)
'hor',trim(gfnvsdddhor)
630 gfnvmdddhor =
'vmdddhor.'//trim(suffix2)
631 open(55,file=gfnvmdddhor,status=
'new',form=
'formatted')
632 write(6,1014)
'hor',trim(gfnvmdddhor)
639 if(.not.nothinlat)
then 640 gfnvsaddlat =
'vsaddlat.'//trim(suffix2)
641 open(61,file=gfnvsaddlat,status=
'new',form=
'formatted')
642 write(6,1014)
'lat',trim(gfnvsaddlat)
644 gfnvmaddlat =
'vmaddlat.'//trim(suffix2)
645 open(66,file=gfnvmaddlat,status=
'new',form=
'formatted')
646 write(6,1014)
'lat',trim(gfnvmaddlat)
649 if(.not.nothinlon)
then 650 gfnvsaddlon =
'vsaddlon.'//trim(suffix2)
651 open(62,file=gfnvsaddlon,status=
'new',form=
'formatted')
652 write(6,1014)
'lon',trim(gfnvsaddlon)
654 gfnvmaddlon =
'vmaddlon.'//trim(suffix2)
655 open(67,file=gfnvmaddlon,status=
'new',form=
'formatted')
656 write(6,1014)
'lon',trim(gfnvmaddlon)
659 if(.not.nothineht)
then 660 gfnvmaddeht =
'vmaddeht.'//trim(suffix2)
661 open(63,file=gfnvmaddeht,status=
'new',form=
'formatted')
662 write(6,1014)
'eht',trim(gfnvmaddeht)
665 if(.not.nothinlat .and. .not.nothinlon)
then 666 gfnvsaddhor =
'vsaddhor.'//trim(suffix2)
667 open(64,file=gfnvsaddhor,status=
'new',form=
'formatted')
668 write(6,1014)
'hor',trim(gfnvsaddhor)
670 gfnvmaddhor =
'vmaddhor.'//trim(suffix2)
671 open(65,file=gfnvmaddhor,status=
'new',form=
'formatted')
672 write(6,1014)
'hor',trim(gfnvmaddhor)
675 1014
format(6x,
'checkgrid.f: ',
676 *
'Opening output differential ',a,
' vector file :',a)
685 write(6,1004)trim(region),glamn,glamx,glomn,glomx
686 1004
format(6x,
'checkgrid.f: Region= ',a,/,
687 * 6x,
'checkgrid.f: North = ',f12.6,/,
688 * 6x,
'checkgrid.f: South = ',f12.6,/,
689 * 6x,
'checkgrid.f: West = ',f12.6,/,
690 * 6x,
'checkgrid.f: East = ',f12.6)
693 8002
format(50(
'*'),/,
694 *6x,
'checkgrid.f: BEGIN STATISTICAL REPORT ',
695 *
'(grid minus true vector diffs)')
709 if(i.eq.1 .and. nothinlat)
goto 1
710 if(i.eq.2 .and. nothinlon)
goto 1
711 if(i.eq.3 .and. nothineht)
goto 1
714 read(ifil)glamn,glomn,dla,dlo,nla,nlo,ikind
716 if(i.eq.1)
read(ifil)(datlats(j,k),k=1,nlo)
717 if(i.eq.2)
read(ifil)(datlons(j,k),k=1,nlo)
718 if(i.eq.3)
read(ifil)(datehtm(j,k),k=1,nlo)
722 glamx = glamn + (nla-1)*dla
723 glomx = glomn + (nlo-1)*dlo
769 if(i.eq.3)stat(i,j,k,l) = 99999.d0
770 if(i.eq.4)stat(i,j,k,l) =-99999.d0
809 if(j.eq.1 .and. nothinlat)
goto 2001
810 if(j.eq.2 .and. nothinlon)
goto 2001
811 if(j.eq.3 .and. nothineht)
goto 2001
817 if(k.eq.1)ifile = 20+j
818 if(k.eq.2)ifile = 30+j
822 101
read(ifile,
'(a)',end=103)card
827 if(j.eq.1 .or. j.eq.2)
read(card, 102)xlo,xla,vvec
828 if(j.eq.3 )
read(card,1102)xlo,xla,vvec
832 if(xla.gt.glamx .or. xla.lt.glamn .or.
833 * xlo.gt.glomx .or. xlo.lt.glomn)
then 843 pid0(itot) = card(74:79)
850 if(j.eq.1)
call bilin(datlats,glamn,glomn,dla,dlo,
851 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(1))
852 if(j.eq.2)
call bilin(datlons,glamn,glomn,dla,dlo,
853 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(1))
854 if(j.eq.3)
call bilin(datehtm,glamn,glomn,dla,dlo,
855 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(1))
858 if(j.eq.1)
call biquad(datlats,glamn,glomn,dla,dlo,
859 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(2))
860 if(j.eq.2)
call biquad(datlons,glamn,glomn,dla,dlo,
861 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(2))
862 if(j.eq.3)
call biquad(datehtm,glamn,glomn,dla,dlo,
863 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(2))
866 if(j.eq.1)
call bicubic(datlats,glamn,glomn,dla,dlo,
867 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(3))
868 if(j.eq.2)
call bicubic(datlons,glamn,glomn,dla,dlo,
869 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(3))
870 if(j.eq.3)
call bicubic(datehtm,glamn,glomn,dla,dlo,
871 * nla,nlo,maxlat,maxlon,xla,xlo,vgrd(3))
875 dd(l) = vgrd(l) - vvec
879 vgrdm(l) = vgrd(l) * s2m
882 coslat = dcos(xla*d2r)
883 vgrdm(l) = vgrd(l) * s2m * coslat
884 ddm(l) = dd(l) * s2m * coslat
909 stat(1,j,k,l) = stat(1,j,k,l) + dd(l)
910 stat(1,j,3,l) = stat(1,j,3,l) + dd(l)
912 stat(1,j+3,k,l) = stat(1,j+3,k,l) + ddm(l)
913 stat(1,j+3,3,l) = stat(1,j+3,3,l) + ddm(l)
917 stat(2,j,k,l) = stat(2,j,k,l) + dd(l)**2
918 stat(2,j,3,l) = stat(2,j,3,l) + dd(l)**2
920 stat(2,j+3,k,l) = stat(2,j+3,k,l) + ddm(l)**2
921 stat(2,j+3,3,l) = stat(2,j+3,3,l) + ddm(l)**2
924 if(dd(l).lt.stat(3,j,k,l))stat(3,j,k,l)=dd(l)
925 if(dd(l).lt.stat(3,j,3,l))stat(3,j,3,l)=dd(l)
927 if(ddm(l).lt.stat(3,j+3,k,l))stat(3,j+3,k,l)=ddm(l)
928 if(ddm(l).lt.stat(3,j+3,3,l))stat(3,j+3,3,l)=ddm(l)
932 if(dd(l).gt.stat(4,j,k,l))stat(4,j,k,l)=dd(l)
933 if(dd(l).gt.stat(4,j,3,l))stat(4,j,3,l)=dd(l)
935 if(ddm(l).gt.stat(4,j+3,k,l))stat(4,j+3,k,l)=ddm(l)
936 if(ddm(l).gt.stat(4,j+3,3,l))stat(4,j+3,3,l)=ddm(l)
953 gim0(itot) = vgrdm(2)
955 avegiprime = avegiprime + dabs(gi0(itot))
956 avegimeter = avegimeter + dabs(gim0(itot))
960 kstat(j,k)=kstat(j,k) + 1
962 kstat(j+3,k)=kstat(j+3,k) + 1
965 kstat(j,3)=kstat(j,3) + 1
967 kstat(j+3,3)=kstat(j+3,3) + 1
982 avegiprime = avegiprime / dble(kall)
983 avegimeter = avegimeter / dble(kall)
988 if(kall.ne.kthin+kdrop)
then 989 write(6,*)
' Thin+Drop .DNE. All => STOP' 993 write(6,*)
' itot .DNE. All => STOP' 999 fac(j,k) = dble(kstat(j,k))/dble(kstat(j,k)-1)
1001 fac(j+3,k) = dble(kstat(j+3,k))/dble(kstat(j+3,k)-1)
1004 stat(1,j,k,l)=stat(1,j,k,l)/kstat(j,k)
1005 stat(2,j,k,l)=dsqrt(stat(2,j,k,l)/kstat(j,k))
1006 stat(5,j,k,l)=dsqrt(fac(j,k)*
1007 * (stat(2,j,k,l)**2 - stat(1,j,k,l)**2))
1010 stat(1,j+3,k,l)=stat(1,j+3,k,l)/kstat(j+3,k)
1011 stat(2,j+3,k,l)=dsqrt(stat(2,j+3,k,l)/kstat(j+3,k))
1012 stat(5,j+3,k,l)=dsqrt(fac(j+3,k)*
1013 * (stat(2,j+3,k,l)**2 - stat(1,j+3,k,l)**2))
1035 rms0prime = stat(2,j,3,2)
1036 lorvogprime =
onzd2(multiplierlorvog*rms0prime)
1041 gprime2pc = lorvopc / lorvogprime
1042 scaledd(j) = gprime2pc
1043 basedd(j) = rms0prime
1045 rms0meters = stat(2,j+3,3,2)
1046 lorvogmeters =
onzd2(multiplierlorvog*rms0meters)
1051 gmeters2pc = lorvopc / lorvogmeters
1052 scaledd(j+3) = gmeters2pc
1053 basedd(j+3) = rms0meters
1055 lorvog(j) = lorvogprime
1056 if(j.lt.3)lorvog(j+3) = lorvogmeters
1063 lorvogprimegi =
onzd2(multiplierlorvog*avegiprime)
1067 gprime2pcgi = lorvopc / lorvogprimegi
1068 scalegi(j) = gprime2pcgi
1069 basegi(j) = avegiprime
1071 lorvogmetersgi =
onzd2(multiplierlorvog*avegimeter)
1076 gmeters2pcgi = lorvopc / lorvogmetersgi
1077 scalegi(j+3) = gmeters2pcgi
1078 basegi(j+3) = avegimeter
1080 lorvoggi(j) = lorvogprimegi
1081 if(j.lt.3)lorvoggi(j+3) = lorvogmetersgi
1091 pvlat = (pvlat / 100.d0)
1092 pvlon = (pvlon / 100.d0)
1102 if(ipt.le.kthin)
then 1110 if(j.eq.1 .or. j.eq.3)
then 1111 if(dd0(ipt).lt.0)
then 1117 if(dd0(ipt).lt.0)
then 1125 if(j.eq.1 .or. j.eq.3)
then 1126 if(gi0(ipt).lt.0)
then 1132 if(gi0(ipt).lt.0)
then 1142 vcprime = dabs(dd0(ipt)*gprime2pc)
1144 vcmeters = dabs(ddm0(ipt) * gmeters2pc)
1147 giprime = dabs(gi0(ipt)*gprime2pcgi)
1149 gimeters = dabs(gim0(ipt) * gmeters2pcgi)
1156 if(j.eq.1 .or. j.eq.2)
then 1158 write(ifout1 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1159 * dd0(ipt),ddm0(ipt),pid0(ipt)
1161 write(ifout1+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1162 * gi0(ipt),gim0(ipt),pid0(ipt)
1166 write(ifout2 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1167 * dd0(ipt),ddm0(ipt),pid0(ipt)
1169 write(ifout2+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1170 * gi0(ipt),gim0(ipt),pid0(ipt)
1174 write(ifout1+5 ,140)xlo0(ipt),xla0(ipt),az,vcmeters,
1175 * dd0(ipt),ddm0(ipt),pid0(ipt)
1177 write(ifout1+35,140)xlo0(ipt),xla0(ipt),azgi,gimeters,
1178 * gi0(ipt),gim0(ipt),pid0(ipt)
1182 write(ifout2+5 ,140)xlo0(ipt),xla0(ipt),az,vcmeters,
1183 * dd0(ipt),ddm0(ipt),pid0(ipt)
1185 write(ifout2+35,140)xlo0(ipt),xla0(ipt),azgi,gimeters,
1186 * gi0(ipt),gim0(ipt),pid0(ipt)
1194 write(ifout1 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1195 * 0.d0 ,ddm0(ipt),pid0(ipt)
1197 write(ifout1+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1198 * 0.d0 ,gim0(ipt),pid0(ipt)
1202 write(ifout2 ,140)xlo0(ipt),xla0(ipt),az,vcprime,
1203 * 0.d0 ,ddm0(ipt),pid0(ipt)
1205 write(ifout2+30,140)xlo0(ipt),xla0(ipt),azgi,giprime,
1206 * 0.d0 ,gim0(ipt),pid0(ipt)
1213 140
format(f16.10,1x,f15.10,1x,f6.2,1x,f12.2,1x,f9.5,1x,f9.3,1x,a6)
1219 write(6,8000)trim(coord(j)),units(j)
1221 write(6,8001)
type(k),
1222 * (kstat(j,k),l=1,3),
1223 * (stat(1,j,k,l),l=1,3),
1224 * (stat(2,j,k,l),l=1,3),
1225 * (stat(5,j,k,l),l=1,3),
1226 * (stat(3,j,k,l),l=1,3),
1227 * (stat(4,j,k,l),l=1,3)
1231 write(6,8000)trim(coord(j)),units(j+3)
1233 write(6,8001)
type(k),
1234 * (kstat(j+3,k),l=1,3),
1235 * (stat(1,j+3,k,l),l=1,3),
1236 * (stat(2,j+3,k,l),l=1,3),
1237 * (stat(5,j+3,k,l),l=1,3),
1238 * (stat(3,j+3,k,l),l=1,3),
1239 * (stat(4,j+3,k,l),l=1,3)
1248 102
format(f16.10,1x,f15.10,1x, 6x,1x, 12x,1x,f9.5,1x, 9x,1x,a6)
1250 1102
format(f16.10,1x,f15.10,1x, 6x,1x, 12x,1x, 9x,1x,f9.3,1x,a6)
1254 *//,25x,a,
' in ',a,/,
1256 *7x,
'Bilinear',5x,
'Biquadratic',
1259 *
'Num:',3(i15 ,1x),/,
1260 *5x,
'Ave:',3(f15.6,1x),/,
1261 *5x,
'RMS:',3(f15.6,1x),/,
1262 *5x,
'STD:',3(f15.6,1x),/,
1263 *5x,
'MIN:',3(f15.6,1x),/,
1264 *5x,
'MAX:',3(f15.6,1x),/,
1269 *6x,
'checkgrid.f: END STATISTICAL REPORT ',
1270 *
'(grid minus true vector diffs)',/,
1280 *6x,
'checkgrid.f: Generating HORIZONTAL vector files',
1281 *
' from lat/lon vector files')
1282 5072
format(
'FATAL in checkgrid: Mismatched PID for hor')
1283 5073
format(
'FATAL in checkgrid: Mismatched LON for hor')
1284 5074
format(
'FATAL in checkgrid: Mismatched LAT for hor')
1295 baseddhors = sqrt(basedd(1)**2+basedd(2)**2)
1296 baseddhorm = sqrt(basedd(4)**2+basedd(5)**2)
1297 basegihors = sqrt(basegi(1)**2+basegi(2)**2)
1298 basegihorm = sqrt(basegi(4)**2+basegi(5)**2)
1311 lorvoghorddm =
onzd2(multiplierlorvog*baseddhorm)
1315 gm2pchordd = lorvopc / lorvoghorddm
1317 lorvoghordds =
onzd2(multiplierlorvog*baseddhors)
1321 gs2pchordd = lorvopc / lorvoghordds
1323 lorvoghorgim =
onzd2(multiplierlorvog*basegihorm)
1327 gm2pchorgi = lorvopc / lorvoghorgim
1329 lorvoghorgis =
onzd2(multiplierlorvog*basegihors)
1333 gs2pchorgi = lorvopc / lorvoghorgis
1335 lorvog(6) = lorvoghordds
1336 lorvog(7) = lorvoghorddm
1338 lorvoggi(6) = lorvoghorgis
1339 lorvoggi(7) = lorvoghorgim
1341 convgs2pcddlat = lorvopc / lorvog(1)
1342 convgs2pcddlon = lorvopc / lorvog(2)
1344 convgm2pcddlat = lorvopc / lorvog(4)
1345 convgm2pcddlon = lorvopc / lorvog(5)
1347 convgs2pcgilat = lorvopc / lorvoggi(1)
1348 convgs2pcgilon = lorvopc / lorvoggi(2)
1350 convgm2pcgilat = lorvopc / lorvoggi(4)
1351 convgm2pcgilon = lorvopc / lorvoggi(5)
1365 convgs2pcddlat = scaledd(1)
1366 convgs2pcddlon = scaledd(2)
1367 convgm2pcddlat = scaledd(4)
1368 convgm2pcddlon = scaledd(5)
1369 convgs2pcgilat = scalegi(1)
1370 convgs2pcgilon = scalegi(2)
1371 convgm2pcgilat = scalegi(4)
1372 convgm2pcgilon = scalegi(5)
1386 convgs2pcddhor = dsqrt(convgs2pcddlat**2 + convgs2pcddlon**2)
1387 convgm2pcddhor = dsqrt(convgm2pcddlat**2 + convgm2pcddlon**2)
1388 convgs2pcgihor = dsqrt(convgs2pcgilat**2 + convgs2pcgilon**2)
1389 convgm2pcgihor = dsqrt(convgm2pcgilat**2 + convgm2pcgilon**2)
1399 convgs2pcddhor = gs2pchordd
1400 convgm2pcddhor = gm2pchordd
1401 convgs2pcgihor = gs2pchorgi
1402 convgm2pcgihor = gm2pchorgi
1414 if(i.le.60 .and. j.eq.1)conv = convgs2pcddhor
1415 if(i.le.60 .and. j.eq.2)conv = convgm2pcddhor
1416 if(i.ge.70 .and. j.eq.1)conv = convgs2pcgihor
1417 if(i.ge.70 .and. j.eq.2)conv = convgm2pcgihor
1419 ilat = i+1 + (j-1)*5
1420 ilon = i+2 + (j-1)*5
1421 ihor = i+4 + (j-1)*1
1426 5078
read(ilat,140,end=5071)ylo1,yla1,az1,vc1,sec1,xmet1,pid1
1427 read(ilon,140)ylo2,yla2,az2,vc2,sec2,xmet2,pid2
1428 if(pid1.ne.pid2)
then 1432 if(ylo1.ne.ylo2)
then 1436 if(yla1.ne.yla2)
then 1440 azhor = datan2(xmet2,xmet1)/d2r
1441 if(azhor.lt.0.d0)azhor=azhor+360.d0
1442 dhors = dsqrt(sec1**2 + sec2**2)
1443 dhorm = dsqrt(xmet1**2 + xmet2**2)
1445 if(j.eq.1)vchor = conv * dhors
1446 if(j.eq.2)vchor = conv * dhorm
1448 write(ihor,140)ylo1,yla1,azhor,vchor,dhors,dhorm,pid1
1460 sfn =
'dvstats.'//trim(suffix2)
1461 open(2,file=sfn,status=
'new',form=
'formatted')
1466 write(2,777)kstat(1,3),stat(2,1,3,2)
1467 write(2,777)kstat(2,3),stat(2,2,3,2)
1468 write(2,777)kstat(3,3),stat(2,3,3,2)
1469 write(2,777)kstat(1,3),stat(2,4,3,2)
1470 write(2,777)kstat(2,3),stat(2,5,3,2)
1472 rhors = sqrt(stat(2,1,3,2)**2 + stat(2,2,3,2)**2)
1473 rhorm = sqrt(stat(2,4,3,2)**2 + stat(2,5,3,2)**2)
1474 write(2,777)kstat(1,3),rhors
1475 write(2,777)kstat(2,3),rhorm
1478 777
format(i10,1x,f20.10)
1496 gmtfile =
'gmtbat04.'//trim(suffix3)
1497 open(99,file=gmtfile,status=
'new',form=
'formatted')
1498 write(6,1011)trim(gmtfile)
1499 1011
format(6x,
'checkgrid.f: Creating GMT batch file ',a)
1500 write(99,1030)trim(gmtfile)
1501 1030
format(
'echo BEGIN batch file ',a)
1511 *bw,be,bs,bn,jm,b1,b2,fn,lrv,rv0x,rv0y,rl0y)
1523 write(6,1006)trim(region)
1524 1006
format(6x,
'checkgrid.f: Calling getmapbounds for region ',a)
1550 *
'# ------------------------------',/,
1551 *
'# Double Difference Vector Plots',/,
1552 *
'# ------------------------------',/,
1553 *
'echo Double Difference Vector Plots')
1556 *
'# ------------------------------',/,
1557 *
'# Grid Interpolated Vector Plots',/,
1558 *
'# ------------------------------',/,
1559 *
'echo Grid Interpolated Vector Plots')
1562 *
'# ------------------------------',/,
1563 *
'# Plots for region: ',a,
', sub-region: ',a,/,
1564 *
'# ------------------------------',/,
1565 *
'echo Creating plots for region: ',a,
', sub-region: ',a)
1574 write(99,990)trim(region),trim(fn(ij)),
1575 * trim(region),trim(fn(ij))
1620 if(j.eq.1.and.k.eq.1)gfn = gfnvstgilat
1621 if(j.eq.1.and.k.eq.2)gfn = gfnvsdgilat
1622 if(j.eq.1.and.k.eq.3)gfn = gfnvsagilat
1624 if(j.eq.2.and.k.eq.1)gfn = gfnvstgilon
1625 if(j.eq.2.and.k.eq.2)gfn = gfnvsdgilon
1626 if(j.eq.2.and.k.eq.3)gfn = gfnvsagilon
1628 if(j.eq.3.and.k.eq.1)gfn = gfnvmtgieht
1629 if(j.eq.3.and.k.eq.2)gfn = gfnvmdgieht
1630 if(j.eq.3.and.k.eq.3)gfn = gfnvmagieht
1632 if(j.eq.4.and.k.eq.1)gfn = gfnvmtgilat
1633 if(j.eq.4.and.k.eq.2)gfn = gfnvmdgilat
1634 if(j.eq.4.and.k.eq.3)gfn = gfnvmagilat
1636 if(j.eq.5.and.k.eq.1)gfn = gfnvmtgilon
1637 if(j.eq.5.and.k.eq.2)gfn = gfnvmdgilon
1638 if(j.eq.5.and.k.eq.3)gfn = gfnvmagilon
1640 if(j.eq.6.and.k.eq.1)gfn = gfnvstgihor
1641 if(j.eq.6.and.k.eq.2)gfn = gfnvsdgihor
1642 if(j.eq.6.and.k.eq.3)gfn = gfnvsagihor
1644 if(j.eq.7.and.k.eq.1)gfn = gfnvmtgihor
1645 if(j.eq.7.and.k.eq.2)gfn = gfnvmdgihor
1646 if(j.eq.7.and.k.eq.3)gfn = gfnvmagihor
1650 *
call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1651 * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1652 * xvlat,xllon,xllat,lorvoggi(j),lorvopc,igridsec,fn)
1654 if(kstat(1,k).ne.0 .and. kstat(2,k).ne.0)
1655 *
call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1656 * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1657 * xvlat,xllon,xllat,lorvoggi(j),lorvopc,igridsec,fn)
1672 write(99,990)trim(region),trim(fn(ij)),
1673 * trim(region),trim(fn(ij))
1719 if(j.eq.1.and.k.eq.1)gfn = gfnvstddlat
1720 if(j.eq.1.and.k.eq.2)gfn = gfnvsdddlat
1721 if(j.eq.1.and.k.eq.3)gfn = gfnvsaddlat
1723 if(j.eq.2.and.k.eq.1)gfn = gfnvstddlon
1724 if(j.eq.2.and.k.eq.2)gfn = gfnvsdddlon
1725 if(j.eq.2.and.k.eq.3)gfn = gfnvsaddlon
1727 if(j.eq.3.and.k.eq.1)gfn = gfnvmtddeht
1728 if(j.eq.3.and.k.eq.2)gfn = gfnvmdddeht
1729 if(j.eq.3.and.k.eq.3)gfn = gfnvmaddeht
1731 if(j.eq.4.and.k.eq.1)gfn = gfnvmtddlat
1732 if(j.eq.4.and.k.eq.2)gfn = gfnvmdddlat
1733 if(j.eq.4.and.k.eq.3)gfn = gfnvmaddlat
1735 if(j.eq.5.and.k.eq.1)gfn = gfnvmtddlon
1736 if(j.eq.5.and.k.eq.2)gfn = gfnvmdddlon
1737 if(j.eq.5.and.k.eq.3)gfn = gfnvmaddlon
1739 if(j.eq.6.and.k.eq.1)gfn = gfnvstddhor
1740 if(j.eq.6.and.k.eq.2)gfn = gfnvsdddhor
1741 if(j.eq.6.and.k.eq.3)gfn = gfnvsaddhor
1743 if(j.eq.7.and.k.eq.1)gfn = gfnvmtddhor
1744 if(j.eq.7.and.k.eq.2)gfn = gfnvmdddhor
1745 if(j.eq.7.and.k.eq.3)gfn = gfnvmaddhor
1749 *
call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1750 * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1751 * xvlat,xllon,xllat,lorvog(j),lorvopc,igridsec,fn)
1753 if(kstat(1,k).ne.0 .and. kstat(2,k).ne.0)
1754 *
call bwplotvc(ele(j),gfn,bw,be,bs,bn,jm,b1,b2,
1755 * maxplots,olddtm,newdtm,region,el0(j),ij,xvlon,
1756 * xvlat,xllon,xllat,lorvog(j),lorvopc,igridsec,fn)
1768 write(99,1031)trim(gmtfile)
1769 1031
format(
'echo END batch file ',a)
1773 9999
format(
'END program checkgrid.f')
1779 subroutine nlines(ifile,num,ilogic)
1786 1
read(ifile,
'(a)',end=2)dummy
1789 2
if(num.eq.0)ilogic = .true.
1796 include
'Subs/getmapbounds.f' 1797 include
'Subs/getgridbounds.f' 1798 include
'Subs/bwplotvc.f' 1799 include
'Subs/plotcoast.f' 1801 include
'Subs/bilin.f' 1802 include
'Subs/biquad.f' 1803 include
'Subs/bicubic.f' 1804 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.
subroutine nlines(ifile, num, ilogic)
subroutine bilin(data, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
Subroutine to perform bilinear interpolation.
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 bicubic(z, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
Subroutine to perform a 2-D cubic ("bicubic") interpolation.
subroutine getgridbounds(region, xn, xs, xw, xe)
Subroutine to collect up the GRID boundaries for use in creating NADCON 5.
program checkgrid
Part of the NADCON5 build process, generates gmtbat04
subroutine biquad(z, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
Subroutine to perform a 2-D quadratic ("biquadratic") interpolation.