*DECK,TIO        TIO (TEST INPUT/OUTPUT PROGRAM). 
C*F45V1P0*
      OVERLAY (TIO,0,0) 
      PROGRAM TIO 
     ,(TAPE1=512,TAPE2=512,TAPE3=512,TAPE4=512,TAPE5=512,OUTPUT=O"101") 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                                                                     * 
*                   CONTROL DATA PROPRIETARY PRODUCT.                 * 
*                   MAINTENANCE SOFTWARE.                             * 
*                                                                     * 
*          REPRODUCTION IN WHOLE OR IN PART WITHOUT EXPRESS           * 
*          WRITTEN PERMISSION OF CONTROL DATA CORPORATION             * 
*          IS STRICTLY PROHIBITED.                                    * 
*                                                                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*         THIS PROGRAM HAS BEEN CONVERTED TO ASSEMBLE UNDER FORTRAN   * 
*         VERSION 5.  TO ASSEMBLE UNDER FORTRAN VERSION 4, MODSET     * 
*         CMLA119 IS YANKED .  ANY CHANGES MADE TO THIS PROGRAM MUST   *
*         ASSEMBLE UNDER FORTRAN 4 AND FORTRAN 5.                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*** 
*         TIO  TEST INPUT OUTPUT FTN CONFIDENCE LEVEL TEST. 
*         ------------------------------------------------- 
* 
*         ----------------------------------------
* 
*         DESCRIPTION 
*         ----------- 
*         TIO IS DESIGNED TO ASSESS A  DEVICES  PERFORMANCE THRU THE USE
*         OF FORTRAN EXTENDED STATEMENTS; BUFFER IN, BUFFER OUT, REWIND,
*         ENDFILE AND BACKSPACE.  FORTRAN INPUT OUTPUT  SUBPROGRAMS USED
*         ARE UNIT  AND  LENGTH.  THE TEST IS COMPOSED OF TWO  SECTIONS.
*         THE SEQUENTIAL SECTION WILL TEST THE  DEVICE  BY  WRITING  AND
*         READING PATTERNS OF PRESET AND RANDOM LENGTH SEQUENTIALLY FROM
*         A PRESET WRITE BUFFER. THE RANDOM SECTION WILL TEST THE DEVICE
*         BY PERFORMING RANDOM OPERATIONS WITH RANDOM LENGTH  DATA  FROM
*         A RANDOM WRITE BUFFER.
* 
  
**        ENTRY 
*         ----- 
*         ENTRY IS MADE TO TIO AFTER COMPASS ROUTINE /START/ AND FORTRAN
*         SUBROUINE /INIT/ HAVE EXECUTED AND CRACKED  THE  CONTROL  CARD
*         PARAMETERS. 
* 
*         EXIT
*         ----
*         IF ERROR FLAG (ERR) IS NON ZERO 
* 
*         CALLS 
*         ----- 
*         BEGIN  - OUTPUTS CONTROL CARD REPORT AND SET FLAGS ECT. 
*         MODSEQ - EXECUTES SEQUENTIAL SECTION
*         MODRAN - EXECUTES RANDOM SECTION
* 
* 
  
***       CONTROL CARD PARAMETERS 
*         ----------------------- 
* 
*         SEQ=N 
*               DECIMAL NUMBER OF SEQUENTIAL  RECORDS TO BE  WRITTEN  ON
*               THE TEST FILE(S) DURING THE SEQUENTIAL SECTION. IF SEQ=0
*               THE SEQUENTIAL SECTION IS SKIPPED.  MAXIMUM  VALUE FOR N
*               IS 9999999. 
*               ( DEFAULT  SEQ=200 )
* 
*         RAN=N 
*               DECIMAL NUMBER OF RANDOM  OPERATIONS TO  PERFORM  DURING
*               THE RANDOM SECTION.  IF  RAN=0  THE  RANDOM  SECTION  IS
*               SKIPPED.  MAXIMUM VALUE FOR N IS 9999999. 
*               ( DEFAULT  RAN=1000 ) 
* 
*         FILES=N 
*         FILES=LFN1/LFN2/LFN3/LFN4/LFN5
*               FILE=N WHERE  N IS THE VALUE 1 TO 5 USED TO  TURN  ON  N
*               TEST  FILE(S)  WITH DEFAULT LOGICAL FILE NAME(S); TAPE1,
*               TAPE2, TAPE3, TAPE4, TAPE5.  THE ALTERNATE FORM  OF THIS
*               IS USED IF THE USER WANTS TO TURN ON  THE  TEST  FILE(S)
*               AND CHANGE THE LOGICAL FILE NAME(S) FROM THE DEFAULT. 
*               ( DEFAULT  FILE=1  OR  FILES=TAPE1 )
* 
*         OUTPUT=LFN
*         O=LFN 
*               THIS PARMETER IS USED TO CHANGE THE  LOGICAL  FILE  NAME
*               FOR THE OUTPUT FILE.
*               ( DEFAULT  OUTPUT=OUTPUT  OR  O=OUTPUT )
* 
*         PASSES=N
*               WHERE N IS THE DECIMAL NUMBER OF PASSES  THE  SEQUENTIAL
*               AND RANDOM SECTIONS WILL EXECUTE.  ONE PASS WILL INCLUDE
*               BOTH BINARY AND CODED MODES IF THE MODE PARAMETER IS NOT
*               USED.  WHEN THE MODE PARAMETER IS  USED  ONE  PASS  WILL
*               CONSIST OF ONE MODE.  MAXIMUM VALUE FOR N IS 9999999. 
*               ( DEFAULT  PASSES=3 ) 
* 
*         LIST=N
*               THE VALUE FOR N IS THE  DECIMAL  NUMBER  OF ERRORS TO BE
*               WRITTEN TO THE OUTPUT FILE BEFORE TERMINATING.   MAXIMUM
*               VALUE FOR N IS 9999999. 
*               ( DEFAULT  LIST=100 ) 
* 
*         MAXREC=N
*               WHERE N EQUALS THE MAXIMUM RECORD LENGTH TO  BE  WRITTEN
*               ON THE TEST FILE(S) IN SIXTY BIT CENTRAL  MEMORY  WORDS.
*               MAXIMUM VALUE FOR N IS 2000.
*               ( DEFAULT  MAXREC = 2000 )
* 
*         MINREC=N
*               WHERE N EQUALS THE MINIMUM RECORD LENGTH TO  BE  WRITTEN
*               ON THE TEST FILE(S) IN SIXTY BIT CENTRAL  MEMORY  WORDS.
*               MINIMUM VALUE FOR N IS 1. 
*               ( DEFAULT  MINREC = 1 ) 
* 
*         PATTERN=NN/AAAA/BBBB/CCCC/DDDD/EEEE 
*         PAT=NN/AAAA/BBBB/CCCC/DDDD/EEEE 
*               THE PATTERN PARAMETER IS USED IF  A  CERTAIN  PATTERN IS
*               DESIRED FOR THE  DATA  WRITTEN ON THE TEST FILE(S).  THE
*               VALUE FOR NN CAN BE  ANY  NUMBER FROM 1-59 DECIMAL.  THE
*               VALUES FOR AAAA THRU EEEE MUST BE FOUR OCTAL DIGIT RIGHT
*               JUSTIFIED NUMBERS REPRESENTING THE PATTERN DESIRED. SOME
*               EXAMPLES WOULD BE;  PAT=12/3210  WILL STORE 321032103210
*               IN THE WRITE BUFFER, PAT=6/0012 WILL STORE 121212 IN THE
*               BUFFER, PAT=30/0012/3456/7077 WILL STORE 123456707712345
*               IN THE BUFFER,  PAT=8/0376 WILL STORE 775773767757737 IN
*               THE WRITE BUFFER.  TO FORCE  RANDOM DATA FOR THE SEQUEN-
*               TIAL  SECTION  USE  PAT=RAN, PAT=RANDOM, PATTERN=RAN, OR
*               PATTERN=RANDOM. 
* 
*               ( DEFAULT  PATTERN = PRESET/RANDOM )
* 
*               ( NOTE---- ALL 00B CHARACTERS REPLACED BY 33B AND 6362B)
*               (          IN BYTE 4 OF 60 BIT WORD BY 3333B FOR CODED )
* 
* 
* 
*         HISTORY=N 
*               IF PRESENT ON THE CALL STATEMENT TIO WILL LIST UP TO THE
*               LAST DECIMAL N OPERATIONS PERFORMED ON THE TEST  FILE(S)
*               PRECEDING AN ERROR.  IF N IS GREATER THAN 50 ALL OF  THE
*               OPERATIONS WILL BE LISTED ON THE OUTPUT FILE. 
*               ( DEFAULT  HISTORY=0 )
* 
*         WRITE 
*               USED TO RUN THE SEQUENTIAL SECTION IN A WRITE ONLY  MODE
*               TO CREATE TEST FILE(S).  THE TEST FILE(S) CAN BE USED IN
*               ANOTHER RUN OF  TIO  WITH  THRU  THE  USE  OF  THE  READ
*               PARAMETER.   THE RANDOM SECTION IS DISABLED IF PARAMETER
*               IS USED.  THE MODE PARAMETER MUST BE USED IF CODED  TEST
*               FILE(S) ARE DESIRED.
*               ( DEFAULT  WRITE=OFF )
* 
*         READ
*               USED TO RUN THE SEQUENTIAL SECTION IN A READ  ONLY  MODE
*               ON TEST FILE(S) PREWRITTEN THRU THE  USE  OF  THE  WRITE
*               PARAMETER.  THE  RANDOM  SECTION  IS  DISABLED  IF  THIS
*               PARAMETER IS USED.  THE MODE PARAMETER MUST BE  USED  IF
*               THE TEST FILE(S) ARE IN CODED FORMAT. 
*               ( DEFAULT  READ=OFF ) 
* 
* 
* 
* 
* 
* 
* 
* 
*         SAMPLE JOBS 
*         ----------- 
* 
*         JOB1. 
*         REQUEST,TAPE1.
*         TIO.
*         COMMENT. THIS JOB WILL RUN TIO DEFAULT PARAMETERS.
*         6/7/8/9  **EOF**
* 
*         JOB2. 
*         REQUEST,TAPE1.
*         TIO(O=SCRATCH,PASSES=10,MINREC=10,MAXREC=10)
*         COMMENT. THIS JOB WILL RUN 10 PASSES OF THE SEQUENTIAL AND
*         COMMENT. RANDOM SECTIONS WITH RECORDS OF LENGTH 10 AND LIST 
*         COMMENT. ALL ERRORS ON A FILE CALLED SCRATCH. 
*         6/7/8/9  **EOF**
* 
*         JOB3. 
*         REQUEST TAPE22. 
*         TIO(FILES=TAPE22,LIST=10,MODE=BIN)
*         COMMENT. THIS JOB WILL RUN THE SEQUENTIAL AND RANDOM SECTIONS 
*         COMMENT. ON A TEST FILE TAPE22 IN BINARY MODE AND TERMINATE 
*         COMMENT. IF 10 ERRORS ARE ENCOUNTERED OR END OF TEST. 
*         6/7/8/9  **EOF**
* 
*         JOB4. 
*         TIO(FILES=5,HISTORY=ALL)
*         COMMENT. THIS JOB WILL RUN THE SEQUENTIAL AND RANDOM SECTIONS 
*         COMMENT. ON FIVE SYSTEM SCRATCH TEST FILES AND LIST ALL OF THE
*         COMMENT. OPERATIONS ON THE OUTPUT FILE, (VERY LARGE OUTPUT).
*         6/7/8/9  **EOF**
* 
*         JOB5. 
*         REQUEST,TAPE1.
*         TIO(PAT=12/7777,WRITE)
*         COMMENT. THIS JOB WILL DO A WRITE ONLY WITH A PATTERN OF ALL
*         COMMENT. ONES IN BINARY MODE AND LOOP FOR THE DEFAULT NUMBER
*         COMMENT. OF PASSES. 
*         6/7/8/9  **EOF**
* 
*         JOB6. 
*         REQUEST,TAPE1.
*         TIO(PAT=12/7777,READ) 
*         COMMENT. THIS JOB WILL READ TAPE1 CREATED IN JOB5 AND REPORT
*         COMMENT. ANY DATA ERRORS THAT ARE ENCOUNTERED WITH THE ONES 
*         COMMENT. PATTERN. 
*         6/7/8/9  **EOF**
* 
*         JOB7. 
*         TIO(PAT=8/0020,HISTORY=5) 
*         COMMENT. THIS JOB WILL RUN THE SEQUENTIAL AND RANDOM SECTIONS 
*         COMMENT. WRITING AND READING A PATTERN OF 00200400100 OCTAL ON
*         COMMENT. DEFAULT SYSTEM SCRATCH FILE TAPE1 AND REPORT THE LAST
*         COMMENT. FIVE OPERATIONS PRECEDING ANY ERROR ENCOUNTERED. 
*         6/7/8/9  **EOF**
* 
* 
* 
* 
*         SAMPLE PARAMETER ERROR MESSAGES 
*         ------------------------------- 
* 
*         1. URECOGNIZED           PARAMETER .. (PARAMETER) 
*            UNRECOGNIZED PARAMETER ON CALL STATEMENT.
* 
*         2. URECOGNIZED           PARAMETER .. (PARAMETER=PARAMETER) 
*            UNRECOGNIZED PARAMETERS ON CALL STATEMENT. 
* 
*         3. DECIMAL CONVERT ERROR PARAMETER .. (PARAMETER=ALPHA) 
*            VALUE ALPHA MUST BE 1-60 FOLLOWED BY / AND OCTAL PARAMETER 
* 
*         4. VALUE TOO HIGH        PARAMETER .. (FILES = 6      ) 
*            VALUE ON FILES PARAMETER TOO HIGH
* 
*         5. OCTAL CONVERT ERROR   PARAMETER .. (PAT=12/1239    ) 
*            1239 VALUE MUST BE OCTAL 
* 
*         6. MAXREC=1999 MINREC=2000  ... MAX LESS THAN MIN 
*            MINIMUM CAN NOT BE GREATER THAN MAXIMUM. 
* 
*         7. .... PROGRAM ABORT .... BAD PARAMETERS ....
*            ONE OR MORE PARAMETER ERRORS ON CONTROL CARD SEE OUTPUT
* 
*         8. VALUE TOO LOW         PARAMETER .. (FILES  = 0      )
*            VALUE WAS BELOW MINIMUM ALLOWED FOR PARAMETER
* 
*         9. NO SECTION SELECTED   (SEQ=0,RAN=0)
*            USER MUST SELECT AT LEAST ONE SECTION
* 
*         10.FILE NAME ABC     = ABC     DUPLICATE NAMES
*            TWO FILE NAMES WERE EQUAL ON EITHER THE FILES OR OUTPUT
*            PARAMETERS.
* 
* 
* 
*         DAYFILE SAMPLE MESSAGES 
*         ----------------------- 
* 
*         11.22.11.TIOTESTS. START OF SEQ PASS=0001 MODE=BIN
*         11.22.22.TIOTESTS. START OF RAN PASS=0001 MODE=BCD
*         11.22.33.TIOTESTS. SEQ COMPLETE RECORDS   =    200 ERR=0000 
*         11.22.44.TIOTESTS. RAN COMPLETE OPERATIONS=   1000 ERR=0000 
*         11.22.55.TIOTESTS. ERRORS EXCEED LIST =  000010 RUN ABORTED 
*         11.22.66.TIOTESTS. ...PARAMETER ERROR(S) ... PROGRAM ABORT. 
*         11.22.77.TIOTESTS. REC NUMBER ERR UNRCVD .. CALL EXIT 
* 
* 
*         SAMPLE SEQ AND RAN ERROR MESSAGES 
*         --------------------------------- 
* 
*         1. SEQ PASS=0001 TAPE1 BIN PARITY ERR R=0001 L=2000 
* 
*         2. SEQ PASS=0001 TAPE2 BCD DATA ERR R=0001 W=1999 E=X A=X D=X 
*                                                      X=20 OCTAL DIGITS
*         3. SEQ PASS=0002 TAPE1 BIN EOF EXPECTED R=0002 L=   0 
* 
*         4. SEQ PASS=0003 TAPE2 BCD EOF NOT EXPECTED R=0002 L=2000 
* 
*         5. RAN PASS=0001 TAPE5 BIN LENGTH ERR R=0001 E=2000 A=1999
* 
*         6. RAN PASS=0002 TAPE1 BCD GT 10 DATA ERRS R=0002 
* 
*         7. RAN PASS=0003 TAPE2 BIN M/R CMP ERR R=0002 M= X R= Y 
*                                 X=20 OCTAL DIGITS OF THE MODEL WORD 
*                                 Y=20 OCTAL DIGITS OF THE RECORD WORD
* 
*            MODEL WORD = 12/FWA OF WRITE,12/RECORD LENGTH,36/RECORD NO.
*            RECORD WORD= 12/FWA OF WRITE,12/RECORD LENGTH,36/RECORD NO.
* 
*         8. ERRORS EXCEED LIST = 000010  RUN ABORTED 
* 
*         9. SEQ PASS=0002 TAPE1 BIN REC-NO ERR E=0002 A=0003 CONT. BY
*                                                        SETTING E=A
* 
*            ( RECORD NUMBER READ DID NOT MATCH INTERNAL MODEL SO TIO ) 
*            ( ATTEMPTED RECOVERY BY SETTING EXPECTED REC TO ACTUAL   ) 
* 
*        10. SEQ PASS=0002 TAPE1 BIN REC-NO ERR E=0003 A=0001 CAN NOT 
*                                                             CONTINUE
* 
*            ( RECORD NUMBER READ DID NOT MATCH EXPECTED VALUE AND    ) 
*            ( CORRECTION WOULD NOT WORK SO CALL TO EXIT MADE         ) 
* 
*         INSTALLATION DECKS. 
*         ------------------- 
* 
*         NOS,CM60000,T100. 
*         COMMENT. THIS JOB WILL ADD TIO TO THE 
*         COMMENT. RUNNING NOS SYSTEM.
*         REQUEST,KPL23.
*         UPDATE,Q,P=KPL23. 
*         FTN,I,L=0.
*         LOAD(LGO) 
*         NOGO. 
*         SYSEDIT,I=0,B=TIO,L=1.
*         7/8/9   ***EOR*** 
*         *COMPILE,TIO
*         6/7/8/9 ***EOF*** 
* 
* 
* 
*         NOSBE,CM60000,T100. 
*         COMMENT. THIS JOB WILL ADD TIO TO THE 
*         COMMENT. RUNNING NOS/BE SYSTEM. 
*         REQUEST,PL5.
*         UPDATE,Q,P=PL5. 
*         FTN,I,L=0.
*         LOAD(LGO) 
*         NOGO. 
*         EDITLIB,SYSTEM. 
*         7/8/9   ***EOR*** 
*         *COMPILE,TIO
*         7/8/9 
*         READY(SYSTEM) 
*         LIBRARY(NUCLEUS,OLD)
*         REPLACE(TIO,TIO,AL=7777,FL=45000,FLO=0) 
*         FINISH. 
*         COMPLETE. 
*         ENDRUN. 
*         6/7/8/9 ***EOF*** 
* 
* 
*         TEST FILE RECORD FORMAT 
*         ----------------------- 
* 
*         THE FIRST 60 BITS OF DATA IS A CONTROL WORD WHICH CONTAINS THE
*         FIRST WORD ADDRESS OF THE OUTPUT FROM THE WRITE BUFFER, LENGTH
*         OF THE RECORD, AND RECORD NUMBER AS FOLLOWS;
* 
*                  5         4         3         2         1
*         987654321098765432109876543210987654321098765432109876543210
*         *--FWA-----**--LENGTH--**-------------RECORD NUMBER--------*
* 
*         DATA CHECKING IS DONE BY COMPARING THE DATA IN THE READ BUFFER
*         WITH THE DATA IN THE WRITE BUFFER.  IF A RECORD HAS MORE THAN 
*         TEN ERRORS FURTHER DATA CHECKING ON THAT RECORD IS ENDED WITH 
*         A MESSAGE ( GT 10 DATA ERRS ) 
* 
* 
* 
* 
  
**        DEFINITIONS COMMON BLOCKS 
*         ------------------------- 
* 
*         BK         OPERATION CODE FOR BACKSPACE RECORD
*         BUFRD      READ  BUFFER 
*         BUFWR      WRITE BUFFER 
*         CORE       USED WHEN REFERING TO ACTUAL CORE LOCATION 
*         CVT1       CHARACTER THAT CHANGES ON CODED WRITE/READ 
*         CVT2       CHARACTER CVT1 IS CONVERTED TO 
*         EF         OPERATION CODE FOR END OF FILE 
*         FHST       FLAG FOR NUMBER OF LAST OPERATIONS TO BE REPORTED
*         FILES      FLAG FOR NUMBER OF FILE(S) TO TEST 
*         FLST       FLAG FOR NUMBER OF ERRORS TO LIST BEFORE ENDING
*         FLT        CONTAINS THE LENGTH OF BUFFER M. UPDATED WITH UPFL 
*         FMODE      MODE FLAG FMODE=0 BOTH MODES, 1=BINARY 2=CODED 
*         FMTOP      CONTAINS THE DISPLAY CODE FOR OPERATION
*         FPAT       FLAG USED IF PATTERN PARAMETER USED  1=USED
*         H(50,5)    HISTORY BUFFER FOR UP TO LAST 50 OPERATIONS
*         INHST      HISTORY BUFFER (H) INPUT ADDRESS 
*         LACT       ACTUAL RECORD LENGTH READ OR BEING WRITTEN.
*         LEXP       EXPECTED RECORD LENGTH.
*         LOP(5)     LAST OPERATION PERFORMED ON TEST FILE
*         M          INTERNAL MODEL BUFFER FLTOT CONTAINS THE LENGTH
*         MAX        MAXIMUM RECORD SIZE TO BE WRITTEN
*         MIN        MINIMUM RECORD SIZE TO BE WRITTEN
*         MODE       CURRENT MODE TO BE USED 0=CODED 1=BINARY 
*         MSKR       MASK FOR RECORD LENGTH 
*         MSKU       MASK FOR UNIT NUMBER USED BY MODRAN
*         PAR        TABLE OF PARAMETERS AND DEFAULT VALUES ECT.
*         PASS       CURRENT PASS NUMBER
*         PASSES     TOTAL PASSES TO RUN
*         PAT        SET TO PATTERN IF FPAT NON ZERO
*         PTM        POINTER INTO INTERNAL MODEL (RWTM*FN)-RWTM)
*         RAN        CONTAINS THE NUMBER OF RANDOM OPERATIONS 
*         RE(5)      CONTAINS THE TOTAL ERRORS ENCOUNTERED
*         RD         OPERATION CODE FOR READ RECORD 
*         RO(5)      CONTAINS THE NUMBER OF OPERATIONS PERFORMED
*         RP(5)      CURRENT RECORD NUMBER POSITIONED ON
*         RT(5)      TOTAL RECORDS ON TEST FILE 
*         RW         OPERATION CODE FOR REWIND
*         RWTM       USED FOR RANDOM SECTION INDEX INTO MODEL 
*         SEQ        CONTAINS THE NUMBER OF RECORDS WRITTEN BY MODSEQ 
*         SF         OPERATION CODE FOR SEARCH FILE MARKS FORWARD 
*         SR         OPERATION CODE FOR SEQRCH FILE MARKS REVERSE 
*         VP         OPERATION CODE FOR VERIFY POSITION 
*         WR         OPERATION CODE FOR WRITE RECORD
* 
* 
  
  
  
*CALL,TIOCOM
  
*         SET FLAGS ECT. AND OUTPUT CONTROL CARD REPORT 
  
      CALL STLBAK 
      CALL STLENF 
      CALL STLIBU 
      CALL STLOBU 
      CALL STLOCO 
      CALL STLREW 
      CALL BEGIN
      IF(ERR.NE.0)GO TO 999 
      DO 200 KK=1,PASSES
         PASS = KK
         DO 100 LL=1,2
            MODE = LL.AND.1 
            IF((FMODE.EQ.1).AND.(MODE.EQ.0))GO TO 100 
            IF((FMODE.EQ.2).AND.(MODE.EQ.1))GO TO 100 
            CALL MODSEQ 
            CALL MODRAN 
  100    CONTINUE 
  200 CONTINUE
  999 CONTINUE
*CALL,CPYFTN
      END 
C*F45V1P0*
      SUBROUTINE INIT 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /INIT/ IS USED TO CRACK THE CALL STATEMENT PARA- 
*         METERS  AND  STORE  THE  LOGICAL  FILE  NAMES  FOR  FORTRAN 
*         SUBTITUTION AFTER MAIN PROGRAM /TIO/ IS ENTERED.  IF ERRORS 
*         ARE FOUND ON CONTROL STATEMENT THEY ARE STORED IN AN  ERROR 
*         TABLE FOR PRINTING AFTER ENTRY IS MADE TO /TIO/ 
* 
*         ENTRY 
*         ----- 
*         RA+2 THRU RA+64 HAS THE CONTROL CARD PARAMETERS STORED
* 
*         EXIT
*         ----
*         RA+2-RA+7 HAS THE LOGICAL FILE NAMES STORED FOR TAPE1-TAPE5 
*         AN OUTPUT.
*         RA+64 HAS THE NUMBER OF PARAMETERS REPLACED WITH A 6
*         FILES  - SET TO NUMBER OF FILES TURNED ON 
*         FRD    - NON ZERO IF READ PARAMETER PRESENT 
*         FWR    - NON ZERO IF WRITE PARAMETER PRESENT
*         FLST   - LIST PARAMETER VALUE OR DEFAULT
*         FMODE  - MODE PARAMETER VALUE 0=BOTH 1=BIN 2=BCD
*         FSEQ   - SEQ PARAMETER VALUE OR DEFAULT 
*         FRAN   - RAN PARAMETER VALUE OR DEFAULT 
*         PASSES - PASSES PARAMETER VALUE OR DEFAULT
* 
*         CALLS 
*         ----- 
*         CONOCT - OCTAL CONVERSION ROUTINE 
*         CONDEC - DECIMAL CONVERSION ROUTINE 
* 
*         CALLED BY 
*         --------- 
*         START  - COMPASS SUBROUTINE WHICH INITIAL ENTRY IS MADE TO
* 
* 
  
*CALL,TIOCOM
  
      DIMENSION P(7),S(7) 
  
  
**        COMMON BLOCK  PAR DEFINITION
*         ----------------------------
* 
*         PAR(1,INDEX) = VALUE TO COMPARE CONTROL STATEMENT WITH
*         PAR(2,INDEX) = DEFAULT VALUE FOR PARAMETER
*         PAR(3,INDEX) = SET TO NON ZERO IF PARAMETER IS USED 
* 
      DATA (PAR(I,01),I=1,3) / L"FILES", L"TAPE1", 0  / 
      DATA (PAR(I,02),I=1,3) / L"FILES", L"TAPE2", 0  / 
      DATA (PAR(I,03),I=1,3) / L"FILES", L"TAPE3", 0  / 
      DATA (PAR(I,04),I=1,3) / L"FILES", L"TAPE4", 0  / 
      DATA (PAR(I,05),I=1,3) / L"FILES", L"TAPE5", 0  / 
      DATA (PAR(I,06),I=1,3) / L"OUTPUT", L"OUTPUT", 0  / 
      DATA (PAR(I,07),I=1,3) / L"O", L"OUTPUT", 0  /
      DATA (PAR(I,08),I=1,3) / L"SEQ",       200, 0  /
      DATA (PAR(I,09),I=1,3) / L"RAN",      1000, 0  /
      DATA (PAR(I,10),I=1,3) / L"LIST",       100, 0  / 
      DATA (PAR(I,11),I=1,3) / L"HISTORY",         0, 0  /
      DATA (PAR(I,12),I=1,3) / L"MAXREC",      2000, 0  / 
      DATA (PAR(I,13),I=1,3) / L"MINREC",         1, 0  / 
      DATA (PAR(I,14),I=1,3) / L"READ",         0, 0  / 
      DATA (PAR(I,15),I=1,3) / L"WRITE",         0, 0  /
      DATA (PAR(I,16),I=1,3) / L"PATTERN",         0, 0  /
      DATA (PAR(I,17),I=1,3) / L"PAT",         0, 0  /
      DATA (PAR(I,18),I=1,3) / L"PASSES",         1, 0  / 
      DATA (PAR(I,19),I=1,3) / L"MODE",         0, 0  / 
  
*         SET MAXPAR EQUAL TO LAST ENTRY NUMBER IN PAR TABLE
  
      MAXPAR = 19 
  
*         SET VARIBLES AND CONSTANTS
  
      FILES  = 1
      SEQ    = PAR(2,8) 
      RAN    = PAR(2,9) 
      FLST   = PAR(2,10)
      FHST   = PAR(2,11)
      MAX    = PAR(2,12)
      MIN    = PAR(2,13)
      FRD    = PAR(2,14)
      FWR    = PAR(2,15)
      FPAT   = 0
      PAT    = 0
      PASSES = PAR(2,18)
      FMODE  = PAR(2,19)
      INDEX  = 2
      ERR    = 0
      RA     = 1-LOCF(CORE(1))
      CORE(RA+O"64") = CORE(RA+O"64").AND.MASK(42)
  
*         CLEAR BUFWR FOR CONTROL CARD ERRORS 
  
      DO 1 J=1,2048 
         BUFWR(J) = 0 
    1 CONTINUE
  
  
* ************ENTER MAIN LOOP UNTILL PAR1 = ZERO OR SEP = 17B***********
* **********************************************************************
  
*         GET SEVEN PARAMETERS AND SEPERATORS 
  
    5 ETYP = 0
      DO 6 J=1,7
         TEMP = INDEX + J - 1 
         P(J) = CORE(RA+TEMP).AND.MASK(42)
         S(J) = CORE(RA+TEMP).AND.O"77" 
    6 CONTINUE
  
      IF(P(1).EQ.0)GO TO 900
  
*         SCAN PAR TABLE FOR MATCHING PARAMETER 
  
        DO 7 J=1,MAXPAR 
          PT = J
          IF(P(1).EQ.PAR(1,PT))GO TO 9
    7   CONTINUE
  
*         UNRECOGIZED PARAMETER 
  
        ETYP = 11 
        GO TO 500 
  
    9   PAR(3,PT) = PAR(3,PT) + 1 
        IF((S(1).NE.O"54").AND.(S(1).NE.2))GO TO 500
  
*       SEP IS AN EQUAL SIGN AND PT SET TO PARAMETER IN PAR 
  
        GO TO ( 10, 10, 10, 10, 10, 60, 60, 80, 90,100, 
     ,         110,120,130,140,150,160,170,180,190,200)PT 
      CALL GOTOER 
  
*       ****************************************
*       *   FILES = NN                         *
*       *   FILES = LFN1/LFN2/LFN3/LFN4/LFN5   *
*       ****************************************
  
   10   CALL CONDEC (P(2))
        IF(P(2).LT.0) GO TO 55
          IF(P(2).EQ.0)ETYP = 28
          IF(P(2).GT.5)ETYP = 10
          IF(P(2).GT.5)P(2) = 1 
          FILES = P(2)
          GO TO 500 
   55   PAR(2,1) = CORE(RA+INDEX+1).AND.MASK(42)
        DO 58 J=2,5 
          IF((S(J).NE.R"/").AND.(S(J).NE.3))GO TO 500 
          INDEX = INDEX + 1 
          FILES = FILES + 1 
          PAR(2,J) = P(J+1) 
   58   CONTINUE
        GO TO 500 
  
*       ****************************************
*       *   OUTPUT = LFN                       *
*       *   O      = LFN                       *
*       ****************************************
  
   60   PAR(2,6) = P(2) 
        GO TO 500 
  
*       ****************************************
*       *   SEQ = N                            *
*       ****************************************
  
   80   CALL CONDEC (P(2))
        SEQ = P(2)
        IF(P(2).LT.0)ETYP = 9 
        GO TO 500 
  
*       ****************************************
*       *   RAN = N                            *
*       ****************************************
  
   90   CALL CONDEC (P(2))
        RAN = P(2)
        IF(P(2).LT.0)ETYP = 9 
        GO TO 500 
  
*       ****************************************
*       *   LIST = N                           *
*       ****************************************
  
  100   CALL CONDEC (P(2))
        FLST = P(2) 
        PAR(2,10) = FLST
        IF(P(2).LT.0)ETYP = 9 
        GO TO 500 
  
*       ****************************************
*       *   HISTORY = N                        *
*       ****************************************
  
  110   IF(P(2).EQ.L"ALL")P(2) = L"9999999" 
        CALL CONDEC (P(2))
        FHST = P(2) 
        IF(P(2).LT.0)ETYP = 9 
        GO TO 500 
  
*       ****************************************
*       *   MAXREC = N                         *
*       ****************************************
  
  120   CALL CONDEC (P(2))
        MAX = P(2)
        IF(P(2).LT.0)ETYP = 9 
        IF(P(2).GT.2000)ETYP = 10 
        IF(P(2).EQ.0)ETYP = 28
        IF(ETYP.NE.0)MAX = PAR(2,12)
        GO TO 500 
  
*       ****************************************
*       *   MINREC = N                         *
*       ****************************************
  
  130   CALL CONDEC (P(2))
        MIN = P(2)
        IF(P(2).LT.0)ETYP = 9 
        IF(P(2).GT.2000)ETYP = 10 
        IF(P(2).EQ.0)ETYP = 28
        IF(ETYP.NE.0)MIN = PAR(2,13)
        GO TO 500 
  
*       ****************************************
*       *   READ                               *
*       ****************************************
  
  140   IF(P(2).EQ.L"OFF")PAR(3,14) = 0 
        GO TO 500 
  
*       ****************************************
*       *   WRITE                              *
*       ****************************************
  
  150   IF(P(2).EQ.L"OFF")PAR(3,15) = 0 
        GO TO 500 
  
*       ****************************************
*       *   PAT = NN/AAAA/BBBB/CCCC/DDDD/EEEE  *
*       *   PATTERN=NN/AAAA/BBBB/CCCC/DDDD/EEEE*
*       ****************************************
  
  160   CONTINUE
  170   IF((P(2).NE.L"RAN").AND.(P(2).NE.L"RANDOM"))GO TO 172 
        FPAT = 64 
        GO TO 500 
  172   CALL CONDEC (P(2))
        IF(P(2).LT.0)ETYP = 9 
        IF(P(2).GT.60)ETYP = 10 
        FPAT = P(2) 
        TEMP = 0
        DO 175 J=3,7
           IF((S(J-1).NE.R"/").AND.(S(J-1).NE.3))GO TO 176
           TEMP = TEMP + 1
           CALL CONOCT (P(J)) 
           IF(P(J).LT.0)ETYP = 8
           PAT = SHIFT(PAT,12).OR.P(J)
  175   CONTINUE
  176   IF(ETYP.EQ.0)INDEX = INDEX + TEMP 
        GO TO 500 
  
*       ****************************************
*       *   PASSES = NNNNNNN                   *
*       ****************************************
  
  180   CONTINUE
        CALL CONDEC (P(2))
        IF(P(2).LT.0)ETYP = 9 
        PASSES = P(2) 
        GO TO 500 
  
*       ****************************************
*       *   MODE = BIN                         *
*       *   MODE = BCD                         *
*       ****************************************
  
  190   IF(P(2).EQ.L"BIN")FMODE = 1 
        IF(P(2).EQ.L"BCD")FMODE = 2 
        GO TO 500 
  
  
*         IF ETYP ZERO PARAMETER IS OK
  
  200   CONTINUE
  500   IF(ETYP.EQ.0)GO TO 510
          DO 502 K=1,7
             P(K) = CORE(RA+INDEX+K-1).AND.MASK(42) 
             S(K) = CORE(RA+INDEX+K-1).AND.O"77"
  502     CONTINUE
          ERR= ERR + 1
          T1 = ERR * 8 - 7
          T2 = T1 + 1 
          BUFWR(T1) = ETYP
          BUFWR(T2) = 1 
          DO 505 J=1,7
             IF(S(J).EQ.0)S(J) = R"," 
             IF(S(J).EQ.1)S(J) = R"," 
             IF(S(J).EQ.2)S(J) = R"=" 
             IF(S(J).EQ.3)S(J) = R"/" 
             IF(S(J).EQ.O"17")S(J)=R"." 
             BUFWR(T2+J) = P(J).OR.S(J) 
             IF((S(J).NE.R"/").AND.(S(J).NE.R"="))GO TO 510 
             IF(J.GT.1)INDEX = INDEX + 1
             BUFWR(T2) = BUFWR(T2) + 1
  505     CONTINUE
  510 INDEX = INDEX + 1 
      IF((S(1).EQ.O"54").OR.(S(1).EQ.2))INDEX = INDEX + 1 
      IF(S(1).NE.O"17")GO TO 5
* ******************* LOOP BACK NOT DONE CRACKING **********************
  
*         STORE LOGICAL FILE NAMES FOR TAPE1-TAPE5 AND OUTPUT 
  
  900 IF(ERR.NE.0)PAR(2,6) = L"OUTPUT"
      DO 910 J=1,FILES
         IF(PAR(2,6).EQ.PAR(2,J))PAR(2,6) = L"OUTPUT" 
  910 CONTINUE
      CORE(RA+2)   = PAR(2,1) 
      CORE(RA+3)   = PAR(2,2) 
      CORE(RA+4)   = PAR(2,3) 
      CORE(RA+5)   = PAR(2,4) 
      CORE(RA+6)   = PAR(2,5) 
      CORE(RA+7)   = PAR(2,6) 
      CORE(RA+O"64") = CORE(RA+O"64").OR.6
      FRD          = PAR(3,14)
      FWR          = PAR(3,15)
      IF(FRD.NE.0)RAN = 0 
      IF(FWR.NE.0)RAN = 0 
      IF((FRD.NE.0).AND.(FMODE.EQ.0))FMODE = 1
      IF((FWR.NE.0).AND.(FMODE.EQ.0))FMODE = 1
      RETURN
      END 
          IDENT  START
          ENTRY  START
          ENTRY  UPFL 
  
          COMMENT  COPYRIGHT CONTROL DATA CORPORATION 1975. 
  
  
**        DESCRIPTION 
*         ----------- 
*         COMPASS  PROGRAM  /START/ IS ENTERED  INITIALLY AND IS USED TO
*         CALL FORTRAN SUBROUTINE /INIT/ FOR PARMAETER CRACKING. /START/
*         WILL THEN JUMP TO THE MAIN PROGRAM /TIO/.  THE  PROGRAM  FIELD
*         LENGTH IS STORED IN FL FOR LATER USE BY COMPASS ROUTINE /UPFL/
* 
*         ENTRY 
*         ----- 
*         PARAMETERS STRORED IN RA+2 - RA+64
* 
*         EXIT
*         ----
*         LOGICAL FILE NAMES STORED IN RA+2 - RA+64 
*         FL     - SET TO PROGRAM FIELD LENGTH IN UPPER 30 BITS 
*         EXITS TO  /TIO/ 
* 
*         CALLS 
*         ----- 
*         INIT - CRACK CONTROL STATEMENT
* 
  
 START    SX6    A0          MOVE FL
          LX6    30          MOVE FL TO UPPER 30 BITS 
          SA6    FL          STORE FIELD LENGTH IN FL 
          RJ     =XINIT      CALL INIT TO CRACK PARAMETERS
          EQ     =XTIO       JUMP TO MAIN PROGRAM (TIO) 
  
  
**        DESCRIPTION 
*         ----------- 
*         COMPASS PROGRAM /UPFL/ IS USED TO RAISE THE FIELD LENGTH
*         OF THE PROGRAM BY THE VALUE IN CALLING ARGRUMENT. 
* 
*         ENTRY 
*         ----- 
*         X1 = INCREMENT VALUE
*         FL = CURRENT FIELD LENGTH 
* 
*         EXIT
*         ----
*         FL = NEW CURRENT FIELD LENGTH 
* 
*         CALLS 
*         ----- 
*         SYSTEM THRU MEMORY MACRO
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
* 
  
 UPFL     PS
          SA1    X1          GET FIELD LENGTH VALUE FROM CALL 
          BX6    X1          MOVE TO X6 
          LX6    30          SHIFT FIELD LENGTH TO UPPER 30 BITS
          SA6    FL          STORE NEW FIELD LENGTH NEEDED
          MEMORY CM,FL,R     CALL SYSTEM TO UP FIELD LENGTH 
          EQ     UPFL        RETURN 
  
 FL       DATA   0           PROGRAM FIELD LENGTH 
 SQ       STLD.RM  USERT=S,USEBT=C,USE=(CLOSEM,ENDFILE,GET               TIO001K
,PUT,REWINDM,SKIPBL),OMIT=CMM                                            TIO001K
          END    START
C*F45V1P0*
      SUBROUTINE MODSEQ 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /MODSEQ/ IS USED TO EXECUTE THE SEQUENTIAL  SECTION
*         ON THE TEST FILE(S).  NUMBER OF RECORDS  TO BUFFER  OUT  COMES
*         FROM THE VALUE STORED IN SEQ.  FOUR TYPES OF RECORDS ARE WRIT-
*         TEN ON THE TEST FILE(S) AS FOLLOWS; 
*         1.  SEQ/4 RECORDS OF LENGTH MAXREC. 
*         2.  SEQ/4 RECORDS OF LENGTH MINREC. 
*         3.  SEQ/4 RECORDS OF INCREASING LENGTH (MINREC-MAXREC). 
*         4.  SEQ-((SEQ*3)/4) RECORDS OF RANDOM LENGTH. 
*         THE DATA IS WRITTEN FROM THE WRITE BUFFER (BUFWR) IS PRESET BY
*         SUBROUTINE /GENDATA/. 
* 
*         ENTRY 
*         ----- 
*         FILES  - NUMBER OF TEST FILES THAT ARE TURNED ON
*         MSKR   - MASK FOR RANDOM LENGTH RECORD
*         MAX    - MAXIMUM RECORD LENGTH TO BUFFER OUT
*         MIN    - MINIMUM RECORD SIZE TO BUFFER OUT
*         RT(1-5)- TOTAL RECORDS ON TEST FILE(S) SET TO ZERO
*         RO(1-5)- TOTAL OPERATIONS PERFORMED ON THE TEST FILE(S) 
*         SEQ    - SET TO VALUE ON SEQ PARAMETER OR DEFAULT 
*         FLT    - CURRENT FIELD LENGTH ASSIGNED TO INTERNAL MODEL (M)
* 
*         EXIT
*         ----
*         HTBL   - HISTORY OF TOTAL OPERATIONS PERFORMED
*         RT(1-5)- TOTAL RECORDS AND FILES WRITTEN ON TEST FILE(S)
*         FLST   - LIST PARAMETER VALUE - NUMBER OF ERRORS FOUND
* 
*         CALLS 
*         ----- 
*         CLR    - CLEAR BUFFERS AND REWIND FILES 
*         UPFL   - USED TO INCREMENT FIELD LENGTH 
*         GENDATA- PRESET WRITE BUFFER (BUFWR)
*         OBKS   - BACKSPACE RECORD 
*         ORDF   - READ RECORD
*         OWRA   - WRITE RECORD ALL TEST FILE(S)
*         ORWD   - REWIND FILE
* 
*         CALLED BY 
*         --------- 
*         TIO 
* 
  
*CALL,TIOCOM
  
      IF(SEQ.EQ.0)GO TO 900 
         SECT = 3HSEQ 
         PTM  = 0 
         RWTM = 0 
         CALL GENDATA 
         IF(MODE.NE.0)GO TO 10
         EOL = O"6362"
         DO 5 J=1,2048
          IF((BUFWR(J).AND.O"7777").EQ.EOL)BUFWR(J)=BUFWR(J).AND.MASK(48
     +) 
    5    CONTINUE 
         CALL FILL (CVT1,CVT2,BUFWR(1),2048)
  
*        COMPUTE FL NEEDED FOR SEQ TEST AND REQUEST IT
  
   10    TEMP = SEQ + 1 
         FLT  = LOCF(M(TEMP)) 
         CALL UPFL (FLT)
         FLT = SEQ
  
*         CLEAR BUFFERS AND REWIND TEST FILES 
  
         CALL CLR 
         IF((FRD.NE.0).AND.(FWR.EQ.0))GO TO 250 
         IF(SEQ.LT.4)GO TO 150
  
*         ******************************************
*         * OUTPUT SEQ/4  RECORDS OF LENGTH MAXREC *
*         ******************************************
  
         NR    = SHIFT(SEQ,-2)
         LACT = MAX 
         CALL OPWR (1)
  
*         ******************************************
*         * OUTPUT SEQ/4  RECORDS OF LENGTH MINREC *
*         ******************************************
  
         LACT = MIN 
         CALL OPWR (1)
  
*         **********************************************
*         * OUTPUT SEQ/4  RECORDS OF INCREASING LENGTH *
*         **********************************************
  
         TEMP = NR
         NR   = 1 
         DO 100 J=1,TEMP
            LACT = J
            IF(LACT.GT.MAX) LACT = MAX
            IF(LACT.LT.MIN) LACT = MIN
            CALL OPWR (1) 
  100    CONTINUE 
  
*         ************************************************* 
*         * OUTPUT SEQ-(3*SEQ)/4 RECORDS OF RANDOM LENGTH * 
*         ************************************************* 
  
  150    TEMP = SEQ - RO(1) + 1 
         NR = 1 
         DO 200 J=1,TEMP
            LACT = (SHIFT (RANF(),36).AND.MSKR) + 1 
            IF(LACT.GT.MAX)LACT = MAX 
            IF(LACT.LT.MIN)LACT = MIN 
            CALL OPWR (1) 
  200    CONTINUE 
  
*         ********************
*         * REWIND ALL FILES *
*         ********************
  
         DO 210 J=1,FILES 
            CALL OPRW (J) 
  210    CONTINUE 
  
*         ******************************************
*         * READ ALL RECORDS AND CHECK FOR ERRORS  *
*         ******************************************
  
  250    CONTINUE 
         IF((FWR.EQ.1).AND.(FRD.EQ.0))GO TO 500 
         DO 310 K=1,SEQ 
           DO 300 J=1,FILES 
              CALL OPRD (J) 
  300      CONTINUE 
  310    CONTINUE 
  
*         ******************************
*         *  BACKSPACE READ ONE RECORD *
*         ******************************
  
         DO 400 J=1,FILES 
            CALL OPBK (J) 
            CALL OPRD (J) 
  400    CONTINUE 
  
*         *********************************************************** 
*         * LOOP BACKSPACE 2 READ 1 UNTILL BEGINING OF TEST FILE(S) * 
*         *********************************************************** 
  
         TEMP = SEQ - 1 
         IF(SEQ.EQ.1)GO TO 500
         DO 440 K=1, TEMP 
            DO 410 J=1,FILES
               IF(RP(J).LE.1)GO TO 440
               CALL OPBK (J)
  410       CONTINUE
            DO 420 J=1,FILES
               CALL OPBK (J)
  420       CONTINUE
            DO 430 J=1,FILES
               CALL OPRD (J)
  430       CONTINUE
  440    CONTINUE 
  
*         OUTPUT REPORT SUMMARY 
  
  500    CALL REPSUM
  
  900 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE MODRAN 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /MODRAN/ IS USED TO EXECUTE THE  RANDOM  SECTION ON
*         THE TEST FILE(S).  NUMBER  OF  OPERATIONS TO PERFORM IS STORED
*         IN RAN.  THE RANDOM OPERATIONS PERFORMED BY  /MODRAN/  ARE  AS
*         FOLLOWS;
* 
*              DESCRIPTION      CODE    SUBROUTINE
*         ------------------------------------------
*         1. REWIND--------------0---------OPRW-----
*         2. BACKSPACE-----------1---------OPBK-----
*         3. END FILE -----------2---------OPEF-----
*         4. READ RECORD---------3---------OPRD-----
*         5. WRITE RECORD--------4---------OPWR-----
*         6. VERIFY POSITION-----5---------OPVP-----
*         7. SKIP FILE FORWARD---6---------OPSF-----
*         8. SKIP FILE REVERSE---7---------OPSR-----
* 
*         RESTRICTIONS PLACED ON THE RANDOM OPERATIONS ARE; 
*         1. NO READS AFTER WRITES
*         2. WRITE MUST FOLLOW A READ 
*         3. NO REWINDS UNTILL TOTAL RECORDS ON TEST FILE = RWTM OR LAST
*            OPERATION
*         4. NO ENDFILE FUNCTIONS AFTER BACKSPACE.
*         5. ENDFILE FUNCTIONS MUST BE FOLLOWED BY A WRITE. 
*         6. MAX NUMBER OF RECORDS OR FILES PLACED ON TEST FILES = RWTM 
* 
*         ENTRY 
*         ----- 
*         FILES  - TOTAL TEST FILE(S) THAT ARE TURNED ON
*         MSKR   - MASK FOR RANDOM LENGTH RECORD
*         MAX    - MAXIMUM RECORD LENGTH TO BUFFER OUT
*         MIN    - MINIMUM RECORD SIZE TO BUFFER OUT
*         RT(1-5)- TOTAL RECORDS ON TEST FILE(S) SET TO ZERO
*         RO(1-5)- TOTAL RANDOM OPERATIONS PERFORMED
*         RAN    - SET TO VALUE ON RAN PARAMETER OR DEFAULT 
*         FLT    - CURRENT FIELD LENGTH ASSIGNED TO INTERNAL MODEL (M)
*         MODE   - SET TO CURRENT MODE 1=ODD PARITY 0=EVEN PARITY 
* 
*         EXIT
*         ----
*         HTBL   - HISTORY OF TOTAL OPERATIONS PERFORMED
*         RT(1-5)- TOTAL RECORDS AND FILES WRITTEN ON TEST FILE(S)
*         FLST   - LIST PARAMETER VALUE - NUMBER OF ERRORS FOUND
* 
*         CALLS 
*         ----- 
*         OPRW   - REWIND TEST FILE 
*         OPEF   - END FILE 
*         OPBK   - BACKSPACE RECORD 
*         OPRD   - READ RECORD
*         OPWR   - WRITE RECORD 
*         OPVP   - VERIFY POSITION
*         OPSF   - SEARCH FILES FORWARD 
*         OPSR   - SEARCH FILES REVERSE 
*         UPFL   - USED TO INCREMENT FIELD LENGTH 
*         GENDATA- STORES WRITE DATA IN BUFFER BUFWR
*         CLR    - CLEARS MODEL, HISTORY TABLES, VARIBLES USED AND
*                  REWIND TEST FILES. 
* 
*         CALLED BY 
*         --------- 
*         TIO    - MAIN PROGRAM 
* 
  
*CALL,TIOCOM
  
      IF(RAN.EQ.0)GO TO 900 
         SECT = 3HRAN 
         RWTM = (RAN+4)/5 
         IF(RAN.LT.15)RWTM = 3
         CALL GENDATA 
         IF(MODE.NE.0)GO TO 3 
         EOL   = O"6362"
         DO 1 J=1,2048
            IF((BUFWR(J).AND.O"7777").EQ.EOL)BUFWR(J)=BUFWR(J).AND.MASK(
     +48) 
    1    CONTINUE 
         CALL FILL (CVT1,CVT2,BUFWR(1),2048)
  
*         REQUEST FIELD LENGTH IF MORE NEEDED 
  
    3    TEMP = (RWTM*FILES)+1
         FLT  = LOCF (M(TEMP))
         CALL UPFL (FLT)
         FLT = RWTM*FILES 
  
*         CLEAR BUFFERS AND REWIND TEST FILES 
  
         CALL CLR 
         IF(RAN.EQ.1)GO TO 100
  
**        INITIALIZE FILES BY 
*         ------------------- 
* 
*         1. WRITE ONE MAXREC        OP = 4 
*         2. END FILE                OP = 2 
*         3. WRITE ONE MAXREC        OP = 4 
*         4. BACKSPACE THREE         OP = 1 
*         5. READ THREE              OP = 3 
*         6. SKIP REVERSE            OP = 7 
*         7. BACKSPACE TWO           OP = 1 
*         7. SKIP FORWARD ONE FILE   OP = 6 
*         8. READ ONE                OP = 3 
*         9. VERIFY POSITION         OP = 5 
*        10. GO INTO RANDOM SECTION 
* 
  
      DO 2 J=1,FILES
         NR = 1 
         LACT = MAX 
         PTM = (RWTM*J) - RWTM
         CALL OPWR (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPEF (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPWR (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPBK (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPBK (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPBK (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPRD (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPRD (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPRD (J)
         NR = 2 
         IF(RO(J)+3 .GT.RAN)GO TO 2 
         CALL OPSR (J)
         NR = 1 
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPBK (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPBK (J)
         IF(RO(J)+2.GT.RAN)GO TO 2
         CALL OPSF (J)
         IF(RO(J)+1.GT.RAN)GO TO 2
         CALL OPRD (J)
         IF(RO(J)+4.GT.RAN)GO TO 2
         CALL OPVP (J)
    2  CONTINUE 
       IF(RO(1).EQ.RAN)GO TO 100
  
  
* **********************************************************************
*        MAIN LOOP 5 THRU 100   LOOP UNTILL ALL RO(FN) = RAN OPERATIONS 
* **********************************************************************
  
    5 FN = (SHIFT(RANF(),36).AND.MSKU) + 1
      IF(FN.GT.FILES)  GO TO 5
      IF(RO(FN).EQ.RAN)GO TO 5
    6 OP = SHIFT(RANF(),23).AND.7 
      IF((LOP(FN).EQ.RD).AND.(OP.NE.RD)) OP = WR
      IF(LOP(FN).EQ.EF)OP = WR
      PTM = (RWTM*FN) - RWTM
      GO TO (10,20,30,40,50,60,70,80)OP+1 
      CALL GOTOER 
  
*         ************************************* 
*         * OP = 0  REWIND FILE FN            * 
*         ************************************* 
  
   10 IF(RT(FN).GE.RWTM)GO TO 15
      IF((RO(FN)+1).LT.RAN)GO TO 6
   15 CALL OPRW (FN)
      GO TO 100 
  
*         ************************************* 
*         * OP = 1  BACKSPACE FILE FN         * 
*         ************************************* 
  
   20 NR = (SHIFT(RANF(),23).AND.7) + 1 
      IF(RP(FN).LT.2)GO TO 6
      IF((RP(FN)-NR).LT.1)NR = RP(FN) - 1 
      IF((RO(FN)+NR).GT.RAN)NR = RAN - RO(FN) 
   25 CALL OPBK (FN)
      GO TO 100 
  
*         ************************************* 
*         * OP = 2  ENDFILE FILE FN           * 
*         ************************************* 
  
   30 IF((RT(FN)+1).GE.RWTM)GO TO 6 
      IF(LOP(FN).EQ.BK)GO TO 6
      NR = 1
      CALL OPEF (FN)
      GO TO 100 
  
*         ************************************* 
*         * OP = 3  READ RECORD FILE FN       * 
*         ************************************* 
  
   40 NR = (SHIFT(RANF(),23).AND.7) + 1 
      IF((RO(FN)+NR).GT.RAN)NR = RAN - RO(FN) 
      IF((RT(FN)-RP(FN)).GE.NR)GO TO 45 
      IF((RO(FN)+NR+NR).GT.RAN)GO TO 6
      IF(NR.GE.RP(FN))GO TO 6 
      CALL OPBK (FN)
   45 CALL OPRD (FN)
      GO TO 100 
  
*         ************************************* 
*         * OP = 4  WRITE RECORD FILE FN      * 
*         ************************************* 
  
  
   50 NR = (SHIFT(RANF(),23).AND.7) + 1 
      IF((RO(FN)+1).EQ.RAN)GO TO 10 
      IF((RO(FN)+NR).GT.RAN)NR = RAN - RO(FN) 
      IF((RP(FN)+NR).GT.RWTM)GO TO 6
      LACT = SHIFT(RANF(),35).AND.MSKR
      IF(LACT.GT.MAX)LACT = MAX 
      IF(LACT.LT.MIN)LACT = MIN 
      CALL OPWR (FN)
      GO TO 100 
  
*         ************************************* 
*         * OP = 5  VERIFY POSITION FILE FN   * 
*         ************************************* 
  
   60 IF((RO(FN)+RP(FN)+1).GT.RAN)GO TO 5 
      IF(RP(FN).EQ.0)GO TO 5
      CALL OPVP (FN)
      GO TO 100 
  
*         ************************************* 
*         * OP = 6  SKIP FILES FORWARD FILE FN* 
*         ************************************* 
  
   70 NR = T4 = (SHIFT(RANF(),23).AND.7) + 1
      IF(NR.GT.HTBL(EF,FN))GO TO 6
      T1 = PTM+RP(FN) 
      T2 = PTM+RT(FN) 
      IF((T2-T1).LT.NR)GO TO 6
      IF(LOP(FN).NE.BK)T1 = T1 + 1
      TNR = 0 
      DO 75 K=T1,T2 
         TNR = TNR + 1
         IF(M(K).NE.EF)GO TO 75 
         T4 = T4 - 1
         IF(T4.EQ.0)GO TO 76
   75 CONTINUE
      IF(NR.EQ.T4)GO TO 6 
      NR = NR - T4
   76 IF((RO(FN)+TNR).GT.RAN)GO TO 6
      CALL OPSF (FN)
      GO TO 100 
  
*         ************************************* 
*         * OP = 7  SKIP FILES REVERSE FILE FN* 
*         ************************************* 
  
   80 NFILES = T3 = (SHIFT(RANF(),23).AND.7) + 1
      IF((NFILES+1).GT.RP(FN))GO TO 6 
      T1 = PTM+1
      T2 = PTM+RP(FN) 
      IF(LOP(FN).NE.BK)T2 = T2 + 1
   84 TNR = 0 
      T4 = T2 - 1 
      DO 85 K=T1,T4 
         TNR = TNR + 1
         IF(M(T2-TNR).NE.EF)GO TO 85
         NFILES = NFILES - 1
         IF(NFILES.EQ.0)GO TO 86
   85 CONTINUE
      IF(NFILES.EQ.T3)GO TO 6 
      NFILES = T3 - NFILES
      T3 = NFILES 
      GO TO 84
   86 IF((RO(FN)+TNR+1).GT.RAN)GO TO 6
      NR = TNR
      CALL OPSR (FN)
      GO TO 100 
  
*         SEE IF DONE 
  
  100 CONTINUE
      DO 110 J=1,FILES
         IF(RO(J).LT.RAN)GO TO 5
  110 CONTINUE
* **********************************************************************
*        MAIN LOOP 5 THRU 100   LOOP UNTILL ALL RO(FN) = RAN OPERATIONS 
* **********************************************************************
  
*         OUTPUT REPORT SUMMARY 
  
      CALL REPSUM 
  
  900 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE BEGIN
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /BEGIN/ IS USED TO SET FLAGS AND LIST CONTROL
*         CARD ERRORS.
* 
*         ENTRY 
*         ----- 
*         PAR     - HAS FLAGS SET AFTER CRACKING PARAMETERS 
* 
*         EXIT
*         ----
*         CONTROL CARD ERRORS LISTED ON OUTPUT FILE 
* 
*         CALLS 
*         ----- 
*         REPORT - OUTPUTS CONTROL CARD REPORT
*         FILL   - USED TO BLANK FILL ZEROS WITH 55B
*         REMARK - USED TO OUTPUT DAYFILE MESSAGES
* 
*         CALLED BY 
*         --------- 
*         TIO    - MAIN PROGRAM 
* 
  
*CALL,TIOCOM
  
*         SET OPERATION CODES FOR FUNCTIONS ALLOWED 
  
      RW = 0
      BK = 1
      EF = 2
      RD = 3
      WR = 4
      VP = 5
      SF = 6
      SR = 7
  
*         CVT1 = CHARACTER CONVERTED ON CODED TAPE THAT IS NOT
*                CONVERTED BACK TO CVT1 
*         CVT2 = CHARACTER CVT1 IS CONVERTED TO 
  
      CVT1 = 0
      CVT2 = R"0" 
  
*         OUTPUT PAGE HEADER FOR CONTROL CARD 
  
      CALL REPORT (1,0) 
  
*         CHECK ERROR FLAG IF NON ZERO OUTPUT PRT BUFFER ERRORS 
  
      IF(ERR.EQ.0)GO TO 200 
         DO 100 K=1,2000,8
            IF(BUFWR(K).EQ.0)GO TO 200
            DO 50 J=1,8 
               PRT(J) = BUFWR(K+J+1)
   50       CONTINUE
   60       PRT(BUFWR(K+1)) = (PRT(BUFWR(K+1)).AND.MASK(42)).OR.R")"
            CALL FILL (00,O"55",PRT(1),BUFWR(K+1))
            CALL REPORT (BUFWR(K),BUFWR(K+1)) 
  100    CONTINUE 
  
*         CHECK FOR DUPLICATE FILE NAMES
  
  200 CONTINUE
      DO 210 J=2,5
         PAR(3,J) = 3HOFF 
  210 CONTINUE
      MSKU = 0
      DO 250 J=1,FILES
         IF(PAR(2,J).NE.PAR(2,6))GO TO 230
         PRT(1) = PAR(2,J)
         PRT(2) = PAR(2,6)
         CALL FILL (0,O"55",PRT(1),2) 
         CALL REPORT (13,2) 
         ERR = ERR + 1
  230    MSKU = MSKU.OR.(J-1) 
         PAR(3,J) = 3H ON 
         DO 240 K=1,FILES 
            IF(J.EQ.K)GO TO 240 
            IF(PAR(2,J).NE.PAR(2,K))GO TO 240 
            PRT(1) = PAR(2,J) 
            PRT(2) = PAR(2,K) 
            CALL FILL (00,O"55",PRT(1),2) 
            CALL REPORT (13,2)
            ERR = ERR + 1 
            PAR(2,J) = J
  240    CONTINUE 
  250 CONTINUE
      IF(MAX.GE.MIN)GO TO 255 
         PRT(1) = MAX 
         PRT(2) = MIN 
         CALL REPORT (27,2) 
         ERR = ERR + 1
  255 IF(SEQ.NE.0)GO TO 260 
        IF(RAN.NE.0)GO TO 260 
           ERR = ERR + 1
           CALL REPORT (26,0) 
  260 IF(ERR.NE.0)GO TO 500 
  
*         SET VARIBLES, WRITE DATA BLOCK, AND RECORD LENGTH MASK
  
        DO 300 J=1,6
           CALL FILL (O"00",O"55",PAR(2,J),1) 
  300   CONTINUE
  
        FLT = 200 
        PAT = PAT.AND..NOT.MASK(60-FPAT)
        MSKR = O"3777"
        IF(MAX.LT.O"1777")MSKR = O"1777"
        IF(MAX.LT.O"0777")MSKR = O"0777"
        IF(MAX.LT.O"0377")MSKR = O"0377"
        IF(MAX.LT.O"0177")MSKR = O"0177"
        IF(MAX.LT.O"0077")MSKR = O"0077"
        IF(MAX.LT.O"0037")MSKR = O"0037"
        IF(MAX.LT.O"0017")MSKR = O"0017"
        IF(MAX.LT.O"0007")MSKR = O"0007"
        IF(MAX.LT.O"0003")MSKR = O"0003"
        IF(MAX.EQ.O"0001")MSKR = O"0001"
  
  
*         CALL REPCALL TO OUTPUT CALL STATEMENT PARAMETERS
  
        CALL REPCALL
        GO TO 600 
  
  500 CALL REMARK('...PARAMETER ERROR(S) ... PROGRAM ENDED.') 
      CALL REMARK('...PARAMETER ERROR(S) ... PROGRAM ENDED.') 
  600 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE CHK (FN) 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /CHK/ IS USED TO CHECK THE DATA IN BUFRD 
*         WITH THE DATA IN BUFWR FOR DIFFERENCES.  THE INTERNAL 
*         MODEL IS USED AND THE CONTROL WORD WITHIN THE RECORD
*         IN THE READ BUFFER.  IF ERRORS ARE FOUND SUBROUTINE 
*         REPERR IS CALLED AND THE ERROR IS LISTED ON THE OUTPUT
*         FILE.  IF TEN DATA ERRORS ARE ENCOUNTERED ON ONE DATA 
*         RECORD CHK WILL ABORT FURTHER DATA CHECKING WITHIN THAT 
*         RECORD. 
* 
*         ENTRY 
*         ----- 
*         FN     - FILE NUMBER CURRENTLY WORKING ON 
*         PTM    - POINT INTO INTERNAL MODEL
*         RP(FN) - CURRENT RECORD POSITION TO CHECK 
*         LACT   - LENGTH OF RECORD FROM THE USE OF THE LENGTH ROUTINE
*         M      - INTERNAL MODEL OF THE TEST FILE(S) 
*         BUFRD  - CURRENT RECORD TO CHECK DATA IN BUFRD(1)-BUFRD(LACT) 
*         BUFWR  - DATA THAT WAS WRITTEN. 
* 
*         EXIT
*         ----
*         DATA RECORD CHECKED FOR ERRORS IN DATA CONTENT
* 
*         CALLS 
*         ----- 
*         REPERR - ROUTINE USED TO FORMAT THE ERROR MESSAGE AND LIST IT 
* 
*         CALLED BY 
*         --------- 
*         OPRD   - READ SUBROUTINE
* 
  
*CALL,TIOCOM
  
  
*     COMPUTE  T1 = WORD IN BUFWR THAT COMPARES TO BUFRD WORD 1 
*              T2 = DATA WORD IN BUFWR TO COMPARE LAST
  
      IF(BUFRD(1).NE.M(PTM+RP(FN)))GO TO 500
      T1 = (SHIFT(BUFRD(1),12).AND.O"7777") + 1 
      T2 = T1 + LACT - 2
      T3 = 1
      T4 = 10 
      IF(T1.GT.T2)GO TO 500 
       DO 300 J=T1,T2 
         T3 = T3 + 1
         DIF = XOR(BUFWR(J),BUFRD(T3))
         IF((DIF.EQ.0).AND.((DIF.AND.MASK(1)).EQ.0))GO TO 300 
           T4 = T4 - 1
          IF(T4.LT.0)GO TO 400
           CALL REPERR (15,FN,T3,BUFWR(J),BUFRD(T3),DIF,4)
  300  CONTINUE 
       GO TO 500
  400  CALL REPERR (20,FN,0,0,0,0,0)
  500 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE CHKMR (FN,T1)
  
**        DESCRIPTION /CHKMR/ 
*         ------------------- 
*         SUBROUTINE CHKRM IS USED TO  CHECK BUFRD(1) AND COMPARE 
*         IT TO THE MODEL WORD.  CHKMR ALSO FILLS M(T1) WHEN THE
*         READ PARAMETER IS USED WITHOUT THE WRITE PARAMETER. 
*         CHKMR CALLS REPERR FOR RECORD NUMBER ERRORS, LENGTH 
*         ERRORS, AND WORD 1 DATA ERRORS.  PROGRAM CALL EXIT IF 
*         A RECORD NUMBER ERROR OCCURS USING THE READ PARAMETER 
*         AND THE WRITE PARAMETER IS NOT USED 
* 
*         ENTRY 
*         ----- 
*         T1     = POINTER TO ADDRESS OF MODEL WORD 
*         RP(FN) = CURENT RECORD POSITION 
*         FN     = CURRENT FILE NUMBER
*         MODE   = CURRENT MODE 0=CODED 1=BINARY
*         LACT   = ACTUAL LENGTH
*         LEXP   = EXPECTED LENGTH
*         FRD    = READ FLAG  1=ON  0=OFF 
*         FWR    = WRITE FLAG 1=ON  0=OFF 
* 
*         EXIT
*         ----
*         M(T1) = VALUE IT SHOULD BE ON A READ SEQUENTIAL MODE
*         LEXP  = LENGTH EXPECTED 
*         REPERR CALLED FOR LENGTH AND M/R ERRORS 
* 
*         CALLS 
*         ----- 
*         FILL   - FILL WORD WITH CVT2 CHARACTERS FOR CVT1
*         REPERR - REPORT LENGTH AND MODEL RECORD ERRORS
*         LENGTH - TO GET THE ACTUAL LENGTH OF THE RECORD 
*         EXIT   - IF A RECORD NUMBER ERROR OCCURS AND CANT BE RCVD 
* 
  
*CALL,TIOCOM
  
      LACT = LENGTH(FN) 
  
*         LENGTH NON ZERO 
  
      IF(LACT.NE.0)GO TO 10 
      BUFRD(1) = 0
      GO TO 80
  
*         MODEL EQUAL RECORD CONTROL WORD 
  
   10 IF(M(T1).EQ.BUFRD(1))GO TO 80 
      RPREC = BUFRD(1).AND.O"777777777777"
      IF(M(T1).NE.EF)GO TO 20 
      CALL REPERR (17,FN,LACT,0,0,0,1)
      GO TO 60
  
*         DATA STORED IN MODEL ALLREADY 
  
   20 IF(M(T1).NE.0)GO TO 60
  
*         BINARY MODE 
  
      IF(MODE.NE.0)GO TO 30 
  
*         RECORD EXP=ACT NO CONVERSION NEEDED 
  
      IF(RP(FN).EQ.RPREC)GO TO 30 
      DIFREC = XOR(RP(FN),RPREC)
      CALL FILL (CVT2,CVT1,DIFREC,1)
  
*         RECORD NUMBER ERROR CANT RECOVER
  
      IF(DIFREC.NE.0)GO TO 35 
      CALL FILL (CVT2,CVT1,BUFRD(1),1)
      BUFRD(1)=(BUFRD(1).AND.MASK(12)).OR.(SHIFT(LACT,36)).OR.RP(FN)
      M(T1) = BUFRD(1)
      LEXP  = LACT
      GO TO 90
  
*         SET MODEL WORD TO BUFRD(1)
  
   30 M(T1) = BUFRD(1)
      LEXP = SHIFT(M(T1),24).AND.O"7777"
      IF(RP(FN).EQ.RPREC)GO TO 80 
  
*         UNRECOVERED RECORD NUMBER ERROR CALL EXIT AFTER MESSAGE 
  
   35 CALL REPERR (29,FN,RPREC,'CAN NOT CO','NTINUE    ',0,3) 
      CALL REMARK ('REC NUMBER ERR UNRECVD .. CALL EXIT') 
      CALL EXIT 
  
*         MODEL WORD STORED ALL-READY 
  
   60 IF(RP(FN).NE.RPREC)GO TO 70 
        DIF = XOR(BUFRD(1),M(T1)) 
        CALL REPERR (15,FN,1,M(T1),BUFRD(1),DIF,4)
        GO TO 80
  
*         RECORD NO,S DO NOT MATCH CHECK FOR BINARY MODE
  
   70 IF(MODE.NE.0)GO TO 75 
        IF(RPREC.LE.SEQ)GO TO 75                                         TIO000K
        DIF = XOR(M(T1),BUFRD(1)) 
        CALL FILL (CVT2,CVT1,DIF,1) 
        BUFRD(1) = M(T1)
  
*         CODED MODE BUT RECORD NUMBERS MATCH SO CONTINUE 
  
        IF(DIF.EQ.0)GO TO 80
  
*         RECORD NUMBER .GT. TOTAL RECORDS ON FILE
  
   75 IF(RPREC.GT.SEQ)GO TO 35
  
*         REC0RD NUMBER ERROR ATTEMPT RECOVERY
  
      CALL REPERR(29,FN,RPREC,'CONT. BY S','ETTING E=A',0,3)
      RP(FN) = RPREC
      T1 = PTM + RP(FN) 
      LEXP = SHIFT(M(T1),24).AND.O"7777"
      GO TO 10
*     ******* LOOP BACK RECORD NO FROM RECORD USED FOR INDEX TO M*****
  
*         CHECK LENGTH EXPECTED WITH LENGTH ACTUAL
  
   80 IF(LEXP.NE.LACT)CALL REPERR (19,FN,LEXP,LACT,0,0,2) 
   90 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE CLR
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /CLR/ IS USED TO  CLEAR OUT THE BUFFERS USED BY THE
*         MAIN MODEULES /MODSEQ/ AND /MODRAN/ PLUS REWIND THE TEST FILES
* 
*         ENTRY 
*         ----- 
*         LAST   - SET TO LAST TEST FILE TURNED ON
*         FLT    - SET TO TOTAL FL ASSIGNED TO INTERNAL MODEL 
* 
*         EXIT
*         ----
*         HTBL( )  - CLEAR   HISTORY OF OPERATIONS PERFORMED
*         H(50)    - CLEAR   HISTORY OF LAST 50 OPERATIONS
*         INHST    - CLEAR   INDEX INTO H(50) TABLE 
*         M(FLT)   - CLEAR   INTERNAL MODEL OF THE TEST FILE(S) 
*         RE(1-5)  - CLEAR   TOTAL ERRORS ON TEST FILE
*         RN(1-5)  - CLEAR   CURRENT RECORD NUMBER
*         RO(1-5)  - CLEAR   TOTAL OPERATIONS PERFORMED 
*         RT(1-5)  - CLEAR   CURRENT TOTAL RECORDS ON TEST FILE(S)
* 
*         CALLS 
*         ----- 
*         OREW   - REWIND SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
  
*CALL,TIOCOM
  
*         CLEAR INTERNAL MODEL  INDEX (IND) AND BUFFER (M)
  
      INHST = 1 
      DO 5 K=1,FLT
         M(K) = 0 
    5 CONTINUE
  
*         CLEAR HISTORY OF OPERATIONS FOR HISTORY PARAMETER 
  
      DO 8 J=1,50 
         H(J) = 0 
    8 CONTINUE
  
*         CLEAR RT, RE, RO, HTBL AND REWIND FILES 
  
      DO 20 J=1,5 
         RT(J) = RE(J) = RO(J) = 0
         DO 10 K=1,8
            HTBL(K,J) = 0 
   10    CONTINUE 
         IF(J.GT.FILES)GO TO 20 
           PTM = 0
           IF(SECT.EQ.3HRAN)PTM = (RWTM*J)-RWTM 
           CALL OPRW (J)
   20 CONTINUE
      PRT(1) = 10HSTART OF
      PRT(2) = 10HSEQ PASS =
      IF(SECT.EQ.3HRAN)PRT(2)=10HRAN PASS = 
      ENCODE (10,21,PRT(3))PASS 
   21 FORMAT(I4,6X) 
      PRT(3) = (PRT(3).AND.MASK(30)).OR.R"MODE="
      PRT(4) = L"BIN" 
      IF(MODE.EQ.0)PRT(4) = L"BCD"
      CALL REMARK (PRT(1))
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE CONOCT (WRD) 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /CONOCT/ IS USED TO CONVERT WRD FROM A LEFT
*         JUSTIFIED OCTAL DISPLAY CODE NUMBER TO THE INTEGER VALUE. 
* 
*         ENTRY 
*         ----- 
*         WRD    - DISPLAY CODE OCTAL VALUE LEFT JUSTIFIED
* 
*         EXIT
*         ----
*         WRD    - RIGHT JUSTIFIED INTEGER VALUE
*         WRD    - SET TO -1 IF CAN NOT CONVERT 
* 
*         CALLED BY 
*         --------- 
*         INIT   - PARAMETER CRACKING SUBROUTINE
* 
      IMPLICIT INTEGER (B-Z)
  
      SCR = WRD 
      WRD = 0 
      SHN = 6 
      DO 10 J=1,10
         CHAR = SHIFT(SCR,SHN).AND.O"77"
         IF(CHAR.EQ.0)GO TO 30
         IF(CHAR.GT.O"42")GO TO 20
         IF(CHAR.LT.O"33")GO TO 20
           CHAR = CHAR - O"33"
           WRD = SHIFT(WRD,3) 
           WRD = WRD.OR.CHAR
           SHN = SHN + 6
   10 CONTINUE
      GO TO 30
   20 WRD = -1
   30 RETURN
      END 
C*F45V1P0*
      SUBROUTINE CONDEC (WRD) 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /CONDEC/ IS USED TO CONVERT A LEFT JUSTIFIED 
*         DECIMAL DISPLAY CODE NUMBER TO A RIGHT JUSTIFIED INTEGER. 
* 
*         ENTRY 
*         ----- 
*         WRD    - DISPLAY CODE OCTAL VALUE LEFT JUSTIFIED
* 
*         EXIT
*         ----
*         WRD    - RIGHT JUSTIFIED INTEGER VALUE
*         WRD    - SET TO -1 IF CAN NOT CONVERT 
* 
*         CALLED BY 
*         --------- 
*         INIT   - PARAMETER CRACKING SUBROUTINE
* 
  
      IMPLICIT INTEGER (B-Z)
  
      DO 10 J=1,10
         IF((WRD.AND.MASK(6)).EQ.0)GO TO 20 
          WRD = SHIFT(WRD,6)
   10     CONTINUE
   20 SIG = 1 
      SCR = WRD 
      WRD = 0 
      DO 30 J=1,10
         CHAR = SCR.AND.O"77" 
         IF(CHAR.EQ.000)RETURN
         IF(CHAR.GT.O"44")GO TO 40
         IF(CHAR.LT.O"33")GO TO 40
            CHAR = CHAR -O"33"
            WRD = WRD + (CHAR * SIG)
            SIG = SIG * 10
            SCR = SHIFT(SCR,-6) 
   30       CONTINUE
            RETURN
   40    CONTINUE 
         WRD = -1 
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE FILL (CH1,CH2,BF,LN) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /FILL/ IS USED TO REPLACE ALL CH1  CHARACTERS  WITH
*         CH2 CHARACTERS IN BUFFER BF OF LENGTH LN. 
* 
*         ENTRY 
*         ----- 
*         CH1    - CHARACTER TO BE REPLACED 
*         CH2    - CHARACTER TO REPLACE WITH
*         BF     - BUFFER TO REPLACE IN 
*         LN     - LENGTH OF BUFFER 
* 
*         EXIT
*         ----
*         ALL CH1 CHARACTERS REPLACE WITH CH2 CHARACTERS
* 
*         CALLED BY 
*         --------- 
*         REPCALL - CONTROL CARD REPORT ROUTINE 
*         GENDATA - GENERATED DATA FOR BUFFER BUFWR 
* 
  
      IMPLICIT INTEGER (B-Z)
      DIMENSION BF(LN)
  
      DO 100 J=1,LN 
        DO 50 K=1,10
           IF((BF(J).AND.O"77").EQ.CH1)BF(J)=(BF(J).AND.MASK(54)).OR.CH2
           BF(J) = SHIFT(BF(J),6) 
   50   CONTINUE
  100 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE GENDATA
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /GENDATA/ IS USED TO SET THE WRITE BUFFER BUFWR TO 
*         THE PROPER DATA PATTERN FOR THE PARTICULAR SECTION BEING RUN
*         SECT = 3HSEQ FOR SEQUENTIAL AND SECT = 3HRAN FOR THE RANDOM 
*         SECTION.  IF THE PATTERN PARAMETER IS USED THE DATA IS SET TO 
*         THE PROPER PATTERN. 
* 
*         ENTRY 
*         ----- 
*         SECT = SEQ IF SEQUENTIAL SECTION. 
*         SECT = RAN IF RANDOM SECTION. 
*         FPAT = 1 IF PATTERN PARAMETER IS USED.
*         FPAT = 0 IF PATTERN PARAMETER IS UNUSED.
*         PAT  = PATTERN DESIRED
* 
*         EXIT
*         ----
*         BUFWR = PROPER PATTERN FOR SECTION
* 
*         CALLED BY 
*         --------- 
*         BEGIN  - IF PAT/PATTERN PARAMETER USED
*         MODSEQ - IF SEQUENTIAL SECTION AND NO PAT/PATTERN PARAMETER 
*         MODRAN - IF RANDOM SECTION AND NO PAT/PATTERN PARAMETER 
* 
*         CALLS 
*         ----- 
*         GENPAT - STORES PATTERN OF DATA INTO BUFFER AREA
* 
  
*CALL,TIOCOM
  
  
*         RANDOM PATTERN SELECTED 
  
      IF(FPAT.EQ.64)GO TO 250 
  
*         PATTERN PARAMETER USED
  
      IF(FPAT.NE.0)GO TO 500
  
*         RANDOM SECTION
  
        IF(SECT.EQ.3HRAN)GO TO 250
  
*          *************************************************
*          SEQUENTIAL SECTION STORE PATTERNS IN BUFFER BUFWR
*          *************************************************
  
  100      CONTINUE 
           SPAT = 0 
           DO 240 K=1,32
            T1 = (K*64) - 63
            T2 = T1 +63 
            SPAT = SPAT + 1 
            IF(SPAT.GT.12)SPAT = 1
  
            GO TO (201,202,203,204,205,206,207,208,209,210, 
     ,             211,212)SPAT 
      CALL GOTOER 
  
*             STORE ALL CHARACTERS
  
  201         CHAR = 00 
              DO 2010 J=T1,T2 
                SHN = 54
                DO 2001 KK=1,10 
                  BUFWR(J) = BUFWR(J).OR.SHIFT(CHAR,SHN)
                  CHAR = CHAR + 1 
                  SHN = SHN - 6 
                  IF(CHAR.EQ.O"100")CHAR = 00 
 2001           CONTINUE
 2010         CONTINUE
              GO TO 240 
  
*             STORE ALL ONES PATTERN
  
  202         CONTINUE
              CALL GENPAT (O"7777",12,BUFWR(T1),64) 
              GO TO 240 
  
*             STORE ALL ZEROR,S 
  
  
  203         CONTINUE
              CALL GENPAT (O"0000",12,BUFWR(T1),64) 
              GO TO 240 
  
*             STORE 5252 PATTERN
  
  204         CONTINUE
              CALL GENPAT (O"5252",12,BUFWR(T1),64) 
              GO TO 240 
  
*             STORE 2525 PATTERN
  
  205         CONTINUE
              CALL GENPAT (O"2525",12,BUFWR(T1),64) 
              GO TO 240 
  
*             STORE 2552 PATTERN
  
  206         CONTINUE
              CALL GENPAT (O"2552",12,BUFWR(T1),64) 
              GO TO 240 
  
*             SEVEN TRACK EDGE PATTERN
  
  207         CONTINUE
              CALL GENPAT (O"01400040",24,BUFWR(T1),64) 
              GO TO 240 
  
*             NINE TRACK EDGE PATTERN 
  
  208         CONTINUE
              CALL GENPAT (O"14211040",23,BUFWR(T1),64) 
              GO TO 240 
  
*             SLIDING ONES PATTERN
  
  209         CONTINUE
              CALL GENPAT (1,7,BUFWR(T1),64)
              GO TO 240 
  
*             SLIDING ZERORS PATTERN
  
  210         CONTINUE
              CALL GENPAT (O"176",7,BUFWR(T1),64) 
              GO TO 240 
  
*             DP8 TEST PATTERN 003C,3C00
  
  211         CONTINUE
              CALL GENPAT (O"000017236400",32,BUFWR(T1),64) 
              GO TO 240 
  
*             PEAK SHIFT PATTERN 7062,5252
  
  212         CONTINUE
              CALL GENPAT (O"70625252",24,BUFWR(T1),64) 
              GO TO 240 
  
  240     CONTINUE
          GO TO 1000
  
*         ******************************************************* 
*         RANDOM SECTION STORE RANDOM BIT DENSITY IN BUFFER BUFWR 
*         ******************************************************* 
  
  250   CONTINUE
        DO 260 K=1,2048 
          T1 = SHIFT(RANF(),30).AND.MASK(30)
          T2 = SHIFT(RANF(),30).AND.MASK(30)
          BUFWR(K) = T1.OR.SHIFT(T2,30) 
  260   CONTINUE
  
*       T1 = START ADDRESSS FOR ADJUSTING DENSITY 
*       T2 = STOP ADDRESS FOR ADJUSTING DENSITY 
*       DEN = DENSITY 1=1/8,2=2/8,3=3/8,5=5/8,6=6/8,7=7/8 
  
        DO 270 K=1,31 
         T1 = (K*64)-63 
         T2 = T1+63 
         DEN = (SHIFT(RANF(),31).AND.7)+1 
         DO 265 J=T1,T2 
          IF(DEN.EQ.1)BUFWR(J)=(BUFWR(J).AND.BUFWR(J+3)).AND.BUFWR(J+5) 
          IF(DEN.EQ.2)BUFWR(J)=(BUFWR(J).AND.BUFWR(J+5))
          IF(DEN.EQ.3)T3      =(BUFWR(J).AND.BUFWR(J+3))
          IF(DEN.EQ.3)BUFWR(J)=(BUFWR(J).AND.BUFWR(J+5)).OR.T3
          IF(DEN.EQ.5)BUFWR(J)=(BUFWR(J).AND.BUFWR(J+3)).OR.BUFWR(J+5)
          IF(DEN.EQ.6)BUFWR(J)=(BUFWR(J).OR.BUFWR(J+5)) 
          IF(DEN.EQ.7)BUFWR(J)=(BUFWR(J).OR.BUFWR(J+3).OR.BUFWR(J+5)) 
  265    CONTINUE 
  270   CONTINUE
        GO TO 1000
  
*     *************************************************************** 
*     PAT/PATTERN PARAMETER USED ON CALL STATEMENT STORE BUFWR BUFFER 
*     *************************************************************** 
  
  500 CONTINUE
      CALL GENPAT (PAT,FPAT,BUFWR(1),2048)
  
*         PATTERN IS STORED RETURN TO WHERE CALLED FROM 
  
 1000 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE GENPAT (INPAT,INFPAT,BUF,LN) 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE GENPAT IS USED TO PLACE A PATTERN (INPAT) OF 
*         LENGTH (INFPAT) INTO BUFFER (BUF) OF LENGTH (LN)
* 
*         ENTRY 
*         ----- 
*         INPAT  - PATTERN TO STORE RIGHT JUSTIFIED 
*         INFPAT - NUMBER OF BITS TO STORE
*         BUF    - FIRST ADDRESS OF BUFFER TO STORE INTO
*         LN     - NUMBER OF WORDS TO STORE 
* 
*         EXIT
*         ----
*         BUFFER IS STORED
* 
*         CALLED BY 
*         --------- 
*         GENDATA-ROUTINE TO STORE DATA PATTERNS IN BUFWR 
* 
* 
  
      IMPLICIT INTEGER (B-Z)
      DIMENSION BUF(LN) 
  
      BITS = 60 
      DO 800 J=1,LN 
  600  IF((BITS-INFPAT).LT.0)GO TO 700
         BUF(J) = BUF(J).OR.(SHIFT(INPAT,BITS-INFPAT))
         BITS = BITS - INFPAT 
         IF(BITS.GT.0)GO TO 600 
         BITS = 60
         GO TO 800
  700  BUF(J) = BUF(J).OR.SHIFT(INPAT,BITS-INFPAT)
       BUF(J+1) = SHIFT(INPAT,60-INFPAT+BITS).AND.MASK(INFPAT-BITS) 
       BITS = 60 - INFPAT + BITS
  800 CONTINUE
      RETURN
C**  THIS PROGRAM VALID ON FTN4 AND FTN5 ** 
      END 
C*F45V1P0*
      SUBROUTINE HISTORY (FN,OP)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /HISTORY/ IS USED TO UPDATE THE HISTORY INFORMATION
*         WITH THE OPERATION THAT IS GOING TO TAKE PLACE AND CALL REPORT
*         TO LIST THAT OPERATION IF HISTORY=ALL.  IF HISTORY IS GT 0 AND
*         LE 50 FHST OPERATIONS ARE SAVE IN THE HISTORY BUFFER H FOR
*         OUTPUT UPON HAVING AN ERROR.
* 
*         ENTRY 
*         ----- 
*         FN     = FILE NUMBER BEING WORKED ON
*         RO(FN) = TOTAL OPERATIONS PERFORMED ON TEST FILE
*         OP     = CURRENT OPERATION TO BE PERFORMED
*         INHST  = INDEX INTO H TABLE SET TO 1 BY CLR 
* 
*         EXIT
*         ----
*         RO(FN) = UPDATED
*         H(50)  = UPDATED
*         HTBL   = UPDATE 
* 
*         CALLS 
*         ----- 
*         REPORT - OUTPUT THE OPERATION THAT IS GOING TO BE PERFORMED 
* 
*         CALLED BY 
*         --------- 
*         OPRW   - REWIND 
*         OPBK   - BACKSPACE
*         OPEF   - ENDFILE
*         OPRD   - READ 
*         OPWR   - WRITE
*         OPVP   - VERIFY POSITION
*         OPSF   - SKIP FILES FORWARD 
*         OPSR   - SKIP FILES REVERSE 
* 
  
*CALL,TIOCOM
  
      DATA FMTOP(1) / 10HREWIND     / 
      DATA FMTOP(2) / 10HBACKSPACE  / 
      DATA FMTOP(3) / 10HEND FILE   / 
      DATA FMTOP(4) / 10HREAD       / 
      DATA FMTOP(5) / 10HWRITE      / 
      DATA FMTOP(6) / 10HVERIFY POS / 
      DATA FMTOP(7) / 10HSKIP FOR.  / 
      DATA FMTOP(8) / 10HSKIP REV.  / 
  
*         UPDATE TOTAL OPERATIONS, HISTORY OF OPERATIONS
  
      RO(FN) = RO(FN) + 1 
      HTBL(OP+1,FN) = HTBL(OP+1,FN) + 1 
  
      IF(FHST.LT.1)GO TO 100
      IF(FHST.GT.50)GO TO 50
  
*         SAVE FHST OPERATIONS FHST .GT. 0 AND .LE. 50
  
         T1 = PTM + RP(FN)
         LN = SHIFT(M(T1),24).AND.O"7777" 
         H(INHST)=SHIFT(FN,48).OR.SHIFT(OP,42).OR.SHIFT(RP(FN),12).OR.LN
         INHST = INHST + 1
         IF(INHST.GT.FHST)INHST = 1 
         GO TO 100
  
*         OUTPUT CURRENT OPERATION  IF HISTORY=ALL OR .GT. 50 
  
   50 IF(FHST.LT.51)GO TO 100 
        PRT(1) = RO(FN) 
        PRT(2) = FN 
        PRT(3) = FMTOP(OP+1)
        PRT(4) = RP(FN) 
        PRT(5) = SHIFT(M(PTM+RP(FN)),24).AND.O"7777"
        CALL REPORT (21,5)
  
  100 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE OPRW (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /OPRW/ IS USED TO REWIND TEST FILE FN. 
*         OPERATION CODE USED FOR REWIND IS RW. 
* 
*         ENTRY 
*         ----- 
*         RP(FN) = CURRENT POSITION ON THE TEST FILE
* 
*         EXIT
*         ----
*         RP(FN) = 0
*         LOP(FN)= 0
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
  
*CALL,TIOCOM
  
      RP(FN) = 0
      CALL HISTORY (FN,RW)
      REWIND FN 
      LOP(FN) = RW
      RETURN
C**  THIS PROGRAM VALID ON FTN4 AND FTN5 ** 
      END 
C*F45V1P0*
      SUBROUTINE OPBK (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /OPBK/ IS USED TO BACKSPACE THE TEST FILE (FN) 
*         (NR) RECORDS. OPERATION CODE USED FOR BACKSPACE IS BK.
* 
*         ENTRY 
*         ----- 
*         LOP(1-5) - LAST OPERATION PERFORMED ON TEST FILE
*         RP(FN)   - CURRENT RECORD POSITION ON THE TEST FILE FN
* 
*         EXIT
*         ----
*         LOP(FN) = 1 
*         RP(FN)  = RP(FN) - NR  IF LOP(FN) EQUAL BACKSPACE 
*         RP(FN)  = RP(FN) - NR + 1 IF LOP(FN) NON BACKSPACE
* 
*         CALLS 
*         ----- 
*         HISTORY- UPDATES INTERNAL MODEL AND HISTORY INFORMATION 
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
* 
  
*CALL,TIOCOM
  
      DO 10 J=1,NR
         IF(LOP(FN).EQ.BK)RP(FN) = RP(FN) - 1 
         CALL HISTORY (FN,BK) 
         BACKSPACE FN 
         LOP(FN) = BK 
   10 CONTINUE
      RETURN
C**  THIS PROGRAM VALID ON FTN4 AND FTN5 ** 
      END 
C*F45V1P0*
      SUBROUTINE OPEF (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /OPEF/ IS USED TO WRITE END OF FILE ON THE TEST
*         FILE FN.  OPERATION CODE USED FOR END OF FILE IS EF.
* 
*         ENTRY 
*         ----- 
*         LOP(FN)- LAST OPERATION PERFORMED ON TEST FILE FN 
*         RP(FN) - CURRENT POSITION ON TEST FILE FN 
*         FN     - CURRENT FILE WORKING WITH
*         EF     - OPERATION CODE FOR END OF FILE 
* 
*         EXIT
*         ----
*         LOP(FN)= 2
*         RP(FN) = RP(FN) + NR IF LOP(FN) NON ZERO
*         RP(FN) = RP(FN) + NR - 1 IF LOP(FN) EQUAL ZERO
* 
*         CALLS 
*         ----- 
*         HISTORY- HISTORY UPDATE SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
  
*CALL,TIOCOM
  
      IF(LOP(FN).NE.BK)RP(FN) = RP(FN) + 1
      RT(FN) = RP(FN) 
      T1 = PTM + RP(FN) 
      M(T1) = EF
      CALL HISTORY (FN,EF)
      ENDFILE FN
      LOP(FN) = EF
      RETURN
C**  THIS PROGRAM VALID ON FTN4 AND FTN5 ** 
      END 
C*F45V1P0*
      SUBROUTINE OPRD (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBUOUTINE /OPRD/ IS USED TO READ THE NR RECORDS FROM TEST
*         FILE FN INTO THE READ BUFFER BUFRD.  THE DATA IS CHECKED USING
*         SUBROUTINE /CHK/. OPERATION CODE USED FOR READ IS RD. 
* 
*         ENTRY 
*         ----- 
*         LOP(FN)- LAST OPERATION PERFORMED ON TEST FILE FN 
*         RP(FN) - CURRENT POSITION ON TEST FILE FN 
*         FN     - CURRENT FILE WORKING WITH
*         NR     - NUMBER OF RECORDS TO BE READ 
*         RD     - OPERATION CODE FOR READ RECORD 
* 
*         EXIT
*         ----
*         LOP(FN)= 3
*         RP(FN) = RP(FN) + NR IF LOP(FN) NON ZERO
*         RP(FN) = RP(FN) + NR - 1 IF LOP(FN) EQUAL ZERO
*         LNEXP  = LENGTH EXPECTED
*         LNACT  = ACTUAL LENGTH
* 
*         CALLS 
*         ----- 
*         HISTORY- HISTORY UPDATE SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
  
*CALL,TIOCOM
  
      DO 40 J=1,NR
         IF(LOP(FN).NE.BK)RP(FN) = RP(FN) + 1 
         T1 = PTM + RP(FN)
         LEXP = SHIFT(M(T1),24).AND.O"7777" 
         CALL HISTORY (FN,RD) 
         BUFFER IN (FN,MODE)(BUFRD(1),BUFRD(2000))
         LOP(FN) = RD 
         IF(UNIT(FN))20,30,10 
   10      CONTINUE 
           CALL REPERR (16,FN,0,0,0,0,0)
   20      CALL CHKMR (FN,T1) 
           CALL CHK (FN)
           GO TO 40 
   30      CONTINUE 
           IF(M(T1).NE.EF)CALL REPERR (18,FN,0,0,0,0,0) 
   40 CONTINUE
  
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE OPWR (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /OPWR/ IS USED TO WRITE NR RECORDS ON TEST FILE FN 
*         OF LENGTH LNTH FROM THE WRITE BUFFER BUFWR. THE OUTPUT ADDRESS
*         IS RANDOM WITHIN THE WRITE BUFFER. OPERATION CODE FOR WRITE IS
*         WR. 
* 
*         ENTRY 
*         ----- 
*         LOP(FN)- LAST OPERATION PERFORMED ON TEST FILE FN 
*         RP(FN) - CURRENT POSITION ON TEST FILE FN 
*         FN     - CURRENT FILE WORKING WITH
*         NR     - NUMBER OF RECORDS TO BE WRITTEN
*         LNACT  - LENGTH OF RECORD TO WRITE
*         WR     - OPERATION CODE FOR WRITE RECORD
* 
*         EXIT
*         ----
*         LOP(FN)= 4
*         RP(FN) = RP(FN) + NR IF LOP(FN) NON BACKSPACE 
*         RP(FN) = RP(FN) + NR - 1 IF LOP(FN) EQUAL BACKSPACE 
* 
*         CALLS 
*         ----- 
*         HISTORY- HISTORY UPDATE SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
* 
  
*CALL,TIOCOM
  
      MSKL =   O"37"
      IF(LACT.LT.O"3000")MSKL =  O"777" 
      IF(LACT.LT.O"2000")MSKL = O"1777" 
  
      IF(SECT.NE.3HSEQ)GO TO 100
  
*         SEQUENTIAL SECTION WRITE NR RECORDS ON ALL FILES
  
        DO 90 J=1,NR
           FADD = (SHIFT(RANF(),24).AND.MSKL) + 1 
           IF(MODE.EQ.0)CALL FILL (CVT2,CVT1,FADD,1)
           LADD = FADD + LACT -1
           SAVE = BUFWR(FADD) 
           DO 40 K=1,FILES
              IF(UNIT(K))30,10,20 
  
*             EOF DETECTED IF NOT WRITE OUTPUT ERROR MSG
  
   10         CONTINUE
              IF(LOP(K).NE.WR)GO TO 30
              CALL REPERR (18,K,0,0,0,0,0)
              GO TO 30
  
*             PARITY DETECTED 
  
   20         CALL REPERR (16,K,0,0,0,0,0)
  
*             UPDATE HISTORY AND OUTPUT RECORD
  
   30         IF(LOP(K).NE.BK)RP(K) = RP(K) +1
              RT(K) = RP(K) 
              M(RP(K)) = SHIFT(FADD,48).OR.SHIFT(LACT,36).OR.RP(K)
              BUFWR(FADD) = M(RP(K))
              CALL HISTORY (K,WR) 
              BUFFER OUT (K,MODE)(BUFWR(FADD),BUFWR(LADD))
              LOP(K) = WR 
   40      CONTINUE 
           DO 80 K=1,FILES
             IF(UNIT(K))70,50,60
  
*            EOF DETECTED 
  
   50        CALL REPERR (18,K,0,0,0,0,0) 
             GO TO 100
  
*            PARITY DETECTED
  
   60        CALL REPERR (16,K,0,0,0,0,0) 
  
*            REPLACE FADD IN BUFWR WITH ORIGINAL DATA 
  
   70        CONTINUE 
   80      CONTINUE 
        BUFWR(FADD) = SAVE
   90   CONTINUE
        GO TO 150 
  
*         RANDOM SECTION WRITE NR RECORDS ON FILE FN
  
  100 CONTINUE
      DO 140 J=1,NR 
         FADD = (SHIFT(RANF(),24).AND.MSKL)+ 1
         IF(MODE.EQ.0)CALL FILL (CVT2,CVT1,FADD,1)
         LADD = FADD + LACT - 1 
         IF(LOP(FN).NE.BK)RP(FN) = RP(FN) + 1 
         RT(FN) = RP(FN)
         SAVE = BUFWR(FADD) 
         T1 = PTM + RP(FN)
         M(T1) = SHIFT(FADD,48).OR.SHIFT(LACT,36).OR.RP(FN) 
         BUFWR(FADD) = M(T1)
         CALL HISTORY (FN,WR) 
         BUFFER OUT (FN,MODE)(BUFWR(FADD),BUFWR(LADD))
         LOP(FN) = WR 
  
*         CHECK STATUS 130=OK 120=PARITY 10=EOF 
  
         IF(UNIT(FN))130,110,120
  110      CALL REPERR (18,K,0,0,0,0,0) 
            GO TO 130 
  120      CALL REPERR (16,K,0,0,0,0,0) 
  130    CONTINUE 
         BUFWR(FADD) = SAVE 
  140 CONTINUE
  150 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE OPVP (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /OPVP/ IS USED TO VERIFY THE CURRENT POSITION ON 
*         THE TEST FILE FN.  TO DO THIS OVPF REWIND THE TEST FILE AND 
*         READ FORWARD TO POSITION ITS SELF ON RP(FN) TEST RECORD.
*         OPERATION CODE USED FOR VERIFY POSITION IS VP.
* 
*         ENTRY 
*         ----- 
*         LOP(FN)- LAST OPERATION PERFORMED ON TEST FILE FN 
*         RP(FN) - CURRENT POSITION ON TEST FILE FN 
*         VP     - OPERATION CODE FOR VERIFY POSITION 
*         FN     - CURRENT FILE WORKING WITH
* 
*         EXIT
*         ----
*         LOP(FN)= 7
*         RO(FN) = RO(FN) + 1 
* 
*         CALLS 
*         ----- 
*         HISTORY- HISTORY UPDATE SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
  
*CALL,TIOCOM
  
*         REWIND TEST FILE
  
      NR = RP(FN) 
      RP(FN) = 0
      CALL HISTORY (FN,VP)
      REWIND FN 
      LOP(FN) = RW
  
*         READ TEST FILE CHECKING STATUS AND LENGTH 
  
      DO 40 J=1,NR
         IF(LOP(FN).NE.BK)RP(FN) = RP(FN) + 1 
         T1 = PTM + RP(FN)
         LEXP = SHIFT(M(T1),24).AND.O"7777" 
         CALL HISTORY (FN,VP) 
         BUFFER IN (FN,MODE)(BUFRD(1),BUFRD(2000))
         LOP(FN) = RD 
         IF(UNIT(FN))20,30,10 
   10     CALL REPERR (16,FN,0,0,0,0,0) 
   20     CALL CHKMR (FN,T1)
           GO TO 40 
   30    IF(M(T1).NE.EF)CALL REPERR (18,FN,0,0,0,0,0) 
   40 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE OPSF (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /OPSF/ IS USED TO SKIP NR FILES FORWARD ON TEST
*         TEST FILE FN.  THE DATA IS NOT CHECKED ON THE BUFFER IN 
*         ONLY THE STATUS AND LENGTH. OPERATION CODE USED FOR SKIP
*         FORWARD IS SF.
* 
*         ENTRY 
*         ----- 
*         LOP(FN)- LAST OPERATION PERFORMED ON TEST FILE FN 
*         RP(FN) - CURRENT POSITION ON TEST FILE FN 
*         FN     - CURRENT FILE WORKING WITH
*         NR     - NUMBER OF FILES TO BE SKIPPED
*         SF     - OPERATION CODE FOR SEARCH FILE MARK FORWARD
* 
*         EXIT
*         ----
*         LOP(FN)= 5
*         RP(FN) = RP(FN) + NR IF LOP(FN) NON ZERO
*         RP(FN) = RP(FN) + NR - 1 IF LOP(FN) EQUAL ZERO
* 
*         CALLS 
*         ----- 
*         HISTORY- HISTORY UPDATE SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
* 
  
*CALL,TIOCOM
  
      DO 50 J=1,NR
   10    IF(LOP(FN).NE.BK)RP(FN) = RP(FN) + 1 
         CALL HISTORY (FN,SF) 
         BUFFER IN (FN,MODE)(BUFRD(1),BUFRD(2000))
         LOP(FN) = RD 
         T1 = PTM + RP(FN)
         LEXP = SHIFT(M(T1),24).AND.O"7777" 
         IF(UNIT(FN))30,40,20 
   20     CALL REPERR (16,FN,0,0,0,0,0) 
   30     CALL CHKMR (FN,T1)
          GO TO 10
   40    IF(M(T1).NE.EF)CALL REPERR (18,FN,0,0,0,0,0) 
   50 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE OPSR (FN)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /OPSR/ IS USED TO SKIP NR FILES REVERSE ON TEST
*         TEST FILE FN.  THE DATA IS NOT CHECKED ON THE BUFFER IN 
*         ONLY THE STATUS AND LENGTH. OPERATION CODE USED FOR SKIP
*         FILES REVERSE IS SR.
* 
*         ENTRY 
*         ----- 
*         LOP(FN)- LAST OPERATION PERFORMED ON TEST FILE FN 
*         RP(FN) - CURRENT POSITION ON TEST FILE FN 
*         FN     - CURRENT FILE WORKING WITH
*         NR     - NUMBER OF FILES TO BE SKIPPED
*         SR     - OPERATION CODE FOR SEARCH FILE MARK REVERSE
* 
*         EXIT
*         ----
*         LOP(FN)= 6
*         RP(FN) = RP(FN) + NR IF LOP(FN) NON ZERO
*         RP(FN) = RP(FN) + NR - 1 IF LOP(FN) EQUAL ZERO
* 
*         CALLS 
*         ----- 
*         HISTORY- HISTORY UPDATE SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION MODULE
*         MODRAN - RANDOM SECTION MODULE
* 
* 
  
*CALL,TIOCOM
  
      DO 10 J=1,NR
         IF(LOP(FN).EQ.BK)RP(FN) = RP(FN) - 1 
         CALL HISTORY (FN,SR) 
         BACKSPACE FN 
         LOP(FN) = BK 
   10 CONTINUE
      CALL HISTORY (FN,SR)
      BUFFER IN (FN,MODE)(BUFRD(1),BUFRD(2000)) 
      LOP(FN) = RD
      T1 = PTM + RP(FN) 
      LEXP = SHIFT(M(T1),24).AND.O"7777"
      IF(UNIT(FN))30,40,20
   20  CALL REPERR (16,FN,0,0,0,0,0)
   30  CALL CHKMR (FN,T1) 
       GO TO 50 
   40 IF(M(T1).NE.EF)CALL REPERR (18,FN,0,0,0,0,0)
   50 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE REPCALL
  
**        SUBROUTINE /REPCALL/ IS USED TO OUTPUT THE CONTROL CARD REPORT
*         IF NO PARAMETER ERRORS WERE ENCOUNTERED.
* 
*         ENTRY 
*         ----- 
*         PAR    - LABELED COMMON BLOCK HAS FILE NAMES STORED 
*         RAN    - RANDOM OPERATIONS TO PERFORM 
*         SEQ    - SEQUENTIAL OPERATIONS TO PERFORM 
*         PASSES - NUMBER OF PASSES TO PERFORM
*         FLST   - NUMBER OF ERRORS TO LIST BEFORE EXIT IS CALLED 
*         FHST   - NUMBER OF HISTORY OPERATION TO LIST ON ERROR 
*         READ   - 1=ON  0=OFF
*         WRITE  - 1=ON  0=OFF
*         MIN    - MINIMUM RECORD SIZE
*         MAX    - MAXIMUM RECORD SIZE
*         FILES  - NUMBER OF FILES TURNED ON
*         FPAT   - NUMBER OF BITS OF PATTERN
*         PAT    - PATTERN UP TO 60 BITS
* 
*         EXIT
*         ----
*         CALL STATEMENT PARAMETERS ARE LISTED ON THE OUTPUT FILE 
* 
*         CALLS 
*         ----- 
*         REPORT - OUTPUT SUBROUTINE
* 
*         CALLED BY 
*         --------- 
*         BEGIN  - INITIALIZATION ROUTINE 
* 
  
*CALL,TIOCOM
  
  
*         OUTPUT PARAMETER VALUES ASSIGNED MESSAGE
  
        CALL REPORT (2,0) 
  
*         SET UP FIRST LINE OF PARAMETER VALUES ASSIGN
  
          PRT(1) = 4HTAPE 
          PRT(2) = 1
          PRT(3) = PAR(3,1) 
          PRT(4) = PAR(2,1) 
          PRT(5) = 10HSEQUENTIAL
          PRT(6) = SEQ
          PRT(7) = 10HRANDOM
          PRT(8) = RAN
        CALL REPORT (3,8) 
          PRT(2) = 2
          PRT(3) = PAR(3,2) 
          PRT(4) = PAR(2,2) 
          PRT(5) = 10HPASSES
          PRT(6) = PASSES 
          PRT(7) = 10HLIST
          PRT(8) = FLST 
        CALL REPORT (3,8) 
          PRT(2) = 3
          PRT(3) = PAR(3,3) 
          PRT(4) = PAR(2,3) 
          PRT(5) = 10HMODE
          PRT(6) = 7HBIN/BCD
          IF(FMODE.EQ.1)PRT(6) = 7H    BIN
          IF(FMODE.EQ.2)PRT(6) = 7H    BCD
          PRT(7) = 10HHISTORY 
          PRT(8) = FHST 
        IF(FHST.LT.51)CALL REPORT(5,8)
          PRT(8) = 7H    ALL
        IF(FHST.GT.50)CALL REPORT(4,8)
          PRT(2) = 4
          PRT(3) = PAR(3,4) 
          PRT(4) = PAR(2,4) 
          PRT(5) = 10HMINIMUM 
          PRT(6) = MIN
          PRT(7) = 10HMAXIMUM 
          PRT(8) = MAX
        CALL REPORT (3,8) 
          PRT(2) = 5
          PRT(3) = PAR(3,5) 
          PRT(4) = PAR(2,5) 
          PRT(5) = 10HREAD
          PRT(6) = 7H    OFF
          IF(FRD.NE.0)PRT(6) = 7H     ON
          PRT(7) = 10HWRITE 
          PRT(8) = 7H    OFF
          IF(FWR.NE.0)PRT(8) = 7H     ON
        CALL REPORT (4,8) 
          PRT(1) = 10HOUTPUT
          PRT(2) = PAR(2,6) 
          PRT(3) = 10HPATTERN 
          IF((FPAT.NE.0).AND.(FPAT.NE.64))GO TO 10
          PRT(4) = 10HPRE/RAN 
          IF(FPAT.EQ.64)PRT(4) = 10HRANDOM
        CALL REPORT ( 6,4)
          GO TO 20
   10     PRT(4) = FPAT 
          IF(FPAT.GT.12)GO TO 11
          PRT(5) = PAT
        CALL REPORT (7,5) 
          GO TO 20
   11     IF(FPAT.GT.24)GO TO 12
          PRT(5) = SHIFT(PAT,48).AND.O"7777"
          PRT(6) = PAT.AND.O"7777"
        CALL REPORT (7,6) 
          GO TO 20
   12     IF(FPAT.GT.36)GO TO 13
          PRT(5) = SHIFT(PAT,36).AND.O"7777"
          PRT(6) = SHIFT(PAT,48).AND.O"7777"
          PRT(7) = PAT.AND.O"7777"
        CALL REPORT (7,7) 
          GO TO 20
   13     IF(FPAT.GT.48)GO TO 14
          PRT(5) = SHIFT(PAT,24).AND.O"7777"
          PRT(6) = SHIFT(PAT,36).AND.O"7777"
          PRT(7) = SHIFT(PAT,48).AND.O"7777"
          PRT(8) = PAT.AND.O"7777"
        CALL REPORT (7,8) 
          GO TO 20
   14     PRT(5) = SHIFT(PAT,12).AND.O"7777"
          PRT(6) = SHIFT(PAT,24).AND.O"7777"
          PRT(7) = SHIFT(PAT,36).AND.O"7777"
          PRT(8) = SHIFT(PAT,48).AND.O"7777"
          PRT(9) = PAT.AND.O"7777"
        CALL REPORT (7,9) 
   20 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE REPERR (CODE,FN,P1,P2,P3,P4,NO)
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /REPERR/ IS USED TO FORMAT THE ERROR(S) ENCOUNTERED
*         AND CALL REPORT TO OUTPUT THEM. REPERR WILL ALSO DECREMENT THE
*         FLST WORD AND CALL EXIT IF IT IS EQUAL TO ZERO. 
* 
*         ENTRY 
*         ----- 
*         FN     - FILE NUMBER CURRENTLY WORKING ON 
*         CODE   - ERROR CODE FOR TYPE OF ERROR 
*         P1-P4  - ADDITIONAL INFORMATION NEEDED TO DEFINE ERROR
*          14    = RECORD NUMBER ERROR
*          15    = DATA ERROR 
*          16    = PARITY ERROR 
*          17    = EOF EXPECTED ERROR 
*          18    = EOF NOT EXPECTED ERROR 
*          19    = LENGTH ERROR 
*          20    = MORE THAN 10 DATA ERRORS 
*         ECODE  = TABLE OF DISPLAY CODE ERROR TYPES
*         NO     = NUMBER OF EXTRA PARAMETERS FOR ERROR MESSAGE 
* 
*         EXIT
*         ----
*         FLST   - DECREMENTED AND EXIT CALLED IF IT IS EQUAL TO ZERO 
*         ERROR MESSAGE IS PRINTED OUT
* 
*         CALLS 
*         ----- 
*         REPORT - OUTPUT ERROR MESSAGE TO OUTPUT FILE
*         REMARK - OUTPUT DAYFILE MESSAGE 
* 
*         CALLED BY 
*         --------- 
*         CHK    - CHECK DATA SUBROUTINE
*         OPRD   - READ SUBROUTINE
*         OPWR   - WRITE SUBROUTINE 
*         OPSF   - SKIP FILES FORWARD 
*         OPSR   - SKIP FILES REVERSE 
* 
  
*CALL,TIOCOM
  
      DATA ECODE( 1) / 10HREC NO.    /
      DATA ECODE( 2) / 10HDATA.      /
      DATA ECODE( 3) / 10HPARITY.    /
      DATA ECODE( 4) / 10HEOF EX     /
      DATA ECODE( 5) / 10HEOF NOT EX /
      DATA ECODE( 6) / 10HLENGTH.    /
      DATA ECODE( 7) / 10HGT 10 DATA /
  
  
      RE(FN) = RE(FN) + 1 
  
*         FILL PRT BUFFER WITH DATA COMMON TO ALL ERRORS
  
    5 PRT(1) = SECT 
      PRT(2) = 6H PASS= 
      PRT(3) = PASS 
      PRT(4) = 5H TAPE
      PRT(5) = FN 
      PRT(6) = 3HBIN
      IF(MODE.EQ.0)PRT(6) = 3HBCD 
      PRT (7) = RP(FN)
      PRT (8) = P1
      PRT (9) = P2
      PRT(10) = P3
      PRT(11) = P4
      NWRDS = 7 + NO
   10 CALL REPORT (CODE,NWRDS)
      IF(FHST.LT.1)GO TO 900
        IF(FHST.GT.50)GO TO 900 
           T1 = INHST 
           IF(H(T1).EQ.0)T1 = 1 
           PRT(1) = 1 
           DO 100 J=1,FHST
              IF(H(T1).EQ.0)GO TO 200 
              PRT(2) = SHIFT(H(T1),12).AND.O"7" 
              PRT(3) = FMTOP((SHIFT(H(T1),18).AND.7)+1) 
              PRT(4) = SHIFT(H(T1),48).AND.O"77777777"
              PRT(5) = H(T1).AND.O"7777"
              CALL REPORT (21,5)
              PRT(1) = PRT(1) + 1 
              H(T1) = 0 
              T1    = T1 + 1
              IF(T1.GT.FHST)T1 = 1
  100      CONTINUE 
  200      INHST = 1
  900 CONTINUE
      FLST = FLST - 1 
      IF(FLST.GT.0)GO TO 950
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*         MORE ERRORS THAN ON LIST VALUE   ABORT PROGRAM
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
        PRT(1) = 10HERRORS EXC
        PRT(2) = 10HEED LIST
        ENCODE (10,925,PRT(3))PAR(2,10) 
  925   FORMAT(4X,I6) 
        PRT(3) = (PRT(3).AND.O"777777777777").OR.L" =  "
        PRT(4) = 10H RUN ENDED
        PRT(5) = L"  "
        CALL REMARK (PRT(1))
        PRT(1) = PAR(2,10)
        CALL REPORT (12,1)
        CALL EXIT 
  
  950 CONTINUE
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE REPSUM 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /REPSUM/ IS USED TO OUTPUT THE SUMMARY OF EACH 
*         SECTION WHEN THEY ARE DONE. 
* 
*         ENTRY 
*         ----- 
*         RO(1-5) = CONTAINS THE TOTAL OPERATIONS DONE ON EACH TEST FILE
*         RT(1-5) = CONTAINS THE TOTAL RECORDS ON THE TEST FILE(S)
*         HTBL()  = CONTAINS THE TOTAL OPERATIONS BY OP CODE
*         SECT    = SEQ IF SEQUENTIAL SECTION  RAN IF RANDOM SECTION
* 
*         EXIT
*         ----
*         SUMMARY REPORT LISTED ON OUTPUT 
* 
*         CALLS 
*         ----- 
*         REPORT - REPORT OUTPUT ROUTINE
* 
*         CALLED BY 
*         --------- 
*         MODSEQ - SEQUENTIAL SECTION 
*         MODRAN - RANDOM SECTION 
* 
  
*CALL,TIOCOM
  
*         OUTPUT HEADER FOR SUMMARY REPORT
  
      TEMP = RE(1) + RE(2) + RE(3) + RE(4) + RE(5)
      ENCODE (10,4,PRT(4))TEMP
      PRT(4) = L" ERR=".OR.(PRT(4).AND.O"7777777777") 
      PRT(5) = 0
      IF(SECT.EQ.3HRAN)GO TO 5
        PRT(1) = 10HSEQ COMPLE
        PRT(2) = 10HTE RECORDS
        ENCODE (10,4,PRT(3))SEQ 
    4   FORMAT(3X,I7) 
        CALL REMARK (PRT(1))
        PRT(1) = 10HSEQUENTIAL
        GO TO 10
  
    5 PRT(1) = 10HRAN COMPLE
      PRT(2) = 10HTE OPERATI
  
      ENCODE (10,4,PRT(3))RAN 
      PRT(3) = (PRT(3).AND.O"777777777777").OR.L"ONS "
      CALL REMARK (PRT(1))
      PRT(1) = 10HRANDOM
  
   10 PRT(2) = PASS 
      PRT(3) = 3HBIN
      IF(MODE.EQ.0)PRT(3) = 3HBCD 
      CALL REPORT (22,3)
  
*         OUTPUT HEADER FOR SUMMARY TOTALS
  
      PRT(1) = 10HRECORDS 
      IF(SECT.EQ.3HRAN)PRT(1) = 10HOPERATIONS 
      CALL REPORT (23,1)
  
*         OUTPUT LINE OF SUMMARY FOR EACH TEST FILE TURNED ON 
  
      PRT(1) = 4HTAPE 
      DO 50 J=1,FILES 
           PRT(2) = J 
           PRT(3) = RE(J) 
           PRT(4) = HTBL(1,J) 
           PRT(5) = HTBL(2,J) 
           PRT(6) = HTBL(3,J) 
           PRT(7) = HTBL(4,J) 
           PRT(8) = HTBL(5,J) 
           PRT(9) = HTBL(6,J) 
           PRT(10)= HTBL(7,J) 
           PRT(11)= HTBL(8,J) 
           PRT(12)= RT(J) 
           IF(SECT.EQ.3HRAN)PRT(12)= RO(J)
           CALL REPORT (24,12)
   50 CONTINUE
  
*         DOUBLE SPACE AFTER  SUMMARY WAS OUTPUT
  
      CALL REPORT (25,0)
  
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE REPORT (NO,WRDS) 
  
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE /REPORT/ IS USED TO OUTPUT ALL INFORMATION ON THE
*         LOGICAL FILE FOR OUTPUT.
* 
*         ENTRY 
*         ----- 
*         NO   = DATA STATEMENT NUMBER FOR PRINTING 
*         WRDS = NUMBERS OF WORDS TO PRINT
* 
*         EXIT
*         ----
*         LINE IS PRINTED 
* 
*         CALLED BY 
*         --------- 
*         BEGIN  - INITIALIZATION SUBROUTINE
*         REPCALL- CALL STATEMENT REPORTING SUBROUTINE
*         REPERR - ERROR REPORTING SUBROUTINE 
* 
  
*CALL,TIOCOM
  
      DIMENSION FMT(9,29),FMT1(9) 
  
*         CONTROL CARD HEADER 
  
      DATA (FMT(I,01),I=1,6)
     ,/10H('1    TES,  10HT INPUT OU,  10HTPUT (TIO),  10H V1.0 CONT, 
     , 10HROL CARD R,  10HEPORT',//)/ 
  
*         VALUES ASSIGNED MESSAGE 
  
      DATA (FMT(I,02),I=1,4)
     ,/10H(10X,' PAR,  10HAMETER VAL,  10HUES ASSIGN,  10HED',//)   / 
  
*         CONTROL CARD REPORT LINE
  
      DATA (FMT(I,03),I=1,6)
     ,/10H(1X,A4,I1,,  10H'/',A3,'=',  10H,A10,1X,A1,  10H0,' = ',I7, 
     , 10H,1X,A10,' ,  10H= ',I7)   / 
  
*         CONTROL CARD REPORT LINE
  
      DATA (FMT(I,04),I=1,6)
     ,/10H(1X,A4,I1,,  10H'/',A3,'=',  10H,A10,1X,A1,  10H0,' = ',A7, 
     , 10H,1X,A10,' ,  10H= ',A7)   / 
  
*         CONTROL CARD REPORT LINE
  
      DATA (FMT(I,05),I=1,6)
     ,/10H(1X,A4,I1,,  10H'/',A3,'=',  10H,A10,1X,A1,  10H0,' = ',A7, 
     , 10H,1X,A10,' ,  10H= ',I7)   / 
  
*         OUTPUT MESSAGE LINE WITH PATTERN=PRE/RAN
  
      DATA (FMT(I,06),I=1,4)
     ,/10H(1X,A6,3X,,  10H'=',A10,1X,  10H,A10,' = ',  10H,A7,//)   / 
  
*         OUTPUT MESSAGE LINE WITH PATTERN=XX/AAAA/BBBB/CCCC/DDDD/EEEE/ 
  
      DATA (FMT(I,07),I=1,5)
     ,/10H(1X,A6,3X,,  10H'=',A10,1X,  10H,A10,' = ',  10HI2,5('/',O, 
     , 10H4))       / 
  
*         OCTAL CONVERSION ERROR MESSAGE
  
      DATA (FMT(I,08),I=1,5)
     ,/10H(' OCTAL C,  10HONVERT ERR,  10HOR   .. PA,  10HRAMETER (', 
     , 10H,7A10)    / 
  
*         DECIMAL CONVERSION ERROR MESSAGE
  
      DATA (FMT(I,09),I=1,5)
     ,/10H(' DECIMAL,  10H CONVERT E,  10HRROR .. PA,  10HRAMETER (', 
     , 10H,7A10)    / 
  
*         VALUE TOO HIGH  MESSAGE 
  
      DATA (FMT(I,10),I=1,5)
     ,/10H(' VALUE T,  10HOO HIGH ER,  10HROR  .. PA,  10HRAMETER (', 
     , 10H,7A10)    / 
  
*         UNRECOGNIZED PARAMETER -- MESSAGE 
  
      DATA (FMT(I,11),I=1,5)
     ,/10H(' UNRECOG,  10HNIZED PARA,  10HMETER.. PA,  10HRAMETER (', 
     , 10H,7A10)    / 
  
*         ERRORS EXCEED LIST =XXXXX RUN ABORTED -- MESSAGE
  
      DATA (FMT(I,12),I=1,5)
     ,/10H' ERRORS  ,  10HEXCEED LIS,  10HT = ',I6,',  10H RUN ENDED, 
     , 10H')        / 
  
*         DUPLICATE FILE NAMES -- MESSAGE 
  
      DATA (FMT(I,13),I=1,5)
     ,/10H(' FILE NA,  10HME ',A7,' ,  10H= ',A7,' D,  10HUPLICATE N, 
     , 10HAMES')    / 
  
*         MODEL/RECORD COMPARE ERROR
  
      DATA (FMT(I,14),I=1,7)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HM/R CMP ER, 
     , 10HR R=',I4,',  10H M=',O20,',  10H R=',O20) / 
  
*         DATA ERROR MESSAGE
  
      DATA (FMT(I,15),I=1,9)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HDATA ERR R, 
     , 10H=',I4,' W=,  10H',I4,' E=',  10H,O20,' A=',  10HO20,' D=',, 
     , 10HO20)      / 
  
*         PARITY ERROR MESSAGE
  
      DATA (FMT(I,16),I=1,6)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HPARITY ERR, 
     , 10H R=',I4,' ,  10HL=',I4)   / 
  
*         EOF EXPECTED
  
      DATA (FMT(I,17),I=1,6)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HEOF EXPECT, 
     , 10HED R=',I4,,  10H' L=',I4) / 
  
*         EOF NOT EXPECTED
  
      DATA (FMT(I,18),I=1,6)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HEOF NOT EX, 
     , 10HPECTED R=',  10HI4)       / 
  
*         LENGTH ERROR
  
      DATA (FMT(I,19),I=1,7)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HLENGTH ERR, 
     , 10H R=',I4,' ,  10HE=',I4,' A,  10H=',I4)    / 
  
*         MORE THAN TEN DATA ERRORS ON ONE RECORD 
  
      DATA (FMT(I,20),I=1,6)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HGT 10 DATA, 
     , 10H ERRS R=',,  10HI4)       / 
  
*         HISTORY MESSAGE 
  
      DATA (FMT(I,21),I=1,6)
     ,/10H(10X,' OP=,  10H',I6.6,' T,  10HAPE',I1,1X,  10H,A10,' R=', 
     , 10H,I6.6,' L=,  10H',I4)     / 
  
*         SUMMARY HEADER MESSAGE I
  
      DATA (FMT(I,22),I=1,5)
     ,/10H(//,22X,A1,  10H0,' SECTIO,  10HN  PASS=',,  10HI4,' MODE=, 
     , 10H',A3)     / 
  
*         SUMMARY HEADER MESSAGE II 
  
      DATA (FMT(I,23),I=1,9)
     ,/10H(7X,'ERROR,  10HS',4X,'REW,  10H',5X,'BK',,  10H4X,'EOF',5, 
     , 10HX,'RD',5X,,  10H'WR',5X,'V,  10HP',5X,'SF',  10H,5X,'SR',2, 
     , 10HX,A10)    / 
  
*         SUMMARY DATA MESSAGE
  
      DATA (FMT(I,24),I=1,2)
     ,/10H(1X,A4,I1,,  10H10(I7))   / 
  
*         DOUBLE SPACE
  
      DATA (FMT(I,25),I=1,1)
     ,/10H(//)      / 
  
*         NO SECTION SELECTED MESSAGE 
  
      DATA (FMT(I,26),I=1,4)
     ,/10H(' NO SECT,  10HION SELECT,  10HED   ..RAN,  10H=0,SEQ=0')/ 
  
*         MAXIMUM LESS THAN MINIMUM MESSAGE 
  
      DATA (FMT(I,27),I=1,5)
     ,/10H(' MAXIMUM,  10H=',I7,' LE,  10HSS THAN MI,  10HNIMUM=',I7, 
     , 10H,' ERROR') /
  
*         VALUE TOO LOW 
  
      DATA (FMT(I,28),I=1,5)
     ,/10H(' VALUE T,  10HOO LOW ERR,  10HOR   .. PA,  10HRAMETER (', 
     , 10H,7A10)    / 
  
*         RECORD NUMBER ERROR 
  
      DATA (FMT(I,29),I=1,7)
     ,/10H(1X,A3,1X,,  10HA6,I2,A5,I,  10H1,1X,A3,' ,  10HREC-NO ERR, 
     , 10H E=',I4,' ,  10HA=',I4,1X,,  10HA10,A10)  / 
  
*         IF NO. OF WORDS EQUAL ZERO OUTPUT FORMAT ELSE OUTPUT PRT(WRDS)
  
      DO5 I=1,9 
        FMT1(I)=FMT(I,NO) 
    5 CONTINUE
      IF(WRDS.EQ.0)GO TO 10 
        PRINT FMT1,(PRT(J),J=1,WRDS)
        GO TO 20
   10 PRINT FMT1
   20 CONTINUE
      RETURN
      END 
