CHARACTER*50 INFILE1,INFILE2,OUTFILE,FILENAME,FILENAME2 CHARACTER*8 ANSWER CHARACTER*1 BLINE(2400),BLINE2(2400) INTEGER*2 ILINE(1200),ILINE2(1200),H,K,L,N INTEGER*4 IX,IY,I64K,I32K LOGICAL EFLG CHARACTER DAT*12,TIM*12 C DATA STRUCTURE: EQUIVALENCE (BLINE,ILINE),(BLINE2,ILINE2) CHARACTER*12 AQDATE, AQTIME,AQDATE2, AQTIME2 REAL*4 LAMBDA,DISTANCE,PHI_START,PHI_END EQUIVALENCE (LAMBDA,BLINE(77)),(DISTANCE,BLINE(81)),(PHI_START, - BLINE(85)),(PHI_END,BLINE(89)),(AQDATE,BLINE(101)), - (AQTIME,BLINE(113)) REAL*4 LAMBDA2,DISTANCE2,PHI_START2,PHI_END2 EQUIVALENCE (LAMBDA2,BLINE2(77)),(DISTANCE2,BLINE2(81)), - (PHI_START2,BLINE2(85)),(PHI_END2,BLINE2(89)), - (AQDATE2,BLINE2(101)),(AQTIME2,BLINE2(113)) I64K=256*256 I32K=I64K/2 5 WRITE(6,1100),1 1100 FORMAT(/'$Input filename',I2,' (CR to quit): ') READ(5,1200) INFILE1 1200 FORMAT(A) IF (INFILE1(:5).EQ.' ') STOP INQUIRE(FILE=INFILE1, NAME=FILENAME,EXIST=EFLG) IF (.NOT.EFLG) GOTO 5 OPEN (UNIT=1,FILE=INFILE1,readonly,STATUS='OLD') WRITE(6,1100),2 READ(5,1200) INFILE2 IF (INFILE2(:5).EQ.' ') STOP INQUIRE(FILE=INFILE2, NAME=FILENAME2,EXIST=EFLG) IF (.NOT.EFLG) GOTO 5 OPEN (UNIT=2,FILE=INFILE2,readonly,STATUS='OLD') WRITE(6,1600) 1600 FORMAT('$Output filename: ') READ(5,1200) OUTFILE OPEN (UNIT=3,FILE=OUTFILE,STATUS='NEW',RECL=2400, & CARRIAGECONTROL='NONE',RECORDTYPE='FIXED') READ(1,155) (BLINE(II),II=1,2400) READ(2,155) (BLINE2(II),II=1,2400) CALL DATE(DAT) CALL TIME(TIM) AQDATE2=DAT AQTIME2=TIM C CHECK FILMS ADJACENT, USE PHI_START OF FIRST AND PHI_END OF SECOND. C PRESENT VERSION OF MAR SOFTWARE DOESN'T REPORT PHI_START. C IF (PHI_END.NE.PHI_START2) STOP'FILMS NOT ADJACENT!' PHI_START2=PHI_START write(3,155) (BLINE2(II),II=1,2400) DO 200 I=1,1200 READ(1,155) (BLINE(II),II=1,2400) READ(2,155) (BLINE2(II),II=1,2400) 155 FORMAT (4096A1) DO 190 J=1,1200 IX=ILINE(J) IF (IX.LT.0.) IX=IX+I64K IY=ILINE2(J) IF (IY.LT.0.) IY=IY+I64K IX=(IX+IY)/2 IF (IX.GE.I32K) IX=IX-I64K 190 ILINE2(J)=IX 200 write(3,155) (BLINE2(II),II=1,2400) CLOSE(UNIT=2) CLOSE(UNIT=3) WRITE(6,*)'DELETE ',FILENAME,' (Y/N)' READ(5,1200),ANSWER IF (ANSWER(:1).NE.'Y') GOTO 5 C IF (ANSWER(:1).NE.'Y').AND.(ANSWER(:1).NE.'y') GOTO 5 write(6,*)'DELETING ',FILENAME J=LIB$SPAWN('DEL '//FILENAME) C FILENAME RETURNED BY INQUIRE, HAS VERSION #. GOTO 5 END