C Clean.  The name of the file that contains the image names has been
C cached into "temp"
C this program finds stars in common.
        implicit double precision (a-h,o-z)
	parameter(maxstars=100000)
	parameter(kfiles=15)
	character*80 inline
	character*25 namelist
	character*25 newfile
	character*1 sign
	dimension iloc(4)
	dimension ra(maxstars,kfiles),dec(maxstars,kfiles),
     &   amag(maxstars,kfiles),sigma(maxstars,kfiles),
     &  sky(maxstars,kfiles),number(kfiles),
     &   ibest(maxstars,kfiles),istat(maxstars)
	integer irvec1(4),idvec1(4)
C
*  SECONDS TO RADIANS
      PARAMETER (S2R=0.72722052166430398D-4)
*  ARC SECONDS TO RADIANS
      PARAMETER (AS2R=0.48481368110953599D-5)
C
*  SECONDS TO RADIANS
      STOR(RH,RM,RS)=S2R*(60D0*(60D0*RH+RM)+RS)
*  ARC SECONDS TO RADIANS
      ASTOR(DD,DM,DS)=AS2R*(60D0*(60D0*DD+DM)+DS)
C read all the data into memory
	search=1.5
	open(unit=1,file='temp',status='old')
	read(1,2) namelist
	close(unit=1)
C We now have the list that contains the file names
	ifile=0
	open(unit=1,file=namelist,status='old')
1	read(1,2,end=99) newfile
2	format(a25)
C the actual file names will have a "rd" appended to this.
	alast=lnblnk(newfile)
	open(unit=2,file=newfile(1:alast)//'rd',status='old')
	istar=0
	ifile=ifile+1
	if(ifile.gt.kfiles) stop 'too many files!'
9	read(2,10,end=88) inline
10	format(a80)
	if(inline(1:1).eq.' ') go to 9
	if(inline(1:1).eq.'') go to 9
	if(inline(1:1).eq.'#') go to 9
C try to be smart about this---there are tabs in them there hills!
	istup=0
	do 9001 i=1,80
	if(inline(i:i).eq.':') then
	istup=istup+1
	if(istup.gt.4) stop 'HELP!!!!'
	iloc(istup)=i
	end if
9001	continue
	if(istup.ne.4) stop 'HELP...call Phil....'
	if(iloc(1).eq.2) then
	read(inline,11) ihr,imin,sec
11	format(i1,1x,i2,1x,f6.3)
	else
	read(inline,12) ihr,imin,sec
	end if
12	format(i2,1x,i2,1x,f6.3)
C go the RA 
C Now get the dec!
	i1=iloc(3)-2
	i2=iloc(4)+5
	read(inline(i1:i2),13) ideg,iamin,asecs
13	format(i2,1x,i2,1x,f5.2)
	sign=''
	do 9002 i=iloc(3)-3,iloc(3)-1
	if(inline(i:i).eq.'-') sign='-'
9002	continue
C Now get everything else
	read(inline(iloc(4)+6:80),*)
     &   am,sig,sk
Cwrite(6,10) inline
Cwrite(6,9003) ihr,imin,sec,sign,ideg,iamin,asecs,
C    &   am,sig,sk
9003	format(i2.2,1x,i2.2,1x,f6.3,1x,a1,i2.2,1x,i2.2,1x,f5.2,
     &  3f8.3)
	istar=istar+1
	amag(istar,ifile)=am
	sigma(istar,ifile)=sig
	sky(istar,ifile)=sk
	r=STOR(ihr,imin,sec)
	if(sign.eq.'-') then
	ideg=-ideg
	iamin=-iamin
	asecs=-asecs
	end if
	d=astor(ideg,iamin,asecs)
	ra(istar,ifile)=r
	dec(istar,ifile)=d
	go to 9
88	number(ifile)=istar
	close(unit=2)
	go to 1
99	nfiles=ifile
Cwrite(6,100) nfiles,(i,number(i),i=1,nfiles)
100	format(i5,(i5,i5))
C now insist that every star be in every file....
C we can do this by just stepping through file 1 and making sure everyone in there is in all other files.
	do 201 i=1,number(1)
	ra1=ra(i,1)
	dec1=dec(i,1)
	do 202 ifile=2,nfiles
C apply fudge!
	best=5*search
	ibest(i,ifile)=0
	do 203 j=1,number(ifile)
	ra2=ra(j,ifile)+raoff
	dec2=dec(j,ifile)+decoff
	call apa(ra1,dec1,ra2,dec2,sep,pa)
	dist=sep/as2r
	if(dist.gt.search) go to 203
C Be sure to remove THAT!
	d=abs(amag(i,1)-amag(j,ifile))
Cif(d.gt.0.1) go to 203
	if(dist.lt.best) then
	best=dist
	ibest(i,ifile)=j
	end if
203	continue
C might as well quit!
	if(ibest(i,ifile).eq.0) go to 201
Cwrite(6,981) i,ifile,ibest(i,ifile),best
981	format(3i8,f8.2)
202	continue
201	continue
	icom=0
	do 251 i=1,number(1)
	istat(i)=-1
	do 252 ifile=2,nfiles
	if(ibest(i,ifile).eq.0) go to 251
252	continue
C We have a winner!
	icom=icom+1
	istat(i)=0
251	continue
	write(6,255) icom
255	format('Number of stars in common:',i5)
C i=1,number(1)
C stars ra(i,1) will match  ra(ibest(i,j),j) where j=2,ifiles
C     amag(i,1)           amag(ibest(i,j),j) where j=2,ifiles
C etc
C
C now, for each file, write out the stars in common
C treat the first file a little differently....
	rewind(1)
301	read(1,2) newfile
	write(6,2) newfile
	alast=lnblnk(newfile)
	open(unit=2,file=newfile(1:alast)//'com',status='new')
	do 302 i=1,number(1)
	if(istat(i).eq.0) then
C this star gets saved
        call dr2tf(3,ra(i,1),sign,irvec1)
        call dr2af(2,dec(i,1),sign,idvec1)
	write(2,303) irvec1,sign,idvec1,amag(i,1),sigma(i,1),
     &  sky(i,1)
303	format(i2.2,':',i2.2,':',i2.2,'.',i3.3,1x,a1,i2.2,':',i2.2,
     &  ':',i2.2,'.',i2.2,2f7.3,f9.2)
	end if
302	continue
	close(unit=2)
C
	write(6,9970) nfiles
9970	format('Number of files=',i5)
	do 401 j=2,nfiles
	read(1,2) newfile
	write(6,2) newfile
Cwrite(6,970) j
970	format(i5)
	alast=lnblnk(newfile)
	open(unit=2,file=newfile(1:alast)//'com',status='new')
C
	icount=0
C
C
C
	do 402 i=1,number(1)
Cwrite(6,980) i,istat(i)
980	format(i5,' status=',i5)
	if(istat(i).eq.0) then
Cwrite(6,4403) i,(ibest(i,ik),ik=2,nfiles)
4403	format(i5,(i5))
C write this out
	index=ibest(i,j)
		if(index.eq.0) then
		write(6,305) i,j
305		format('Failure at:',2i8)
		stop
		end if
        call dr2tf(3,ra(index,j),sign,irvec1)
        call dr2af(2,dec(index,j),sign,idvec1)
	write(2,303) irvec1,sign,idvec1,
     &      amag(index,j),sigma(index,j),sky(index,j)
	icount=icount+1
	end if
402	continue
	close(unit=2)
	write(6,403) j,icount
403	format('File',i3,' count:',i5)
401	continue
	stop
	end	
        subroutine apa(rac,dcc,rao,dco,dist,pa)
c computes the distance (delt) and position (pa) along the
c sky FROM (rac,dec) to (rao,dco)
c written aug 14, 1987
C rewritten August 21, 1989, to do using "standard coords", rather
C than the old and peculiar (but possibly equivalent!) way
c plm
      implicit double precision (a-h,o-z)
        parameter (PI=3.141592653589793238462643)
C CONVERT TO PROPER COORDS
        CALL DS2TP(RAO,DCO,RAC,DCC,XI,ETA)
        pa=0.
        if(xi*eta.ne.0.)PA=DATAN2(XI,ETA)
        if(pa.le.0.) pa=pa+2.*pi
        DIST=DSQRT(XI**2+ETA**2)
        return
        end
	include '/tofu/home/massey/observing/astromsub.f'
