      GO TO 263 
  261 WRITE(NWRIT,517)
      GO TO 263 
  262 WRITE(NWRIT,518)IPAKN(1)
  263 WRITE(NWRIT,521)ISCOD(1)
      GO TO 5 
C 
C POST MESSAGE
C 
  209 WRITE(NWRIT,548)
  548 FORMAT(" ALL FILES POSTED") 
      GO TO 5 
C 
CDIRECTIVE /REA,FNAME,RCDNO,PAKNO 
C 
C RECORD CONTENTS WILL APPEAR ON LIST OUTPUT DEVICE IN OCTAL
C RECORDS MUST BE 512 WORDS OR LESS 
C 
  400 CALL FNAME(IDIR,N3,N1,N2,IFNAM,IETYP,JATOE) 
      CALL INTR(IDIR,N3,N1,N2,IRCDN,IETYP)
      CALL PKNUM(IDIR,N3,N1,N2,IPAKN,IETYP) 
      IF(IETYP)17,359,17
  359 IETYP=-1
      CALL INTR(IDIR,N3,N1,N2,IUSTA,IETYP)
      IF(IETYP)17,403,17
  403 CALL EXEC(24,10,1,IFNAM,IPAKN,IRCDN,ISTAT,IETYP)
      IF(IETYP)17,405,17
  405 IF(ISTAT(7)-512)406,406,407 
  407 WRITE(NTYP,509) 
      GO TO 5 
  406 CALL FILL(IBUFF,1,512,040B) 
      CALL EXEC(24,6,IFNAM,IRCDN,IBUFF,IETYP) 
      IF(IETYP)17,408,17
  408 WRITE(NWRIT,549)(IFNAM(I),I=1,3),IRCDN
      I=1 
  409 ISTAT(7)=ISTAT(7)-8 
      I=I+8 
  410 K1=I+7
      WRITE(NWRIT,550)(IBUFF(J),J=1,8)
      IF(ISTAT(7))5,5,411 
  411 CALL MOVER(IBUFF,I,K1,IBUFF,1)
      GO TO 409 
C 
CDIRECTIVE /WRI,FNAME,RCDNO,LOGUN 
C 
C BUFFER CONTENTS WILL BE FILLED FROM THE DEVICE SPECIFIED
C BY THE LOGICAL UNIT #.UP TO 512 WORDS WILL ENTER THE BUFFER,8 
C WORDS AT A TIME IN OCTAL FORMAT.A 000072000072
C IS THE DELIMITER IF LESS THAN 512 WORDS ARE ENTERED 
C 
  450 CALL FNAME(IDIR,N3,N1,N2,IFNAM,IETYP,JATOE) 
      CALL INTR(IDIR,N3,N1,N2,IRCDN,IETYP)
      CALL INTR(IDIR,N3,N1,N2,ILOGU,IETYP)
      IF(IETYP)17,360,17
  360 IETYP=-1
      CALL INTR(IDIR,N3,N1,N2,IUSTA,IETYP)
      IF(IETYP)17,452,17
  452 CALL FILL(IBUFF,1,512,040B) 
      I=1 
  458 CALL FILL(IDIR,1,8,040B)
      READ(ILOGU,551)(IDIR(J),J=1,8)
      IF(IDIR(1)-072B)455,456,455 
  455 CALL MOVER(IDIR,1,8,IBUFF,I)
      IF(I-512)460,457,457
  460 I=I+8 
      GO TO 458 
  456 IF(IDIR(2)-072B)455,457,455 
  457 CALL EXEC(24,8,IFNAM,IRCDN,IBUFF,IETYP) 
      IF(IETYP)17,700,17
  700 CALL EXEC(24,14,IETYP)
      GO TO 17
  501 FORMAT(" /CRE,FNAME,PAKNO,FLGTH,RLGTH,SCODE,USTAT"/" /DES,FNAME,PA
     1KNO,SCODE"/" /OPE,FNAME,PAKNO,RCDNO,SCODE"/" /CLO,FNAME,USTAT"/ 
     2" /INI,PAKNO,DIRSZ"/" /RES,FNAME,PAKNO,RCDNO"/
     3" /STA,DF,FNAME,PAKNO"/" /STA,FO,FNAME"/
     4" /STA,SC,FNAME,PAKNO,SCODE"/" /STA,LR,FNAME,PAKNO"/
     5" /STA,LF,PAKNO"/" /STA,NF,PAKNO,STATB"/" /STA,AP,FNAME,STATB"/ 
     6" /REP,PAKNO"/" /COP,FNAME,PAKNO"/" /CHA,FNAM1,FNAM2,PAKNO,SCODE"/
     7" /POS"/" /BRI,FNAME,SCODE"/" /END")
  502 FORMAT("UTIL READY")
  503 FORMAT(72R1)
  507 FORMAT(" ILLEGAL OPERATION")
  504 FORMAT(" ERROR # "I6) 
  552 FORMAT(" FILE  "2A2,A1,"  ALREADY OPEN")
  505 FORMAT(" ILLEGAL RECORD #,TRY PACK # "I6) 
  506 FORMAT(" AVAILABLE RECS. ="I6" RECORDS USED = "I6/" NEW RECORD COU
     1NT?") 
  508 FORMAT(" TOO BIG")
  509 FORMAT(" RECORD SIZE TOO BIG")
  510 FORMAT(" "I6" CONSECUTIVE TRACK NOT AVAILABLE") 
  511 FORMAT(" AVAILABLE RECS. ="I6" RECORDS USED = "I6)
  512 FORMAT(" WHICH FILES?") 
  513 FORMAT(" ERROR ON ENTRY "I6)
  514 FORMAT(" ERROR,TOO MANY FILES") 
  549 FORMAT(" FILE  "2A2,A1," RECORD # "I6/) 
  550 FORMAT(8(" "K6))
  551 FORMAT(8K6) 
  620 CALL FNAME(IDIR,N3,N1,N2,IFNAM,IETYP,JATOE) 
      CALL PKNUM(IDIR,N3,N1,N2,IPAKN,IETYP) 
      CALL INTR(IDIR,N3,N1,N2,IRCDN,IETYP)
      IF(IETYP)17,361,17
  361 IETYP=-1
      CALL INTR(IDIR,N3,N1,N2,IUSTA,IETYP)
      IF(IETYP)17,621,17
  621 CALL EXEC(24,9,IFNAM,IPAKN,IRCDN,IETYP) 
      GO TO 17
  650 WRITE(NWRIT,655)(IFNAM(I),I=1,3)
  655 FORMAT(" FILE  "2A2,A1," RESET")
      IF(IPAKN(1))651,652,653 
  651 WRITE(NWRIT,516)
      GO TO 654 
  652 WRITE(NWRIT,517)
      GO TO 654 
  653 WRITE(NWRIT,518)IPAKN(1)
  654 WRITE(NWRIT,525)IRCDN 
      GO TO 5 
      END 
C SUBROUTINE FNAME
C CALLING SEQUENCE: 
C CALL FNAME(JCARD,J,K,KLAST,KCARD,IETYP,JATOE) 
C 
C PURPOSE: FNAME PACKS THE CHARACTERS FROM N1 TO N2,2 CHARACTERS PER
C  WORD. IF 2 CONSECUTIVE COMMAS OCCUR, IETYP =20, OTHERWISE IETYP=0. 
      SUBROUTINE FNAME(JCARD,J,K,KLAST,KCARD,IETYP,JATOE) 
      DIMENSION JCARD(1),KCARD(1),JATOE(1)
      DATA LCB/0/ 
      IF(IETYP)1,2,1
    1 RETURN
    2 J=J+1 
      IF(JCARD(J)-40100B)3,4,3
    4 IF(J-72)2,5,5 
    5 IETYP=20
      RETURN
    3 IF(JCARD(J)-65500B)6,5,6
    6 K=J 
    8 J=J+1 
      IF(JCARD(J)-65500B)7,20,7 
    7 IF(J-72)8,20,20 
   20 KLAST=J-1 
      N=KLAST-K+1 
      CALL FILL(KCARD,1,3,020040B)
      CALL EBASC(JCARD,K,KLAST,JCARD,K,JATOE) 
      IF(N-5)9,9,10 
   10 KLAST=K+4 
    9 N=K 
      I=1 
   15 KCARD(I)=256*JCARD(N) 
      IF(N-KLAST)11,12,12 
   12 KCARD(I)=KCARD(I)+040B
      RETURN
   11 N=N+1 
      KCARD(I)=JCARD(N)+KCARD(I)
      IF(N-KLAST)13,14,14 
   14 RETURN
   13 N=N+1 
      I=I+1 
      GO TO 15
      END 
CFUNCTION NCOMP 
CFUNCTION-TWO VARIABLE-LENGTH DATA FIELDS ARE COMPARED,AND THE RESULT IS
CSET TO A NEGATIVE NUMBER,ZERO,OR A POSITIVE NUMBER.THIS IS A FUNCTION
CSUBPROGRAM.
C 
CCALLING SEQUENCE-
C 
CNCOMP(JCARD,J,JLAST,KCARD,K) 
      FUNCTION NCOMP(JCARD,J,JLAST,KCARD,K) 
      DIMENSION JCARD(1),KCARD(1) 
      DATA LCB/0/ 
      JNOW=J
    1 KNOW=K+JNOW-J 
      NCOMP=JCARD(JNOW)/16-KCARD(KNOW)/16 
      IF(NCOMP)3,2,3
    2 JNOW=JNOW+1 
      IF(JNOW-JLAST)1,1,3 
    3 RETURN
      END 
CSUBROUTINE A1DEC 
C 
CFUNCTION-CONVERTS A FIELD FROM A1 FORMAT,ONE DIGIT PER WORD, 
CTO DECIMAL FORMAT,RIGHT-JUSTIFIED,ONE DIGIT PER WORD.
C 
CCALLING SEQUENCE-
C 
CCALL A1DEC(JCARD,J,JLAST,NER)
      SUBROUTINE A1DEC(JCARD,J,JLAST,NER) 
      DIMENSION JCARD(1)
      DATA LCB/0/ 
CISOLATE THE SIGN IN JSIGN
      JSIGN=0 
      CALL NZONE(JCARD,JLAST,4,JSIGN) 
      JNOW=J
    1 JTEST=JCARD(JNOW) 
C IS JTEST LESS THAN ZERO 
      IF(JTEST)2,3,3
CIS JTEST EQUAL TO AN EBCDIC BLANK
    3 IF(JTEST-40100B)4,5,4 
CIS JTEST LESS THAN -4032 
    2 IF(JTEST+4032)4,6,6 
CSET ERROR CONDITION AT THIS CHARACTER
    4 NER=JNOW
      GO TO 7 
CSET JTEST EQUAL TO AN EBCDIC ZERO
    5 JTEST=170100B 
CCONVERT CHARACTER TO ITS DECIMAL EQUIVALENT
    6 JCARD(JNOW)=(JTEST+4032)/256
    7 IF (JNOW-JLAST)8,9,9
    8 JNOW=JNOW+1 
      GO TO 1 
CIF THE SIGN IS NEGATIVE,MAKE THE LAST DECIMAL DIGIT NEGATIVE 
    9 IF(JSIGN-2)11,10,11 
   10 JCARD(JLAST)=-JCARD(JLAST)-1
   11 RETURN
      END 
CSUBROUTINE MOVE
CFUNCTION-MOVES DATA FROM ONE ARRAY TO ANOTHER ARRAY
C 
CCALLING SEQUENCE-
C 
CCALL MOVE(JCARD,J,JLAST,KCARD,K) 
      SUBROUTINE MOVER(JCARD,J,JLAST,KCARD,K) 
      DIMENSION JCARD(1),KCARD(1) 
      DATA LCB/0/ 
      JNOW=J
    1 KNOW=K+JNOW-J 
      KCARD(KNOW)=JCARD(JNOW) 
      IF(JNOW-JLAST)2,3,3 
    2 JNOW=JNOW+1 
      GO TO 1 
    3 RETURN
      END 
C SUBROUTINE EBASC
C FUNCTION-TO CONVERT AN ARRAY FROM A1 FORMAT(EBCDIC)TO ASCII.
C 
C CALLING SEQUENCE- 
C 
C CALL EBASC(JCARD,J,JLAST,KCARD,K,JATOE) 
C 
      SUBROUTINE EBASC(JCARD,J,JLAST,KCARD,K,JATOE) 
      DIMENSION JCARD(1),KCARD(1),JATOE(1)
      DATA LCB/0/ 
      JNOW=J
    1 KNOW=K+JNOW-J 
      DO 2 I=1,62 
      IF(JCARD(JNOW)-JATOE(I))2,3,2 
    2 CONTINUE
    4 KCARD(KNOW)=40B 
      GO TO 5 
    3 KCARD(KNOW)=I+37B 
      IF(KCARD(KNOW)-42B)5,4,5
    5 IF(JNOW-JLAST)6,7,7 
    6 JNOW=JNOW+1 
      GO TO 1 
    7 RETURN
      END 
CSUBROUTINE ASCEB 
CFUNCTION-TO CONVERT AN ARRAY FROM ASCII TO A1 FORMAT(EBCDIC).
C 
CCALLING SEQUENCE-
C 
CCALL ASCEB(JCARD,J,JLAST,KCARD,K,JATOE)
C 
      SUBROUTINE ASCEB(JCARD,J,JLAST,KCARD,K,JATOE) 
      DIMENSION JCARD(1),KCARD(1),JATOE(1)
      DATA LCB/0/ 
      JNOW=J
    1 KNOW=K+JNOW-J 
      IF(JCARD(JNOW)-40B)4,2,2
    2 IF(JCARD(JNOW)-135B)3,3,4 
    3 JTEST=JCARD(JNOW)-37B 
      KCARD(KNOW)=JATOE(JTEST)
      GO TO 5 
    4 KCARD(KNOW)=40100B
    5 IF(JNOW-JLAST)6,7,7 
    6 JNOW=JNOW+1 
      GO TO 1 
    7 RETURN
      END 
      SUBROUTINE NZONE(JCARD,J,NEWZ,NOLDZ)
      DIMENSION JCARD(1)
      DATA LCB/0/ 
      JTEST=JCARD(J)
      IF(JTEST)10,20,20 
   10 IF(JTEST-170100B)21,11,21 
   11 IF(NEWZ-2)13,12,13
   12 JCARD(J)=60100B 
   13 NOLDZ=4 
   14 RETURN
   20 IF(JTEST-60100B)21,30,21
   21 NOLDZ=5+(JTEST-4096)/4096 
      IF(NOLDZ-5)22,14,14 
   22 IF(NEWZ-5)23,14,14
   23 JCARD(J)=JTEST+4096*(NEWZ-NOLDZ)
      GO TO 14
   30 NOLDZ=2 
      IF(NEWZ-4)14,31,14
   31 JTEST=150100B 
      GO TO 23
      END 
C SUBROUTINE INTR 
C CALLING SEQUENCE: CALL INTR(JCARD,J,K,KLAST,KCARD,IETYP)
C 
C PURPOSE: INTR FORMS AN INTEGER FROM THE JCARD FIELD FROM POSITIONS K
C          TO KLAST. IF THE INTEGER FORMED IS NOT IN THE RANGE -32768 
C          TO 32767,IETYP IS SET TO 20. 
C 
      SUBROUTINE INTR(JCARD,J,K,KLAST,KCARD,IETYP)
      DIMENSION JCARD(1),KCARD(1) 
      DATA LCB/0/ 
      IF(IETYP)30,2,1 
   30 IF(J-72)31,32,32
   31 IETYP=20
      GO TO 1 
   32 IETYP=0 
    1 RETURN
    2 J=J+1 
      IF(J-72)4,4,5 
    4 IF(JCARD(J)-40100B)3,2,3
    5 IETYP=20
      RETURN
    3 IF(JCARD(J)-60100B)7,6,7
    6 JSIGN=-1
      J=J+1 
      GO TO 8 
    7 JSIGN=1 
    8 K=J 
   12 IF(JCARD(J)-65500B)10,9,10
   10 IF(J-72)11,13,13
   11 J=J+1 
      GO TO 12
   13 KLAST=J 
      GO TO 14
    9 KLAST=J-1 
   14 IF(JCARD(KLAST)-40100B)15,16,15 
   16 IF(K-KLAST)17,5,5 
   17 KLAST=KLAST-1 
      GO TO 14
   15 IF(JCARD(KLAST)-170100B)33,18,18
   18 CALL A1DEC(JCARD,K,KLAST,IETYP) 
      IF(IETYP)33,19,33 
   33 IETYP=23
      RETURN
   19 N=0 
      N1=KLAST
      KCARD=0 
   23 KCARD=JCARD(N1)*(10**N)+KCARD 
      IF(KCARD)5,20,20
   20 IF(K-N1)21,22,22
   22 KCARD=KCARD*JSIGN 
      RETURN
   21 N=N+1 
      N1=N1-1 
      IF(N-4)23,24,5
   24 IF(JCARD(N1)-3)23,23,5
      END 
C SUBROUTINE PAKNO
C CALLING SEQUENCE: 
C CALL PAKNO(JCARD,J,K,KLAST,KCARD,IETYP) 
C 
C PURPOSE: PAKNO RETURNS THE PACK NUMBER SPECIFIED IN THE JCARD FIELD.
C          VALID NUMBERS ARE 0,1-999,AND(-1)-(-999).IF ANY OTHER
C          NUMBER APPEARS,IETYP IS SET TO 20. 
C 
      SUBROUTINE PKNUM(JCARD,J,K,KLAST,KCARD,IETYP) 
      DIMENSION JCARD(1),KCARD(1) 
      DATA LCB/0/ 
      IF(IETYP)1,2,1
    1 RETURN
    2 CALL INTR(JCARD,J,K,KLAST,KCARD,IETYP)
      IF(IETYP)1,3,1
    3 IF(KCARD)4,1,6
    4 IF(KCARD+999)5,1,1
    5 IETYP=20
      RETURN
    6 IF(KCARD-999)1,1,5
      END 
      END$
                    