	character*40 nam1
	character*40 nam2
	character*50 nam3
	character*40 nam4
	character*45 nam5
	character*2 idtype,itypesear
	dimension ipoly(50)
	inc=0
	iappend=0
	icnt=1
	ichoice=0
	idchoice=99.0
	t1old=999.9
	t2young=-999.9
	write (*,*)   'this program allows you to'
	write(*,*) 'to make symbols at points.'
c   
c  1. enter name and open source file
c
	goto 5
 4	continue
	write(*,*) 'Error in file name. Try again.'
5	continue
	write (*,*)  ' '
	write (*,*)  'enter name of digitized source file'
	read(*,2) nam1
	if (nam1.eq.' ') stop 'au revoir'
        write (*,2) nam1
2	format (a)
 6	open (unit=2,file=nam1,status='old',err=4)

	if(iappend.eq.1) goto 30
c
c   2. enter name and open output file, choose data format
c
 20	continue
	write (*,*)  '  '
	write (*,*)  'enter name of digitized source file'
	read(*,2) nam2
	open (unit=3,file=nam2,status='unknown')
c    3.  select search parameters
c
 30	continue
c       write (*,*)  '  '
c       write (*,*)  '  '
c       write (*,*)  'do you wish to search by: '
c       write (*,*)  '(1) plate id number  '
c       write (*,*)  '(2) age of feature  '
c       write (*,*)  '(3) data type  '
c       write (*,*)  '(4) string id numbers '
c       write (*,*)  '(5) pass all data '
c       write (*,*)  '  '
	iselect=5
c       read *, iselect
	goto (31,32,33,34,45) iselect
 31	continue
	write (*,*)  'enter plate id '
	read *, idchoice
	goto 40
 32	continue
	write (*,*)  '   '
	write (*,*)  '  '
	write (*,*)  'enter age of oldest feature to be included'
	read *, t1old
	write (*,*)  'enter age of youngest feature to be included'
	read *, t2young
	goto 40
 33	continue
	write (*,*) ' enter data type'
	read (*,'(a)') itypesear
c 1033	format (2a)
	goto 40
 34	continue
	write (*,*)  ' '
	write (*,*)  'do you wish to select:'
	write (*,*)  '(1) individual string numbers'
	write (*,*)  '(2) a range of string numbers'
	read *, isearch
	if(isearch.eq.1) goto 35
	if(isearch.eq.2) goto 37
 35	continue
	write (*,*)  ' '
	write (*,*)  'enter string numbers to be selected'
	write (*,*)  '999 to end string list' 
	do 36 i=1,50
	write (*,*)  'enter string number'
	read *, ipoly(i)
	icount=i
	if(ipoly(i).eq.999) goto 40
 36	continue
 37	continue
	write (*,*)  'enter starting id number'
	read *, istart
	write (*,*)  'enter ending id number'
	read *, iend
 40	continue
c	if(iform.ne.2) goto 45
c       write (*,*) '  '
c       write (*,*)  'do you wish to resequence?'
c       write (*,*)  '(1)yes, (2) no'
c       read *, iseq
	iseq = 2
	if(iseq.eq.2) goto 45
	write (*,*)  'enter starting number for new sequence'
	read *, ibegin
c
 45	continue
c
	isymtyp=0
	write (*,*)  'symbols you wish to create at lat/long coord?'
	write (*,*)  'enter symbol type'
	write(*,*)'(1) circle  (2) plus  (3) square  (4) triangle
     &  (5) diamond'
	read *, isymtyp
	write (*,*) '  '
	write (*,*) 'enter size in degrees? (e.g., 0.5)'
	read *,size
49	continue
c
c   4. begin main program
c      read header for input file
c
50	continue
      read(2,1001,err=998,end=999) imo,iyr,istring,nam3			
      read(2,1002,err=998,end=999) id,t1,t2,idtype,itype,iplat,iclr,nam4
c23456789 123456789 123456789 123456789 123456789 123456789 123456789 12
	goto (55,60,65,70,100) iselect
c
c   5. test if id matches search id, or pass all ids if 99  
c
55	continue
	if(id.eq.idchoice) goto 100
	goto 90
c
c   6. test if times lie within selected time window
c
60	continue
	if((t1.ge.t2young).and.(t1.le.t1old)) goto 100
	if((t2.ge.t2young).and.(t2.le.t1old)) goto 100
	if((t1.ge.999.0).and.(t2.le.-999.0)) goto 100
	goto 90
c
65	continue
	if (idtype.eq.itypesear) goto 100
 67	read(2,1103) alat,along,ipen,nam4
	write(3,1103) alat,along,ipen,nam4
	if(alat.eq.99.0) goto 50
	goto 67
c
70	continue
	if(isearch.eq.1) goto 72
	if(isearch.eq.2) goto 76
72	continue
	if(icnt.eq.0) icnt=1
	do 74 i=icnt,50
	if(istring.eq.ipoly(i)) icnt=i-1
	if(istring.eq.ipoly(i)) goto 100
74	continue
	goto 90
76	continue
	if((istring.ge.istart).and.(istring.le.iend)) goto 100
	goto 90
c
c   7. read lat, longs and look for next string, but do not save 
c
 90	continue
	read(2,*)alat,along,ipen
	if(alat.eq.99.0) goto 50
	goto 70
c
c  10. write out in digitizer format
c
 100	continue
	inc=inc+1
	if(iseq.eq.1) istring=(ibegin-1)+inc
	write(3,1001) imo,iyr,istring,nam3				
	write(3,1002) id,t1,t2,idtype,itype,iplat,iclr,nam4
 125	continue
	read(2,1103) alat,along,ipen,nam4
	write(3,1103) alat,along,ipen,nam4
	if(alat.eq.99.0) goto 50
c  only ipen = 3 will have symbols drawn around them
c	if(ipen.eq.2) goto 125
	goto (125,140,141,142,143,144,125) isymtyp+1
 140	call circle (alat,along,size,30)
	goto 125
 141	call plus (alat,along,size)
	goto 125
 142	call square (alat,along,size)
	goto 125
 143	call circle (alat,along,size,120)
	goto 125
 144	call circle (alat,along,size,90)
	goto 125
c
998	continue
	write (*,*)  'error during read'
	goto 50
999	continue
	write (*,*)  'search complete'
	write (*,*)  inc, '=number of strings written to new file'
	write (*,*)  ' '
c       write (*,*)  'do you wish to continue with a new search?'
c       write (*,1010) nam1
c1010	format (10x,'in ',a)
c       write (*,*)  'yes=1, n0=2, you are done=3'
	ichoice=3
c       read *, ichoice
	if (ichoice.ge.3) stop 'adios amigo'
	rewind (unit=2)
	write (*,1011) nam2
 1011	format (/,' new strings append to ',a,' ?')
	write (*,*)  'yes =1, n0=2'
	read *, iappend
	if (iappend.eq.2) close (unit=3)
	goto (6,5) ichoice
1001    format(2i2,1x,1i4,1x,a)
c old 1002    format(x,i3,x,f6.1,x,f6.1,x,1a2,1i4,x,i2,x,i2,x,i2)
1002    format(x,i3,x,f6.1,x,f6.1,x,1a2,i4,2i4,a)
1103    format(f9.4,x,f9.4,i2,a)
1003    format(f9.4,x,f9.4,i2)
1004	format(2f7.2,2i3)
	stop 'how vee der zen !!'
	end
c
c  subroutine plus
c
	subroutine plus(alat,along,size)
	alat1=alat+size
	alat2=alat-size
	along1=along+size
	along2=along-size
	write(3,1003) alat1,along,3
	write(3,1003) alat2,along,2
	write(3,1003) alat,along1,3
	write(3,1003) alat,along2,2
1003    format(f9.4,x,f9.4,i2)
	return
	end
c
c  subroutine square
c
	subroutine square (alat,along,size)
	alat1=alat+size
	alat2=alat-size
	along1=along+size
	along2=along-size
	write(3,1003) alat1,along2,3
	write(3,1003) alat1,along1,2
	write(3,1003) alat2,along1,2
	write(3,1003) alat2,along2,2
	write(3,1003) alat1,along2,2
1003    format(f9.4,x,f9.4,i2)
	return
	end
c
	subroutine circle (x,y,r,j)
	d=1/57.29578
	jj=360+j
	write (3,1003) x+r,y,3
	do 10 i=j,jj,j
	ang=i*d
	xa=x+cos(ang)*r
	ya=y+sin(ang)*r
 10	write(3,1003)xa,ya,2
1003    format(f9.4,x,f9.4,i2)
	return
	end
