character*8 sta(11000),s,name(11000),clock character infile*65,pairs*65,dat*9,ans*1 logical exists dimension nc(11000),lat(11000),lon(11000),jel(11000),icb(11000), 1 kob(11000),line(11000) data itest,m,n,null,ieldif,icbdif,match/7*0/ print 100 100 format (' REDUND, 2-95, Plouff. To list and output stations ', 1 'that are close to others',/,' in a plouff-format file.') inquire (file='REDUND.PNT',exist=exists) if (exists) then print 101 101 format (' **You already have a print file called REDUND.PNT.', 1 /,' Do you want to STOP so that it is not overwritten?') read 501, ans 501 format (a1) if (ans .eq. 'Y' .or. ans .eq. 'y' .or. ans .eq. ' ' .or. ans 1 .eq. 'Q') stop end if print 102 102 format (' TYPE the name of the plouff-file to be tested for ', 1 'redundant stations:') read 565, infile 565 format (a65) inquire (file=infile,exist=exists) if (.not. exists) then print 103 103 format (' That file does not exist. Try again.') read 565, infile inquire (file=infile,exist=exists) if (.not. exists) then print 104 104 format (' **STOP. That file does not exist.') stop end if end if open (15,file=infile,form='formatted',status='old',blank='zero') open (16,file='REDUND.PNT',form='formatted',status='unknown') call date(dat) call time(clock) write (16,600) dat,clock 600 format (1x,a9,1x,a8) write (16,100) write (16,601) infile 601 format (' List of redundant stations from gravity data in ', 1 'plouff-file:',/,2x,a65) print 105 105 format (' The test is based on closeness of geographic coordi', 1 'nates. Do not select a',/,' distance that includes adja', 2 'cent stations along a closely spaced profile.') 88 print 106 106 format (' TYPE the redundancy distance in decimal minutes ', 1 '(geographic):') read (5,*,err=88) d id=100.0*abs(d)+0.5 print 107 107 format (' Do want to create an abbreviated plouff-file ', 1 'of pairs of redundant stations',/,' for later testing?') read 501, ans if (ans .eq. 'Y' .or. ans .eq. 'y' .or. ans .eq. ' ') then itest =1 if (itest .eq. 0) go to 7 print 108 108 format (' TYPE the name of that file:') read 565, pairs inquire (file=pairs,exist=exists) if (exists) then print 109 109 format (' That file exists. Do you want to STOP to save ', 1 'it from being overwritten?') read 501, ans if (ans .eq. 'Y' .or. ans .eq. 'y' .or. ans .eq. ' ' .or. ans 1 .eq. 'Q') then print 110 write (16,110) 110 format (' **STOPPED to find another file name for match', 1 'ing pairs.') go to 99 end if end if 7 open (7,file=pairs,form='formatted',status='unknown') write (16,602) pairs 602 format (' Pairs of redundant stations are in file:',/,2x,a65) end if write (16,603) d 603 format(' Geographic offset=',f5.2,' minute.',/,' Elevation dif', 1 'ferences in feet; CB1-differences to 0.1-mGal.',/, 2 ' Differences that are too large to print will be listed as ', 3 'nines.',/,' List of close pairs of stations:') write (16,604) 604 format (' LINE STATION LATIT LONGIT ELEV/ERR OBS.GRV/ERR', 1 4x,'CB1/ERR STATION') 1 n=n+1 read (15,500,err=6,end=9) s,latd,latm,lond,lonm,kel,lob,kcb 500 format (bz,a8,1x,i2,i4,1x,i3,i4,i6,i7,27x,i6) c Coordinates in 0.01-minute units; protect negative longitude. lt=6000*latd+latm ln=6000*iabs(lond)+lonm if (lt .ne. 0) go to 8 null=null+1 line(null)=n name(null)=s go to 3 8 if (n .eq. 1) go to 3 c Loop to test previous unique stations do 2 j=1,m k=j ltd=iabs(lat(j)-lt) if (ltd .gt. id) go to 2 lnd=iabs(lon(j)-ln) if (lnd .le. id) go to 5 2 continue c No match found. A unique station. 3 m=m+1 if (m .lt. 11001) go to 4 print 111, n 111 format (' **STOP. 11,000 unique stations exceeded at line',i5) go to 99 4 nc(m)=n lat(m)=lt lon(m)=ln jel(m)=kel kob(m)=lob icb(m)=kcb sta(m)=s go to 1 5 match=match+1 ltd=lat(k)/6000 ltm=lat(k)-6000*ltd lnd=lon(k)/6000 lnm=lon(k)-6000*lnd iogdif=lob-kob(k) call tenth (jel(k),kel,ieldif) call tenth (icb(k),kcb,icbdif) write (16,606) nc(k),sta(k),ltd,ltm,lnd,lnm,jel(k), 1 kob(k),icb(k),sta(k) 606 format (i6,1x,a8,i3,i5,i4,i5,i7,3x,i8,5x,i7,4x,a8,' FIRST') C 3 statements protect against overflow asterisks. if (ieldif .lt. -99 .or. ieldif .gt. 999) ieldif=999 if (iogdif .lt. -9999 .or. iogdif .gt. 99999) iogdif=99999 if (icbdif .lt. -99 .or. icbdif .gt. 999) icbdif=999 write (16,605) n,s,latd,latm,lond,lonm,kel,ieldif,lob,iogdif, 1 kcb,icbdif,s 605 format (i6,1x,a8,i3,i5,i4,i5,i7,i3,i8,i5,i7,i3,1x,a8, 1 ' MATCH') if (itest .ne. 0) write (7,700) sta(k),ltd,ltm,lnd,lnm,jel(k), 1 kob(k),s,latd,latm,lond,lonm,kel,lob 700 format (a8,1x,i2,i4,1x,i3,i4,i6,i7,/, 1 a8,1x,i2,i4,1x,i3,i4,i6,i7) go to 1 6 write (16,607) n print 607, n 607 format (' **Premature STOP. Bad format on input line',i5,'.') go to 99 9 n=n-1 print 609, match,n write (16,609) match,n 609 format (/,i6,' pairs of closely spaced stations in file of', 1 i6,' stations.') if (null .eq. 0) go to 99 print 112, null 112 format (' See REDUND.PNT for list of',i5,' stations without ', 1 'geographic coordinates.') write (16,610) null 610 format (' List of',i5,' stations (and line numbers) of stations', 1 ' with latitude=0:') write (16,611) (name(i),line(i),i=1,null) 611 format (5(1x,a8,' (',i4,')')) 99 print 119 119 format (' The results of this program are in a file named ', 1 'REDUND.PNT') close (15) close (16) if (itest .ne. 0) close (7) stop end subroutine tenth (i1,i2,idiff) idf=i2-i1 c Round the absolute value of the difference idiff=(5+iabs(idf))/10 if (idf .lt. 0) idiff=-idiff return end