character dat*9,s*8,clock*8,rest*57,ans*1,tempfile*12 character*65 oddfile,discards,fileout,goodfile,r4*4 logical exists dimension lat(11000),lon(11000) data idel,m,n/3*0/ print 200 200 format (' REDUNDEL, Plouff. Deletes stations in a newly acquir', 1 'ed file that are too',/,' close to stations in a reliable ', 2 'file (both plouff format).') tempfile='REDUNDEL.PNT' inquire (file=tempfile,exist=exists) if (exists) then print 201 201 format (' A print file REDUNDEL.PNT already exists.',/,' Do ', 1 'want to stop to rename it before it''s overwritten?') read 501, ans 501 format (a1) if (ans .eq. 'Y' .or. ans .eq. 'y' .or. ans .eq. ' ') stop end if print 103 103 format (' TYPE the name of your reliable file:') read 100, goodfile 100 format (a65) inquire (file=goodfile,exist=exists) if (.not. exists) then print 102 102 format (' File was not found. Try again.') print 103 read 100, goodfile inquire (file=goodfile,exist=exists) if (.not. exists) then print 104 104 format (' **STOP. File again was not found.') stop end if end if print 105 105 format (' TYPE the name of your new file:') read 100, oddfile inquire (file=oddfile,exist=exists) if (.not. exists) then print 102 print 105 read 100, oddfile inquire (file=oddfile,exist=exists) if (.not. exists) then print 104 stop end if end if open (12,file='REDUNDEL.PNT',form='formatted',status='unknown') call date(dat) call time(clock) write (12,120) dat,clock,oddfile,goodfile 120 format (' REDUNDEL. ',a9,1x,a8,/,' Program to delete stations ', 1 'with locations in a new file:',/,5x,a65,/,' that nearly ', 2 'coincide with presumed reliable stations in an old file:',/, 3 5x,a65) print 107 107 format (' The test is based on closeness of geographic ', 1 'coordinates.'/,' TYPE the redundancy distance in minutes ', 2 '(geographic) (first try 0.0):') read (5,*,err=88) d id=100.0*d+0.5 print 108 108 format (' TYPE the name of a file for stations from the new ', 1 'file that are not',/,' too close to stations in the old ', 2 'file:') read 100, fileout inquire (file=fileout,exist=exists) if (exists) then print 109 109 format (' That output file already exists. Do you want to ', 1 'overwrite it?') read 501, ans if (ans .eq. 'Y' .or. ans .eq. 'y' .or. ans .eq. ' ') then write (12,121) fileout 121 format (' Overwritten file: ',a65) else write (12,122) fileout print 122, fileout 122 format (' You decided to stop to rerun REDUNDEL or rename ', 1 'file:',/,a65) close (12) stop end if end if write (12,601) fileout 601 format (' Stations from the new file that are not redundant ', 1 'are stored in file:',/,2x,a65) write (12,620) d 620 format(' Geographic offset=',f5.2,' minute.') print 206 206 format (' Do you also want to create a file of stations that ', 1 'were discarded?') read 501, ans if (ans .eq. 'Y' .or. ans .eq. 'y' .or. ans .eq. ' ') then print 207 207 format (' TYPE the name of that file:') read 100, discards inquire (file=discards,exist=exists) if (exists) then print 109 read 501, ans if (ans .eq. 'Y' .or. ans .eq. 'y' .or. ans .eq. ' ') then write (12,121) discards else write (12,122) discards print 122, discards close (12) stop end if end if open (13,file=discards,form='formatted',status='unknown') write (12,602) discards 602 format (' Redundant stations are stored in file:',/,2x,a65) idel=1 end if open (10,file=goodfile,form='formatted',status='old', 1 blank='zero') open (11,file=oddfile,form='formatted',status='old', 1 blank='zero') open (7,file=fileout,form='formatted',status='unknown') 10 n=n+1 if (n .lt. 11001) go to 4 print 203 write (12,203) 203 format(' STOP. 11000 stations exceeded in old file. Subdivide.') go to 99 4 read (10,500,err=6,end=8) latd,latm,lond,lonm 500 format (bz,9x,i2,i4,1x,i3,i4) c Coordinates in 0.01-minute units lat(n)=6000*latd+latm lon(n)=6000*lond+lonm go to 10 8 n=n-1 print 110, n write (12,110) n 110 format (' There are',i6,' stations in the old file.') match=0 nomatch=0 1 m=m+1 read (11,503,err=6,end=9) s,latd,latm,lond,lonm,rest,r4 503 format (bz,a8,1x,i2,i4,1x,i3,i4,a57,a4) c Coordinates in 0.01-minute units lt=6000*latd+latm ln=6000*lond+lonm c Loop to test old file for a match do 2 j=1,n 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. nomatch=nomatch+1 if (r4 .ne. ' ') then write (7,703) s,latd,latm,lond,lonm,rest,r4 703 format (bz,a8,1x,i2,i4,1x,i3,i4,a57,a4) else write (7,704) s,latd,latm,lond,lonm,rest 704 format (bz,a8,1x,i2,i4,1x,i3,i4,a57) end if go to 1 c A match found 5 match=match+1 if (idel .ne. 1) go to 1 if (r4 .ne. ' ') then write (13,703) s,latd,latm,lond,lonm,rest,r4 else write (13,704) s,latd,latm,lond,lonm,rest end if go to 1 6 print 666, m write (12,666) m 666 format (' ****STOP. Bad format on line',i5) go to 99 9 m=m-1 print 609, match,m,nomatch,fileout write (12,609) match,m,nomatch,fileout 609 format (/,i6,' redundant stations in new file of',i6, 1 ' stations.',/,' There are',i5,' remaining new stations for ', 2 'further redundancy testing in file:',/,5x,a65) go to 99 88 print 610 610 format (' STOP. Response has bad format. Run program again.') 99 print 106 106 format(' Your print file from this session is REDUNDEL.PNT.') close (11) close (12) close (10) close (7) if (idel .ne. 0) close (13) stop end