PROGRAM SCANER
C** ROUTINE TO SCAN THROUGH AN EXISTING FILE AND DISPLAY
C** IT ON THE TERMINAL UNDER COLUMN COUNTERS.
C**
C** USERS 'CURSOR.FTN' ROUTINE FOR CURSOR CONTROL.
C**
        COMMON /SCUNT/ICRT,K2,K3,KNTIN,KNTOUT,ICMND(4),IOFIL,IGOOD
        COMMON /SCDTA/IDATA(162),KDATA(162)
       BYTE IFILE(40),IDATA,KDATA,ICMND
       DIMENSION ITERM(6),IPARM(5)
       LOGICAL NEWFL
       DATA ANONE/'    '/
       DATA IPARM/5*0/
C********************************************************************
C** SET TERMINAL DEVICE
       ICRT = 5
C** GET TERMINAL WIDTH
C      CALL GETLUN(ICRT,ITERM)		!!DEPENDANT
C** CHECK FOR SCOPE TYPE TERMINAL
C      IF((ITERM(4) .AND. "10000) .NE. 0)GO TO 10
C      WRITE(ICRT,1018)
C1018  FORMAT(' THIS PROGRAM CANNOT RUN ON A NON-SCOPE TYPE TERMINAL',/,
C    *        ' THE PROGRAM WILL EXIT WITH NO CHANGE TO YOUR DATA.')
C      GO TO 999
C** SET SCOPE WIDTH TO 80
C10    IPARM(5) = 80		!!DEPENDANT
C      CALL QIO("32,ICRT,,,,IPARM,)		!!DEPENDANT
C** OPEN SCREEN FOR INPUT
       OPEN(UNIT=ICRT,NAME='TO:',CARRIAGECONTROL='NONE')
C** OUTPUT FORM TO SCREEN
       CALL DISPLY(ICRT)
C** TURN OFF FILE OPEN ERROR
       CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,,)
C** SET NEW FILE TO FALSE
       NEWFL = .FALSE.
C** READ IN INPUT FILE SPEC
        CALL CURSOR(11,25,1,0,ANONE)
       READ(ICRT,1001,END=999)IFILE
 1001  FORMAT(40A1)
       IFILE(40) = 0
C** OPEN FILE
       IN =1
       OPEN(UNIT=IN,NAME=IFILE,TYPE='OLD',CARRIAGECONTROL='LIST',
     * ERR= 20)
       GO TO 30
C** CREATE NEW FILE
 20    CALL CURSOR(11,20,2,17,'CREATING NEW FILE')
       OPEN(UNIT=IN,NAME=IFILE,TYPE='NEW',CARRIAGECONTROL='LIST',
     * ERR= 25)
       NEWFL = .TRUE.
       ICMND(1) = 'I'
       GO TO 30
C** FILE OPEN FAILURE
 25    CALL CURSOR(11,40,2,20,'OPEN FAILURE - ABORT')
       GO TO 950
C** OPEN SEQUENTIAL FILE - SCRATCH
 30    IOFIL = 2
       OPEN(UNIT=IOFIL,NAME='SCAN.TMP',TYPE='NEW',ACCESS='DIRECT',
     * FORM='FORMATTED',RECORDSIZE=162,ASSOCIATEVARIABLE=K2)
C** OPEN SECOND SCRATCH FILE
       IGOOD = 3
       OPEN(UNIT=IGOOD,NAME='SCAN.TMP',TYPE='NEW',ACCESS='DIRECT',
     * FORM='FORMATTED',RECORDSIZE=162,ASSOCIATEVARIABLE=K3)
       K3 = 1
C** COUNT THE SIZE OF THE FILE AND ROLL IT TO SCRATCH FILE
       KNTIN = 0
       K2 = 1
       IF(NEWFL)GO TO 50
 40    READ(IN,1006,END=50)IQ,(IDATA(K),K=1,IQ)
 1006  FORMAT(Q,162A1)
       WRITE(IOFIL'K2,1002)(IDATA(K),K=1,IQ)
       KNTIN = KNTIN + 1
       GO TO 40
C** SET PROMPT
 50    K2 = 1
C** INITIALIZE OUTPUT LINE COUNTER
       KNTOUT = 0
C** 
C*****
C** LOAD FILE
C*****
       NSCNED=0
C** CLEAR RECORD
       CALL BFILL(KDATA,1,162,' ')
 120   CALL CURSOR(11,1,10,0,ANONE)
       WRITE(ICRT,1004)(KDATA(J),J=1,80)
 1004  FORMAT(81A1)
       CALL CURSOR(11,1,17,0,ANONE)
       CALL BFILL(KDATA,1,162,' ')
       IF(NEWFL)GO TO 408
C** CHECK FOR END OF FILE
       IF(K2 .LE. KNTIN)GO TO 127
       ICMND(1) = 'B'
       CALL CURSOR(11,1,24,23,'END OF FILE - GO TO TOP')
       GO TO 900
 127   READ(IOFIL'K2,1012)IQ,(KDATA(J),J=1,IQ)
1012   FORMAT(Q,162A1)
       IQW = MIN0(IQ,80)
       WRITE(ICRT,1004)(KDATA(J),J=1,IQW)
       IF(IQ .LE. 80)GO TO 140
       CALL CURSOR(11,1,21,0,ANONE)
       IQW = MIN0(IQ,160)
       WRITE(ICRT,1004)(KDATA(J),J=81,IQW)
C** UPDATE LINE COUNT
 140   NSCNED = NSCNED + 1
       CALL CURSOR(11,24,3,0,ANONE)
       WRITE(ICRT,1003)NSCNED
 1003  FORMAT(I3)
C*****
C** READ AND SORT OUT NEW COMMAND
C*****
 205   CALL CURSOR(12,10,23,0,ANONE)
       ICMND(1) = ' '
       IF(NEWFL)GO TO 408
       READ(ICRT,1005)ICMND
 1005  FORMAT(4A1)
C** ZERO OUT ERROR MESSAGE
       CALL CURSOR(12,1,24,0,ANONE)
       IF(ICMND(1) .EQ. 'R')GO TO 300
       IF(ICMND(1) .EQ. 'D')GO TO 120
C** WRITE OUT RECORD TO OUTPUT FILE
 207   WRITE(IGOOD'K3,1002)(KDATA(J),J=1,IQ)
 1002  FORMAT(162A1)
       KNTOUT = KNTOUT + 1
       IF(ICMND(1) .EQ. ' ')GO TO 120
       IF(ICMND(1) .EQ. 'E')GO TO 900
       IF(ICMND(1) .EQ. 'B')GO TO 900
       IF(ICMND(1) .EQ. 'I')GO TO 408
       IF(ICMND(1) .EQ. 'S')GO TO 355
       IF(ICMND(1) .EQ. 'K')GO TO 950
C** COMMAND ERROR
 800   CALL CURSOR(11,1,24,32,'COMMAND ERROR - NO ACTION TAKEN')
       GO TO 205
C** REPLACE COMMAND
 300   CALL CURSOR(11,1,24,16,'COLUMN NUMBER > ')
       READ(ICRT,1015)IC
 1015  FORMAT(I2)
       IF(IC .GT. 80)GO TO 310
       CALL CURSOR(11,IC,17,0,ANONE)
       GO TO 315
 310   ICW = IC - 80
       CALL CURSOR(11,ICW,21,0,ANONE)
 315   READ(ICRT,1016)ICQ,(KDATA(J),J=IC,IC+ICQ-1)
 1016  FORMAT(Q,80A1)
       GO TO 205
C** SEARCH COMMAND
 355   CALL SEARCH(IMTCH)
       IF(IMTCH .NE. 0)GO TO 120
       GO TO 205
C** ADD A LINE OF INPUT
 408   CALL CURSOR(12,1,17,0,ANONE)
       CALL CURSOR(12,1,21,0,ANONE)
       CALL CURSOR(11,1,10,0,ANONE)
       WRITE(ICRT,1002)(KDATA(J),J=1,80)
       CALL CURSOR(11,1,17,0,ANONE)
       READ(ICRT,1017)IQ,(IDATA(K),K=1,IQ)
 1017  FORMAT(Q,80A1)
C** FILE IS NOT NEW ANY MORE
       NEWFL = .FALSE.
C** CHECK FOR END OF INPUT
       IF(IQ .EQ. 0)GO TO 120
C** CHECK FOR MORE THAN 80 COLUMNS
       IF(IQ .LT. 80)GO TO 410
       CALL CURSOR(11,1,21,0,ANONE)
       READ(ICRT,1017)IQ,(IDATA(K),K=81,IQ+80)
       IQ = IQ + 80
 410   CALL BFILL(KDATA,1,162,' ')
       DO 210 I=1,IQ
       KDATA(I) = IDATA(I)
 210   CONTINUE
C** WRITE RECORD TO FILE
       GO TO 207
C** ROLL REMAINING INPUT TO OUTPUT FILE
 900  CALL BFILL(KDATA,1,162,' ')
       IF(K2 .GT. KNTIN)GO TO 904
      READ(IOFIL'K2,1002)KDATA
      WRITE(IGOOD'K3,1002)KDATA
      KNTOUT = KNTOUT + 1
      IF(K2 .LE. KNTIN)GO TO 900
C** CHECK FOR BEGIN COMMAND
 904  IF(ICMND(1) .NE. 'B')GO TO 905
      CLOSE(UNIT=IGOOD)
      CLOSE(UNIT=IOFIL,DISPOSE='DELETE')
      ISAVE = IGOOD
      IGOOD = IOFIL
      IOFIL = ISAVE
      OPEN(UNIT=IOFIL,NAME='SCAN.TMP',TYPE='OLD',ACCESS='DIRECT',
     * FORM='FORMATTED',RECORDSIZE=162,ASSOCIATEVARIABLE=K2)
      OPEN(UNIT=IGOOD,NAME='SCAN.TMP',TYPE='NEW',ACCESS='DIRECT',
     * FORM='FORMATTED',RECORDSIZE=162,ASSOCIATEVARIABLE=K3)
C** REWIND FILES
       K2 = 1
       K3 = 1
       KNTIN = KNTOUT
       KNTOUT = 0
       NSCNED = 0
       IF(ICMND(1) .EQ. 'B')GO TO 120
C** COPY DIRECT SCRATCH FILE TO SEQUENTIAL FILE
 905   K3 = 1
       CLOSE(UNIT=IOFIL,DISPOSE='DELETE')
       ISVFL = 4
       OPEN(UNIT=ISVFL,NAME=IFILE,TYPE='NEW',CARRIAGECONTROL='LIST')
       DO 930 I=1,KNTOUT
       READ(IGOOD'K3,1010)IDATA
 1010  FORMAT(162A1)
C** COUNT THE CHAR
       IEND = 162
 915   IF(IDATA(IEND) .NE. ' ')GO TO 920
       IEND = IEND -1
       GO TO 915
C** WRITE
 920   WRITE(ISVFL,1010)(IDATA(J),J=1,IEND)
 930   CONTINUE
C** GO TO BOTTOM OF SCREEN
       IF(ICMND(2) .EQ. 'K')CLOSE(UNIT=ISVFL,DISPOSE='DELETE')
       IF(ICMND(2) .NE. 'K')CLOSE(UNIT=ISVFL,DISPOSE='SAVE')
 950   CALL CURSOR(11,1,24,0,ANONE)
C** RESET TERMINAL WIDTH
C      IPARM(5) = ITERM(6)
C      CALL QIO("32,ICRT,,,,IPARM,)
       CLOSE(UNIT=ICRT)
       IF(ICMND(2) .EQ. 'D')CLOSE(UNIT=IN,DISPOSE='DELETE')
       IF(ICMND(2) .NE. 'D')CLOSE(UNIT=IN,DISPOSE='SAVE')
       CLOSE(UNIT=IOFIL,DISPOSE='DELETE')
       CLOSE(UNIT=IGOOD,DISPOSE='DELETE')
 999   STOP
       END
C**++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       SUBROUTINE BFILL(ARRAY,ISTRT,IEND,IFILL)
C** ROUTINE TO FILL A BYTE ARRAY
       BYTE ARRAY(1),IFILL
       DO 10 I=ISTRT,IEND
       ARRAY(I) = IFILL
 10    CONTINUE
       RETURN
       END
C**+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        SUBROUTINE DISPLY(ICRT)
        BYTE DIGIT(10)
        DATA DIGIT/'1','2','3','4','5','6','7','8','9','0'/
        DATA ANONE/'    '/
C*********************************************************************
C** CLEAR AND HOME SCREEN
        CALL CURSOR(9,0,0,0,ANONE)
        CALL CURSOR(13,0,0,0,ANONE)
C** INDICATE PROGRAMMED COMMANDS
        CALL CURSOR(11,45,4, 9,'COMMANDS:')
        CALL CURSOR(11,44,5, 9,'B - BEGIN')
        CALL CURSOR(11,44,6,10,'D - DELETE')
        CALL CURSOR(11,44,7, 8,'E - EXIT')
        CALL CURSOR(11,44,8,17,'ED- EXIT + DELETE')
        CALL CURSOR(11,44,9,10,'I - INSERT')
        CALL CURSOR(11,64,5, 8,'K - KILL')
        CALL CURSOR(11,64,6,11,'R - REPLACE')
        CALL CURSOR(11,64,7,10,'S - SEARCH')
C** PUT UP COLUMN LINE NUMBERS
        DO 100 I=1,8
        CALL CURSOR(11,I*10,15,1,DIGIT(I))
        IX = (I-1)*10 + 1
        CALL CURSOR(11,IX,16,10,'1234567890')
 100    CONTINUE
        J = 9
        DO 115 I=9,16
        IX = (I-8)*10
        CALL CURSOR(11,IX,19,1,DIGIT(J))
        J = J + 1
        IF(J .GT. 10) J=1
        IX = (I-9)*10 + 1
        CALL CURSOR(11,IX,20,10,'1234567890')
 115    CONTINUE
C** PLACE PROMPTS
        CALL CURSOR(11,1,1,24,'TYPE IN FULL FILE SPEC> ')
        CALL CURSOR(11,1,23,9,'COMMAND> ')
        CALL CURSOR(11,1,3,24,'NO. LINES READ SO FAR> 0')
        CALL CURSOR(11,1,9,17,'LAST LINE SCANNED')
        CALL CURSOR(11,1,17,0,ANONE)
        RETURN
        END
C**+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C**
C**       IBCOMP
C**
C**+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       FUNCTION IBCOMP(A,B,N)
C** D. CLUSE 08/09/77
C** COMPARE A CHARACTER STRING IN ARRAY "A" TO A STRING IN ARRAY "B"
C**
C** CALLING ARGUMENTS:
C** A     - ARRAY OF CHARACTERS TO BE COMPARED.  MAY BE AN ARRAY NAME
C**         OR ARRAY ELEMENT INDICATING THE BEGINNING OF THE STRING.
C** B     - ARRAY OF CHARACTERS THAT IS THE KEY STRING TO BE COMPARED
C**         WITH THE CHARACTERS IN A.  MAY BE AN ARRAY NAME OF THE ELEMENT
C**         OF AN ARRAY INDICATING THE BEGINNING OF THE STRING.
C** N     - THE NUMBER OF CHARACTERS TO BE COMPARED.
C**
C** RETURNED ARGUMENTS:
C** IBCOMP - 0 IF THE CHARACTERS IN "A" ARE EQUAL TO "B".
C**         -K IF CHARACTERS IN "A" ARE NUMERICALLY LESS THAN "B".
C**         +K IF CHARACTERS IN "A" ARE NUMERICALLY GREATER THAN "B".
C**         WHERE "K" IF THE RELATIVE ELEMENT THAT DID NOT MATCH (1 TO N).
      BYTE A(N),B(N)
C**************************************************************************
      DO 10 I=1,N
      IF(A(I)-B(I)) 11,10,12
 10   CONTINUE
      IBCOMP=0
      GO TO 999
 11   IBCOMP=-I
      GO TO 999
 12   IBCOMP=I
 999  RETURN
      END
C**+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C**
C**        SEARCH
C**
C**+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       SUBROUTINE SEARCH(IMTCH)
C** SEARCH NEXT LINE TO END OF FILE FOR MATCH
       COMMON /SCUNT/ICRT,K2,K3,KNTIN,KNTOUT,ICMND(4),IOFIL,IGOOD
       COMMON /SCDTA/IDATA(162),KDATA(162)
       BYTE IDATA,KDATA,ICMND
       BYTE ITEXT(82)
C****************************************************************
C** SEND MESSAGE
       CALL CURSOR(11,1,24,35,'ENTER START,STOP,TEXT FOR SEARCH > ')
       READ(ICRT,1001)IQ,ITEXT
 1001  FORMAT(Q,82A1)
C** DECIDE START COLUMN NUMBER
       ICHR1 = 82
       DO 20 I=1,ICHR1
       IF(ITEXT(I) .EQ. ',')GO TO 25
 20    CONTINUE
       GO  TO 801
 25    ICHR1 = I
       IF(ICHR1 .EQ. 1)GO TO 29
       DECODE(ICHR1-1,1002,ITEXT)ISTRT
 1002  FORMAT(I3)
       GO TO 30
 29    ISTRT = 1
C** DECODE STOP COLUMN
 30    ICHR2 = ICHR1 + 1
       DO 40 I=ICHR2,82
       IF(ITEXT(I) .EQ. ',')GO TO 45
 40    CONTINUE
       GO TO 801
 45    ICHR2 = I
       IF(ICHR2 .EQ. ICHR1 + 1)GO TO 49
       DECODE(ICHR2-1,1002,ITEXT(ICHR1+1))ISTOP
       GO TO 50
 49    ISTOP = 80
C** CURRENT LINE ALREADY WRITTEN OUT
 50    ISTRG = IQ - ICHR2
       IMTCH = 1
C** DIAGX
C      CALL CURSOR(11,1,26,0,' ')
C      WRITE(ICRT,9001)ISTRT,ISTOP,ISTRG,IMTCH
C9001  FORMAT(' ISTRT,ISTOP,ISTRG,IMTCH = ',4I5)
 60    CALL BFILL(KDATA,1,162,' ')
       IF(K2 .GT. KNTIN)GO TO 64
       READ(IOFIL'K2,1003)IR,(KDATA(J),J=1,IR)
 1003  FORMAT(Q,162A1)
C** CHECK FOR MATCH
       IEND = ISTOP - ISTRG
       DO 63 I=ISTRT,IEND
       IMTCH = IBCOMP(ITEXT(ICHR2+1),KDATA(I),ISTRG)
       IF(IMTCH .EQ. 0)GO TO 100
 63    CONTINUE
C** NO MATCH THIS RECORD
       WRITE(IGOOD'K3,1004)(KDATA(J),J=1,IR)
 1004  FORMAT(162A1)
       KNTOUT = KNTOUT+1
       IF(K2 .LE. KNTIN)GO TO 60
C** END OF FILE - NO MATCH
 64    CALL CURSOR(11,1,24,22,'END-OF-FILE : NO MATCH')
       GO TO 900
C** MATCH
 100   CALL CURSOR(11,1,17,0,' ')
       IRW = MIN0(IR,80)
       WRITE(ICRT,1005)(KDATA(J),J=1,IRW)
 1005  FORMAT(80A1)
       IF(IR .LE. 80)GO TO 900
       CALL CURSOR(11,1,21,0,' ')
       IRW = MIN0(IR,160)
       WRITE(ICRT,1005)(KDATA(J),J=81,IRW)
       GO TO 900
C** ERROR
 801   CALL CURSOR(11,1,24,32,'COMMAND ERROR - NO ACTION TAKEN')
 900   RETURN
       END