C                     
C	
C   PARTIALS.FOR	
C*  **********************************************
C
	CHARACTER*50 INFILE,OUTFILE,FILENAME
        CHARACTER*40 FNAME
	CHARACTER*80 ASTRING(3,4)
C	INTEGER*2 HKL(2,5000,3)
	INTEGER*2 NSPOTS(3),PFLAG(3,5000)
C	PFLAG(I,J) IF NONZERO IS THE INDEX OF SPOT ON FILM I-1 
C		COMMON WITH SPOT J OF FILM I.
	REAL*4 INTEN(3,5000),X(3,5000),Y(3,5000),TABLE(9),PHI(3),WHAT(3)
	REAL*4 RMOSAIC
	LOGICAL EFLG
	CHARACTER*12 AQDATE, AQTIME
	CHARACTER DAT*12,TIM*12
	DATA TABLE /-1.28,-.84,-.52,-.25,0,.25, .52, .84, 1.28/
c	DO 3 I=1,9
c3	WRITE(6,*) I,TABLE(I)

	WRITE(6,1000)
1000	FORMAT(//' INTERPOLATE PARTIALS IN SPOTS FILES TO ACCURATE 
     .   PHI VALUES'
     .  /'PROGRAM Version 920924'/)

	WRITE(6,*)'ENTER MOSAICITY VALUE:'
	READ(5,*) RMOSAIC
	WRITE(6,*) RMOSAIC

4	WRITE(6,1100)
1100	FORMAT(/'$Input filename (CR to quit):  ')
	READ(5,1200) INFILE
1200	FORMAT(A)
	IF (INFILE(:5).EQ.'     ') STOP
	  INQUIRE(FILE=INFILE, NAME=FILENAME,EXIST=EFLG)
	  IF (.NOT.EFLG) GOTO 5
	  write(6,*)'infile=',infile
        OPEN (UNIT=2,FILE=INFILE,STATUS='OLD')
        DO 245 I=1,4
245	READ (2,350)ASTRING(2,I)
C	READ FIRST FILE INTO COLUMN 2. ONE PASS ONLY.
C	NONE OF THESE SPOTS CAN BE USED, MAY BE PARTIAL ON 3 OR MORE FILMS
    	I=1
        READ(2,101,END=400)X(2,I),Y(2,I),Z1,Z2,INTEN(2,I)
	PFLAG(2,I)=I
   	PFLAG(1,I)=I 
	PHI(2)=Z2
	WHAT(2)=Z1	
	DO 270 I=2,5000
        READ(2,101,END=400)X(2,I),Y(2,I),Z1,Z2,INTEN(2,I)
	if (z2.eq.-999.) goto 400
C	LINK BACKWARDS SO NONE OF THE SPOTS ON 1ST FILM WILL BE USED:
	  PFLAG(2,I)=I 
	  PFLAG(1,I)=I 
270 	CONTINUE
101    FORMAT (f9.3,3f8.3,f10.1)
400	CLOSE (UNIT=2)
	NSPOTS(2)=I-1
   	TYPE *,'NUMBER OF SPOTS REPORTED:',NSPOTS(2)

5	WRITE(6,1100)
	READ(5,1200) INFILE
	IF (INFILE(:5).EQ.'     ') STOP
	  INQUIRE(FILE=INFILE, NAME=FILENAME,EXIST=EFLG)
	  IF (.NOT.EFLG) GOTO 5
	  write(6,*)'infile=',infile
        OPEN (UNIT=2,FILE=INFILE,STATUS='OLD')
        DO 345 I=1,4
345	READ (2,350)ASTRING(3,I)
    	I=1
        READ(2,101,END=500)X(3,I),Y(3,I),Z1,Z2,INTEN(3,I)
	PHI(3)=Z2
	WHAT(3)=Z1	
	DO 370 I=2,5000
        READ(2,101,END=500)X(3,I),Y(3,I),Z1,Z2,INTEN(3,I)
	if (z2.eq.-999.) goto 500
	IF (Z2.NE.PHI(3)) STOP 'THIS FILE CONTAINS DIFFERENT VALUES OF PHI!'
370 	CONTINUE
500	CLOSE (UNIT=2)
	NSPOTS(3)=I-1
510	TYPE *,'NUMBER OF SPOTS REPORTED:',NSPOTS(3)

	IF (FLAG.EQ.1) THEN
	  WRITE (6,*)'ENTER FILE NAME FOR INTERPOLATED PARTIALS:'
	  READ(5,1200)OUTFILE
	  write(6,*)'outfile=',OUTfile
	  IF (OUTFILE(:5).EQ.'     ') STOP
          OPEN (UNIT=3,FILE=OUTFILE,STATUS='NEW')
	  ENDIF
	DO 645 I=1,4
645	WRITE(3,350) ASTRING(3,I)
 350    FORMAT (A80)
	PHIMEAN=(PHI(1)+PHI(2))/2
	ncom=0
	nfull=0
	np1=0
	np2=0
	np3=0
	DO 600 I=1,Nspots(2)
	DO 590 J=1,Nspots(3)
	D=(X(2,I)-X(3,J))**2 + (Y(2,I)-Y(3,J))**2
c	WRITE(6,*)'X2:',X(2,I),' X3:',X(3,J),' Y2:',Y(2,I),' Y3',Y(3,J),
c     .		' D',D
C  SAY 2 PIXEL ERROR = .3 MM, SQUARED IS .09 MM
	IF (D.LT.0.09) THEN
c	  WRITE(6,*)I,J,inten(2,i),inten(3,j),'COMMON W NEXT'
	  PFLAG(3,J)=I
	  ncom=ncom+1
	  goto 600
	ENDIF
590	continue
C	NO MATCHING SPOT IN NEXT FILM (3), SO CHECK PREV TWO:
	  IF (PFLAG(2,I).eq.0) then
C		WRITE OUT SPOT (2,I) AS A FULL
 		WRITE(3,101) X(2,i),Y(2,i),WHAT(2),PHI(2),INTEN(2,I)
c		WRITE(6,*)I,INTEN(2,I),' FULL'
		nfull=nfull+1
	  ELSE IF (PFLAG(1,PFLAG(2,I)).eq.0) then
C		WRITE OUT SPOT(2,I)+SPOT(1,PFLAG(2,I)) AS PARTIAL
c		WRITE(6,*)PFLAG(2,I),i,inten(1,PFLAG(2,I)),inten(2,i),' P2'
		np1=np1+1
		FRAC1=INTEN(1,PFLAG(2,I))/(INTEN(1,PFLAG(2,I))+INTEN(2,I))
		K=INT(10*FRAC1)
		IF ((K.GT.0).AND.(K.LT.10)) THEN
		  PHICALC=PHIMEAN-TABLE(K)*RMOSAIC
		  XAVE=(X(1,PFLAG(2,I))+X(2,I))/2
		  YAVE=(Y(1,PFLAG(2,I))+Y(2,I))/2
		  WRITE(3,101)XAVE,YAVE,WHAT(1),PHICALC,INTEN(1,PFLAG(2,I))+
     . 		       INTEN(2,I)
		  np2=np2+1
		  ENDIF
	  ELSE 
	    IF (FLAG.EQ.1) then
c		WRITE(6,*)'PRESENT ON 3 FILMS:',
c     .		  PFLAG(1,PFLAG(2,I)),PFLAG(2,I),I 
		np3=np3+1
		endif
	  ENDIF
600	continue
	IF (FLAG.EQ.1) THEN
	  WRITE(3,101)-999.,-999.,-999.,-999.,-999.
	   write(6,*)'closing output file'
	   CLOSE (UNIT=3)
	   ENDIF
	write(6,601)ncom,nfull,np1,np2,np3
601	format(' ',i5,' shared w prev film,',i5,' full on prev film,',/
     .	i5,' partial on prev 2 films only,',i5,' of these used',/
     .	i5,' shared on prev 3 films (not used).')
	FLAG=1
C	FLAG IS ZERO ON FIRST PASS
C	NOW SCROLL THE ARRAYS DOWN
	DO 630 I=1,2
	PHI(I)=PHI(I+1)
	WHAT(I)=WHAT(I+1)
	NSPOTS(I)=NSPOTS(I+1)
	DO 630 J=1,NSPOTS(I)
	X(I,J)=X(I+1,J)
	Y(I,J)=Y(I+1,J)
	INTEN(I,J)=INTEN(I+1,J)
630	PFLAG(I,J)=PFLAG(I+1,J)
c	rezero partiality flags for new film:
	do 640 j=1,nspots(3)
640	pflag(3,j)=0
	GOTO 5                
700	STOP
	END