Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0141/getfil.for
There are 3 other files named getfil.for in the archive. Click here to see a list.
SUBROUTINE GETFIL(MAXFIL, ITTY, JTTY,KMDNUM,KMDDVC,
1 KMDNAM,KMDEXT,MAXSTR,MAXBFR, KIND,NEWNUL,NEWDSK,
2 NEWNAM,NEWPTH,LCNRIT,IBUFFR,MAXFLG,INILTR,KNTLTR,
3 LCNOWN)
C RENBR(/EVALUATE FORM FILE,FILE=FILE,FILE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAFLAG LOCATES COMPONENTS OF SINGLE FILE
C SPECIFICATION, BUT DOES NOT PACK CHARACTERS WHICH
C FORM THESE COMPONENTS INTO SINGLE OR DOUBLE PRECISION
C COMPUTER LOCATIONS WHICH CAN BE USED AS ARGUMENTS IN
C SYSTEM SUBROUTINE CALLS OR FORTRAN OPEN STATEMENTS
C WHICH ARE NECESSARY TO PREPARE FOR READING OR WRITING
C OF DESIRED FILE. LISTED ON FOLLOWING PAGES IS
C WRAPPER FOR DAFLAG ROUTINE WHICH PACKS COMPONENTS OF
C FILE SPECIFICATION INTO FORM REQUIRED FOR
C DECSYSTEM-10 FORTRAN OPEN STATEMENTS. WRAPPER
C ROUTINE, NAMED GETFIL, SUPPORTS MULTIPLE FILE
C SPECIFICATION OF FORM
C LIST OF OUTPUT FILES=LIST OF INPUT FILES
C OR
C LIST OF INPUT FILES
C AND SO MUST SCAN COMMAND FROM LEFT TO RIGHT UNTIL ONE
C MORE THAN NUMBER OF FILES WHICH CAN APPEAR IN LIST OF
C OUTPUT FILES HAS BEEN FOUND. IF USER DESIRES TO
C INPUT SEVERAL LINES, ALL BUT LAST LINE CAN BE
C TERMINATED BY AMPERSAND, OR, IF COMMAND CONSISTS OF
C LIST OF FILE SPECIFICATIONS, ALL BUT LAST LINE CAN BE
C TERMINATED BY RIGHTMOST COMMA. ALTHOUGH GETFIL
C INITIALLY INTERACTS WITH USER, USER CAN AT ANY POINT
C SPECIFY THAT REMAINDER OF COMMAND IS TO BE READ FROM
C FILE BY GIVING ITS NAME ALONG WITH AT (@) SIGN. IF
C COMMAND IS BEING READ FROM FILE, THEN CONTINUATION
C INDICATIONS ARE NOT NECESSARY SINCE ENTIRE COMMAND
C FILE WILL BE READ UNTIL END OF FILE IS ENCOUNTERED.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT AND ARE
C RETURNED UNCHANGED.
C
C MAXFIL = 1 MORE THAN NUMBER OF FILES WHICH CAN APPEAR
C TO LEFT OF EQUAL SIGN. SINGLE PRECISION
C ARRAYS NEWNUL AND NEWDSK, AND DOUBLE
C PRECISION ARRAY NEWNAM MUST BE DIMENSIONED
C TO AT LEAST VALUE OF MAXFIL, AND DOUBLE
C PRECISION AND DOUBLY DIMENSIONED ARRAY
C NEWPTH MUST HAVE 3 AS ITS FIRST DIMENSION
C AND MAXFIL AS ITS SECOND DIMENSION.
C SWITCHES ARE ALWAYS RETURNED TO CALLING
C PROGRAM PRIOR TO FILE SPECIFICATIONS WITH
C WHICH THEY ARE ASSOCIATED. ALL SWITCHES
C LEFT OF EQUAL SIGN AND SWITCHES ASSOCIATED
C WITH FIRST FILE SPECIFICATION RIGHT OF EQUAL
C SIGN WILL HAVE BEEN RETURNED TO CALLING
C PROGRAM BEFORE ANY FILE SPECIFICATIONS ARE
C RETURNED. FIRST CALL TO THIS ROUTINE WHICH
C RETURNS FILE SPECIFICATIONS CAN RETURN UP TO
C MAXFIL FILE SPECIFICATIONS, OF WHICH ONLY
C FILE SPECIFICATION WHICH IS RETURNED IN
C LOCATION IN EACH ARRAY HAVING VALUE OF
C LCNRIT AS ITS SUBSCRIPT IS TO RIGHT OF EQUAL
C SIGN. SUBSEQUENT CALLS TO THIS ROUTINE WILL
C RETURN EITHER SINGLE SWITCH SPECIFICATION OR
C SINGLE FILE SPECIFICATION. EQUAL SIGN FOUND
C AFTER MORE THAN MAXFIL FILE SPECIFICATIONS
C HAVE BEEN FOUND IS TAKEN AS EQUIVALENT TO
C COMMA.
C ITTY = NUMBER OF UNIT FROM WHICH TERMINAL INPUT IS
C TO BE READ.
C JTTY = NUMBER OF UNIT TO WHICH TERMINAL OUTPUT IS
C TO BE WRITTEN.
C KMDNUM = NUMBER OF UNIT FROM WHICH COMMAND FILE
C INDICATED BY AT SIGN IS TO BE READ.
C KMDDVC = DEFAULT NAME IN 5H FORM OF DEVICE FROM WHICH
C COMMAND FILE IS TO BE READ IF USER FAILS TO
C SUPPLY DEVICE NAME FOLLOWED BY COLON.
C KMDNAM = DEFAULT FIRST NAME IN A6 FORM TO BE USED IN
C NAME OF COMMAND FILE IF NONE IS SUPPLIED BY
C USER. THIS MUST BE A DOUBLE PRECISION
C VARIABLE ON PDP10 COMPUTER.
C KMDEXT = DEFAULT EXTENSION IN 3H FORM TO BE USED IN
C NAME OF COMMAND FILE IF NONE IS SUPPLIED BY
C USER. IF COMMAND FILE NAME IS NOT TO HAVE
C EXTENSION, THEN USER MUST TYPE PERIOD
C FOLLOWING FIRST PART OF NAME.
C MAXSTR = DIMENSION OF INILTR AND KNTLTR ARRAYS IN
C WHICH DESCRIPTIONS OF COMPONENTS OF SWITCHS
C ARE RETURNED AND WHICH ARE USED INTERNALLY
C WITHIN THIS ROUTINE FOR STORAGE OF
C DESCRIPTIONS OF COMPONENTS OF EACH FILE
C SPECIFICATION. MAXSTR SHOULD HAVE VALUE OF
C AT LEAST 6.
C MAXBFR = DIMENSION OF IBUFFR ARRAY INTO WHICH EACH
C LINE OF COMMANDS TYPED BY USER OR READ FROM
C COMMAND FILE ARE STORED IN MULTIPLE OF A1
C FORMAT. MAXBFR IS MAXIMUM NUMBER OF
C CHARACTERS WHICH CAN APPEAR IN SINGLE
C COMMAND LINE. MAXBFR MUST NOT EXCEED 132.
C
C FOLLOWING ARGUMENT MUST BE SET BEFORE THIS ROUTINE IS
C FIRST CALLED, BUT THEN VALUE RETURNED BY THIS ROUTINE
C SHOULD BE SENT TO FOLLOWING CALL OF THIS ROUTINE
C UNCHANGED.
C
C KIND = SHOULD BE INPUT SET TO ZERO WHEN THIS
C ROUTINE IS FIRST CALLED, OR WHENEVER
C INTERPRETATION OF PREVIOUS SET OF COMMANDS
C IS TO BE ABANDONED. KIND IS RETURNED
C DESCRIBING REASON WHY CONTROL HAS BEEN
C TRANSFERRED BACK TO CALLING PROGRAM, AND
C SHOULD NOT BE CHANGED BY CALLING PROGRAM IF
C THIS ROUTINE IS TO BE CALLED AGAIN TO
C CONTINUE INTERPRETATION OF SAME SEQUENCE OF
C COMMANDS.
C = 1, RETURNED IF NO MORE FILE SPECIFICATIONS
C REMAIN TO BE EVALUATED.
C = 2, RETURNED IF SEMICOLON WAS FOUND. IF THIS
C ROUTINE IS CALLED AGAIN WITHOUT KIND HAVING
C FIRST BEEN ZEROED, THEN EVALUATION OF NEW
C SET OF FILE SPECIFICATIONS WILL BE BEGUN IN
C TEXT APPEARING TO RIGHT OF SEMICOLON.
C APPEARANCE OF SEMICOLON WHEN FILE
C SPECIFICATION IS KNOWN BY THIS ROUTINE TO BE
C INCOMPLETE WILL NOT BE REPORTED SINCE TEXT
C TO RIGHT OF SEMICOLON IS TREATED AS IF IT
C CONTINUED FILE SPECIFICATIONS ON SUBSEQUENT
C LINE OF INPUT.
C = 3, RETURNED IF THIS ROUTINE IS REPORTING ALL
C OF FILE SPECIFICATIONS APPEARING TO LEFT OF
C EQUAL SIGN TOGETHER WITH FIRST FILE
C SPECIFICATION TO RIGHT OF EQUAL SIGN, OR IF
C THIS ROUTINE IS REPORTING FIRST FILE
C SPECIFICATION IN SERIES OF FILE
C SPECIFICATIONS WHICH DOES NOT INCLUDE EQUAL
C SIGN.
C = 4, RETURNED IF THIS ROUTINE IS REPORTING
C SECOND OR SUBSEQUENT FILE SPECIFICATION TO
C RIGHT OF EQUAL SIGN, OR IF THIS ROUTINE IS
C REPORTING SECOND OR SUBSEQUENT FILE
C SPECIFICATION IN SERIES OF FILE
C SPECIFICATIONS WHICH DOES NOT INCLUDE EQUAL
C SIGN.
C = 5, RETURNED IF THIS ROUTINE IS RETURNING
C DESCRIPTION OF SWITCH IN INILTR AND KNTLTR
C ARRAY LOCATIONS HAVING SUBSCRIPTS 1 THROUGH
C MAXFLG. LCNOWN IS RETURNED CONTAINING VALUE
C OF SUBSCRIPT OF LOCATIONS IN NEWNUL, NEWDSK,
C NEWNAM AND NEWPTH ARRAYS WHICH WILL DESCRIBE
C FILE SPECIFICATION WHEN KIND IS NEXT
C RETURNED SET TO EITHER 3 OR 4.
C
C FOLLOWING ARGUMENTS ARE USED BOTH FOR RETURNING
C INFORMATION TO CALLING PROGRAM AND FOR COMMUNICATING
C WITH SUBSEQUENT CALLS OF THIS ROUTINE. ORIGINAL
C CONTENTS OF THESE ARGUMENTS ARE IGNORED.
C
C NEWNUL = IF KIND IS RETURNED SET TO EITHER 3 OR 4,
C THEN LOCATIONS IN NEWNUL ARRAY HAVING
C SUBSCRIPTS 1 THROUGH LCNRIT ARE RETURNED
C DESCRIBING WHETHER FILE SPECIFICATION WAS
C FOUND, AND IF SO, WHETHER EXTENSION WAS
C SPECIFIED.
C = 0, AN EXTRA COMMA INDICATED THAT NO FILE WAS
C BEING SPECIFIED. NO FILE SPECIFICATION IS
C DESCRIBED IN NEWDSK, NEWNAM AND NEWPTH
C ARRAYS.
C = 1, EITHER DEVICE NAME OR PATH WAS SPECIFIED,
C BUT NO FILE NAME WAS SPECIFIED.
C = 2, FILE NAME BUT NOT EXTENSION WAS
C SPECIFIED.
C = 3, BOTH FILE NAME AND ITS EXTENSION WERE
C SPECIFIED.
C = 4, PERIOD AND EXTENSION WERE SPECIFIED, BUT
C NO NAME WAS SPECIFIED TO LEFT OF PERIOD.
C NEWDSK = IF KIND IS RETURNED SET TO EITHER 3 OR 4,
C THEN LOCATIONS IN NEWDSK ARRAY HAVING
C SUBSCRIPTS 1 THROUGH LCNRIT ARE RETURNED
C CONTAINING DEVICE NAME IN 5H FORM. IF NO
C DEVICE NAME IS SPECIFIED IN FILE
C SPECIFICATIONS TO LEFT OF EQUAL SIGN, THEN
C THESE LOCATIONS CONTAIN BLANKS. IF NO
C DEVICE NAME IS SPECIFIED IN FILE
C SPECIFICATIONS TO RIGHT OF EQUAL SIGN, THEN
C THESE LOCATIONS CONTAIN PREVIOUSLY SPECIFIED
C DEVICE NAME IF ANY HAS BEEN SPECIFIED TO
C RIGHT OF EQUAL SIGN, OR CONTAIN BLANKS IF
C NONE HAS YET BEEN SPECIFIED TO RIGHT OF
C EQUAL SIGN.
C NEWNAM = IF KIND IS RETURNED SET TO EITHER 3 OR 4,
C THEN LOCATIONS IN NEWNAM DOUBLE PRECISION
C ARRAY HAVING SUBSCRIPTS 1 THROUGH LCNRIT ARE
C RETURNED CONTAINING FILE NAME AND EXTENSION
C IN A10 FORM (FORMAT 1A6,1H.,1A3).
C NEWPTH = IF KIND IS RETURNED SET TO EITHER 3 OR 4,
C THEN LOCATIONS IN NEWPTH DOUBLE PRECISION
C AND DOUBLY DIMENSIONED ARRAY HAVING
C SUBSCRIPTS 1 THROUGH LCNRIT ARE RETURNED
C CONTAINING PATH UPON WHICH FILE IS LOCATED.
C IF NO PATH IS SPECIFIED IN FILE
C SPECIFICATIONS TO LEFT OF EQUAL SIGN, THEN
C THESE LOCATIONS CONTAIN ZEROES. IF NO PATH
C IS SPECIFIED IN FILE SPECIFICATIONS TO RIGHT
C OF EQUAL SIGN, THEN THESE LOCATIONS CONTAIN
C PREVIOUSLY SPECIFIED PATH IF ANY HAS BEEN
C SPECIFIED TO RIGHT OF EQUAL SIGN, OR CONTAIN
C ZEROES IF NONE HAS YET BEEN SPECIFIED TO
C RIGHT OF EQUAL SIGN. NEWPTH(1,...) CONTAINS
C IN ITS LEFT HALF PROJECT NUMBER AND IN ITS
C RIGHT HALF PROGRAMMER NUMBER, OR CONTAINS
C ZERO IF NO PATH HAS BEEN SPECIFIED.
C NEWPTH(2,...) CONTAINS SUB FILE DIRECTORY
C (SFD) NAME IN 6H FORM IF ANY HAS BEEN
C SPECIFIED, OR CONTAINS ZERO OTHERWISE.
C NEWPTH(3,...) ALWAYS CONTAINS ZERO.
C LCNRIT = IF KIND IS RETURNED SET TO EITHER 3 OR 4,
C THEN LCNRIT IS RETURNED CONTAINING VALUE OF
C SUBSCRIPT OF LOCATIONS IN NEWNUL, NEWDSK,
C NEWNAM AND NEWPTH ARRAYS WHICH DESCRIBE FILE
C SPECIFICATION WHICH APPEARS TO RIGHT OF
C EQUAL SIGN. IF KIND IS RETURNED SET TO 3
C AND IF LCNRIT IS GREATER THAN ONE, THEN
C LOWER LOCATIONS IN THESE ARRAYS DESCRIBE
C FILE SPECIFICATIONS APPEARING TO LEFT OF
C EQUAL SIGN. IF KIND IS RETURNED SET TO 4,
C THEN LOCATIONS WITHIN THESE ARRAYS HAVING
C LOWER SUBSCRIPTS SHOULD BE IGNORED.
C IBUFFR = ARRAY INTO WHICH THIS ROUTINE CAN READ
C CHARACTERS TYPED BY USER OR READ FROM
C COMMAND FILE.
C MAXFLG = IF KIND IS RETURNED SET TO 5, THEN MAXFLG IS
C RETURNED CONTAINING SUPSCRIPT OF LOCATIONS
C IN INILTR AND KNTLTR ARRAYS WHICH DESCRIBE
C RIGHTMOST COMPONENT OF SWITCH.
C INILTR = IF KIND IS RETURNED SET TO 5, THEN LOCATIONS
C IN INILTR ARRAY HAVING SUBSCRIPTS 1 THROUGH
C VALUE OF MAXFLG ARE RETURNED CONTAINING
C VALUES OF SUBSCRIPTS OF LOCATIONS WITHIN
C IBUFFR ARRAY AT WHICH EACH OF COMPONENTS OF
C SWITCH START.
C KNTLTR = IF KIND IS RETURNED SET TO 5, THEN LOCATIONS
C IN INILTR ARRAY HAVING SUBSCRIPTS 1 THROUGH
C VALUE OF MAXFLG ARE RETURNED CONTAINING
C NUMBER OF CHARACTERS WITHIN EACH OF
C COMPONENTS OF SWITCH. MISSING COMPONENT OF
C SWITCH IS INDICATED BY ZERO VALUE IN KNTLTR
C ARRAY.
C LCNOWN = IF KIND IS RETURNED SET TO 5, THEN LCNOWN IS
C RETURNED CONTAINING VALUE OF SUBSCRIPT OF
C LOCATIONS IN NEWNUL, NEWDSK, NEWNAM AND
C NEWPTH ARRAYS WHICH WILL DESCRIBE FILE
C SPECIFICATION WHEN KIND IS NEXT RETURNED SET
C TO EITHER 3 OR 4.
C
COMMON/FASPZ/KNTFIL,MANY,IEOF,IAFTER,LSTPTH,LSTDSK,
1LOWBFR
DIMENSION INILTR(MAXSTR),KNTLTR(MAXSTR),
1IBUFFR(MAXBFR),NEWNUL(MAXFIL),NEWDSK(MAXFIL),
2LETTER(8),KOLECT(10),NUMTWO(2)
DOUBLE PRECISION NEWNAM(MAXFIL),NEWPTH(3,MAXFIL),
1KOMAND,ONEPTH(3),LSTPTH(3),TWONUM,KMDNAM
EQUIVALENCE (TWONUM,NUMTWO),(NEWPRJ,NUMTWO(1)),
1(NEWUSR,NUMTWO(2))
DATA LETTER/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7/
DATA IBLANK,JBLANK,IDOT/1H ,5H ,1H./
C
C DECIDE WHETHER ARE STARTING OR CONTINUING EVALUATION
IF(KIND.EQ.5)GO TO 9
IF(KIND.GE.3)GO TO 30
LCNRIT=0
KNTFIL=0
IAFTER=0
MANY=0
IF(KIND.EQ.2)GO TO 9
C
C READ CONTENTS OF NEXT LINE
WRITE(JTTY,1)
1 FORMAT(2H *,$)
GO TO 4
2 WRITE(JTTY,3)
3 FORMAT(2H &,$)
4 READ(ITTY,5,END=10)IBUFFR
5 FORMAT(132A1)
IEOF=0
GO TO 7
6 READ(KMDNUM,5,END=10)IBUFFR
IEOF=1
7 LOWBFR=1
GO TO 9
8 LCNRIT=1
KNTFIL=0
C
C LOCATE NEXT FILE SPECIFICATION
9 CALL DAFLAG(1,1,MAXSTR,MAXBFR,IBUFFR,
1LOWBFR,MANY,KIND,INILTR,KNTLTR,MAXDSK,MAXNAM,
2MAXNUM,MAXFLG,KONTNT,MINPRT,MAXPRT)
GO TO(11,11,13,15,16,17,17,17),KIND
C
C END OF LINE, END OF FILE OR SEMICOLON FOUND
10 KIND=1
IEOF=0
11 IF(IAFTER.LT.0)GO TO 14
IF(IAFTER.EQ.1)GO TO 14
IF(KNTFIL.GT.0)GO TO 12
IF(LCNRIT.EQ.0)GO TO 15
IF(KIND.EQ.2)GO TO 37
IF(IEOF.EQ.0)GO TO 37
GO TO 6
12 IF(KIND.EQ.2)LOWBFR=LOWBFR-1
GO TO 29
C
C EQUAL SIGN FOUND
13 IF(IAFTER.GT.0)GO TO 27
MANY=-1
IAFTER=0
LCNRIT=-1
GO TO 9
C
C AMPERSAND FOUND OR MORE FILES NEEDED
14 KNTFIL=KNTFIL-1
MANY=-1
IAFTER=0
15 IF(KIND.EQ.2)GO TO 9
IF(IEOF.NE.0)GO TO 6
GO TO 2
C
C EXTRA COMMA FOUND
16 IF(IAFTER.GT.0)GO TO 27
KNTFIL=KNTFIL+1
NEWNUL(KNTFIL)=0
IAFTER=1
GO TO 19
C
C EVALUATE LOCATION AND REPACK DEVICE AND FILE NAME
17 IF(KONTNT.EQ.0)GO TO 20
IF(IAFTER.GT.0)GO TO 28
NXTFIL=KNTFIL+1
GO TO 38
18 IF(KONTNT.GE.16)GO TO 21
KNTFIL=NXTFIL
IAFTER=2
19 IF(LCNRIT.NE.0)GO TO 9
IF(KNTFIL.LT.MAXFIL)IAFTER=IAFTER-2
GO TO 9
C
C ALLOW CALLING PROGRAM TO EVALUATE SWITCH
20 LCNOWN=KNTFIL
KIND=5
IF(MANY.GT.0)GO TO 37
IF(IAFTER.GT.0)GO TO 28
MANY=-1
LCNOWN=LCNOWN+1
GO TO 37
C
C OPEN COMMAND FILE SPECIFIED BY USER
21 KOMAND=NEWNAM(NXTFIL)
IF(NEWNUL(NXTFIL).LE.1)ENCODE(10,22,KOMAND)
1KMDNAM,KMDEXT
IF(NEWNUL(NXTFIL).EQ.2)ENCODE(10,22,KOMAND)
1NEWNAM(NXTFIL),KMDEXT
22 FORMAT(1A6,1H.,1A3)
IF(NEWNUL(NXTFIL).EQ.4)ENCODE(10,23,KOMAND)
1KMDNAM,(KOLECT(I),I=8,10)
23 FORMAT(1A6,1H.,3A1)
INDISK=NEWDSK(NXTFIL)
IF(INDISK.EQ.JBLANK)INDISK=KMDDVC
DO 24 I=1,3
24 ONEPTH(I)=NEWPTH(I,NXTFIL)
OPEN(UNIT=KMDNUM,DEVICE=INDISK,FILE=KOMAND,
1DIRECTORY=ONEPTH,ACCESS=5HSEQIN,ERR=25)
GO TO 6
25 WRITE(JTTY,26)(IBUFFR(I),I=MINPRT,MAXPRT)
26 FORMAT(26H CANNOT READ COMMAND FROM ,100A1)
GO TO 2
C
C PREPARE TO RETURN RESULTS TO CALLING PROGRAM
27 MANY=-1
GO TO 29
28 LOWBFR=MINPRT
29 IAFTER=0
IF(LCNRIT.GT.0)GO TO 31
KIND=3
IF(LCNRIT.LT.0)GO TO 33
LCNRIT=1
GO TO 34
30 LCNRIT=LCNRIT+1
31 IF(LCNRIT.GT.KNTFIL)GO TO 8
KIND=4
IF(NEWNUL(LCNRIT).EQ.0)GO TO 37
IF(NEWDSK(LCNRIT).EQ.JBLANK)NEWDSK(LCNRIT)=LSTDSK
IF(NEWPTH(1,LCNRIT).NE.0)GO TO 34
DO 32 I=1,3
32 NEWPTH(I,LCNRIT)=LSTPTH(I)
GO TO 36
33 LCNRIT=KNTFIL
34 DO 35 I=1,3
35 LSTPTH(I)=NEWPTH(I,LCNRIT)
36 LSTDSK=NEWDSK(LCNRIT)
C
C RETURN TO CALLING PROGRAM
37 RETURN
C
C *****************************************************
C * *
C * A10 PACK NAME, A5 PACK DEVICE, EVALUATE NUMBERS *
C * *
C *****************************************************
C
C SET SWITCHES WHICH STATE IF ANYTHING WAS FOUND
38 NEWPRJ=0
NEWUSR=0
DO 39 I=1,3
39 NEWPTH(I,NXTFIL)=TWONUM
NEWNUL(NXTFIL)=0
NEWDSK(NXTFIL)=JBLANK
C
C PACK DEVICE NAME INTO A5 FORM
IF(MAXDSK.LT.1)GO TO 42
KOUNT=KNTLTR(1)
IF(KOUNT.LE.0)GO TO 42
IBGN=INILTR(1)
DO 40 I=1,5
KOLECT(I)=IBLANK
IF(KOUNT.GT.0)KOLECT(I)=IBUFFR(IBGN)
IBGN=IBGN+1
40 KOUNT=KOUNT-1
ENCODE(5,41,NEWDSK(NXTFIL))(KOLECT(I),I=1,5)
41 FORMAT(5A1)
NEWNUL(NXTFIL)=1
C
C EVALUATE OCTAL PROJECT, PROGRAMMER NUMBERS
42 INDEX=MAXNAM+1
IF(INDEX.GE.MAXNUM)GO TO 48
43 KOUNT=KNTLTR(INDEX)
IF(KOUNT.LE.0)GO TO 48
IBGN=INILTR(INDEX)
IEND=IBGN+KOUNT-1
NEWPRJ=NEWUSR
NEWUSR=0
DO 45 I=IBGN,IEND
LTRNOW=IBUFFR(I)
NEWUSR=8*NEWUSR
DO 44 J=1,8
IF(LETTER(J).NE.LTRNOW)GO TO 44
NEWUSR=NEWUSR+J-1
GO TO 45
44 CONTINUE
45 CONTINUE
IF(NEWUSR.LE.0)GO TO 48
INDEX=INDEX+1
IF(INDEX.LE.(MAXNAM+2))GO TO 43
NEWPTH(1,NXTFIL)=TWONUM
NEWNUL(NXTFIL)=1
C
C PACK SUB FILE DIRECTORY NAME
IF(MAXNUM.LE.(MAXNAM+2))GO TO 48
KOUNT=KNTLTR(MAXNAM+3)
IF(KOUNT.LE.0)GO TO 48
IBGN=INILTR(MAXNAM+3)
DO 46 I=1,6
KOLECT(I)=IBLANK
IF(KOUNT.GT.0)KOLECT(I)=IBUFFR(IBGN)
IBGN=IBGN+1
46 KOUNT=KOUNT-1
ENCODE(10,47,NEWPTH(2,NXTFIL))(KOLECT(I),I=1,6)
47 FORMAT(6A1,4X)
C
C PACK FILE NAME AND ITS EXTENSION INTO A10 FORM
48 DO 49 I=1,10
49 KOLECT(I)=IBLANK
IF(MAXNAM.LE.MAXDSK)GO TO 55
KOUNT=KNTLTR(MAXDSK+1)
IF(KOUNT.LE.0)GO TO 51
NEWNUL(NXTFIL)=2
IBGN=INILTR(MAXDSK+1)
IF(KOUNT.GT.6)KOUNT=6
DO 50 I=1,KOUNT
KOLECT(I)=IBUFFR(IBGN)
50 IBGN=IBGN+1
IF(MAXNAM.LE.(MAXDSK+1))GO TO 54
NEWNUL(NXTFIL)=3
KOUNT=KNTLTR(MAXDSK+2)
GO TO 52
51 IF(MAXNAM.LE.(MAXDSK+1))GO TO 55
KOUNT=KNTLTR(MAXDSK+2)
IF(KOUNT.LE.0)GO TO 55
NEWNUL(NXTFIL)=4
52 IBGN=INILTR(MAXDSK+2)
IF(KOUNT.GT.3)KOUNT=3
DO 53 I=8,10
IF(KOUNT.GT.0)KOLECT(I)=IBUFFR(IBGN)
IBGN=IBGN+1
53 KOUNT=KOUNT-1
54 KOLECT(7)=IDOT
55 ENCODE(10,56,NEWNAM(NXTFIL))KOLECT
56 FORMAT(10A1)
GO TO 18
C610045095007$&
END