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
