C|IK0VER (C) 1988 BY J.F.CHANDLER 00001000 C PERMISSION IS GRANTED TO COPY OR USE THIS PROGRAM, EXCEPT FOR 00002000 C EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES. 00003000 C 00004000 C ORIGINAL VERSION 1977 OCTOBER, CONDENSED 1988 OCTOBER. 00005000 C 00006000 C COMPARE TWO LINE-NUMBERED CARD-IMAGE FILES AND PUNCH UPDATE CARDS 00007000 C WHICH WOULD CONVERT ONE DATA SET TO THE OTHER. THE COMPARISON IS DONE00008000 C LINE BY LINE. EACH PAIR OF LINES IS TESTED IN COLUMNS 1-72. THE 00009000 C INPUT FILES ARE READ FROM UNITS 1 AND 2; OUTPUT TO UNIT 7. 00010000 C 00011000 C TO CHANGE FROM FORTRAN 66 TO FORTRAN 77, JUST CHANGE ALL REAL*8'S TO 00012000 C CHARACTER*8'S AND LOGICAL*1'S TO CHARACTER*1'S, AND CHANGE THE DECODE 00013000 C STEP IN VDUMP. JUST REVERSE THE PROCESS FOR 77 TO 66. 00014000 C 00015000 C INPUT TEXT BUFFER 00016000 COMMON/BUFFER/ CBF(10,2,300) 00017000 CHARACTER*8 CBF 00018000 INTEGER*4 ISIZ/300/ 00019000 C 00020000 C POINTERS 00021000 COMMON/PTRS/ SEQ(2),LN(2),IP(2),JP(2),IEF(2),IDMP,LOOK,IBFL 00022000 CHARACTER*8 SEQ 00023000 C SEQ - SEQUENCE NUMBER OF LAST MATCH, 1ST NON-MATCH 00024000 C LN - LINE NUMBER OF LATEST CONFIRMED MATCH 00025000 C IP - CURRENT POINTER IN SEARCH FOR MATCH (MATCH WHEN FOUND) 00026000 C JP - HIGHEST NUMBERED CARD CURRENTLY READ IN 00027000 C IEF - END OF FILE INDICATOR (0 BEFORE, 1 AS SOON AS EOF REACHED) 00028000 C LOOK- SEARCH LEVEL FOR NEXT MATCH 00029000 C IBFL- INDEX OF LAST RECORD IN EACH BUFFER 00030000 C 00031000 INTEGER*4 LNJ(2),LNV(2),IPS(2) 00032000 EQUIVALENCE(LNJ(1),LNJ1),(LNJ(2),LNJ2),(LNV(1),LNV1),(LNV(2),LNV2)00033000 LOGICAL CMP 00034000 C SYNCH EXCEPTIONS: COLS 1-16 OF RECORDS THAT SHOULDN'T BE 00035000 C USED IN DETERMINING A NEW MATCH (MIGHT NOT BE REAL). 00036000 CHARACTER*8 ZEROES,SYNCH(2,12) 00037000 DATA NSYNCH/12/, SYNCH/ 00038000 1' ',' ','C ',' ','* ',' ',00039000 2' ',' SPACE ',' ',' SPACE 1',' ',' SPACE ,',00040000 3'.* ',' ',' ',' MACRO ',' ',' MEND ',00041000 4' ',' MEXIT ','/* ',' ','//* ',' '/00042000 DATA ZEROES/'00000000'/ 00043000 C 00044000 C INITIALIZE PTRS 00045000 DO 2 I=1,2 00046000 LN(I)=0 00047000 JP(I)=0 00048000 2 IEF(I)=0 00049000 IBFL=ISIZ 00050000 IDMP=0 00051000 SEQ(1)=ZEROES 00052000 WRITE(7,6) 00053000 6 FORMAT('./ * * * * * * START OF UPDATES - IK0VER * * * * * ') 00054000 C 00055000 C RESET COMPARE POINTER IN CASE RECORDS WERE SKIPPED 00056000 10 DO 20 I=1,2 00057000 20 LNJ(I)=MOD(LN(I),IBFL)+1 00058000 C START HERE WHEN EXPECTING A MATCH 00059000 30 IF(LN(1).GE.JP(1)) CALL CRD(1) 00060000 IF(LN(2).GE.JP(2)) CALL CRD(2) 00061000 80 IF(LN(1).GE.JP(1).OR.LN(2).GE.JP(2)) GOTO 220 00062000 C NOW WE HAVE TWO CARDS TO COMPARE 00063000 IF(.NOT.CMP(CBF(1,1,LNJ1),CBF(1,2,LNJ2))) GOTO 100 00064000 C RECORDS MATCH, ADVANCE POINTERS AND CHECK NEXT 00065000 SEQ(1)=CBF(10,1,LNJ1) 00066000 DO 90 I=1,2 00067000 LN(I)=LN(I)+1 00068000 LNJ(I)=LNJ(I)+1 00069000 IF(LNJ(I).GT.IBFL) LNJ(I)=1 00070000 90 CONTINUE 00071000 GOTO 30 00072000 C NON-MATCH, LOOK FOR NEXT MATCH 00073000 100 LOOK=1 00074000 SEQ(2)=CBF(10,1,LNJ1) 00075000 LN12=LN(1)+LN(2) 00076000 LNT=LNJ1 00077000 C LOOP ON 'LOOK' (NO. OF CARDS NEEDED IN BUFFER FOR COMPARISON) 00078000 110 LOOK=LOOK+1 00079000 LNT=LNT+1 00080000 IF(LNT.GT.IBFL) LNT=1 00081000 IF(LOOK.LE.IBFL) GOTO 130 00082000 IF(IEF(1).EQ.1.AND.IEF(2).EQ.1) GOTO 140 00083000 C BUFFER OVERFLOW, SOME MATCHING MAY BE LOST 00084000 WRITE(6,120) IBFL,LN 00085000 120 FORMAT('0***MORE THAN',I4,' NON-MATCHING CARDS BEGINNING AT LINE',00086000 1 I6,',',I5) 00087000 IDMP=IDMP+1 00088000 GOTO 1000 00089000 C READ CARDS IF NECESSARY 00090000 130 IF(LN(1)+LOOK.GT.JP(1)) CALL CRD(1) 00091000 IF(LN(2)+LOOK.GT.JP(2)) CALL CRD(2) 00092000 C SEE IF BOTH FILES AT EOF 00093000 140 IF(JP(1)+JP(2)-LN12.LE.LOOK) GOTO 200 00094000 C COMPARE AT LEVEL 'LOOK', 'IP(*)' AND 'LNU*' ARE EQUIVALENT 00095000 IP(1)=LN(1)+LOOK 00096000 IP(2)=LN(2)+1 00097000 LNU1=LNT 00098000 LNU2=LNJ2 00099000 DO 160 L=1,LOOK 00100000 C SEE IF OFF THE END OF ONE 00101000 IF(IP(1).GT.JP(1)) GOTO 150 00102000 IF(CMP(CBF(1,1,LNU1),CBF(1,2,LNU2))) GOTO 170 00103000 C STILL NO MATCH 00104000 150 IP(1)=IP(1)-1 00105000 IP(2)=IP(2)+1 00106000 C SEE IF OFF THE END OF TWO 00107000 IF(IP(2).GT.JP(2)) GOTO 110 00108000 LNU1=LNU1-1 00109000 IF(LNU1.LT.1) LNU1=IBFL 00110000 LNU2=LNU2+1 00111000 IF(LNU2.GT.IBFL) LNU2=1 00112000 160 CONTINUE 00113000 GOTO 110 00114000 C MATCH FOUND AT IP(1) --- IP(2), MAKE SURE IT'S SIGNIFICANT 00115000 170 LNV1=LNU1 00116000 LNV2=LNU2 00117000 IPS(1)=IP(1) 00118000 IPS(2)=IP(2) 00119000 LOOKS=LOOK 00120000 173 DO 175 I=1,NSYNCH 00121000 IF(SYNCH(1,I).EQ.CBF(1,1,LNV1).AND.SYNCH(2,I).EQ.CBF(2,1,LNV1)) 00122000 1 GOTO 177 00123000 175 CONTINUE 00124000 GOTO 190 00125000 177 DO 180 I=1,2 00126000 IF(IPS(I).LT.JP(I)) GOTO 180 00127000 C NEED TO READ NEXT CARD 00128000 IF(LOOKS.GE.IBFL) GOTO 190 00129000 CALL CRD(I) 00130000 C DON'T INSIST IF A FILE HAS REACHED END 00131000 IF(IPS(I).GE.JP(I)) GOTO 190 00132000 180 CONTINUE 00133000 C NOW TRY NEXT PAIR OF CARDS AFTER MATCH, KEEP LOOKING IF DIF.00134000 LOOKS=LOOKS+1 00135000 DO 183 I=1,2 00136000 IPS(I)=IPS(I)+1 00137000 LNV(I)=LNV(I)+1 00138000 183 IF(LNV(I).GT.IBFL) LNV(I)=1 00139000 IF(.NOT.CMP(CBF(1,1,LNV1),CBF(1,2,LNV2))) GOTO 150 00140000 GOTO 173 00141000 C ACCEPT MATCH 00142000 190 CALL VDUMP 00143000 GOTO 10 00144000 C NO MATCH UP TO END OF BOTH FILES 00145000 200 IP(1)=JP(1)+2 00146000 IP(2)=JP(2)+2 00147000 GOTO 250 00148000 C ONE FILE EXHAUSTED 00149000 220 DO 230 I=1,2 00150000 IF(LN(I).LT.JP(I)) GOTO 240 00151000 230 CONTINUE 00152000 C BOTH EXHAUSTED. ALL DONE 00153000 GOTO 1000 00154000 C ALL EXCESS OF THE REMAINING FILE IS 'NON-MATCHING' 00155000 240 IP(3-I)=JP(3-I)+2 00156000 IP(I)=99999999 00157000 250 CALL VDUMP 00158000 C PRINT SUMMARY 00159000 1000 IF(IDMP.GT.0) WRITE(6,1010) 00160000 1010 FORMAT(' * * * * DISCREPANCIES') 00161000 STOP 00162000 END 00163000 SUBROUTINE VDUMP 00164000 C ALL LINES BETWEEN LN AND IP ARE TO BE PRINTED AS NON-MATCHING 00165000 C LN IS UPDATED TO INDICATE LAST MATCH 00166000 C INPUT TEXT BUFFER 00167000 COMMON/BUFFER/ CBF(10,2,1) 00168000 CHARACTER*8 CBF 00169000 C POINTERS 00170000 COMMON/PTRS/ SEQ(2),LN(2),IP(2),JP(2),IEF(2),IDMP,LOOK,IBFL 00171000 CHARACTER*8 SEQ 00172000 C... FORTRAN 77 ONLY... 00173000 CHARACTER*16 SEQX 00174000 EQUIVALENCE (SEQ,SEQX) 00175000 C............................ 00176000 C 00177000 CHARACTER*1 CMDS(3)/'I','D','R'/ 00178000 CHARACTER*8 BLNK8/' '/,SEQB 00179000 C 00180000 NCMD=0 00181000 IF(IP(1).GT.LN(1)+1) NCMD=2 00182000 IF(IP(2).GT.LN(2)+1) NCMD=NCMD+1 00183000 IF(NCMD.EQ.0 .AND. JP(1).GE.IP(1).AND.JP(2).GE.IP(2)) GOTO 1300 00184000 C NO CHANGE CARDS FOR LAST GASP 00185000 IF(LN(1).GE.JP(1).AND.LN(2).GE.JP(2)) RETURN 00186000 IDMP=IDMP+1 00187000 IF(NCMD.GT.1) SEQ(1)=SEQ(2) 00188000 SEQB=BLNK8 00189000 LNP1=LN(1)+1 00190000 IPM1=IP(1)-1 00191000 IF(IEF(1).EQ.1.AND.IPM1.GT.JP(1)) IPM1=JP(1) 00192000 IF(LNP1.GE.IPM1) GOTO 130 00193000 IF(IP(1).LT.99999999) GOTO 120 00194000 110 CALL CRD(1) 00195000 IF(IEF(1).NE.1) GOTO 110 00196000 IPM1=JP(1) 00197000 120 LNM=MOD(IPM1-1,IBFL)+1 00198000 SEQB=CBF(10,1,LNM) 00199000 130 LNM=MOD(IPM1,IBFL)+1 00200000 IF(IPM1.LT.JP(1)) SEQ(2)=CBF(10,1,LNM) 00201000 C----------- CHOOSE ONE ------------------ 00202000 C... WRITE/READ USING FORTRAN 66... 00203000 C WRITE(3,1210) SEQ 00204000 C REWIND 3 00205000 C READ(3,135) ISEQ3,ISEQ4 00206000 C REWIND 3 00207000 C... DECODE USING FORTRAN 77... 00208000 READ(SEQX,135) ISEQ3,ISEQ4 00209000 C----------------------------------------- 00210000 C FORMAT CAN BE CHANGED TO 2(3X,I5) FOR 'NOSEQ8' 00211000 135 FORMAT(2I8) 00212000 NNEW=IP(2)-LN(2) 00213000 IF(NCMD.EQ.3) NNEW=NNEW-1 00214000 INC=1000 00215000 IF(IPM1.LT.JP(1)) INC=MAX0(1,(ISEQ4-ISEQ3)/NNEW) 00216000 IMOD=1000 00217000 IF(INC.LT.1000) IMOD=100 00218000 IF(INC.LT.100) IMOD=10 00219000 IF(INC.GT.10) INC=(INC/IMOD)*IMOD 00220000 IF(NCMD.EQ.1) ISEQ3=ISEQ3+INC 00221000 C CAN ADD T6,' ',T15,' ' TO FORMATS FOR 'NOSEQ8' 00222000 IF(NCMD.EQ.2) WRITE(7,140) CMDS(NCMD),SEQ(1),SEQB 00223000 140 FORMAT('./ ',A1,1X,A8,1X,A8,T55,'*IK0VER* **TAG***') 00224000 IF(NCMD.NE.2) WRITE(7,150) CMDS(NCMD),SEQ(1),SEQB,ISEQ3,INC 00225000 150 FORMAT('./ ',A1,1X,A8,1X,A8,' $',2I9,T55,'*IK0VER* **TAG***') 00226000 C 00227000 IF(LN(1).LT.IP(1)) LN(1)=IP(1) 00228000 LNM=MOD(LN(1)-1,IBFL)+1 00228300 IF(LN(1).LE.JP(1)) SEQ(1)=CBF(10,1,LNM) 00228600 IF(LN(2).LT.IP(2)) LN(2)=LN(2)+1 00229000 C GET INDEX FOR FIRST CARD 00230000 LNM=MOD(LN(2)-1,IBFL)+1 00231000 1100 IF(LN(2).GE.IP(2)) RETURN 00232000 C SEE IF END OF FILE 00233000 1120 IF(LN(2).GT.JP(2)) RETURN 00234000 C WATCH FOR END OF BUFFER 00235000 IF(LNM.GT.IBFL) LNM=1 00236000 C PUNCH CHANGE CARDS 00237000 WRITE(7,1210) (CBF(J,2,LNM),J=1,9) 00238000 1210 FORMAT(10A8) 00239000 1220 LN(2)=LN(2)+1 00240000 LNM=LNM+1 00241000 IF(IP(2).LT.99999999) GOTO 1100 00242000 C INDEFINITE PRINT 00243000 CALL CRD(2) 00244000 IF(IEF(2).EQ.1) IP(2)=JP(2)+2 00245000 GOTO 1100 00246000 C 00247000 1300 LN(1)=IP(1) 00248000 LN(2)=IP(2) 00249000 RETURN 00250000 END 00251000 SUBROUTINE CRD(I) 00252000 C READ A CARD FROM FILE I IF NOT ALREADY AT EOF 00253000 C CARD BUFFERS 00254000 COMMON/BUFFER/ CBF(10,2,1) 00255000 CHARACTER*8 CBF 00256000 C POINTERS 00257000 COMMON/PTRS/ SEQ(2),LN(2),IP(2),JP(2),IEF(2),IDMP,LOOK,IBFL 00258000 CHARACTER*8 SEQ 00259000 C 00260000 INTEGER*4 ICP(2) 00261000 C 00262000 IF(IEF(I).EQ.1) RETURN 00263000 IF(JP(I).EQ.0) ICP(I)=IBFL 00264000 ICP(I)=ICP(I)+1 00265000 IF(ICP(I).GT.IBFL) ICP(I)=1 00266000 LNM=ICP(I) 00267000 READ(I,60,END=800) (CBF(J,I,LNM),J=1,10) 00268000 60 FORMAT(10A8) 00269000 100 JP(I)=JP(I)+1 00270000 RETURN 00271000 C REACHED END OF FILE 00272000 800 IEF(I)=1 00273000 RETURN 00274000 END 00275000 LOGICAL FUNCTION CMP(BUFA,BUFB) 00276000 C RETURN 'TRUE' IF BUFA = BUFB 00277000 CHARACTER*8 BUFA(9),BUFB(9) 00278000 C 00279000 CMP=.FALSE. 00280000 DO 100 I=1,9 00281000 100 IF(BUFA(I).NE.BUFB(I)) RETURN 00282000 CMP=.TRUE. 00283000 RETURN 00284000 END 00285000