      PROGRAM DSFC
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  NOTE ---- PROGRAM MAY BE TERMINATED BY 'CTRL-C'
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                   8/86     MOVED TO VAX SYSTEM
C       ADH       01/16/89   MODIFIED IBM FORTRAN G TO VAX FORTRAN 77
C        "            "      ADDED CTRL-C TRAP AND COMMAND LINE DECODE
C        "            "      ADDED CODE TO VERIFY EXISTANCE OF IS/WAS
C                            FILES
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  OUT_FILE  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  9999      CTRL_C PRESSED
C
C	INCLUDE SYSTEM SERVER DEFINITIONS FOR TRAPPINC CTRL_C
C
      INCLUDE '($SYSSRVNAM)'
C
C	SETUP CTRL_C VARIABLES
C
      INTEGER*4 TT_CHAN
      CHARACTER*40 TRAP_LINE
C
      DIMENSION ARRAYA(4620),ARRAYZ(4620)
      DIMENSION BUFA(133),BUFZ(133)
      DIMENSION ITIME(5),IYEAR(1)
      INTEGER LENGTH
      INTEGER*2 ARRAYA,ARRAYZ,BUFA,BUFZ
      INTEGER*2 A,B,C,X,Y,Z,OUT_FILE, LEN
      INTEGER*2 EOFA,EOFZ
      INTEGER*2 FILEA,FILEZ
      INTEGER*2 IDCBA
      INTEGER*2 IDCBZ
      INTEGER*2 NRECA
      INTEGER*2 NRECZ
      INTEGER*2 KNT
      INTEGER*2 IBM
      LOGICAL CB,OK,GOT_FILEA,GOT_FILEZ
      CHARACTER*8  TIME_string
      CHARACTER*9  DATE_string
      CHARACTER*48 FILENAMEA,FILENAMEZ
      CHARACTER*48 IN_NAME
C
      COMMON /FNAMES/FILENAMEA,FILENAMEZ,OK,GOT_FILEA,GOT_FILEZ
      COMMON /CTRLC/TT_CHAN,OUT_FILE,IDCBA,IDCBZ
C
      DATA COMMA /2H, /
      DATA COLON /2H: /
      CALL DATE (DATE_string)
      CALL TIME (TIME_string)
      IDCBA=14
      IDCBZ=15
C     unit 16 used for output file
      OUT_FILE=16
      TYPE 10,DATE_string,TIME_string
   10 FORMAT (' DINKEY SEARCHING FILE COMPARE - 2/22/89'//
     - ,5X,'DATE/TIME OF RUN:  ',5X,A9,5X,A8,///)
      IA=1
      IB=0
      C=70
      Y=70
      LEN=66
      KNT=70
      IZ=1
C
C
C      WRITE (5,'(''$Enter File A/Was'',T30,''* '')')
C      READ (6,19) FILENAMEA
C      WRITE (5,'(''$Enter File Z/Is '',T30,''* '')')
C      READ (6,19) FILENAMEZ
C
      CALL GET_FILE_NAMES
C
   13 CONTINUE
      IDCB = IDCBA
      OPEN (UNIT=IDCB,NAME=FILENAMEA,STATUS = 'OLD',ERR=15,IOSTAT=IERR)
      IDCB = IDCBZ
      OPEN (UNIT=IDCB,NAME=FILENAMEZ,STATUS = 'OLD',ERR=15,IOSTAT=IERR)
      IDCB = OUT_FILE
      OPEN (UNIT=IDCB,NAME='DSFC.RESULTS',STATUS='UNKNOWN')
C
      TYPE *,' FILES HAVE BEEN OPENED'
      I = LENGTH(FILENAMEA)
      WRITE (OUT_FILE,23)FILENAMEA(1:I)
      I = LENGTH(FILENAMEZ)
      WRITE (OUT_FILE,24)FILENAMEZ(1:I),DATE_string,TIME_string
C
C	ENABLE CTRL_C TRAPPING
C
      ISTAT = SYS$ASSIGN('TT',TT_CHAN,,)       ! FETCH SYSTEM LUN FOR TT
      IF(.NOT.ISTAT)CALL LIB$STOP(%VAL(ISTAT)) ! STOP IF NOT ASSIGNED
      CALL ENABLE_CTRLC                        ! ENABLE TRAPPING
C
C	NOW CONTINUE WITH DSFC
C
      GOTO 20
   23 FORMAT(1H1,3X,'COMPARE SOURCE FILE (WAS): ',A,/)
   24 FORMAT(1H ,3X,'             AGAINST (IS): ',A,//
     - ,2X,'DATE AND TIME OF COMPARISON:  ',2(5X,A),///)
   15 TYPE 16,IERR,IDCB
   16 FORMAT (/,' 16 (DSFC): OPEN FAILURE ON FILE',I6)
      TYPE *,'STOP 773'
      CALL LIB$STOP(%VAL(IERR))
C
C----------------------------------------------------------
C  FILL AND PRINT INITIAL ARRAY VALUES FOR IDENTIFICATION PURPOSES.
C                'WAS' FILE IDENTIFICATION
C
   20 CONTINUE
      IF (EOFA.GT.0) GOTO 38
      CALL READ (BUFA,EOFA,IDCBA,OUT_FILE,LEN)
*****
*  22 TYPE *,' 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,OUT_FILE,LEN)
      GOTO 20
   26 TYPE 29
      WRITE (OUT_FILE,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 CONTINUE
   33 IF (EOFZ.GT.0) GOTO 38
      CALL READ (BUFZ,EOFZ,IDCBZ,OUT_FILE,LEN)
      IF (EOFZ.EQ.1) GOTO 31
      L = ((IZ*LEN)-LEN)
      DO 35 M= 1,LEN
      ARRAYZ(L+M) = BUFZ(M)
   35 CONTINUE
*****
*     TYPE *,' 35 (DSFC): CALL PRINT ARRAYZ'
*****
      IZ=IZ+1
      IF (IZ.GT.Y) GOTO 50
      IF (IZ.EQ.22) GOTO 34
      IF (IZ.GT.22) GOTO 33
      IY=IZ-1
      CALL PRINT (ARRAYZ,IY,OUT_FILE,LEN)
      GOTO 33
   34 TYPE 36
      WRITE (OUT_FILE,36)
   36 FORMAT (//,' ^^^^^^^^^^ 20 RECORDS FROM  "IS" FILE ^^^^^^^^^^',/)
      WRITE (OUT_FILE,37)
   37 FORMAT('1')
      NRECA=1
      NRECZ=1
      GOTO 33
   38 TYPE 39
      WRITE(OUT_FILE,39)
   39 FORMAT(1X,'  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 TYPE 45
      WRITE(OUT_FILE,45)
   45 FORMAT (/,' LESS THAN 20 RECORDS BEFORE EOF - RUN ABORTED',/,
     + ' STOP 1234')
      IRET = 9020
      GOTO 9500
C
C   SEE IF THE FIRST REC IN EACH ARRAY IS EQUAL
C      (WILL BE MOST OF THE TIME)
C
   50 CONTINUE
*****
*     TYPE *,' 115
*     WRITE(OUT_FILE,115)
  115 FORMAT(1X,' 115 (DSFC): (1) TO (1) COMPARE')
*****
  117 IRET=116
*****
*     GOTO 9500
*****
  116 CONTINUE
C
C   	
C  FUNCTION CB IS AN ASSEMBLY CODE ROUTINE ON THE HP, IBM AND VAX
      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
*****
*     TYPE 125
*     WRITE(OUT_FILE,125)
  125 FORMAT(' 125 (DSFC): (1) TO (1) EQUAL - MOVE DOWN')
*****
      IF ((C+Y).EQ.2) GOTO 9000
C  SUBROUTINE MB IS AN ASSEMBLY CODE ROUTINE ON THE HP, IBM AND VAX
      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
*****
*     TYPE 135
*     WRITE(OUT_FILE,135)
  135 FORMAT(' 135 (DSFC): FILL IN LAST POSITION OF EACH ARRAY')
*****
C
      IRET=136
C
*****
*     GOTO 9500
*****
C
  136 CONTINUE
      IF (EOFA.GT.0) GOTO 150
      CALL READ (BUFA,EOFA,IDCBA,OUT_FILE,LEN)
C   PRINT SCREEN MESSAGE TO KEEP USER INFORMED
      KNT = KNT+1
      IF (KNT.NE.100*(KNT/100))GOTO 119
      TYPE 118,KNT
*     WRITE (OUT_FILE,118)KNT
  118 FORMAT (' WORKING ON REC: ',I5)
  119 CONTINUE

      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,OUT_FILE,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
C
*****
*     GOTO 9500
*****
C
*****
  245 CONTINUE
      GOTO 249 ! COMMENT THIS LINE TO ENABLE DEBUG PRINT ===============
  246 TYPE 248
      WRITE(OUT_FILE,248)
  248 FORMAT(' 248 (DSFC): COMPLETE COMPARISON FAILURE')
  249 CONTINUE
*****
C
      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
*****
*     TYPE 255
*     WRITE(OUT_FILE,255)
  255 FORMAT(' 255 (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
      TYPE 260,NRECA,(ARRAYA(L),L=NBEGA,NENDA)
      TYPE 270,NRECZ,(ARRAYZ(L),L=NBEGA,NENDA)
      WRITE (OUT_FILE,260) NRECA,(ARRAYA(L),L=NBEGA,NENDA)
      WRITE (OUT_FILE,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
*****
*     TYPE 290
*     WRITE(OUT_FILE,290)
  290 FORMAT(' 290 (DSFC): LEAVING EVEN COMPARISON FOR REFILL')
*****
C
      GOTO 400
  295 CONTINUE
      TYPE *,' STOP 713'
      WRITE(OUT_FILE,*) ' STOP 713'
      IRET = 9020
      GOTO 9500
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
*****
  300 CONTINUE
* 300 TYPE 310
*     WRITE(OUT_FILE,310)
  310 FORMAT(' 300 (DSFC): ENTERING UNEVEN COMPARISON')
*****
C
C    I= HIGHER COUNT OF J & K (-1 FOR LAST UNEQUAL)
C
      IRET=314
C
*****
*     GOTO 9500
*****
C
  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
CCCCC
C	FORMAT 1020 IS "WAS NO CORRESPONDING RECORD"
CCCCC
      TYPE 1020,NRECA
      WRITE (OUT_FILE,1020) NRECA
      GOTO 350
  320 NBEGA = ((L*LEN)-(LEN-1))
      NENDA = NBEGA+(LEN-11)
      TYPE 340,NRECA,(ARRAYA(N),N=NBEGA,NENDA)
      WRITE (OUT_FILE,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
CCCCC
C       FORMAT 2020 IS "IS  NO CORRESPONDING RECORD"
CCCCC
      TYPE 2020,NRECZ
      WRITE (OUT_FILE,2020) NRECZ
      GOTO 390
  360 NBEGZ = ((L*LEN)-(LEN-1))
      NENDZ = NBEGZ+(LEN-11)
      TYPE 380,NRECZ,(ARRAYZ(N),N=NBEGZ,NENDZ)
      WRITE (OUT_FILE,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
*****
  400 CONTINUE
      GOTO 403 ! COMMENT THIS LINE TO ENABLE DEBUG PRINT ==============
  401 TYPE 402
      WRITE(OUT_FILE,402)
  402 FORMAT(' 402 (DSFC): UNEVEN COMPARISON PUSH-DOWN.')
  403 CONTINUE
*****
C
      IRET=410
C
*****
*     GOTO 9500
*****
C
  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
*****
*     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
*****
*     TYPE 500
*     WRITE(OUT_FILE,500)
  500 FORMAT(' 500 (DSFC): BEGIN TO FILL IN UNEVEN HOLES')
*****
C
      IRET=508
C
*****
*     GOTO 9500
*****
C
  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,OUT_FILE,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,OUT_FILE,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
*****
*     GOTO 9500
*****
  595 CONTINUE
      GOTO 50
C
C    END OF FILE ON FILEA
C         (POSSIBLE EOF ON FILEZ ALSO)
C
 1000 CONTINUE
      TYPE 1002
      WRITE(OUT_FILE,1002)
 1002 FORMAT(' 1002 (DSFC):  EOF ON FILEA')
      IRET=1004
C
*****
*      GOTO 9500
*****
C
 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)
      TYPE 1020,NRECA
      TYPE 1030,NRECZ,(ARRAYZ(K), K=NBEGZ,NENDZ)
      WRITE (OUT_FILE,1020) NRECA
      WRITE (OUT_FILE,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 ',
     1  '  R E C O R D ')
 1030 FORMAT (1X,I5,'    I S ===   ',56A2,//)
      NRECZ = NRECZ +1
 1040 CONTINUE
C     END THE TAPE
      TYPE 1070
      WRITE (OUT_FILE,1070)
 1070 FORMAT(1X,//,' ----- THE FOLLOWING EXCEEDS THE LENGTH OF THE',
     1 ' "WAS" FILE ----- ',//)
      NENDZ= LEN-20
 1050 IF (EOFZ.GT.0) GOTO 9000
      CALL READ (BUFZ,EOFZ,IDCBZ,OUT_FILE,LEN)
      IF (EOFZ.GT.0) GOTO 9000
      TYPE 1060,NRECZ,(BUFZ(K),K=1,NENDZ)
      WRITE (OUT_FILE,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
 2000 CONTINUE
      TYPE 2002
      WRITE(OUT_FILE,2002)
 2002 FORMAT(' 2002 (DSFC): EOF ON FILEZ')
      IRET=2004
C
*****
*      GOTO 9500
*****
C
 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)
      TYPE 2030,NRECA,(ARRAYA(K),K=NBEGA,NENDA)
      TYPE 2020,NRECZ
      WRITE (OUT_FILE,2030) NRECA,(ARRAYA(K),K=NBEGA,NENDA)
      WRITE (OUT_FILE,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
      TYPE 2070
      WRITE (OUT_FILE,2070)
 2070 FORMAT (1X,//,' ----- THE FOLLOWING EXCEEDS THE LENGTH OF THE
     1 "IS" FILE ----- ',//)
      NENDA = LEN-20
 2050 IF (EOFA.GT.0) GOTO 9000
      CALL READ (BUFA,EOFA,IDCBA,OUT_FILE,LEN)
      IF (EOFA.GT.0) GOTO 9000
      TYPE 2030,NRECA,(BUFA(K),K=1,NENDA)
      WRITE (OUT_FILE,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
*****
*     TYPE 8010
*     WRITE(OUT_FILE,8010)
 8010 FORMAT (' 8010(DSFC): LAST RECORD NOT EQUAL - PRINT & TERM')
*****
C
      IRET=8020
C
*****
*     GO TO 9500
*****
C
 8020 CONTINUE
      NBEGA = 1
      NENDA = LEN -10
      TYPE 8040,NRECZ,(ARRAYZ(K),K=NBEGA,NENDA)
      TYPE 8030,NRECA,(ARRAYA(K),K=NBEGA,NENDA)
      WRITE (OUT_FILE,8040) NRECZ,(ARRAYZ(K),K=NBEGA,NENDA)
      WRITE (OUT_FILE,8030) NRECA,(ARRAYA(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 CONTINUE
      TYPE 9001
      WRITE(OUT_FILE,9001)
 9001 FORMAT(' 0000(DSFC):  - - -  E N D    O F   P R O G R A M - - -')
      TYPE *,'RESULTS STORED IN DSFC.RESULTS '
      IRET=9020
C
*****
*      GOTO 9500
*****
C
C     CLOSE THE IS, WAS, AND RESULTS FILES
C
C     ==============================****=============================
C
C     THIS IS THE NORMAL EXIT LOCATION FOR DSFC, EVEN IF ERRORS OCCUR
C
 9020 CONTINUE
      CLOSE (UNIT=OUT_FILE,STATUS='KEEP',ERR=9025,IOSTAT=IERR)
      CLOSE (UNIT=IDCBA,STATUS='KEEP',ERR=9025,IOSTAT=IERR)
      CLOSE (UNIT=IDCBZ,STATUS='KEEP',ERR=9025,IOSTAT=IERR)
      CALL EXIT
 9025 CONTINUE
      TYPE *,'ERROR ',IERR,' CLOSING FILES'
      call errsns(ierr,ists,istv,iunit,icond)
      CALL LIB$STOP(%VAL(Icond))
C
C  ARRAY DUMP ROUTINE FOR DEBUGGING
C
*****
 9500 GOTO 9560
*9500 CONTINUE
*****
 9502 WRITE (OUT_FILE,9542)
      WRITE (OUT_FILE,9510) I,J,K,L,M,N
 9510 FORMAT (//,' I=',I4,' J=',I4,' K=',I4,' L=',I4,' M=',I4,
     1' N=',I4)
 9514 WRITE (OUT_FILE,9516) X,Y,Z
 9516 FORMAT (' X=',I3,' Y=',I3,' Z=',I3)
      WRITE (OUT_FILE,9520) NBEGA,NENDA,ICNTA,IA,EOFA
 9520 FORMAT (' NBEGA=',I4,' NENDA=',I4,' ICNTA=',I4,' IA=',I4,
     1' EOFA=',I3)
      WRITE (OUT_FILE,9522) NBEGZ,NENDZ,ICNTZ,IZ,EOFZ
 9522 FORMAT (' NBEGZ=',I4,' NENDZ=',I4,' ICNTZ=',I4,' IZ=',I4,
     1' EOFZ=',I3)
      WRITE (OUT_FILE,9524) ICOUNT,C,IRET,NRECA,NRECZ
 9524 FORMAT (' ICOUNT=',I3,' C=',I3,' IRET=',I4,'  NRECA=',I6,
     1'  NRECZ=',I6)
      WRITE (OUT_FILE,9530)
 9530 FORMAT ('0 =======    ARRAY A  ==================
     1    ARRAY Z ==',//)
      NM=C
      IF (NM.LT.Y) NM=Y
      DO 9550 NI=1,NM
      NJ=(NI*LEN) -(LEN-1)
      NL=NJ+19
      WRITE (OUT_FILE,9540) NI, (ARRAYA(NK),NK=NJ,NL),(ARRAYZ(NK),
     1NK=NJ,NL)
 9540 FORMAT (1X,I2,5X,20A2,5X,20A2)
 9550 CONTINUE
      WRITE (OUT_FILE,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
      TYPE 9570,IRET
      WRITE(OUT_FILE,9570)IRET
 9570 FORMAT(//,' 2222(DSFC): ILLEGAL RETURN LABEL: ',I5)
      WRITE (OUT_FILE,*) ' STOP 2222'
      TYPE *,' STOP 2222'
C
C     NOW GO CLOSE THE FILES
C
      GOTO 9020
      END
C
C----------------------------------------------------------
C    SUBROUTINE READ BUFFER
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,OUT_FILE,LEN)
      DIMENSION BUF (133)
      INTEGER*2 BUF, BUF1 (133)
      INTEGER*2 EOF,OUT_FILE,BLANK,LEN
      INTEGER*2 IDCB
      CHARACTER*266 BUFFER
      EQUIVALENCE (BUFFER, BUF1)
C       
      DATA BLANK /2H--/
C     WRITE (OUT_FILE,2) EOF
    2 FORMAT ('  2 (READ): READ ENTRY "EOF" : ',I6)
      IF (EOF.EQ.0) GOTO 10
      WRITE (OUT_FILE,5)
    5 FORMAT (' SECOND ATTEMPT AT EOF')
      STOP '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 (66(A2))
      DO K = 1, LEN
        BUF1 (K) = BUF (K)
      END DO
C     WRITE (OUT_FILE,*)  BUFFER
* 50   FORMAT (1X,'THE BUFFER IS:',/,
*     1     1X, A266)
* 50   FORMAT (1X,132A2,I6)
C   50 FORMAT ('  50 (READ):', 66A2,I6)
      RETURN
  100 CONTINUE
      WRITE (6, '(1X,''100'',/,1X,A132)') (BUF (J), J=1,LEN)
      WRITE (OUT_FILE,101) IERR
  101 FORMAT (/,' READ ERROR #',I4)
      STOP 'STOP 772'
  200 CONTINUE
c     WRITE (6, '(1X,''200'',/,1X,A132)') (BUF (J), J=1,LEN)
C     WRITE (OUT_FILE,*)   (BUF(J), J=1,LEN),IDCB
C 225 FORMAT (' 225 (READ):', 66A2,I6)
      EOF = 1
C     WRITE (OUT_FILE,250) IDCB
  250 FORMAT (/,' READ (DSFC): EOF SET TO -1-  IDCB= ',I6)
      RETURN
      END
C
C---------------------------------------------------------
C     SUBROUTINE PRINT ARRAY
C---------------------------------------------------------
C
C     PRINT THE ARRAY ELEMENT NAMED FROM ARRAY
C
      SUBROUTINE PRINT (ARRAYA,IA,OUT_FILE,LEN)
      DIMENSION ARRAYA (1)
      INTEGER*2 ARRAYA
      INTEGER*2 OUT_FILE,LEN
C
*****
*     TYPE 10,IA,OUT_FILE,LEN
*     WRITE(OUT_FILE,10)
   10 FORMAT(' 10(PRINT): IA =',I6,', OUT_FILE =',I3,',LEN = ',I2)
*****
C
      IF (IA.LE.0) STOP 'STOP 776'
      IF (LEN.GT.66) STOP 'STOP 777'
      IB= ((IA*LEN)-(LEN-1))
      IBB = IB+(LEN-1)
      TYPE 20,(ARRAYA(I),I=IB,IBB)
      WRITE (OUT_FILE,20) (ARRAYA(I),I=IB,IBB)
   20 FORMAT (' ',66A2)
*****
*     TYPE 30
*     WRITE(OUT_FILE,30)
   30 FORMAT(' 30 (PRINT): EXITING "PRINT"')
*****
      RETURN
      END 
C
C------------------------------------------------------------
C     SUBROUTINE MOVE BUFFER
C------------------------------------------------------------
C     
C     MOVE Z INTEGER*2 WORDS (2Z bytes) OF BUFFER X TO BUFFER Y
C
C     NOTE:
C     IF THIS ROUTINE IS WRITTEN IN MACHINE CODE (ASSEMBLY LANGUAGE)
C     A MACHINE DEPENDENT SPEEDUP OF ABOUT 7X WILL BE REALIZED.
C
C      SUBROUTINE MB (X,Y,Z)
C      INTEGER*2 X(1),Y(1),Z,COUNT						
C      DO COUNT = 1,Z
C      Y(COUNT) = X(COUNT)
C      END DO
C      RETURN
C      END
C
C-------------------------------------------------------------
C    FUNCTION COMPARE BUFFERS
C-------------------------------------------------------------
C
C     COMPARES WCNT INTEGER*2 WORDS OF BUFFER J AGAINST BUFFER K
C     AND RETURNS .TRUE. IF ALL WORDS COMPARE ON A ONE FOR ONE BASIS
C     OTHERWISE .FALSE. IS RETURNED
C
C     NOTE:
C     IF THIS ROUTINE IS WRITTEN IN MACHINE CODE (ASSEMBLY LANGUAGE)
C     A MACHINE DEPENDENT SPEEDUP OF ABOUT 7X WILL BE REALIZED.
C
C     LOGICAL FUNCTION CB (J,K,WCNT)
C     INTEGER*2 J(1),K(1),WCNT,COUNT
C     DO COUNT = 1,WCNT
C     IF (J(COUNT).NE.K(COUNT)) THEN
C           CB = .FALSE.
C           RETURN
C           END IF                      ! J.....K
C     END DO                            ! COUNT
C     CB = .TRUE.
C     RETURN
C     END
C
C-------------------------------------------------------------
C	FUNCTION CHARACTER STRING LENGTH
C-------------------------------------------------------------
C
C	THIS FUNCTION RETURNS THE ACTUAL LENGTH OF A CHARACTER 
C	STRING, I.E., THE LENGTH UP TO THE POINT WHERE ALL OTHER
C	CHARACTERS IN THE STRING ARE SPACES, INSTEAD OF THE 
C	DECLARED LENGTH AS THE FORTRAN FUNCTION LEN DOES
C
	INTEGER FUNCTION LENGTH(S)
	CHARACTER*(*) S
C
C	GET THE DECLARED LENGTH
C
	J = LEN(S)
	IF(J.EQ.0) THEN
	  LENGTH = 0
	  RETURN
	END IF
C
C	STARTING AT THE LAST CHARACTER POSITION, SCAN TOWARDS THE
C	START OF THE STRING LOOKING FOR A PRINTABLE CHARACTER
C
	DO I=J,1,-1
C
C	IF A PRINTABLE CHARACTER IS FOUND WITHIN THE LOOP, THE LENGTH
C	OF THE STRING HAS BEEN FOUND
C
	  IF(S(I:I).GT.' ') THEN
	    LENGTH = I
	    RETURN
	  END IF
	END DO
C
C	OTHERWISE, THE ENTIRE STRING WAS SPACES - RETURN A ZERO
C
	LENGTH = 0
	RETURN
	END
C
C-------------------------------------------------------------
C	SUBROUTINE ENABLE CTRL-C TRAPPING
C-------------------------------------------------------------
C
C	THIS SUBROUTINE CALLS SYS$QIOW TO ENABLE CTRL-C TRAPPING
C
	SUBROUTINE ENABLE_CTRLC
	INTEGER*2 OUT_FILE,IDCBA,IDCBZ
	INTEGER*4 TT_CHAN,ISTAT
	COMMON /CTRLC/TT_CHAN,OUT_FILE,IDCBA,IDCBZ
	EXTERNAL CTRLC_TRAP
C
C	INCLUDE I/O AND SYSTEM SERVICES SYMBOLS
C
	INCLUDE '($IODEF)'
	INCLUDE '($SYSSRVNAM)'
C
C	ENABLE CTRL_C TRAPPING AND SPECIFY CTRLC_TRAP
C	AS ROUTINE TO BE CALLED WHEN CTRL_C IS PRESSED
C
	ISTAT = SYS$QIOW(,%VAL(TT_CHAN),
     +		%VAL(IO$_SETMODE .OR. IO$M_CTRLCAST),,,,
     +		CTRLC_TRAP,,%VAL(3),,,)
C
C	TEST ISTAT AND CALL LIB$STOP IF VALUE IS .FALSE.
C
	IF(.NOT.ISTAT)CALL LIB$STOP(%VAL(ISTAT))
C
C	OTHERWISE - RETURN
C
	RETURN 
	END
C
C-------------------------------------------------------------
C	AST SUBROUTINE CTRL-C TRAP
C-------------------------------------------------------------
C
C	THIS SUBROUTINE IS THE CTRL-C ASYNCHRONOUS TRAP (AST)
C	AND, AFTER ENABLE_CTRLC IS EXECUTED, WILL BE EXECUTED
C	WHENEVER CTRL-C IS PRESSED.  IF MULTIPLE CTRL-C PRESSES
C	ARE ALLOWED, THIS ROUTINE MUST CALL ENABLE_CTRLC JUST
C	PRIOR TO EXITING.
C
	SUBROUTINE CTRLC_TRAP
	INTEGER*2 OUT_FILE,IDCB,IDCBA,IDCBZ
	INTEGER*4 TT_CHAN
	COMMON /CTRLC/TT_CHAN,OUT_FILE,IDCBA,IDCBZ
C
C	CTRL-C HAS BEEN PRESSED - INFORM THE USER, THEN PERFORM AN
C	ORDERLY, CLEAN EXIT FROM THE PROGRAM
C
	IDCB = IDCBA
	CLOSE (UNIT=IDCB,STATUS='KEEP',ERR=10,IOSTAT=IERR)
	IDCB = IDCBZ
	CLOSE (UNIT=IDCB,STATUS='KEEP',ERR=10,IOSTAT=IERR)
	TYPE 20
	WRITE(OUT_FILE,20)
 	TYPE 30
 	WRITE(OUT_FILE,30)
	IDCB = OUT_FILE
	CLOSE (UNIT=IDCB,STATUS='KEEP',ERR=10,IOSTAT=IERR)
	TYPE *,'RESULTS STORED IN DSFC.RESULTS '
	STOP 'STOP 9999'
C
C	IF AN ERROR OCCURED WHILE CLOSING THE FILES, COME HERE
C	AND LET THE USER KNOW ABOUT THE PROBLEM, THEN CALL
C	LIB$STOP TO FORCE AN EXIT WITH A DCL ERROR MESSAGE
C	OTHERWISE - USE THE 'STOP 9999' EXIT
C
   10	CONTINUE
	TYPE *,'ERROR ',IERR,' CLOSING FILE ',IDCB
	CALL ERRSNS(Ierr,Ists,Istv,Iunit,Icond)
	CALL LIB$STOP(%VAL(Icond))
C
   20	FORMAT(/,' 9999(TRAP) ===  CTRL_C RECEIVED, RUN ABORTED ABNORMALLY
     +		 ===:',//)
   30	FORMAT(' 9999(DSFC):  - - -  E N D    O F   P R O G R A M - - -')
	END
C
C-------------------------------------------------------------
C	SUBROUTINE GET FILE NAMES
C-------------------------------------------------------------
C
C	THIS ROUTINE MAKES CLI (COMMAND LINE INTERPERTER) CALLS 
C	TO DECODE THE FILE NAMES ENTERED ON THE DSFC COMMAND LINE
C
	SUBROUTINE GET_FILE_NAMES
	INTEGER*4 CLI$PRESENT,CLI$GET_VALUE,ISTAT
	CHARACTER*48 FILENAMEA,FILENAMEZ,TEST_NAME,namea,namez
	LOGICAL OK,GOT_FILEA,GOT_FILEZ
	COMMON /FNAMES/FILENAMEA,FILENAMEZ,OK,GOT_FILEA,GOT_FILEZ
	OK = .FALSE.
	GOT_FILEA = .FALSE.
	ISTAT = CLI$PRESENT('FILEA')
	IF(ISTAT)OK = .TRUE.
	IF(OK) THEN
	  ISTAT = CLI$GET_VALUE('FILEA',NAMEA)
	  IF(ISTAT) THEN
	    INQUIRE(FILE=NAMEA,EXIST=GOT_FILEA,NAME=FILENAMEA)
	  ENDIF
	ENDIF
	OK = .FALSE.
	GOT_FILEZ = .FALSE.
	ISTAT = CLI$PRESENT('FILEZ')
	IF(ISTAT) OK = .TRUE.
	IF(OK) THEN
	  ISTAT = CLI$GET_VALUE('FILEZ',NAMEZ)
	  IF(ISTAT) THEN
	    INQUIRE(FILE=NAMEZ,EXIST=GOT_FILEZ,NAME=FILENAMEZ)
	  ENDIF
	ENDIF
	IF(GOT_FILEA .AND. GOT_FILEZ) RETURN
	IF(.NOT.GOT_FILEA)THEN
	  i = length(namea)
	  type *,'WAS file: ',namea(1:i),', not good file name'
   10	  TYPE 30
	  ACCEPT 50,TEST_NAME
	  INQUIRE(FILE=TEST_NAME,EXIST=GOT_FILEA,NAME=FILENAMEA)
	  IF(.NOT.GOT_FILEA)THEN
	    I = LENGTH(TEST_NAME)
	    TYPE *,' FILE ',TEST_NAME(1:I),' NOT FOUND'
	    GOTO 10
	  ENDIF
	ENDIF
   20	IF(.NOT.GOT_FILEZ)THEN
	  i = length(namez)
	  type *,'IS file: ',namez(1:i),', not good file name'
	  TYPE 40
	  ACCEPT 50,TEST_NAME
	  INQUIRE(FILE=TEST_NAME,EXIST=GOT_FILEZ,NAME=FILENAMEZ)
	  IF(.NOT.GOT_FILEZ)THEN
	    I = LENGTH(TEST_NAME)
	    TYPE *,' FILE ',TEST_NAME(1:I),' NOT FOUND'
	    GOTO 20
	  ENDIF
	ENDIF
	RETURN
   30 FORMAT(' Enter Was File: ',$)
   40 FORMAT(' Enter Is  File: ',$)
   50 FORMAT (A)
	END
