//*   #JVDCMP   IBM   CURRENT COPY OF  DSFC
//*
//STEP1   EXEC   FORTGCLG,PARM.FORT='DECK'
//FORT.SYSPUNCH  DD  DUMMY
//FORT.SYSIN  DD  *
C           ---------  G E N E R A L   D E S C R I P T I O N  -----


C    THE DINKEY SEARCHING FILE COMPARE IS DESIGNED TO ENHANCE QUALITY
C    ASSURANCE FUNCTIONS ON SOFTWARE.  SPECIFICALLY, THE PROGRAM
C    CAUSES TWO FILES TO BE COMPARED TO BE READ INTO RESPECTIVE
C    ARRAYS;  MATCHES ARE THEN FOUND (OR NOT FOUND) AND THE
C    RESULTING DIFFERENCES ARE THEN PRINTED IN THE STANDARD
C    ENGINEERING 'IS/WAS' FORMAT FOR VISUAL VERIFICATION.
C
C
C
C    THE KEY TO THE PROGRAM COMPARISON IS THAT THE PROGRAM DOES
C    NOT MERELY COMPARE, BUT ALSO ACCOUNTS FOR MISSING OR INSERTED
C    RECORDS. OUTPUT IS IN 'IS/WAS' FORMAT FOR ECO REQUIREMENTS.
C
C           --------------  U S E R   I N F O R M A T I O N  ----------
C
C    CALLING SEQUENCE: (HP FORMAT)
C       RU,DSFC,FILEA:SC:CT,FILEB:SC:CT,MESSAGES,COMPARES OUTPUT
C    EXAMPLES:
C       RU,DSFC,JVDA:1111:105,JVDZ:1111:105,12,6
C       RU,DSFC,JVDA,JVDB,0G,0G
C       RU,DSFC,JVDA,JVXX,12,12
C
C  NOTE ---- PROGRAM MAY BE TERMINATED BY 'BREAK'
C
C     ----------   UPDATING INFORMATION   -------------
C     INITIALS   DATE             ITEM
C       JVD      11/10/78    INPUT PARAMETERS ON 'TIME STAMP' LINE
C        "           "       REMOVE BIAS FROM COMPARE
C        "           "       GIVE RECORD NUMBER ON EACH LINE
C       JVD       12/7/78    FIX E-O-F ROUTINES
C        "        12/13/78   SCREEN PROMPTS WHILE RUNNING
C        "            "      WRAP 'FILES USED' MESSAGE
C       JVD       08/8/80    ADJUST TO 132 CHARACTER INPUT (WAS 80)
C        "            "      ALLOW FOR LESS THAN AN ARRAY OF DATA
C        "            "      ELIMINATE CRT PROMPTS FOR IBM
C       JVD       09/28/82   CORRECT NUMBERING WITHIN ARRAY WITH EOF
C        "            "      CORR NON-COMPARE ON LAST ENTRY EVEN FILES
C       JVD       11/17/82   MULTIPLE ITERATIVE PROGRAMMER SEQUENCES
C
C
C           ---- P R O G R A M M E R   I N F O R M A T I O N ---------
C
C    THE ARRAY SIZES CAN BE CHANGED BY SETTING THE VARIABLES 'C' & 'Y'
C         TO SOME VALUE 20 OR MORE.  AT THE SAME TIME, THE ARRAYS
C         ARRAYA & ARRAYZ MUST BE SET TO (66*C) IN SIZE E.G. 66 X 20
C         WORDS LONG EACH IF ARRAY IS 20 LONG.
C         THE ARRAYS MUST BE THE SAME SIZE.
C
C           ------   V A R I A B L E S   -------
C
C    VALUES ARE USUALLY INTEGERS REPRESENTING LINE NUMBERS.
C    VARIABLES MUST USUALLY BE MULTIPLIED BY LINE LENGTH TO
C        COMPUTE ARRAY ADDRESS.
C
C  EOFA      END-OF-FILE SWITCH FOR FILEA
C  EOFZ        "    "     "      "  FILEZ
C  B         FLOATING POINTER RUNNING IN ARRAYA
C  X            "        "      "     "  ARRAYZ
C  C         END POINTER OF ARRAYA
C  Y          "      "   "  ARRAYZ
C  LA,LZ     LENGTH OF EACH ARRAY
C  IA        CURRENT POINTER INTO ARRAYA
C  IZ          "       "      "   ARRAYZ
C  CRT       OUTPUT FILE (FROM RMPAR)
C  NBEGA     POINTER TO FIRST POSITION OF SPECIFIC ARRAY LINE
C  NBEGZ       "     "   "        "    "     "       "    "
C  NENDA       "     "  LAST      "    "     "       "    "
C  NENDZ       "     "   "        "    "     "       "    "
C  I,J,K,L,M,N  ARE ALL AVAILABLE AT ALL TIMES FOR LOCAL MANIPULATION
C  IGOOD     GOOD COMPARE POSITIONS IN A LINE.
C  IRET      DEBUGGING RETURN FROM ARRAY PRINTER
C  NRECA     RECORD COUNT OF 'A' FILE
C  NRECZ       "      "   "  'Z' FILE
C
C                 --------   S T O P S      -------
C  0000      END OF PROGRAM  NORMAL TERMINATION
C  1234      LESS THAN 20 RECORDS ON AN INPUT FILE.
C  2222      NO RETURN PROVIDED IN ARRAY PRINTOUT.
C   713      BUG - ATTEMPTING TO WRITE OUT MORE THAN A LINE
C   770      SECOND ATTEMPT TO READ E-O-F
C   772      READ ERROR
C   773      OPEN FAILURE ON FILES
C   774      LENGTH OF INPUT RECORD GREATER THAN ALLOWED
C
C
      DIMENSION ARRAYA(4620),ARRAYZ(4620)
      DIMENSION BUFA(133),BUFZ(133)
      DIMENSION ITIME(5),IYEAR(1)
      INTEGER*2 ARRAYA,ARRAYZ,BUFA,BUFZ
      INTEGER A,B,C,X,Y,Z,CRT
      INTEGER EOFA,EOFZ
      INTEGER FILEA,FILEZ
      INTEGER IDCBA
      INTEGER IDCBZ
      INTEGER NRECA
      INTEGER NRECZ
      INTEGER KNT
      INTEGER IBM
      LOGICAL CB
      DOUBLE PRECISION DATE, TIME
C
C
      DATA COMMA /2H, /
      DATA COLON /2H: /
      CALL DTIME(TIME,DATE)
      IDCBA=4
      IDCBZ=5
      CRT=6
      WRITE (CRT,10) DATE,TIME
   10 FORMAT ('1','DINKEY SEARCHING FILE COMPARE - 11/17/82'
     - ,5X,'DATE/TIME OF RUN:  ',5X,A8,5X,A8)
      IA=1
      IB=0
      C=70
      Y=70
      LEN=66
      KNT=C
      IZ=1
      WRITE (CRT,12)
   12 FORMAT (' FILES HAVE BEEN OPENED',//)
      GOTO 20
   15 WRITE (CRT,16) IERR,JVDA,JVDZ,FILEA,FILEZ
   16 FORMAT (/,' 16 (DSFC): OPEN FAILURE ON FILES',7I6)
      WRITE (CRT,18)
   18 FORMAT (' STOP 773')
      GOTO 9000
C----------------------------------------------------------
C  FILL AND PRINT INITIAL ARRAY VALUES FOR IDENTIFICATION PURPOSES.
C                'WAS' FILE IDENTIFICATION
C
   20 IF (EOFA.GT.0) GOTO 38
      CALL READ (BUFA,EOFA,IDCBA,CRT,LEN)
C     WRITE (CRT,22)
   22 FORMAT (' READ RETURNED @ 22 - ')
      IF (EOFA.EQ.1) GOTO 21
      L=((IA*LEN)-LEN)
      DO 25 M = 1,LEN
      ARRAYA(L+M) = BUFA(M)
   25 CONTINUE
      IA=IA+1
      IF (IA.GT.C) GOTO 30
      IF (IA.EQ.22) GOTO 26
      IF (IA.GT.22) GOTO 20
      IB=IA-1
      CALL PRINT (ARRAYA,IB,CRT,LEN)
      GOTO 20
   26 WRITE (CRT,29)
   29 FORMAT (//,' ^^^^^^^ 20 RECORDS FROM "WAS" FILE ^^^^^^^^^^',/)
      GOTO 20
C
C   ALLOW SHORT FILES IF GREATER THAN 20
C
   21 IF (IA.LT.22) GOTO 40
      C=(IA-1)
      GOTO 30
C
C   'IS' FILE IDENTIFICATION
C
   30 IF (EOFZ.GT.0) GOTO 38
      CALL READ (BUFZ,EOFZ,IDCBZ,CRT,LEN)
      IF (EOFZ.EQ.1) GOTO 31
      L = ((IZ*LEN)-LEN)
      DO 35 M= 1,LEN
      ARRAYZ(L+M) = BUFZ(M)
   35 CONTINUE
C     WRITE (CRT,37)
C  37 FORMAT (' 37 (DSFC): CALL PRINT ARRAYZ')
      IZ=IZ+1
      IF (IZ.GT.Y) GOTO 50
      IF (IZ.EQ.22) GOTO 34
      IF (IZ.GT.22) GOTO 30
      IY=IZ-1
      CALL PRINT (ARRAYZ,IY,CRT,LEN)
      GOTO 30
   34 WRITE (CRT,36)
   36 FORMAT (//,' ^^^^^^^ 20 RECORDS FROM  "IS" FILE ^^^^^^^^^^',/)
      WRITE (CRT,41)
   41 FORMAT ('1')
      NRECA=1
      NRECZ=1
      GOTO 30
   38 WRITE (CRT,39)
   39 FORMAT ('  39 (DSFC): ATTEMPTING 2ND E-O-F ON FILE')
      GOTO 9000
C
C   SET UP FOR LESS THAN AN ARRAY BUT MORE THAN 20
C
   31 IF (IZ.LT.22) GOTO 40
      Y=(IZ-1)
      GOTO 50
C
C   THERE IS LESS THAN ONE "ARRAY-FULL" OF RECORDS - TERMINATE RUN
C
   40 WRITE (CRT,45)
   45 FORMAT (/,' LESS THAN 20 RECORDS BEFORE EOF - RUN ABORTED')
      WRITE (CRT,47)
   47 FORMAT (' STOP 1234')
      GOTO 9000
C
C   SEE IF THE FIRST REC IN EACH ARRAY IS EQUAL
C      (WILL BE MOST OF THE TIME)
C
C  50 WRITE (CRT,115)
   50 CONTINUE
  115 FORMAT (' 115 (DSFC): (1) TO (1) COMPARE')
  117 IRET=116
C     GOTO 9500
  116 CONTINUE
C  THE FOLLOWING IS A UNIQUE ROUTINE FOR THE HP AND IBM
      IF (.NOT. CB (ARRAYA,ARRAYZ,LEN)) GOTO 200
C
C   COMPARISON OF (1) TO (1) IS EQUAL.
C   MOVE CONTENTS OF EACH ARRAY DOWN 1 LINE FOR (C-1)
C      LINES.  TERMINATE IF THESE WERE LAST RECORDS.
C
C 125 WRITE (CRT,126)
  125 CONTINUE
  126 FORMAT (' 126 (DSFC): (1) TO (1) EQUAL - MOVE DOWN')
      IF ((C+Y).EQ.2) GOTO 9000
      CALL MB (ARRAYA(LEN+1),ARRAYA(1),(C-1)*LEN)
      CALL MB (ARRAYZ(LEN+1),ARRAYZ(1),(Y-1)*LEN)
      NRECA=NRECA+1
      NRECZ=NRECZ+1
C
C    NOW FILL IN THE LAST POSITION IN EACH ARRAY IF NOT E-O-F.
C
C     WRITE (CRT,135)
  135 FORMAT (' 135 (DSFC): FILL IN LAST POSITION OF EACH ARRAY')
      IRET=136
C     GOTO 9500
  136 CONTINUE
      IF (EOFA.GT.0) GOTO 150
      CALL READ (BUFA,EOFA,IDCBA,CRT,LEN)
      IF (EOFA.GT.0) GOTO 150
      CALL MB (BUFA(1),ARRAYA((C*LEN)-(LEN-1)),LEN)
      GOTO 160
  150 C = C-1
      IF (C.LT.1) GOTO 1000
  160 IF (EOFZ.GT.0) GOTO 180
      CALL READ (BUFZ,EOFZ,IDCBZ,CRT,LEN)
      IF (EOFZ.GT.0) GOTO 180
      CALL MB (BUFZ(1),ARRAYZ((Y*LEN)-(LEN-1)),LEN)
      GOTO 50
  180 Y=Y-1
      IF (Y.LT.1) GOTO 2000
      GOTO 50
C
C   COMPARISON FAILURE IN (1) VS (1).
C
C   SEARCH EACH ARRAY EVENLY FOR A PARALLEL MATCH AND, IF FOUND
C     SAVE FOR LATER RESOLUTION OF BEST FIT VS. 'BIASED' SEARCHES.
C
C       SEARCH EACH ARRAY FOR A MATCH IN EACH DIRECTION TO
C          AVOID MAKING A "BIAS" TOWARDS EITHER ARRAY.  THEN
C          RESOLVE THE DIFFERENCE TOWARDS THE PAIR CLOSEST TO
C          THE TOP OF THE ARRAY.
C
C   DO NOT SEARCH IF THE ARRAY LENGTH IS 1 AND 1, BUT TERMINATE
C        AFTER WRITING OUT LAST TWO RECORDS.
C
  200 IF ((C.EQ.1).AND.(Y.EQ.1)) GO TO 8000
C
      DO 670 I= 1,C
      NBEGA = ((I*LEN)-(LEN-1))
      NENDA = (NBEGA + (LEN-1))
      IF (CB(ARRAYA(NBEGA),ARRAYZ(NBEGA),LEN)) GOTO 680
  670 CONTINUE
C
      I = 71
  680 CONTINUE
C
      DO 240 J = 1,C
      DO 230 K = 1,Y
      NBEGA = ((J*LEN)-(LEN-1))
      NENDA = (NBEGA +(LEN-1))
      NBEGZ = ((K*LEN) -(LEN-1))
      NENDZ = (NBEGZ +(LEN-1))
      IF (CB(ARRAYA(NBEGA),ARRAYZ(NBEGZ),LEN)) GOTO 700
  230 CONTINUE
  240 CONTINUE
      GOTO 244
  700 DO 740 N=1,Y
      DO 730 M=1,C
      NBEGA = ((M*LEN)-(LEN-1))
      NENDA = (NBEGA +(LEN-1))
      NBEGZ = ((N*LEN) -(LEN-1))
      NENDZ = (NBEGZ +(LEN-1))
      IGOOD=0
      IF (CB(ARRAYA(NBEGA),ARRAYZ(NBEGZ),LEN)) GOTO 750
  730 CONTINUE
  740 CONTINUE
      STOP 22
  750 IF ((IABS(J-K)).GT.(IABS(M-N))) GOTO 770
      GOTO 250
  770 J=M
      K=N
      GOTO 250
  244 IRET=245
      GOTO 9500
  245 CONTINUE
C     WRITE (CRT,248)
  248 FORMAT (' 248 (DSFC): COMPLETE COMPARISON FAILURE')
      IF ((C-1).LT.1) GOTO 1000
      IF ((Y-1).LT.1) GOTO 2000
      GOTO 250
C
C   COMPARISON HAS BEEN FOUND (AT J,K)  - ARE INCREMENTS IDENTICAL?
C
  250 IRET=251
      GOTO 9500
  251 CONTINUE
C
      IF (I.GE.IABS(J-K)) GOTO 253
      J = I
      K = I
C
  253 IF (J.NE.K) GOTO 300
C
C  EVEN COMPARISON MATCH (BUT KNOWN BY PREVIOUS TEST
C    NOT TO BE (1) VS (1)).  OUTPUT EVEN RECORDS UNTIL THE
C    COMPARISONS ARE REACHED, MOVE DOWN AND REFILL THE ARRAYS.
C       (J HAS LINE NUMBER OF MATCHED COMPARISON IN IT.)
C
C 255 WRITE (CRT,259)
  255 CONTINUE
  259 FORMAT (' 259 (DSFC): ENTERED EVEN COMPARISON')
      IBM = J-1
      DO 280 I=1,IBM
      NBEGA=((I*LEN)-(LEN-1))
      NENDA=NBEGA +(LEN-11)
      IF ((NENDA-NBEGA).NE.(LEN-11)) GOTO 295
      WRITE (CRT,260) NRECA,(ARRAYA(L),L=NBEGA,NENDA)
      WRITE (CRT,270) NRECZ,(ARRAYZ(L),L=NBEGA,NENDA)
  260 FORMAT (1X,I5,'  W A S ===   ',56A2)
  270 FORMAT (1X,I5,'    I S ===   ',56A2,//)
      NRECA = NRECA +1
      NRECZ = NRECZ +1
  280 CONTINUE
C     WRITE (CRT,290)
  290 FORMAT (' 290 (DSFC): LEAVING EVEN COMPARISON FOR REFILL')
      GOTO 400
  295 WRITE (CRT,296)
  296 FORMAT (' STOP 713')
      GOTO 9000
C
C   UNEVEN COMPARISON.
C      EMPTY BUFFERS IN PARALLEL UNTIL NO CORRESPONDING RECORD
C      AT WHICH TIME START GENERATING "NO CORRESPONDING RECORD"
C      MESSAGES UNTIL SATISFIED. (J= ARRAYA, K=ARRAYZ COMPARISON POINTERS)
C
C 300 WRITE (CRT,310)
  300 CONTINUE
  310 FORMAT (' 310 (DSFC): ENTERING UNEVEN COMPARISON')
C    I= HIGHER COUNT OF J & K (-1 FOR LAST UNEQUAL)
      IRET=314
      GOTO 9500
  314 CONTINUE
      I=J
      IF (K.GT.J) I=K
      M=I-1
      DO 390 L=1,M
      IF (L.LE.(J-1)) GOTO 320
      WRITE (CRT,1020) NRECA
C1020 IS "NO CORRESPONDING RECORD"
      GOTO 350
  320 NBEGA = ((L*LEN)-(LEN-1))
      NENDA = NBEGA+(LEN-11)
      WRITE (CRT,340) NRECA,(ARRAYA(N),N=NBEGA,NENDA)
  340 FORMAT (1X,I5,'  W A S ===   ',56A2)
      NRECA = NRECA +1
  350 IF (L.LE.(K-1)) GOTO 360
      WRITE (CRT,2020) NRECZ
      GOTO 390
  360 NBEGZ = ((L*LEN)-(LEN-1))
      NENDZ = NBEGZ+(LEN-11)
      WRITE (CRT,380) NRECZ,(ARRAYZ(N),N=NBEGZ,NENDZ)
  380 FORMAT (1X,I5,'    I S ===   ',56A2,//)
      NRECZ = NRECZ +1
  390 CONTINUE
C
C   THE UNEVEN COMPARISONS HAVE BEEN WRITTEN OUT. NOW
C      THE EXISTING BUFFERS MUST BE MOVED DOWN AND
C      THE BALANCE OF THE ARRAYS REFILLED.
C           (J & K ARE ARRAY CURRENT EQUAL LINE POINTERS)
C
C 400 WRITE (CRT,401)
  400 CONTINUE
  401 FORMAT (' 401 (DSFC): UNEVEN COMPARISON PUSH-DOWN.')
      IRET=410
      GOTO 9500
  410 CONTINUE
      IF ((J-1).EQ.0) GOTO 430
      IF (J.NE.1) CALL MB (ARRAYA(LEN*J-(LEN-1)),ARRAYA(1),(C-J+1)*LEN)
  430 IF ((K-1).EQ.0) GOTO 480
      IF (K.NE.1) CALL MB (ARRAYZ(LEN*K-(LEN-1)),ARRAYZ(1),(Y-K+1)*LEN)
  480 CONTINUE
      IRET=505
C     GOTO 9500
  505 CONTINUE
C
C    FILL IN THE HOLES (UNEVEN) AT THE TOP OF THE ARRAY IN
C         EACH CASE.  J & K ARE STILL OLD COMPARE POSITIONS.
C
C 500 WRITE (CRT,501)
  500 CONTINUE
  501 FORMAT (' 501 (DSFC): BEGIN TO FILL IN UNEVEN HOLES')
      IRET=508
C     GOTO 9500
  508 CONTINUE
      IF ((J-1).EQ.0) GOTO 530
      IBM = J-1
      DO 520  I=1, IBM
      IF (EOFA.GT.0) C=C-1
      IF (EOFA.GT.0) GOTO 520
      CALL READ (BUFA,EOFA,IDCBA,CRT,LEN)
      IF (EOFA.NE.0) C= C-1
      IF (EOFA.NE.0) GOTO 520
      CALL MB (BUFA(1),ARRAYA(((C-J+I+1)*LEN)-(LEN-1)),LEN)
  520 CONTINUE
  530 CONTINUE
  550 IF ((K-1).EQ.0) GOTO 580
      IBM = K-1
      DO 570 I= 1, IBM
      IF (EOFZ.GT.0) Y=Y-1
      IF (EOFZ.GT.0) GOTO 570
      CALL READ (BUFZ,EOFZ,IDCBZ,CRT,LEN)
      IF (EOFZ.NE.0) Y= Y-1
      IF (EOFZ.NE.0) GOTO 570
      CALL MB (BUFZ(1),ARRAYZ(((Y-K+I+1)*LEN)-(LEN-1)),LEN)
  570 CONTINUE
  580 CONTINUE
      IF(C.LT.1) GOTO 1000
      IF(Y.LT.1) GOTO 2000
      IRET=595
C     GOTO 9500
  595 CONTINUE
      GOTO 50
C
C    END OF FILE ON FILEA
C         (POSSIBLE EOF ON FILEZ ALSO)
C
C1000 WRITE (CRT,1002)
 1000 CONTINUE
 1002 FORMAT (' 1002(DSFC):  EOF ON FILEA')
      IRET=1004
      GOTO 9500
 1004 CONTINUE
C
C   CHECK THAT OTHER FILE IS EOF, IF SO END PROGRAM
C
      IF (Y.LT.1) GOTO 9000
C
C   WRITE OUT CONTENTS OF ARRAYZ (WITH NO "CORRES" MESSAGE)
C      FOLLOWED BY THE BALANCE OF THE FILEZ RECORDS THAT HAVE
C      NOT YET BEEN READ IN.
C   TERMINATE PROGRAM AT END OF EITHER THE ARRAY DUMPING (IF NO
C      MORE RECORDS) OR WHEN EOF IS ENCOUNTERED ON FILEZ.
C
      DO 1040 I=1,Y
      NBEGZ = ((I*LEN)-(LEN-1))
      NENDZ = NBEGZ +(LEN-20)
      WRITE (CRT,1020) NRECA
      WRITE (CRT,1030) NRECZ,(ARRAYZ(K), K=NBEGZ,NENDZ)
 1020 FORMAT (1X,I5,'  W A S ===   ',' N O   C O R R E S P O N D I N G   R E C O
     - R E C O R D ')
 1030 FORMAT (1X,I5,'    I S ===   ',56A2,//)
      NRECZ = NRECZ +1
 1040 CONTINUE
C     END THE TAPE
      WRITE (CRT,1070)
 1070 FORMAT (1X,//,' ----- THE FOLLOWING EXCEEDS THE LENGTH OF THE "WAS
     -" FILE ----- ',//)
      NENDZ= LEN-20
 1050 IF (EOFZ.GT.0) GOTO 9000
      CALL READ (BUFZ,EOFZ,IDCBZ,CRT,LEN)
      IF (EOFZ.GT.0) GOTO 9000
      WRITE (CRT,1060) NRECZ,(BUFZ(K),K=1,NENDZ)
 1060 FORMAT (1X,I5,'    I S ===   ',56A2)
      NRECZ = NRECZ +1
      GOTO 1050
C
C    END OF FILE ON FILEZ
C       (POSSIBLE  EOF ON FILEA ALSO)
C
C2000 WRITE (CRT,2001)
 2000 CONTINUE
C2001 FORMAT (' 2001(DSFC): EOF ON FILEZ')
      IRET=2004
      GOTO 9500
 2004 CONTINUE
C
C    CHECK THAT FILE IS NOT ALSO EOF  IF SO END PROGRAM
C
      IF (C.LT.1) GOTO 9000
C
C   WRITE OUT CONTENTS OF ARRAYA (WITH NO CORRES MESSAGE)
C     FOLLOWED BY THE BALANCE OF THE FILEA RECORDS THAT HAVE
C     NOT YET BEEN READ IN.  TERMINATE PROGRAM AT END OF EITHER
C     THE ARRAY DUMPING (IF NO MORE RECORDS) OR WHEN EOF
C     IS ENCOUNTERED ON FILEA.
C
      DO 2040 I=1,C
      NBEGA = ((I*LEN)-(LEN-1))
      NENDA = NBEGA + (LEN-20)
      WRITE (CRT,2030) NRECA,(ARRAYA(K),K=NBEGA,NENDA)
      WRITE (CRT,2020) NRECZ
 2020 FORMAT (1X,I5,'    I S ===   ',' N O    C O R R E S P O N D I N G
     -   R E C O R D '//)
 2030 FORMAT (1X,I5,'  W A S ===   ',56A2)
      NRECA = NRECA +1
 2040 CONTINUE
C   END THE TAPE
      WRITE (CRT,2070)
 2070 FORMAT (1X,//,' ----- THE FOLLOWING EXCEEDS THE LENGTH OF THE "IS"
     - FILE ----- ',//)
      NENDA = LEN-20
 2050 IF (EOFA.GT.0) GOTO 9000
      CALL READ (BUFA,EOFA,IDCBA,CRT,LEN)
      IF (EOFA.GT.0) GOTO 9000
      WRITE (CRT,2030) NRECA,(BUFA(K),K=1,NENDA)
      NRECA = NRECA +1
      GOTO 2050
C
C    THE LAST RECORD OF THE FILE HAS FAILED COMPARISON AND THERE
C       IS NOTHING MORE TO SEARCH OR SCAN.  PRINT THEM OUT AND
C       TERMINATE JOB.
 8000 CONTINUE
C8000 WRITE (CRT,8010)
 8010 FORMAT (' 8010(DSFC): LAST RECORD NOT EQUAL - PRINT & TERM')
      IRET=8020
      GO TO 9500
 8020 CONTINUE
      NBEGA = 1
      NENDA = LEN -10
      WRITE (CRT,8030) NRECA,(ARRAYA(K),K=NBEGA,NENDA)
      WRITE (CRT,8040) NRECZ,(ARRAYZ(K),K=NBEGA,NENDA)
 8030 FORMAT (1X,I5,'  W A S ===   ',56A2)
 8040 FORMAT (1X,I5,'    I S ===   ',56A2,//)
      GOTO 9000
C
C                 END THE PROGRAM
C
 9000 WRITE (CRT,9010)
 9010 FORMAT (' 0000(DSFC):  - - -  E N D    O F   P R O G R A M - - -')
      IRET=9020
      GOTO 9500
 9020 CONTINUE
      STOP 0000
C
C  ARRAY DUMP ROUTINE FOR DEBUGGING
C
 9500 GOTO 9560
C9500 CONTINUE
 9502 WRITE (CRT,9542)
      WRITE (CRT,9510) I,J,K,L,M,N
 9510 FORMAT (//,' I=',I4,' J=',I4,' K=',I4,' L=',I4,' M=',I4,' N=',I4)
 9514 WRITE (CRT,9516) X,Y,Z
 9516 FORMAT (' X=',I3,' Y=',I3,' Z=',I3)
      WRITE (CRT,9520) NBEGA,NENDA,ICNTA,IA,EOFA
 9520 FORMAT (' NBEGA=',I4,' NENDA=',I4,' ICNTA=',I4,' IA=',I4,' EOFA=',I3)
     -I3)
      WRITE (CRT,9522) NBEGZ,NENDZ,ICNTZ,IZ,EOFZ
 9522 FORMAT (' NBEGZ=',I4,' NENDZ=',I4,' ICNTZ=',I4,' IZ=',I4,' EOFZ=',I3)
     -I3)
      WRITE (CRT,9524) ICOUNT,C,IRET,NRECA,NRECZ
 9524 FORMAT (' ICOUNT=',I3,' C=',I3,' IRET=',I4,'  NRECA=',I6,'  NRECZ=',I6)
     -',I6)
      WRITE (CRT,9530)
 9530 FORMAT ('0 =======    ARRAY A  ==================    ARRAY Z ==',//)
     -/)
      NM=C
      IF (NM.LT.Y) NM=Y
      DO 9550 NI=1,NM
      NJ=(NI*LEN) -(LEN-1)
      NL=NJ+19
      WRITE (CRT,9540) NI, (ARRAYA(NK),NK=NJ,NL),(ARRAYZ(NK),NK=NJ,NL)
 9540 FORMAT (1X,I2,5X,20A2,5X,20A2)
 9550 CONTINUE
      WRITE (CRT,9542)
 9542 FORMAT (//,' ============================================',//)
 9560 IF (IRET.EQ.116) GOTO 116
      IF (IRET.EQ.9020) GOTO 9020
      IF (IRET.EQ. 136) GOTO  136
      IF (IRET.EQ. 245) GOTO  245
      IF (IRET.EQ. 251) GOTO  251
      IF (IRET.EQ. 314) GOTO  314
      IF (IRET.EQ. 410) GOTO  410
      IF (IRET.EQ. 505) GOTO  505
      IF (IRET.EQ. 508) GOTO  508
      IF (IRET.EQ. 595) GOTO  595
      IF (IRET.EQ.1004) GOTO 1004
      IF (IRET.EQ.2004) GOTO 2004
      IF (IRET.EQ.8020) GOTO 8020
      WRITE (CRT,9552)
 9552 FORMAT (' STOP 2222')
      GOTO 9000
      END
C----------------------------------------------------------
C
C    READS A FILE AND MAKES THE "EOF" = 1 IF EOF HAS BEEN ENCOUNTERED.
C        PROHIBITS A SECOND READ REQUEST FROM READING AFTER "EOF".
C
      SUBROUTINE READ (BUF,EOF,IDCB,CRT,LEN)
      DIMENSION BUF (133)
      INTEGER*2 BUF
      INTEGER EOF,CRT,BLANK,LEN
      INTEGER IDCB
      DATA BLANK /2H--/
C     WRITE (CRT,2) EOF
    2 FORMAT ('  2 (READ): READ ENTRY "EOF" : ',I6)
      IF (EOF.EQ.0) GOTO 10
      WRITE (CRT,5)
    5 FORMAT (' SECOND ATTEMPT AT EOF')
      STOP 770
   10 DO 11 K = 1,LEN
      BUF (K) = BLANK
   11 CONTINUE
      READ (IDCB,40,ERR=100,END=200) (BUF(J),J=1,LEN)
   40 FORMAT (132A2)
C     WRITE (CRT,50)   (BUF(J), J=1,LEN),IDCB
   50 FORMAT ('  50 (READ):', 66A2,I6)
      RETURN
  100 WRITE (CRT,101) IERR
  101 FORMAT (/,' READ ERROR ')
      STOP 772
  200 CONTINUE
C     WRITE (CRT,225)   (BUF(J), J=1,LEN),IDCB
  225 FORMAT (' 225 (READ):', 66A2,I6)
      EOF = 1
C     WRITE (CRT,250) IDCB
  250 FORMAT (/,' READ (DSFC): EOF SET TO -1-  IDCB= ',I6)
      RETURN
      END
C---------------------------------------------------------
C     PRINT THE ARRAY ELEMENT NAMED FROM ARRAY
C
      SUBROUTINE PRINT (ARRAYA,IA,CRT,LEN)
      DIMENSION ARRAYA (4620)
      INTEGER*2 ARRAYA
      INTEGER CRT,LEN
C     WRITE (CRT,1) IA,CRT,LEN
    1 FORMAT (' 1 (PRINT): IA = ',I6,6X,I6,6X,I6)
      IF (IA.LE.0) STOP 776
      IB= ((IA*LEN)-(LEN-1))
      IBB = IB+(LEN-1)
      WRITE (CRT,20) (ARRAYA(I),I=IB,IBB)
   20 FORMAT (' ',66A2)
C     WRITE (CRT, 30)
   30 FORMAT (' 30 (PRINT): EXITING "PRINT"')
      RETURN
      END
//LKED.SYSLMOD  DD  DSN=MEN.CM.QMB.LINKLIB(DSFC),DISP=SHR
//LKED.SYSIN  DD  *
 ESD            CB             K                                        00000001
 TXT             00  CB-DWM-V78320                                      00000002
 TXT   *               O        N           &       Q       Q  *        00000003
 TXT   M         YN                 H&         & & %          K   &   Q 00000004
 TXT                                                                    00000005
 RLD                   -                                                00000006
 END                            15741SC103 020179010                    00000007
 ESD            MB             8                                        00000001
 TXT             00  MB-DWM-V78320                                      00000002
 TXT   *        K           &       Q                  Q - HK           00000003
 TXT   M            H&       Y & & *    K   Q                           00000004
 END                            15741SC103 020179011                    00000005
//GO.FT06F001  DD  SYSOUT=A,DCB=(RECFM=FBA,LRECL=133,BLKSIZE=2640)
//GO.FT04F001  DD  DSNAME=MEN.CM.QMB.IS2,UNIT=INTDA,
//   DISP=OLD
//GO.SYSIN    DD  DSNAME=MEN.CM.QMB.WAS2,UNIT=INTDA,
//   DISP=OLD
//MSG   EXEC  PGM=P42143,PARM='M ====  COND = 0     ===',
//          COND=(0,NE)
//MSG   EXEC  PGM=P42143,PARM='M ====  DSFC COMPLETED  ====',
//          COND=EVEN
