Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0034/reusr4.for
There are 6 other files named reusr4.for in the archive. Click here to see a list.
SUBROUTINE REUSER
C RENBR(REUSR4/VAX11 FILE SPECIFICATION DIALOG)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS VERSION OF THE USER COMMAND DIALOG PROCESSOR
C FOR RENBR RUNS ON THE VAX11 COMPUTER. COMMANDS TYPED
C BY USER CONSIST OF THE SPECIFICATION OF THE OUTPUT
C RENUMBERED FILE AND/OR THE SPECIFICATION OF THE
C OUTPUT LISTING FILE, THEN AN EQUAL SIGN CHARACTER AND
C A LIST OF INPUT FILES USING 72 CHARACTERS OR LESS PER
C LINE. AN AMPERSAND OR A COMMA MUST TERMINATE THE
C LINE IF THE NEXT LINE CONTINUES THE COMMAND. THE
C COMMAND CAN BE READ FROM A FILE IF THE SPECIFICATION
C OF THE FILE IS TYPED WITH AN AT SIGN CHARACTER. THE
C FILE TYPES .FOR, .LPT, .FOR AND .RNB ARE THE DEFAULTS
C FOR THE RENUMBERING, THE LISTING, THE INPUT AND THE
C COMMAND FILES RESPECTIVELY. FILE SPECIFICATIONS CAN
C INCLUDE NODE, DEVICE, NAME, FILE TYPE, VERSION AND
C DIRECTORY. IF 2 OUTPUT NAMES ARE GIVEN, THEN A COMMA
C SHOULD SEPARATE THESE AND A SWITCH WITH AT LEAST 1
C MUST IMPLY USE. SWITCHES HAVE THE FORM
C /LETTER:NUMBER:NUMBER WHERE THE NUMBERS ARE OPTIONAL.
C THE TITLE FOR EACH PAGE CAN BE SPECIFIED BETWEEN
C APOSTROPHES AND IMPLIES THAT THE ASSOCIATED
C SPECIFICATION IS OF THE LISTING FILE. AFTER THE
C FILES SPECIFIED IN THE COMMAND HAVE BEEN PROCESSED,
C THEN RENBR WILL AGAIN ASK FOR ANOTHER COMMAND.
C TYPING A BLANK COMMAND TERMINATES PROCESSING.
C
COMMON/RNBONE/I ,IALPHA,IBASE ,IBR ,IBREAK,
1IEND ,IENTER,IEOF ,IERR ,IFILL ,IFORM ,IHIHDO,
2IIN ,ILEVEL,ILPT ,INCR ,INCSAV,INDENT,INITOC,
3INRCPY,INRFND,INIOPR,IOUT ,IPAGE ,IPASS ,ISPACE,
4ISPLIT,ISPR ,ISTART,ISTN ,ITAB ,ITBL ,ITITLE,
5ITTY ,J ,JBGN ,JBREAK,JEND ,JEOF ,JFORM ,
6JIN ,JIN1 ,JLEVEL,JMPBGN,JMPEND,JOUT ,JPASS ,
7JSPLIT,JSTN ,JTAB ,JTTY ,K ,KLEVEL,KNDGRP,
8KNT ,MAXPRT,KNTONE,KNTPNT,KNTSPL,KNTTOC,KNTTWO,
9KOMENT,KOMKNT,KOMNUM,KONTRL,KOUNT ,KPAGE
COMMON/RNBTWO/MASTER,KPYEND,KSTN ,KTAB ,KUTNUM,
1KUTPNT,KUTSPL,L ,LCLNUM,LCLPNT,LCLSPL,LEFT ,
2LIKE ,LMTTOC,LOW1 ,LOW2 ,LOWDO ,LOWER ,
3LPTTTY,LRGSPL,LRGNUM,LRGPNT,LRGTOC,LSTKNT,LSTN ,
4LSTSTN,LTAB ,M ,MANY ,MAXEND,MAXLIN,MAXPNT,
5MAXSPL,MAXTOC,MID ,MOST ,MOVE ,MSTN ,MTAB ,
6N ,NCD ,NEED ,NEWNUM,NEWSTN,NONFOR,
7NSTN ,NUM ,LOWTOC,NXTLST,IPOINT,JPOINT,NXTEND,
8KEND ,NTAB ,IFREAR,KPOINT,KBGN ,LEND ,LNGNAM,
9LOWSHO,ININAM,JTBL ,NOWTOC,LPOINT,INIPRT,JOBNUM
COMMON/RNBTHR/MODBAS,MODINC,MODMAX,MODMIN,MODNEW,
1MODOLD,KMDMIN,KMDMAX,ITRACE,LNGCOM,LNGNXT,KPASS
COMMON/RNBFOU/INRSTR(21) ,JPNT (10) ,MCHOPR(50) ,
1 NNEW (1000),NOLD (1000),NOTOPR(50) ,NUMPNT(5000),
2 NUMPRS(515) ,NUMTOC(112) ,NUMTYP(7) ,LINREF(9)
COMMON/RNBFIV/LTRCCC,LTRCLN,LTREQL,LTREXC,LTRHHH,
1LTRLFT,LTRMNS,LTRPLS,LTRQOT,LTRRIT,LTRSEM,LTRSLA,
2LTRSPC,LTRTAB,LWRCCC,LWRHHH,LTRNOW,LTR1ST,LTR2ND,
3LTRREF,LTRDDD,LWRDDD,LTREEE,LWREEE,LTRDOT,LTRSTR
COMMON/RNBSIX/LTRABC(26) ,LTRBGN(5) ,LTRBIG(2211),
1 LTRDGT(10) ,LTREND(3) ,LTRFLG(7) ,LTRKEY(5) ,
2 LTROPR(50) ,LTRPRS(247) ,LTRSPL(2000),LTRTOC(168) ,
3 LTRTOP(117) ,LTRTTL(5) ,LTRTYP(55) ,LTRUSE(6) ,
4 LWRABC(26) ,LWRBGN(5) ,LWREND(3) ,LWRFLG(7) ,
5 LWRKEY(5) ,LWRPRS(247) ,LWRTTL(5) ,LTRNAM(10) ,
6 LTRSRT(26) ,LWRSRT(26) ,LTR120(120)
C
C ITEMS WHICH MUST BE KEPT FROM LAST CALL OF REUSER
COMMON/RNBSEV/KIND,LCNRIT,LNGFIL(3)
COMMON/RNBEIG/LTRCMD(72),LTRFIL(60,3)
C
C ITEMS WHICH ARE NOT KEPT FROM LAST CALL OF REUSER
DIMENSION INILOC(3),KNTCHR(3)
DATA MAXFIL,MAXCHR,MAXSTR,MAXBFR/3,60,3,72/
DATA LTRMRK/1H'/
DATA ICMD/24/
C
C CLEAR DEFAULT VALUES
JPASS=1
IF(MASTER.LE.1)GO TO 1
CLOSE(UNIT=IIN)
GO TO 6
1 JIN=JTAB
JBGN=IFORM
JEND=JFORM
IF(MASTER.LE.0)GO TO 4
WRITE(ITTY,2)
2 FORMAT(14H RENBR (01/79)/17H Type /H for Help)
3 KIND=0
IF(MASTER.NE.1)KIND=1
4 IPAGE=0
ISPACE=0
INCR=0
IBASE=0
INDENT=0
ISPLIT=0
IFILL=0
ITAB=0
IFORM=JBGN
JFORM=JEND
JTAB=JIN
LTAB=0
ITBL=1
JMPEND=0
JMPBGN=0
KMDMIN=0
KMDMAX=0
KNDONE=0
KNDTWO=0
KNDTHR=0
LPTTTY=0
ITRACE=0
C
C INSERT DEFAULT TITLE SIMILAR TO 12-MAY-78 15:30
DO 5 I=1,54
5 LTRTOP(I)=LTRSPC
CALL REDATE(LTRTOP)
C
C GET NEXT COMPONENT OF COMMAND TYPED BY USER
6 CALL REFILE(MAXFIL,ITTY,JTTY,ICMD,MAXSTR,
1MAXBFR,MAXCHR,ITRACE,KIND,LTRFIL,LNGFIL,LCNRIT,
2LTRCMD,MAXFLG,INILOC,KNTCHR,LCNOWN)
GO TO(112,113,112,57,63,7),KIND
C
C DECIDE WHICH SWITCH WAS GIVEN
7 IF(MAXFLG.LE.0)GO TO 6
IF(KNTCHR(1).LE.0)GO TO 6
LOCFLG=INILOC(1)
LTRNOW=LTRCMD(LOCFLG)
KNDFLG=0
IF(LTRNOW.EQ.LTRMRK)GO TO 53
IF(MASTER.GT.1)GO TO 6
KNTFLG=1
8 KNDFLG=KNDFLG+1
IF(KNDFLG.GT.26)GO TO 6
IF(LTRABC(KNDFLG).EQ.LTRNOW)GO TO 9
IF(LWRABC(KNDFLG).NE.LTRNOW)GO TO 8
C GO TO( A, B, C, D, E, F, G, H, I, J,
C 1 K, L, M, N, O, P, Q, R, S, T,
C 2 U, V, W, X, Y, Z),KNDFLG
9 GO TO(26,16,12,26,21,21,21,56,17,21,
1 10,21,16,26,26,22,26,26,21,11,
2 13,14,26,26,26,15),KNDFLG
10 ISPLIT=0
GO TO 21
11 ITAB=1
GO TO 16
12 ITAB=0
GO TO 16
13 ITAB=-1
GO TO 16
14 LPTTTY=1
GO TO 21
15 ITRACE=1
GO TO 26
C
C MARK THAT FILE CONTAINS RENUMBERED PROGRAM
16 IF(INCR.EQ.0)INCR=1
17 GO TO(18,19,20),LCNOWN
18 IF(KNDONE.EQ.1)GO TO 26
IF(KNDONE.NE.3)KNDONE=KNDONE+1
GO TO 26
19 IF(KNDTWO.EQ.1)GO TO 26
IF(KNDTWO.NE.3)KNDTWO=KNDTWO+1
GO TO 26
20 IF(KNDTHR.EQ.1)GO TO 26
IF(KNDTHR.NE.3)KNDTHR=KNDTHR+1
GO TO 26
C
C MARK THAT FILE CONTAINS LISTING OF PROGRAM
21 IF(IPAGE.EQ.0)IPAGE=1
22 GO TO(23,24,25),LCNOWN
23 IF(KNDONE.LE.1)KNDONE=KNDONE+2
GO TO 26
24 IF(KNDTWO.LE.1)KNDTWO=KNDTWO+2
GO TO 26
25 IF(KNDTHR.LE.1)KNDTHR=KNDTHR+2
C
C EVALUATE NUMBERS IN RANGE OF SWITCH
26 IF(KNDFLG.LE.0)GO TO 6
LMTFLG=LOCFLG+KNTCHR(1)
LOCFLG=LOCFLG+1
27 NUMFLG=0
IF(LOCFLG.GE.LMTFLG)GO TO 29
LTRNOW=LTRCMD(LOCFLG)
IF(LTRNOW.EQ.LTRPLS)GO TO 30
IF(LTRNOW.EQ.LTRMNS)GO TO 30
DO 28 L=1,10
IF(LTRNOW.EQ.LTRDGT(L))GO TO 30
28 CONTINUE
29 IF(KNTFLG.GE.MAXFLG)GO TO 34
KNTFLG=KNTFLG+1
IF(KNTCHR(KNTFLG).LE.0)GO TO 34
LOCFLG=INILOC(KNTFLG)
LMTFLG=LOCFLG+KNTCHR(KNTFLG)
30 I=0
IF(LTRCMD(LOCFLG).EQ.LTRPLS)GO TO 31
IF(LTRCMD(LOCFLG).NE.LTRMNS)GO TO 32
I=1
31 LOCFLG=LOCFLG+1
32 IF(LOCFLG.GE.LMTFLG)GO TO 34
LTRNOW=LTRCMD(LOCFLG)
LOCFLG=LOCFLG+1
DO 33 L=1,10
IF(LTRDGT(L).NE.LTRNOW)GO TO 33
NUMFLG=(10*NUMFLG)+L-1
GO TO 32
33 CONTINUE
LOCFLG=LOCFLG-1
34 IF(I.EQ.0)GO TO 35
NUMFLG=-NUMFLG
IF(KNDFLG.NE.9)NUMFLG=0
C GO TO( A, B, C, D, E, F, G, H, I, J,
C 1 K, L, M, N, O, P, Q, R, S, T,
C 2 U, V, W, X, Y, Z,L/,J/,M/),KNDFLG
35 GO TO(37,39, 6, 6,51,48,38, 6,40,41,
1 6,49,42, 6, 6,36, 6, 6,52, 6,
2 6, 6,46, 6, 6, 6,47,43,44),KNDFLG
36 IPAGE=NUMFLG
IF(IPAGE.EQ.0)IPAGE=1
GO TO 6
37 INDENT=NUMFLG
IF(INDENT.EQ.0)INDENT=1
GO TO 6
38 ISPACE=NUMFLG
IF(ISPACE.EQ.0)ISPACE=1
GO TO 6
39 IBASE=NUMFLG
GO TO 6
40 INCR=NUMFLG
IF(INCR.EQ.0)INCR=1
GO TO 6
41 JMPBGN=NUMFLG
KNDFLG=28
GO TO 27
42 KMDMIN=NUMFLG
KNDFLG=29
GO TO 27
43 JMPEND=NUMFLG
GO TO 6
44 IF(NUMFLG.GT.0)GO TO 45
IF(KMDMIN.GT.0)NUMFLG=99999
IF(KMDMIN.EQ.0)KMDMIN=-1
45 IF(KMDMIN.EQ.0)KMDMIN=1
KMDMAX=NUMFLG
GO TO 6
46 JTAB=NUMFLG
IF(JTAB.EQ.0)JTAB=JIN
LTAB=1
GO TO 6
47 IF(NUMFLG.GT.10)IFORM=NUMFLG
GO TO 6
48 IFILL=0
GO TO 50
49 IFILL=1
50 JFORM=NUMFLG
IF(JFORM.LE.10)JFORM=JEND
IFORM=JBGN
IF(IFILL.EQ.0)GO TO 6
IF(ISPLIT.EQ.0)ISPLIT=1
KNDFLG=27
GO TO 27
51 ITBL=NUMFLG+1
IF(ITBL.EQ.1)ITBL=2
GO TO 6
52 ISPLIT=NUMFLG+1
GO TO 6
C
C TITLE IS ENCLOSED IN APOSTRPHES
53 IF(MASTER.LE.1)GO TO 54
IF(IPAGE.EQ.0)GO TO 6
54 LMTFLG=LOCFLG+KNTCHR(1)
DO 55 I=1,54
LTRTOP(I)=LTRSPC
LOCFLG=LOCFLG+1
55 IF(LOCFLG.LT.LMTFLG)LTRTOP(I)=LTRCMD(LOCFLG)
IF(MASTER.LE.1)GO TO 21
GO TO 6
C
C ISSUE HELP MESSAGE
56 CALL REHELP(ITTY)
GO TO 3
C
C SET DEFAULT OUPUT DEVICE NAMES AND PATHS
57 IF(IPAGE.NE.0)GO TO 58
IF(INCR.EQ.0)INCR=1
58 GO TO(63,59,62),LCNRIT
C
C SINGLE FILE LEFT OF EQUAL SIGN
59 IF(LNGFIL(1).EQ.0)GO TO 63
IF(KNDONE.GE.3)GO TO 74
IF(KNDONE.EQ.2)GO TO 61
IF(KNDONE.EQ.1)GO TO 60
IF(KNDTWO.EQ.2)GO TO 61
IF(KNDTWO.GE.3)GO TO 74
60 KNDONE=1
KNDTWO=0
GO TO 63
61 KNDONE=0
KNDTWO=1
GO TO 63
C
C TWO FILES LEFT OF EQUAL SIGN
62 IF(KNDONE.GE.3)GO TO 74
IF(KNDTWO.GE.3)GO TO 74
IF(KNDONE.EQ.KNDTWO)GO TO 74
IF(INCR.EQ.0)INCR=1
IF(IPAGE.EQ.0)IPAGE=1
IF(KNDONE.EQ.0)KNDONE=3-KNDTWO
IF(KNDTWO.EQ.0)KNDTWO=3-KNDONE
C
C OPEN FILES
63 IF(MASTER.GT.1)GO TO 65
IF(LNGFIL(LCNRIT).LE.0)GO TO 76
CALL REOPEN(2,IIN,LCNRIT,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 70
IF(INCR.EQ.0)GO TO 64
IF(KNDONE.GE.LCNRIT)KNDONE=0
CALL REOPEN(3,IOUT,KNDONE,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 66
IF(IPAGE.EQ.0)GO TO 78
64 IF(KNDTWO.GE.LCNRIT)KNDTWO=0
CALL REOPEN(4,ILPT,KNDTWO,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 68
GO TO 78
65 IF(LNGFIL(LCNRIT).EQ.0)GO TO 6
CALL REOPEN(5,IIN,LCNRIT,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 72
GO TO 114
C
C ERROR IN COMMAND TYPED BY USER
66 I=LNGFIL(KNDONE)
WRITE(ITTY,67)(LTRFIL(J,KNDONE),J=1,I)
67 FORMAT(30H Cannot write renumbered file ,100A1)
GO TO 3
68 I=LNGFIL(KNDTWO)
WRITE(ITTY,69)(LTRFIL(J,KNDTWO),J=1,I)
69 FORMAT(27H Cannot write listing file ,100A1)
GO TO 3
70 I=LNGFIL(LCNRIT)
WRITE(ITTY,71)(LTRFIL(J,LCNRIT),J=1,I)
71 FORMAT(25H Cannot read source file ,100A1)
GO TO 3
72 I=LNGFIL(LCNRIT)
WRITE(ITTY,73)(LTRFIL(J,LCNRIT),J=1,I)
73 FORMAT(25H Cannot read source file ,100A1)
GO TO 6
74 WRITE(ITTY,75)
75 FORMAT(31H Ambiguous output specification)
GO TO 3
76 WRITE(ITTY,77)
77 FORMAT(34H 1st source file must be specified)
GO TO 3
C
C REPORT OPTIONS SELECTED
78 IF(INDENT.GT.0)WRITE(ITTY,79)INDENT
79 FORMAT(4X,16HAdd Block Indent,1I5)
IF(LTAB.NE.0)WRITE(ITTY,80)JTAB
80 FORMAT(2X,18HWidth OF Tab Stops,1I5)
IF(IPAGE.EQ.0)GO TO 94
WRITE(ITTY,81)
81 FORMAT(10X,15HListing Options)
I=54
82 IF(LTRTOP(I).NE.LTRSPC)GO TO 83
I=I-1
IF(I.GT.0)GO TO 82
GO TO 85
83 WRITE(ITTY,84)(LTRTOP(J),J=1,I)
84 FORMAT(15X,6HTitle ,54A1)
85 WRITE(ITTY,86)IPAGE
86 FORMAT(9X,11HPage Number,1I5)
IF(ISPACE.NE.0)WRITE(ITTY,87)ISPACE
87 FORMAT(2X,18HGap Interstatement,1I5)
IF(IFILL.EQ.0)WRITE(ITTY,88)JFORM
88 FORMAT(10X,10HForm Feeds,1I5)
IF(IFILL.NE.0)WRITE(ITTY,89)JFORM,IFORM
89 FORMAT(10X,10HLine Feeds,1I5,1H:,1I5)
IF((JMPBGN+JMPEND).NE.0)WRITE(ITTY,90)JMPBGN,JMPEND
90 FORMAT(2X,18HJump at Top/Bottom,1I5,1H:,1I5)
IF(ISPLIT.EQ.0)WRITE(ITTY,91)
91 FORMAT(3X,17HKeep Lines Intact)
I=ISPLIT-1
IF(ISPLIT.NE.0)WRITE(ITTY,92)I
92 FORMAT(4X,16HSplit Long Lines,1I5)
I=ITBL-1
IF(I.NE.0)WRITE(ITTY,93)I
93 FORMAT(1X,19HExtra Table Content,1I5)
IF(INCR.EQ.0)GO TO 106
94 WRITE(ITTY,95)
95 FORMAT(6X,19HRenumbering Options)
IF(KMDMIN.GT.0)GO TO 97
IF(KMDMIN.EQ.0)GO TO 99
WRITE(ITTY,96)
96 FORMAT(2X,18HMaintain Numbering)
GO TO 102
97 WRITE(ITTY,98)KMDMIN,KMDMAX
98 FORMAT(3X,17HModify Only Range,1I5,1H:,1I5)
99 WRITE(ITTY,100)INCR
100 FORMAT(11X,9HIncrement,1I5)
IF(IBASE.NE.0)WRITE(ITTY,101)IBASE
101 FORMAT(16X,4HBase,1I5)
102 IF(ITAB.LT.0)WRITE(ITTY,103)
103 FORMAT(20H Uniform Left Margin)
IF(ITAB.EQ.0)WRITE(ITTY,104)
104 FORMAT(7X,13HColumn Format)
IF(ITAB.GT.0)WRITE(ITTY,105)
105 FORMAT(10X,10HTab Format)
C
C POSITION PAPER IF TELETYPE OUTPUT
106 IF(IPAGE.EQ.0)GO TO 110
IF(LPTTTY.EQ.0)GO TO 110
IF(IFILL.EQ.0)GO TO 110
WRITE(ITTY,107)
107 FORMAT(1X/15H Position paper,
137H (carriage return or local line feed)/
230H then type non-space character,
320H and carriage return)
108 READ(JTTY,109)LTRNOW
109 FORMAT(1A1)
IF(LTRNOW.EQ.LTRSPC)GO TO 108
GO TO 114
110 WRITE(ITTY,111)
111 FORMAT(1H )
GO TO 114
C
C RETURN TO MAIN PROGRAM
112 IF(MASTER.LE.1)GO TO 3
113 JPASS=0
114 RETURN
C526075227265':
END
SUBROUTINE REFILE(MAXFIL, ITTY, JTTY, ICMD,MAXSTR,
1 MAXBFR,MAXCHR,ITRACE, KIND,LTRFIL,LNGFIL,LCNRIT,
2 LTRCMD,MAXFLG,INILOC,KNTCHR,LCNOWN)
C RENBR(REFIL4/VAX11 STORE OUTPUT AND INPUT FILE NAMES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C MAXFIL = 1 MORE THAN NUMBER OF FILE SPECIFICATIONS
C WHICH CAN APPEAR TO LEFT OF EQUAL SIGN.
C THIS IS MAXIMUM VALUE OF SUBSCRIPT OF LNGFIL
C ARRAY AND MAXIMUM VALUE OF SECOND SUBSCRIPT
C OF LTRFIL ARRAY.
C ITTY = NUMBER OF UNIT TO WHICH TERMINAL OUTPUT IS
C TO BE WRITTEN.
C JTTY = NUMBER OF UNIT FROM WHICH TERMINAL INPUT IS
C TO BE READ.
C ICMD = NUMBER OF UNIT FROM WHICH COMMAND FILE
C INDICATED BY AT SIGN IS TO BE READ.
C MAXSTR = DIMENSION OF INILOC AND KNTCHR ARRAYS IN
C WHICH DESCRIPTIONS OF COMPONENTS OF SWITCHES
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 3.
C MAXBFR = DIMENSION OF LTRCMD 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 MAXCHR = MAXIMUM NUMBER OF CHARACTERS WHICH CAN BE
C STORED IN ANY ONE FILE SPECIFICATION.
C MAXCHR IS FIRST DIMENSION OF LTRFIL ARRAY.
C ITRACE = 0, INPUT IF DESCRIPTIONS OF FILES ARE NOT TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
C = 1, INPUT IF USER SELECTS /Z SWITCH
C INDICATING THAT DESCRIPTIONS OF FILES ARE TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
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 KIND WAS INPUT CONTAINING THE
C VALUE 1 OR 2 AND THE NEXT LINE TYPED BY THE
C USER IS EMPTY.
C = 3, 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 = 4, 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 = 5, 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 = 6, RETURNED IF THIS ROUTINE IS RETURNING
C DESCRIPTION OF SWITCH IN INITAL AND LENGTH
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 4 OR 5.
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 LTRFIL = IF KIND IS RETURNED SET TO EITHER 4 OR 5,
C THEN LOCATIONS IN LTRFIL ARRAY HAVING SECOND
C SUBSCRIPTS 1 THROUGH LCNRIT ARE RETURNED
C CONTAINING THE CHARACTERS FORMING THE FILE
C SPECIFICATIONS AS TYPED BY THE USER.
C LGNFIL = IF KIND IS RETURNED SET TO EITHER 4 OR 5,
C THEN THE LNGFIL ARRAY CONTAINS THE NUMBER OF
C CHARACTERS IN EACH OF THE FILE
C SPECIFICATIONS RETURNED IN THE LTRFIL ARRAY.
C LCNRIT = IF KIND IS RETURNED SET TO EITHER 4 OR 5,
C THEN LCNRIT IS RETURNED CONTAINING VALUE OF
C SUBSCRIPT OF LOCATIONS IN LNGFIL ARRAY AND
C SECOND SUBSCRIPT OF LOCATIONS IN LTRFIL
C ARRAY WHICH DESCRIBE FILE SPECIFICATION
C WHICH APPEARS TO RIGHT OF EQUAL SIGN. IF
C KIND IS RETURNED SET TO 4 AND IF LCNRIT IS
C GREATER THAN ONE, THEN LOWER LOCATIONS IN
C THESE ARRAYS DESCRIBE FILE SPECIFICATIONS
C APPEARING TO LEFT OF EQUAL SIGN. IF KIND IS
C RETURNED SET TO 5, THEN LOCATIONS WITHIN
C THESE ARRAYS HAVING LOWER SUBSCRIPTS SHOULD
C BE IGNORED.
C LTRCMD = 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 6, THEN MAXFLG IS
C RETURNED CONTAINING SUPSCRIPT OF LOCATIONS
C IN INILOC AND KNTCHR ARRAYS WHICH DESCRIBE
C RIGHTMOST COMPONENT OF SWITCH.
C INILOC = IF KIND IS RETURNED SET TO 6, THEN LOCATIONS
C IN INILOC ARRAY HAVING SUBSCRIPTS 1 THROUGH
C VALUE OF MAXFLG ARE RETURNED CONTAINING
C VALUES OF SUBSCRIPTS OF LOCATIONS WITHIN
C LTRCMD ARRAY AT WHICH EACH OF COMPONENTS OF
C SWITCH START.
C KNTCHR = IF KIND IS RETURNED SET TO 6, THEN LOCATIONS
C IN INILOC 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 KNTCHR
C ARRAY.
C LCNOWN = IF KIND IS RETURNED SET TO 6, THEN LCNOWN IS
C RETURNED CONTAINING VALUE OF SUBSCRIPT OF
C LOCATIONS IN LNGFIL AND LTRFIL ARRAYS WHICH
C WILL DESCRIBE FILE SPECIFICATION WHEN KIND
C IS NEXT RETURNED SET TO EITHER 4 OR 5.
C
COMMON/RNBNIN/KNTFIL,MANY,IEOF,IAFTER,LOWBFR
DIMENSION LTRFIL(MAXCHR,MAXFIL),LNGFIL(MAXFIL)
DIMENSION INILOC(MAXSTR),KNTCHR(MAXSTR),
1LTRCMD(MAXBFR),
2KOLECT(10),NUMTWO(2)
C
C DECIDE WHETHER ARE STARTING OR CONTINUING EVALUATION
INIKND=KIND
IF(KIND.EQ.6)GO TO 9
IF(KIND.GE.4)GO TO 30
LCNRIT=0
KNTFIL=0
IAFTER=0
MANY=0
IF(KIND.EQ.3)GO TO 9
C
C READ CONTENTS OF NEXT LINE
WRITE(ITTY,1)
1 FORMAT(2H *,$)
GO TO 4
2 WRITE(ITTY,3)
3 FORMAT(2H &,$)
4 READ(JTTY,5,END=10)LTRCMD
5 FORMAT(132A1)
IEOF=0
GO TO 7
6 READ(ICMD,5,END=10)LTRCMD
IEOF=1
7 LOWBFR=1
GO TO 9
8 LCNRIT=1
KNTFIL=0
C
C LOCATE NEXT FILE SPECIFICATION
9 CALL REFLAG(1,MAXSTR,MAXBFR,LTRCMD,
1LOWBFR,MANY,KIND,INILOC,KNTCHR,MAXNAM,
2MAXFLG,KONTNT,MINPRT)
GO TO(11,11,14,16,18,19),KIND
C
C END OF LINE, END OF FILE OR SEMICOLON FOUND
10 KIND=1
IEOF=0
11 IF(IAFTER.LT.0)GO TO 15
IF(IAFTER.EQ.1)GO TO 15
IF(KNTFIL.GT.0)GO TO 13
IF(LCNRIT.EQ.0)GO TO 17
IF(KIND.EQ.2)GO TO 12
IF(IEOF.EQ.0)GO TO 33
GO TO 6
12 KIND=3
GO TO 33
13 IF(KIND.EQ.2)LOWBFR=LOWBFR-1
GO TO 29
C
C EQUAL SIGN FOUND
14 IF(IAFTER.GT.0)GO TO 27
MANY=-1
IAFTER=0
LCNRIT=-1
GO TO 9
C
C AMPERSAND FOUND OR MORE FILES NEEDED
15 KNTFIL=KNTFIL-1
MANY=-1
IAFTER=0
16 INIKND=0
17 IF(KIND.EQ.2)GO TO 9
IF(IEOF.NE.0)GO TO 6
IF(INIKND.LE.0)GO TO 2
IF(INIKND.GT.2)GO TO 2
KIND=2
GO TO 33
C
C EXTRA COMMA FOUND
18 IF(IAFTER.GT.0)GO TO 27
KNTFIL=KNTFIL+1
LNGFIL(KNTFIL)=0
IAFTER=1
GO TO 22
C
C STORE FILE SPECIFICATION
19 IF(KONTNT.EQ.0)GO TO 23
IF(IAFTER.GT.0)GO TO 28
NXTFIL=KNTFIL+1
LNGFIL(NXTFIL)=0
IF(MAXNAM.LE.0)GO TO 21
J=KNTCHR(1)
IF(J.GT.MAXCHR)J=MAXCHR
IF(J.LE.0)GO TO 21
LNGFIL(NXTFIL)=J
K=INILOC(1)
DO 20 I=1,J
LTRFIL(I,NXTFIL)=LTRCMD(K)
20 K=K+1
21 IF(KONTNT.GE.2)GO TO 24
KNTFIL=NXTFIL
IAFTER=2
22 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
23 LCNOWN=KNTFIL
KIND=6
IF(MANY.GT.0)GO TO 33
IF(IAFTER.GT.0)GO TO 28
MANY=-1
LCNOWN=LCNOWN+1
GO TO 33
C
C OPEN COMMAND FILE SPECIFIED BY USER
24 CALL REOPEN(1,ICMD,NXTFIL,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,I,IERR)
IF(IERR.EQ.0)GO TO 6
J=LNGFIL(NXTFIL)
IF(J.LE.0)GO TO 26
WRITE(ITTY,25)(LTRFIL(I,NXTFIL),I=1,J)
25 FORMAT(26H Cannot read command file ,100A1)
GO TO 2
26 WRITE(ITTY,25)
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=4
IF(LCNRIT.LT.0)GO TO 32
LCNRIT=1
GO TO 33
30 LCNRIT=LCNRIT+1
31 IF(LCNRIT.GT.KNTFIL)GO TO 8
KIND=5
GO TO 33
32 LCNRIT=KNTFIL
C
C RETURN TO CALLING PROGRAM
33 RETURN
C696002136255$&
END
SUBROUTINE REFLAG(LOWSTR,MAXSTR,MAXBFR,LTRCMD,LOWBFR,
1 MANY ,KIND ,INILOC,KNTCHR,MAXNAM,MAXFLG,KONTNT,
2 MINPRT)
C RENBR(REFLG4/VAX11 FIND SWITCHES AND FILE NAMES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C ROUTINE TO LOCATE FILE SPECIFICATIONS AND SWITCHES IN
C TEXT TYPED BY USER. THE FILE SPECIFICATION OR THE
C COMPONENTS OF THE SWITCH FIELD ARE IDENTIFIED BY
C LOCATION AND LENGTH IN THE BUFFER.
C
C THE FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT.
C
C LOWSTR = SUBSCRIPT OF FIRST LOCATION WITHIN INILOC
C AND KNTCHR WHICH CAN BE USED TO HOLD
C POSITION AND LENGTH OF FILE SPECIFICATION OR
C OF COMPONENTS OF SWITCH.
C MAXSTR = SUBSCRIPT OF FINAL LOCATION WITHIN INILOC
C AND KNTCHR WHICH CAN BE USED TO HOLD
C POSITION AND LENGTH OF FILE SPECIFICATION OR
C OF COMPONENTS OF SWITCH.
C MAXBFR = SUBSCRIPT OF LOCATION WITHIN LTRCMD ARRAY
C WHICH CONTAINS RIGHTMOST CHARACTER TYPED BY
C USER.
C
C FOLLOWING ARGUMENTS ARE USED FOR BOTH INPUT TO, AND
C OUTPUT FROM THIS ROUTINE.
C
C LTRCMD = ARRAY CONTAINING IN LOCATIONS LTRCMD(LOWBFR)
C THROUGH LTRCMD(MAXBFR) CHARACTERS READ BY
C CALLING PROGRAM WITH MULTIPLE OF A1 FORMAT
C AND WHICH CAN FORM FILE SPECIFICATION.
C CONTENTS OF LTRCMD ARRAY ARE RETURNED
C UNCHANGED, WITH EXCEPTION THAT PORTION OF
C TEXT STRING TO RIGHT OF ADJACENT APOSTROPHES
C IS MOVED 1 CHARACTER TO LEFT.
C LOWBFR = SUBSCRIPT OF FIRST (LEFTMOST) LOCATION
C WITHIN LTRCMD ARRAY WHICH CONTAINS CHARACTER
C WHICH CAN BE PART OF FILE SPECIFICATION.
C LOWBFR IS RETURNED POINTING TO FIRST
C CHARACTER WHICH SHOULD BE EVALUATED BY
C SUBSEQUENT CALL TO THIS ROUTINE, OR ELSE IS
C RETURNED POINTING BEYOND END OF BUFFER IF
C BUFFER IS EMPTY OR IF BUFFER CONTAINS MERELY
C COMMENT.
C MANY = SHOULD BE INPUT CONTAINING ZERO EACH TIME
C THIS ROUTINE IS CALLED TO BEGIN PROCESSING
C OF A NEW LOGICAL SECTION OF TEXT, AS FOR
C EXAMPLE WHEN BEGINNING PROCESSING OF A LINE
C OF TEXT NOT TIED TO THE PREVIOUS LINE BY AN
C AMPERSAND AT THE END OF THE PREVIOUS LINE,
C OR WHEN PROCESSING THE TEXT TO THE RIGHT OF
C A SEMICOLON OR TO THE RIGHT OF AN EQUALS
C SIGN.
C = RETURNED CONTAINING THE VALUE WHICH MANY
C SHOULD HAVE WHEN THIS ROUTINE OR ANY OTHER
C IN THE FASP PACKAGE HAVING MANY AS AN
C ARGUMENT IS NEXT CALLED. THE RETURNED VALUE
C OF MANY SHOULD NOT BE CHANGED BY THE CALLING
C PROGRAM UNLESS THE INTERPRETATION OF THE
C CONTENTS OF THE BUFFER IS BEING ABANDONED
C PREMATURELY, IN WHICH CASE MANY SHOULD BE
C RESET TO HAVE A ZERO VALUE.
C = -1, RETURNED IF A MISSING ITEM IS TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA OR FINDS THAT THE BUFFER
C CONTAINS NOTHING OTHER THAN A POSSIBLE
C COMMENT. MANY IS RETURNED CONTAINING -1 IF
C A COMMA PRECEDES EITHER AN AMPERSAND OR A
C SWITCH FIELD.
C = 0, RETURNED IF A MISSING ITEM IS TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA, BUT A MISSING ITEM IS NOT
C INDICATED IF THE BUFFER CONTAINS NOTHING
C OTHER THAN A POSSIBLE COMMENT. MANY IS
C RETURNED CONTAINING ZERO IF BUFFER IS FOUND
C TO BE EMPTY, OR IF FIRST PRINTING CHARACTER
C AT OR TO RIGHT OF LTRCMD(LOWBFR) IS FOUND TO
C BE EXCLAMATION POINT, SEMICOLON OR EQUALS
C SIGN. THESE ARE ALL CONDITIONS UNDER WHICH
C NEXT CALL TO THIS ROUTINE WOULD EVALUATE
C START OF NEW GROUP OF FILE SPECIFICATIONS.
C MANY IS RETURNED UNCHANGED IF A SWITCH FIELD
C IS FOUND AT THE START OF THE CONTENTS OF THE
C BUFFER.
C = 1, RETURNED IF A MISSING ITEM IS NOT TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA OR FINDS THAT THE BUFFER
C CONTAINS NOTHING OTHER THAN A POSSIBLE
C COMMENT. MANY IS RETURNED CONTAINING ONE IF
C A FILE SPECIFICATION CONSISTING OF MORE THAN
C JUST A SWITCH FIELD IS FOUND, OR IF A
C MISSING ITEM IS BEING INDICATED.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT. THEIR
C INPUT VALUES ARE IGNORED.
C
C KIND = RETURNED DESCRIBING TYPE OF ITEM
C ENCOUNTERED.
C = 1, NOTHING, EXCEPT POSSIBLY COMMENT
C INDICATED BY LEADING EXCLAMATION POINT, WAS
C FOUND AT OR TO RIGHT OF LTRCMD(LOWBFR).
C LOWBFR IS RETURNED POINTING BEYOND END OF
C BUFFER.
C = 2, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF LTRCMD(LOWBFR) IS SEMICOLON. LOWBFR IS
C RETURNED POINTING TO CHARACTER TO RIGHT OF
C SEMICOLON. IT IS SUGGESTED THAT CALLING
C PROGRAM TREAT THIS AS INDICATION BY USER
C THAT PRECEDING COMMAND HAS BEEN COMPLETED
C AND THAT SUBSEQUENT COMMAND WILL FOLLOW ON
C SAME LINE.
C = 3, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF LTRCMD(LOWBFR) IS EQUALS SIGN. LOWBFR IS
C RETURNED POINTING TO CHARACTER TO RIGHT OF
C EQUALS SIGN.
C = 4, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF LTRCMD(LOWBFR) IS AMPERSAND. CHARACTERS
C TO RIGHT OF AMPERSAND ARE TAKEN TO BE
C COMMENT. LOWBFR IS RETURNED POINTING BEYOND
C END OF BUFFER. IT IS SUGGESTED THAT CALLING
C PROGRAM TREAT THIS AS REQUEST BY USER THAT
C COMMAND BE CONTINUED ON FOLLOWING LINE.
C EFFECT IS NOT QUITE SAME AS IF USER HAD
C TYPED ALL OF FILE SPECIFICATIONS ON SINGLE
C LINE SINCE FILE SPECIFICATION CANNOT BE
C SPLIT ACROSS LINE BOUNDARY.
C = 5, MISSING FILE SPECIFICATION WAS INDICATED
C BY AN EXTRA COMMA.
C = 6, FILE SPECIFICATION IS BEING RETURNED IF
C MAXNAM IS RETURNED EQUAL TO LOWSTR, OR
C SWITCH IS RETURNED IF MAXFLG IS RETURNED SET
C GREATER THAN OR EQUAL TO LOWSTR.
C INILOC = IF KIND IS RETURNED CONTAINING 6 AND MAXNAM
C IS RETURNED SET EQUAL TO LOWSTR, THEN
C INILOC(LOWSTR) IS RETURNED CONTAINING THE
C SUBSCRIPT OF THE LTRCMD ARRAY LOCATION WHICH
C CONTAINS THE FIRST PRINTING CHARACTER OF THE
C FILE SPECIFICATION AND KNTCHR(LOWSTR) IS
C RETURNED CONTAINING THE NUMBER OF CHARACTERS
C (INCLUDING EMBEDDED SPACES) IN THE FILE
C SPECIFICATION.
C = IF KIND IS RETURNED CONTAINING 6 AND MAXFLG
C IS RETURNED SET TO LOWSTR OR GREATER, THEN
C LOCATIONS INILOC(LOWSTR) THROUGH
C INILOC(MAXFLG) CONTAIN LOCATIONS IN BUFFER
C OF INITIAL CHARACTERS OF WORDS IN SWITCH
C FIELD, AND LOCATIONS KNTCHR(LOWSTR) THROUGH
C KNTCHR(MAXFLG) CONTAINING NUMBERS OF
C CHARACTERS IN WORDS IN SWITCH FIELD. IF A
C TEXT STRING DELIMITED BY APOSTROPHES IS
C FOUND, THEN MAXFLG WILL BE RETURNED SET TO
C LOWSTR, AND THE INITIAL APOSTROPHE WILL BE
C POINTED TO BY INILOC(LOWSTR).
C KNTCHR = ARRAY RETURNED CONTAINING NUMBERS OF
C CHARACTERS IN EACH OF WORDS FOR WHICH FIRST
C CHARACTERS ARE IN BUFFER LOCATIONS INDICATED
C BY VALUES IN INILOC ARRAY. SUBSCRIPTS OF
C INILOC ARRAY AND KNTCHR ARRAY LOCATIONS
C DESCRIBING PARTICULAR WORD ARE IDENTICAL.
C MAXNAM = RETURNED SET TO LOWSTR-1 IF A FILE
C SPECIFICATION WAS NOT FOUND.
C = RETURNED SET TO LOWSTR IF A FILE
C SPECIFICATION WAS FOUND.
C MAXFLG = RETURNED SET TO LOWSTR-1 IF A SWITCH FIELD
C OR TEXT STRING DELIMITED BY APOSTROPHES WAS
C NOT FOUND.
C = IF A SWITCH FIELD OR TEXT STRING DELIMITED
C BY APOSTROPHES WAS FOUND, THEN MAXFLG IS
C RETURNED CONTAINING SUBSCRIPT OF INILOC AND
C KNTCHR ARRAY LOCATIONS DESCRIBING RIGHTMOST
C WORD OF SWITCH FIELD.
C KONTNT = 0, NEITHER FILE SPECIFICATION NOR AT SIGN
C FOUND.
C = 1, FILE SPECIFICATION BUT NOT AT SIGN FOUND.
C = 2, AT SIGN BUT NOT FILE SPECIFICATION FOUND.
C = 3, BOTH FILE SPECIFICATION AND AT SIGN
C FOUND.
C MINPRT = SUBSCRIPT OF LTRCMD ARRAY LOCATION WHICH
C CONTAINS FIRST CHARACTER OF FILE
C SPECIFICATION OR SWITCH IF KIND IS RETURNED
C CONTAINING VALUE OF 6.
C
DIMENSION KNTCHR(MAXSTR),INILOC(MAXSTR),
1LTRCMD(MAXBFR)
C
DATA LTROPN,LTRCLS/1H[,1H]/
C
DATA LTRCLN,LTRCMA,LTRSLA,LTRQOT,LTRSEM,
1LTRAND,LTREXC,LTREQL,LTRATS,LTRSPC,LTRTAB/1H:,
21H,,1H/,1H',1H%,1H&,1H!,1H=,1H@,1H ,1H /
DATA LTRLES,LTRGRT/1H<,1H>/
C
C MAJOR = -2 OR LESS, NAME IN RANGE OF LEFT BRACKET
C = -1, NAME BUT NOT IN RANGE OF LEFT BRACKET
C = 0, NEITHER NAME OR SWITCH FOUND YET
C = 1, AFTER SLASH OR COLON AFTER SLASH
C
MAXNAM=0
MAXFLG=0
KONTNT=0
KIND=1
MAJOR=0
IF(MANY.GE.0)GO TO 3
KIND=5
MANY=1
GO TO 3
1 KOUNT=0
INIBFR=LOWBFR
2 LOWBFR=LOWBFR+1
3 IF(LOWBFR.GT.MAXBFR)GO TO 24
LTRNOW=LTRCMD(LOWBFR)
IF(LTRNOW.EQ.LTRSPC)GO TO 2
IF(LTRNOW.EQ.LTRTAB)GO TO 2
IF(MAJOR.EQ.0)MINPRT=LOWBFR
C
C CHECK FOR GENERAL PUNCTUATION CHARACTERS
IF(LTRNOW.EQ.LTRSEM)GO TO 19
IF(LTRNOW.EQ.LTRAND)GO TO 22
IF(LTRNOW.EQ.LTREXC)GO TO 23
IF(LTRNOW.EQ.LTREQL)GO TO 20
IF(LTRNOW.EQ.LTRSLA)GO TO 16
IF(LTRNOW.EQ.LTRATS)GO TO 14
IF(LTRNOW.EQ.LTRQOT)GO TO 9
IF(MAJOR.LT.-1)GO TO 8
IF(LTRNOW.EQ.LTRCMA)GO TO 18
IF(MAJOR.EQ.0)GO TO 4
IF(KOUNT.GT.0)GO TO 5
4 INIBFR=LOWBFR
IF(MAJOR.LE.0)GO TO 7
5 IF(MAJOR.LE.0)GO TO 8
C
C EXTEND SWITCH FIELD
6 IF(LTRNOW.EQ.LTRCLN)GO TO 26
IF((INIBFR+KOUNT).LT.LOWBFR)GO TO 24
KOUNT=KOUNT+1
GO TO 2
C
C FIRST CHARACTER IN NAME
7 INDRCT=MANY
IF(KIND.EQ.5)INDRCT=-1
MANY=1
KIND=6
MAJOR=-1
C
C EXTEND NAME
8 KOUNT=LOWBFR-INIBFR+1
IF(LTRNOW.EQ.LTROPN)MAJOR=MAJOR-1
IF(LTRNOW.EQ.LTRCLS)MAJOR=MAJOR+1
IF(LTRNOW.EQ.LTRLES)MAJOR=MAJOR-1
IF(LTRNOW.EQ.LTRGRT)MAJOR=MAJOR+1
IF(MAJOR.GE.0)MAJOR=-1
GO TO 2
C
C APOSTROPHE STARTS TEXT STRING
9 IF(MAJOR.NE.0)GO TO 24
IF(KIND.EQ.5)MANY=-1
KIND=6
INIBFR=LOWBFR
I=LOWBFR
MIDPRT=LOWBFR
10 IF(I.GE.MAXBFR)GO TO 12
I=I+1
LOWBFR=LOWBFR+1
LTRCMD(LOWBFR)=LTRCMD(I)
IF(LTRCMD(I).EQ.LTRSPC)GO TO 10
IF(LTRCMD(I).EQ.LTRTAB)GO TO 10
MIDPRT=LOWBFR
IF(LTRCMD(I).NE.LTRQOT)GO TO 10
IF(I.GE.MAXBFR)GO TO 11
IF(LTRCMD(I+1).NE.LTRQOT)GO TO 11
I=I+1
GO TO 10
11 MIDPRT=MIDPRT-1
12 KOUNT=MIDPRT-INIBFR+1
13 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.I)GO TO 26
LTRCMD(LOWBFR)=LTRSPC
GO TO 13
C
C AT SIGN
14 IF(MAJOR.GT.0)GO TO 24
IF(KONTNT.GE.2)GO TO 24
KONTNT=KONTNT+2
IF(MAJOR.EQ.0)GO TO 15
MANY=INDRCT
GO TO 24
15 MAJOR=-1
GO TO 17
C
C INITIAL SLASH FOUND
16 IF(MAJOR.NE.0)GO TO 24
MAJOR=1
17 IF(KIND.EQ.5)MANY=-1
KIND=6
GO TO 1
C
C COMMA FOUND OTHER THAN IN NUMBER SECTION
18 IF(KIND.NE.1)GO TO 24
KIND=5
IF(MANY.GT.0)GO TO 2
GO TO 29
C
C SEMICOLON FOUND
19 IF(KIND.NE.1)GO TO 24
KIND=2
GO TO 21
C
C EQUALS SIGN FOUND
20 IF(KIND.NE.1)GO TO 24
KIND=3
21 LOWBFR=LOWBFR+1
GO TO 29
C
C AMPERSAND FOUND
22 IF(MAJOR.NE.0)GO TO 24
IF(KIND.EQ.5)MANY=-1
KIND=4
C
C EXCLAMATION POINT FOUND
23 LOWBFR=MAXBFR+1
C
C TERMINATE GROUP OF NAMES OR NUMBERS
24 IF(MAJOR.EQ.0)GO TO 29
IF(MAJOR.GT.0)GO TO 25
IF(KONTNT.EQ.0)KONTNT=1
IF(KONTNT.EQ.2)KONTNT=3
MAXNAM=1
KNTCHR(1)=KOUNT
INILOC(1)=INIBFR
GO TO 29
25 MAJOR=0
26 IF(MAXFLG.GE.MAXSTR)GO TO 28
MAXFLG=MAXFLG+1
27 KNTCHR(MAXFLG)=KOUNT
INILOC(MAXFLG)=INIBFR
28 IF(MAJOR.GT.0)GO TO 1
C
C RETURN TO CALLING PROGRAM
29 IF(KIND.EQ.5)MANY=1
IF(KIND.LT.4)MANY=0
RETURN
C842125602122[]:'%&!@<>
END
SUBROUTINE REOPEN(KNDFIL,IUNIT,LOCFIL,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
C RENBR(REOPN4/VAX11 OPEN INPUT AND OUTPUT FILES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS VAX11 ROUTINE OPENS THE INPUT AND OUTPUT FILES
C WHICH HAVE BEEN SPECIFIED BY THE USER. THE REPART
C ROUTINE IS FIRST CALLED TO SPLIT THE FILE
C SPECIFICATION INTO ITS COMPONENT PARTS: THE NODE,
C THE DEVICE, THE FILE NAME, THE FILE TYPE, THE
C VERSION, AND THE DIRECTORY. MISSING COMPONENTS ARE
C SUPPLIED BY THIS ROUTINE, AND THE FILES ARE THEN
C OPENED.
C
C THE FILE VERSION IS SUPPLIED TO THE OPEN STATEMENT
C ONLY IF IT IS TYPED BY THE USER. A DEFAULT FILE TYPE
C IS SUPPLIED IF A PERIOD IS NOT TYPED BY THE USER. A
C PERIOD MUST BE TYPED IF THE FILE TYPE IS TO BE NULL.
C A MISSING FILE NAME IN AN OUTPUT FILE SPECIFICATION
C IS TAKEN TO BE THE SAME AS THE FILE NAME OF THE FIRST
C INPUT FILE SPECIFICATION TO THE RIGHT OF THE EQUAL
C SIGN. THE FIRST INPUT FILE SPECIFICATION TO THE
C RIGHT OF THE EQUAL SIGN MUST INCLUDE A FILE NAME.
C
C TYPED BY USER IMPLIES (IF TO RIGHT OF =)
C
C NAME NAME.FOR
C NAME. NAME.
C NAME.. NAME.
C NAME.; NAME.
C NAME.TYPE NAME.TYPE
C NAME.TYPE. NAME.TYPE
C NAME.TYPE; NAME.TYPE
C NAME;VERSION NAME.FOR;VERSION
C NAME..VERSION NAME.;VERSION
C NAME.;VERSION NAME.;VERSION
C NAME.TYPE.VERSION NAME.TYPE;VERSION
C NAME.TYPE;VERSION NAME.TYPE;VERSION
C
C KNDFIL = SPECIFIES TYPE OF FILE TO BE OPENED.
C = 1, OPEN INPUT COMMAND FILE.
C = 2, OPEN FIRST INPUT SOURCE FILE. OUTPUT
C FILES HAVE NOT YET BEEN OPENED.
C = 3, OPEN OUTPUT RENUMBERED FILE.
C = 4, OPEN OUTPUT LISTING FILE.
C = 5, OPEN SECOND OR SUBSEQUENT INPUT SOURCE
C FILE. ALL OUTPUT FILES HAVE ALREADY BEEN
C OPENED.
C IUNIT = NUMBER SELECTING THE DEVICE UPON WHICH THE
C FILE IS TO BE OPENED.
C LOCFIL = SERIAL NUMBER WITHIN THE LNGFIL AND LTRFIL
C ARRAYS OF THE DESCRIPTION OF THE CURRENT
C FILE RELATIVE TO THE DESCRIPTIONS OF ALL
C FILES.
C LNGFIL = ARRAY CONTAINING NUMBERS OF CHARACTERS IN
C FILE DESCRIPTIONS IN THE LTRFIL ARRAY.
C LTRFIL = ARRAY CONTAINING THE FILE DESCRIPTIONS TYPED
C BY THE USER.
C MAXFIL = 1 MORE THAN NUMBER OF FILE SPECIFICATIONS
C WHICH CAN APPEAR TO LEFT OF EQUAL SIGN.
C THIS IS MAXIMUM VALUE OF SUBSCRIPT OF LNGFIL
C ARRAY AND MAXIMUM VALUE OF SECOND SUBSCRIPT
C OF LTRFIL ARRAY.
C MAXCHR = MAXIMUM NUMBER OF CHARACTERS IN ANY 1 FILE
C DESCRIPTION IN THE LTRFIL ARRAY.
C ITRACE = 0, INPUT IF DESCRIPTIONS OF FILES ARE NOT TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
C = 1, INPUT IF USER SELECTS /Z SWITCH
C INDICATING THAT DESCRIPTIONS OF FILES ARE TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
C ITTY = UNIT NUMBER TO WHICH DESCRIPTIONS ARE
C WRITTEN IF ITRACE=1.
C LPTTTY = INPUT CONTAINING 0 IF USER DID NOT SPECIFY
C /V SWITCH. THE /V SWITCH FORCES THE LISTING
C TO BE WRITTEN ONTO THE CONTROLLING TERMINAL.
C = INPUT CONTAINING 1 IF USER SPECIFIED /V
C SWITCH.
C = RETURNED SET TO 1 IF LPTTTY WAS INPUT SET TO
C 1 OR IF THE NAME OF THE OUTPUT DEVICE FOR
C THE LISTING WAS TTY:.
C NOTOPN = RETURNED SET TO 0 IF FILE WAS SUCCESSFULLY
C OPENED.
C = RETURNED SET TO 1 IF FILE COULD NOT BE
C OPENED.
C
COMMON/RNBTEN/LNGNOD,LNGDVC,LNGNAM,LNGPTH
COMMON/RNBELE/LTRNAM(9),LTRNOD(9),LTRPTH(50),LTRDVC(9)
DIMENSION LNGFIL(MAXFIL),LTRFIL(MAXCHR,MAXFIL),
1LTRRNB(5),LTRTTY(3),LWRTTY(3),LTREXT(15),
2LTRLPT(3),LWRLPT(3),LTRVAX(60),LA4VAX(16)
DATA MAXNOD,MAXDVC,MAXNAM,MAXPTH,MAXVAX/
19,9,9,50,60/
DATA MAXEXT,MAXRNB,MAXTTY,MAXLPT/3,5,3,3/
DATA LTREXT/1HR,1HN,1HB,
1 1HF,1HO,1HR,
2 1HF,1HO,1HR,
3 1HL,1HP,1HT,
4 1HF,1HO,1HR/
DATA LTRRNB/1HR,1HE,1HN,1HB,1HR/
DATA LTRTTY/1HT,1HT,1HY/
DATA LWRTTY/1Ht,1Ht,1Hy/
DATA LTRLPT/1HL,1HP,1HT/
DATA LWRLPT/1Hl,1Hp,1Ht/
DATA LTRDOT,LTROPN,LTRCLS,LTRCLN,LTRSEM,LTRSPC,LTRTAB/
11H.,1H[,1H],1H:,1H;,1H ,1H /
C
C PARSE FILE SPECIFICATION
IF(LOCFIL.LE.0)GO TO 2
K=LNGFIL(LOCFIL)
IF(K.LE.0)GO TO 2
J=0
DO 1 I=1,K
IF(LTRFIL(I,LOCFIL).EQ.LTRSPC)GO TO 1
IF(LTRFIL(I,LOCFIL).EQ.LTRTAB)GO TO 1
J=J+1
LTRFIL(J,LOCFIL)=LTRFIL(I,LOCFIL)
1 CONTINUE
LNGFIL(LOCFIL)=J
2 CALL REPART(MAXFIL,LTRFIL,MAXCHR,LOCFIL,LNGFIL,
1ININOD,LMTNOD,INIDVC,LMTDVC,ININAM,LMTNAM,INIPTH,
2LMTPTH,LOC1ST,LOC2ND)
KNTVAX=0
IF(KNDFIL.NE.2)GO TO 3
LNGNOD=0
LNGDVC=0
LNGNAM=0
LNGPTH=0
C
C DEFAULT NODE NAME
3 LMTNOD=LMTNOD-2
IF(ININOD.LE.LMTNOD)GO TO 5
IF(KNDFIL.NE.5)GO TO 10
IF(LNGNOD.LE.0)GO TO 10
IF((KNTVAX+LNGNOD+2).GT.MAXVAX)GO TO 55
DO 4 I=1,LNGNOD
KNTVAX=KNTVAX+1
4 LTRVAX(KNTVAX)=LTRNOD(I)
GO TO 9
C
C USER SUPPLIED NODE NAME
5 IF((KNTVAX+LMTNOD-ININOD+3).GT.MAXVAX)GO TO 55
DO 6 I=ININOD,LMTNOD
KNTVAX=KNTVAX+1
6 LTRVAX(KNTVAX)=LTRFIL(I,LOCFIL)
IF(KNDFIL.EQ.2)GO TO 7
IF(KNDFIL.NE.5)GO TO 9
7 LNGNOD=LMTNOD-ININOD+1
IF(LNGNOD.GT.MAXNOD)LNGNOD=MAXNOD
DO 8 I=1,LNGNOD
LTRNOD(I)=LTRFIL(ININOD,LOCFIL)
8 ININOD=ININOD+1
9 KNTVAX=KNTVAX+2
LTRVAX(KNTVAX-1)=LTRCLN
LTRVAX(KNTVAX)=LTRCLN
C
C DEFAULT DEVICE NAME
10 LMTDVC=LMTDVC-1
IF(INIDVC.LE.LMTDVC)GO TO 17
GO TO(27,27,27,11,15),KNDFIL
11 IF(LPTTTY.GT.0)GO TO 13
IF((KNTVAX+MAXLPT+1).GT.MAXVAX)GO TO 55
DO 12 I=1,MAXLPT
KNTVAX=KNTVAX+1
12 LTRVAX(KNTVAX)=LTRLPT(I)
LPTTTY=-1
GO TO 26
13 IF((KNTVAX+MAXTTY+1).GT.MAXVAX)GO TO 55
DO 14 I=1,MAXTTY
KNTVAX=KNTVAX+1
14 LTRVAX(KNTVAX)=LTRTTY(I)
GO TO 26
15 IF(LNGDVC.LE.0)GO TO 27
IF((KNTVAX+LNGDVC+1).GT.MAXVAX)GO TO 55
DO 16 I=1,LNGDVC
KNTVAX=KNTVAX+1
16 LTRVAX(KNTVAX)=LTRDVC(I)
GO TO 26
C
C USER SUPPLIED DEVICE NAME
17 IF((KNTVAX+LMTDVC-INIDVC+2).GT.MAXVAX)GO TO 55
DO 18 I=INIDVC,LMTDVC
KNTVAX=KNTVAX+1
18 LTRVAX(KNTVAX)=LTRFIL(I,LOCFIL)
GO TO(26,24,26,19,24),KNDFIL
19 J=INIDVC+MAXTTY-1
IF(LMTDVC.LT.J)GO TO 21
DO 20 I=INIDVC,J
IF(LTRFIL(I,LOCFIL).EQ.LTRTTY(I))GO TO 20
IF(LTRFIL(I,LOCFIL).NE.LWRTTY(I))GO TO 21
20 CONTINUE
LPTTTY=1
GO TO 26
21 J=INIDVC+MAXLPT-1
IF(LMTDVC.LT.J)GO TO 23
DO 22 I=INIDVC,J
IF(LTRFIL(I,LOCFIL).EQ.LTRLPT(I))GO TO 22
IF(LTRFIL(I,LOCFIL).NE.LWRLPT(I))GO TO 23
22 CONTINUE
LPTTTY=-1
GO TO 26
23 LPTTTY=0
GO TO 26
24 LNGDVC=LMTDVC-INIDVC+1
IF(LNGDVC.GT.MAXDVC)LNGDVC=MAXDVC
DO 25 I=1,LNGDVC
LTRDVC(I)=LTRFIL(INIDVC,LOCFIL)
25 INIDVC=INIDVC+1
26 KNTVAX=KNTVAX+1
LTRVAX(KNTVAX)=LTRCLN
C
C DEFAULT DIRECTORY NAME
27 INIPTH=INIPTH+1
LMTPTH=LMTPTH-1
IF(INIPTH.LE.LMTPTH)GO TO 29
IF(KNDFIL.NE.5)GO TO 34
IF(LNGPTH.LE.0)GO TO 34
IF((KNTVAX+LNGPTH+2).GT.MAXVAX)GO TO 55
KNTVAX=KNTVAX+1
LTRVAX(KNTVAX)=LTROPN
DO 28 I=1,LNGPTH
KNTVAX=KNTVAX+1
28 LTRVAX(KNTVAX)=LTRPTH(I)
GO TO 33
C
C USER SUPPLIED DIRECTORY NAME
29 IF((KNTVAX+LMTPTH-INIPTH+3).GT.MAXVAX)GO TO 55
KNTVAX=KNTVAX+1
LTRVAX(KNTVAX)=LTROPN
DO 30 I=INIPTH,LMTPTH
KNTVAX=KNTVAX+1
30 LTRVAX(KNTVAX)=LTRFIL(I,LOCFIL)
IF(KNDFIL.EQ.2)GO TO 31
IF(KNDFIL.NE.5)GO TO 33
31 LNGPTH=LMTPTH-INIPTH+1
IF(LNGPTH.GT.MAXPTH)LNGPTH=MAXPTH
DO 32 I=1,LNGPTH
LTRPTH(I)=LTRFIL(INIPTH,LOCFIL)
32 INIPTH=INIPTH+1
33 KNTVAX=KNTVAX+1
LTRVAX(KNTVAX)=LTRCLS
C
C DEFAULT FILE NAME
34 IF(ININAM.LT.LOC1ST)GO TO 39
GO TO(35,55,37,37,55),KNDFIL
35 IF((KNTVAX+MAXRNB+1).GT.MAXVAX)GO TO 55
DO 36 I=1,MAXRNB
KNTVAX=KNTVAX+1
36 LTRVAX(KNTVAX)=LTRRNB(I)
GO TO 44
37 IF((KNTVAX+LNGNAM+1).GT.MAXVAX)GO TO 55
IF(LNGNAM.LE.0)GO TO 55
DO 38 I=1,LNGNAM
KNTVAX=KNTVAX+1
38 LTRVAX(KNTVAX)=LTRNAM(I)
GO TO 44
C
C USER SUPPLIED FILE NAME
39 IF((KNTVAX+LOC1ST-ININAM+1).GT.MAXVAX)GO TO 55
I=ININAM
40 IF(I.GE.LOC1ST)GO TO 41
KNTVAX=KNTVAX+1
LTRVAX(KNTVAX)=LTRFIL(I,LOCFIL)
I=I+1
GO TO 40
41 IF(KNDFIL.EQ.2)GO TO 42
IF(KNDFIL.NE.5)GO TO 44
42 LNGNAM=LOC1ST-ININAM
IF(LNGNAM.GT.MAXNAM)LNGNAM=MAXNAM
DO 43 I=1,LNGNAM
LTRNAM(I)=LTRFIL(ININAM,LOCFIL)
43 ININAM=ININAM+1
C
C DEFAULT FILE EXTENSION
44 KNTVAX=KNTVAX+1
LTRVAX(KNTVAX)=LTRDOT
IF(LOC1ST.GT.LMTNAM)GO TO 45
IF(LOC1ST.LT.LOC2ND)GO TO 47
45 IF((KNTVAX+MAXEXT).GT.MAXVAX)GO TO 55
J=MAXEXT*(KNDFIL-1)
DO 46 I=1,MAXEXT
J=J+1
KNTVAX=KNTVAX+1
46 LTRVAX(KNTVAX)=LTREXT(J)
GO TO 48
C
C USER SUPPLIED FILE EXTENSION
47 LOC1ST=LOC1ST+1
IF(LOC1ST.GE.LOC2ND)GO TO 48
KNTVAX=KNTVAX+1
IF(KNTVAX.GT.MAXVAX)GO TO 55
LTRVAX(KNTVAX)=LTRFIL(LOC1ST,LOCFIL)
GO TO 47
C
C USER SUPPLIED FILE VERSION
48 IF(LOC2ND.GE.LMTNAM)GO TO 50
KNTVAX=KNTVAX+1
IF(KNTVAX.GT.MAXVAX)GO TO 55
LTRVAX(KNTVAX)=LTRSEM
49 LOC2ND=LOC2ND+1
KNTVAX=KNTVAX+1
IF(KNTVAX.GT.MAXVAX)GO TO 55
LTRVAX(KNTVAX)=LTRFIL(LOC2ND,LOCFIL)
IF(LOC2ND.LT.LMTNAM)GO TO 49
C
C OPEN FILE AND, IF /Z GIVEN, REPORT FULL SPECIFICATION
50 DO 51 I=1,16
51 LA4VAX(I)=0
ENCODE(KNTVAX,52,LA4VAX)(LTRVAX(I),I=1,KNTVAX)
52 FORMAT(60A1)
NOTOPN=0
C KNDFIL = 1, OPEN COMMAND FILE
C = 2, OPEN FIRST INPUT SOURCE FILE
C = 3, OPEN RENUMBERED OUTPUT FILE
C = 4, OPEN LISTING FILE
C = 5, OPEN SECOND OR SUBSEQUENT SOURCE FILE
GO TO(53,53,54,58,53),KNDFIL
C INPUT FORTRAN SOURCE FILES OR INPUT COMMAND FILES
53 OPEN(UNIT=IUNIT,NAME=LA4VAX,ERR=55,TYPE='OLD',
1READONLY)
GO TO 56
C OUTPUT RENUMBERED FORTRAN FILE
54 OPEN(UNIT=IUNIT,NAME=LA4VAX,ERR=55,TYPE='NEW',
1CARRIAGECONTROL='LIST')
GO TO 56
C OUTPUT LISTING FILE
58 OPEN(UNIT=IUNIT,NAME=LA4VAX,ERR=55,TYPE='NEW',
1CARRIAGECONTROL='FORTRAN')
GO TO 56
55 NOTOPN=1
56 IF(ITRACE.NE.0)WRITE(ITTY,57)KNDFIL,NOTOPN,
1(LTRVAX(I),I=1,KNTVAX)
57 FORMAT(1X,3HKND,1I2,1X,3HERR,I2,1X,100A1)
RETURN
C011046148746[]:;'
END
SUBROUTINE REPART(MAXFIL,LTRFIL,MAXCHR,LOCFIL,LNGFIL,
1 ININOD,LMTNOD,INIDVC,LMTDVC,ININAM,LMTNAM,INIPTH,
2 LMTPTH,LOC1ST,LOC2ND)
C RENBR(REPRT4/VAX11 FIND COMPONENTS OF FILE NAMES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS VAX11 ROUTINE SPLITS THE FILE SPECIFICATION
C TYPED BY THE USER INTO ITS COMPONENT PARTS.
C
C MAXFIL = 1 MORE THAN NUMBER OF FILE SPECIFICATIONS
C WHICH CAN APPEAR TO LEFT OF EQUAL SIGN.
C THIS IS MAXIMUM VALUE OF SUBSCRIPT OF LNGFIL
C ARRAY AND MAXIMUM VALUE OF SECOND SUBSCRIPT
C OF LTRFIL ARRAY.
C LTRFIL = ARRAY CONTAINING THE FILE DESCRIPTIONS TYPED
C BY THE USER.
C MAXCHR = MAXIMUM NUMBER OF CHARACTERS IN ANY 1 FILE
C DESCRIPTION IN THE LTRFIL ARRAY.
C LOCFIL = SERIAL NUMBER WITHIN THE LNGFIL AND LTRFIL
C ARRAYS OF THE DESCRIPTION OF THE CURRENT
C FILE RELATIVE TO THE DESCRIPTIONS OF ALL
C FILES.
C LNGFIL = ARRAY CONTAINING NUMBERS OF CHARACTERS IN
C FILE DESCRIPTIONS IN THE LTRFIL ARRAY.
C ININOD = RETURNED POINTING TO FIRST CHARACTER OF NODE
C NAME.
C LMTNOD = RETURNED POINTING TO SECOND COLON AFTER NODE
C NAME. IF NO NODE NAME IS FOUND, THEN
C ININOD=LMTNOD+1
C INIDVC = RETURNED POINTING TO FIRST CHARACTER OF
C DEVICE NAME.
C LMTDVC = RETURNED POINTING TO COLON AFTER DEVICE
C NAME. IF NO DEVICE NAME IS FOUND, THEN
C INIDVC=LMTDVC+1
C ININAM = RETURNED POINTING TO FIRST CHARACTER OF FILE
C NAME.
C LMTNAM = RETURNED POINTING TO FINAL CHARACTER OF FILE
C NAME OR FILE TYPE OR VERSION, WHICHEVER IS
C RIGHTMOST. IF NONE OF THESE ARE FOUND, THEN
C ININAM=LMTNAM+1.
C INIPTH = RETURNED POINTING TO LEFT BRACKET AT START
C OF DIRECTORY SPECIFICATION.
C LMTPTH = RETURNED POINTING TO RIGHT BRACKET AT END OF
C DIRECTORY SPECIFICATION OR TO CHARACTER TO
C RIGHT OF FINAL PRINTING CHARACTER IF
C DIRECTORY IS NOT TERMINATED BY RIGHT
C BRACKET. IF NO DIRECTORY IS FOUND, THEN
C INIPTH=LMTPTH+1
C LOC1ST = RETURNED POINTING TO PERIOD BETWEEN FILE
C NAME AND FILE TYPE. IF FILE SPECIFICATION
C DOES NOT INCLUDE PERIOD THEN LOC1ST=LOC2ND.
C LOC2ND = RETURNED POINTING TO PERIOD OR SEMICOLON
C BETWEEN FILE TYPE AND VERSION. IF NO PERIOD
C OR SEMICOLON APPEARS BETWEEN FILE TYPE AND
C VERSION THEN LOC2ND=LMTNAM+1.
C
DIMENSION LTRFIL(MAXCHR,MAXFIL),LNGFIL(MAXFIL)
C
DATA LTRLES,LTRGRT,LTROPN,LTRCLS,LTRDOT,LTRCLN,
1LTRSEM,LTRCMA,LTRSPC,LTRTAB/
21H<,1H>,1H[,1H],1H.,1H:,1H;,1H,,1H ,1H /
MAXPRT=0
IF(LOCFIL.GT.0)MAXPRT=LNGFIL(LOCFIL)
C
C LOCATE DIRECTORY INSIDE BRACKETS
INIPTH=0
1 INIPTH=INIPTH+1
IF(INIPTH.GT.MAXPRT)GO TO 4
IF(LTRFIL(INIPTH,LOCFIL).EQ.LTROPN)GO TO 2
IF(LTRFIL(INIPTH,LOCFIL).EQ.LTRLES)GO TO 2
GO TO 1
2 LMTPTH=INIPTH
3 LMTPTH=LMTPTH+1
IF(LMTPTH.GT.MAXPRT)GO TO 5
IF(LTRFIL(LMTPTH,LOCFIL).EQ.LTRCLS)GO TO 5
IF(LTRFIL(LMTPTH,LOCFIL).EQ.LTRGRT)GO TO 5
GO TO 3
4 LMTPTH=INIPTH-1
C
C LOCATE NODE NAME
5 LMTNOD=0
6 LMTNOD=LMTNOD+1
IF(LMTNOD.GT.MAXPRT)GO TO 9
IF(LMTNOD.LT.INIPTH)GO TO 7
IF(LMTNOD.GT.LMTPTH)GO TO 7
LMTNOD=LMTPTH
GO TO 6
7 IF(LTRFIL(LMTNOD,LOCFIL).NE.LTRCLN)GO TO 6
LMTDVC=LMTNOD
8 LMTNOD=LMTNOD+1
IF(LMTNOD.GT.MAXPRT)GO TO 10
IF(LTRFIL(LMTNOD,LOCFIL).EQ.LTRSPC)GO TO 8
IF(LTRFIL(LMTNOD,LOCFIL).EQ.LTRTAB)GO TO 8
IF(LTRFIL(LMTNOD,LOCFIL).NE.LTRCLN)GO TO 10
LMTDVC=LMTNOD
ININOD=1
IF(INIPTH.GT.LMTPTH)GO TO 11
IF(LMTNOD.GT.LMTPTH)ININOD=LMTPTH+1
GO TO 11
9 ININOD=LMTNOD+1
LMTDVC=0
INIDVC=LMTDVC+1
GO TO 15
10 LMTNOD=0
ININOD=LMTNOD+1
GO TO 13
C
C LOCATE DEVICE NAME TO LEFT OF COLON
11 LMTDVC=LMTDVC+1
IF(LMTDVC.GT.MAXPRT)GO TO 14
IF(LMTDVC.LT.INIPTH)GO TO 12
IF(LMTDVC.GT.LMTPTH)GO TO 12
LMTDVC=LMTPTH
GO TO 11
12 IF(LTRFIL(LMTDVC,LOCFIL).NE.LTRCLN)GO TO 11
13 INIDVC=1
IF(ININOD.LE.LMTNOD)INIDVC=LMTNOD+1
IF(INIPTH.GT.LMTPTH)GO TO 15
IF(INIDVC.GT.LMTPTH)GO TO 15
IF(LMTDVC.GT.LMTPTH)INIDVC=LMTPTH+1
GO TO 15
14 INIDVC=LMTDVC+1
C
C LOCATE FILE NAME
15 ININAM=0
IF(ININOD.LE.LMTNOD)ININAM=LMTNOD
IF(INIDVC.LE.LMTDVC)ININAM=LMTDVC
16 ININAM=ININAM+1
IF(ININAM.GT.MAXPRT)GO TO 18
IF(ININAM.GT.LMTPTH)GO TO 17
IF(ININAM.LT.INIPTH)GO TO 17
ININAM=LMTPTH
GO TO 16
17 IF(LTRFIL(ININAM,LOCFIL).EQ.LTRSPC)GO TO 16
IF(LTRFIL(ININAM,LOCFIL).EQ.LTRTAB)GO TO 16
LMTNAM=MAXPRT
IF(INIPTH.GT.LMTPTH)GO TO 19
IF(ININAM.LT.INIPTH)LMTNAM=INIPTH-1
GO TO 19
18 LMTNAM=ININAM-1
C
C LOCATE COMPONENTS OF FILE NAME
19 LOC1ST=ININAM
20 IF(LOC1ST.GT.LMTNAM)GO TO 23
IF(LTRFIL(LOC1ST,LOCFIL).EQ.LTRDOT)GO TO 21
IF(LTRFIL(LOC1ST,LOCFIL).EQ.LTRSEM)GO TO 23
LOC1ST=LOC1ST+1
GO TO 20
21 LOC2ND=LOC1ST+1
22 IF(LOC2ND.GT.LMTNAM)GO TO 24
IF(LTRFIL(LOC2ND,LOCFIL).EQ.LTRDOT)GO TO 24
IF(LTRFIL(LOC2ND,LOCFIL).EQ.LTRSEM)GO TO 24
LOC2ND=LOC2ND+1
GO TO 22
23 LOC2ND=LOC1ST
24 CONTINUE
RETURN
C860559717780<>[]:;
END
SUBROUTINE REDATE(LTRTOP)
C RENBR(REDAT4/VAX11 INSERT DATE AND TIME INTO TITLE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS ROUTINE INSERTS CURRENT DATE AND TIME SIMILAR TO
C 29-JAN-79 10:15
C INTO LEFT 15 COLUMNS OF TITLE FOR LISTING. THIS
C INFORMATION IS RETURNED IN A5 HOLLERITH FORM BY THE
C DATE AND TIME ROUTINES, THEN CONVERTED TO A1 FORM BY
C DECODE STATEMENTS.
C
DIMENSION LTRTOP(117),LA4DAT(3),LA4TIM(2)
CALL DATE(LA4DAT)
CALL TIME(LA4TIM)
DECODE(9,1,LA4DAT)(LTRTOP(I),I=1,9)
1 FORMAT(9A1)
DECODE(5,2,LA4TIM)(LTRTOP(I),I=11,15)
2 FORMAT(5A1)
RETURN
C095410018459
END
SUBROUTINE REHELP(ITTY)
C RENBR(REHLP4/VAX11 TYPE INSTRUCTIONS)
WRITE(ITTY,1)
WRITE(ITTY,2)
WRITE(ITTY,3)
WRITE(ITTY,4)
WRITE(ITTY,5)
WRITE(ITTY,6)
WRITE(ITTY,7)
WRITE(ITTY,8)
WRITE(ITTY,9)
WRITE(ITTY,10)
1 FORMAT(42H This program renumbers and/or lists ,
119HFORTRAN programs./26H Commands typed by user,
235H consist of specification of output/10H renumbere,
349Hd file and/or specification of output listing fil,
42He,/44H then = and list of input files using 72 c,
517Hharacters or less/28H per line. & or , must term,
633Hinate line if next line continues/12H command. ,
749HCommand can be read from file if specification of/
849H file is typed with @. Filetypes .FOR, .LPT, .FO,
912HR and .RNB)
2 FORMAT(42H are defaults for renumbering, listing,
119H, input and command/26H files. File specificat,
235Hions can include node, device,/10H directory,
349H, filename, filetype and version. If 2 outp,
42Hut/44H specifications are given, comma should sep,
517Harate these and/28H switch with at least 1 mu,
633Hst imply use. Switches have form/12H /letter:num,
749Hber:number where numbers are optional. Title for/
849H each page can be specified between apostrophes,
912H and implies)
3 FORMAT(42H that associated specification is of listi,
18Hng file./1H /34H Following switches are recognized,
21H./1H /41H A followed by number of spaces to add le,
320Hft of statements in/25H IF THEN block or in DO,
430H loop. /A or /A:0 equals /A:1/15H B followed by ,
546Hsmallest statement number in renumbered output/
649H C column formatted renumbered output with statem,
712Hent numbers/33H ending in column 5. Statement,
828H text will start in column 7/17H E followed by nu,
944Hmber of extra tables of contents. /E or)
4 FORMAT(19H /E:0 equals /E:1/19H F listing device h,
142Has form feed. Pages in listing will be/4H s,
249Heparated by form feeds if output is to LPT dev,
38Hice. /F/38H can be followed by number of lines ,
423Hprintable per page. /F/22H or /F:0 equals /F:6,
51H0/45H G followed by number of blank lines to be ,
616H listed between/29H FORTRAN statements. No ,
732H extra blank lines are listed/13H between co,
836Hmment lines. /G or /G:0 equals /G:1)
5 FORMAT(42H I followed by increment between state,
119Hment numbers in/26H renumbered output. Ne,
235Hgative increment, such as specified/10H by /I:,
349H-1, gives smallest number at end of progra,
42Hm./44H Smallest number will be absolute value of,
517H increment unless/28H /B specifies non-zero sma,
633Hllest number. /I or /I:0 equals/7H /I:1/3H J ,
749Hfollowed by number of blank lines to be at top of,
89H 1st, at/37H bottom of 2nd and top of 3rd ,
924Hpages, etc. This can be)
6 FORMAT(42H followed by number of blank lines to be,
119H at bottom of 1st,/26H at top of 2nd and bot,
235Htom of 3rd pages, etc. These blank/10H lines a,
349Hre inserted to allow top binding of unburst fanfo,
42Hld/44H paper and must be included in prin,
517Hting line limit/24H specified by /F or /L/1H ,
645HK long lines are to be kept intact in listing/1H ,
749HL pages in listing will be separated by counted l,
811Hine feeds./34H /L can be followed by number o,
927Hf lines printable per page.)
7 FORMAT(42H This can be followed by total number of,
119H lines per page./26H /S:0 is assumed if /S,
235H has not already been selected. /L/10H or /L:0,
316H equals /L:60:66/29H M if issued not followed by ,
432Ha number, old statement numbers/13H are mainta,
548Hined. If M is followed by 2 numbers, then these/
649H are lowest and highest statement numbers to be,
79H modified/37H P followed by first page number in ,
824H listing. /P or /P:0/14H equals /P:1)
8 FORMAT(42H S followed by number of characters printa,
119Hble beyond normal/26H right margin. Excess,
235H characters are right justified on/10H followi,
349Hng line. /S or /S:0 gives 70 character line,
42Hs./18H /S:13 equals /K/22H T tab formatted ren,
539Humbered output. Tab character will/7H prec,
618Hede statement text/27H U column formatted renumbe,
734Hred output with statement numbers/11H starting,
849H in column 1. Statement text will start in colum,
91Hn/4H 7)
9 FORMAT(42H V listing is to be viewed on this termina,
11Hl/45H W followed by width of tab stop columns to,
216H be used when/29H converting tabs to spac,
332Hes in comment lines. Tabs in/13H comment li,
448Hnes are not converted in renumbered output/
546H unless /W is typed. /W or /W:0 equals /W:8/
61H /45H Listing file is identified by /E, /F, /G, /J,
716H, /K, /L, /P,/29H /S, /V or '. Default op,
832Htions are initial page number 1,/13H form feeds, ,
948Hintact long lines, single spacing, and 1 table)
10 FORMAT(13H of contents./1H /21H Renumbered output is,
140H identified by /B, /C, /I, /M, /T or /U./6H Defau,
249Hlt options are smallest statement number 1, incre,
36Hment 1/19H and column format./1H )
RETURN
C010305680796&@:'
END
SUBROUTINE RETEMP(KNDSPR,JOBNUM,ISPR)
C RENBR(RETMP4/VAX11 OPEN AND CLOSE SCRATCH FILE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C KNDSPR = 0, RETURN JOBNUM CONTAINING NUMBER UNIQUELY
C IDENTIFYING THIS JOB WHICH CAN BE USED BY
C SUBSEQUENT CALLS TO THIS ROUTINE IN THE
C CONSTRUCTION OF A SCRATCH FILE NAME. NO
C FILES ARE OPENED.
C = 1, OPEN SCRATCH FILE FOR WRITING
C = 2, CLOSE SCRATCH FILE JUST WRITTEN
C = 3, OPEN SCRATCH FILE FOR READING
C = 4, CLOSE AND DELETE SCRATCH FILE AFTER
C READING
C ISPR = UNIT NUMBER UPON WHICH SCRACH UNIT CAN BE
C WRITTEN OR READ OR CLOSED
C
DIMENSION LA4TMP(4)
C
IF(KNDSPR.GT.0)GO TO 1
C
C OBTAIN JOB IDENTIFIER FROM WHICH FILE NAME IS MADE
C
C THE SECNDS ROUTINE IS FIRST CALLED TO OBTAIN THE TIME
C AS THE NUMBER OF SECONDS SINCE MIDNIGHT. THE FILE
C NAME IS THEN CONSTRUCTED FROM THE NUMBER OF TENTHS OF
C SECONDS SINCE MIDNIGHT PLUS 100000. THE OFFSET IS
C ADDED TO FORCE THE NUMBER TO CONSIST OF 6 CHARACTERS
C WHEN WRITTEN AS A DECIMAL INTEGER. THE MAXIMUM VALUE
C INCLUDING THIS OFFSET IS 963999.
C
JOBNUM=100000.0+10.0*SECNDS(0.0)
GO TO 8
C
C CONSTRUCT NAME OF FILE THEN OPEN OR CLOSE IT
1 DO 2 I=1,4
2 LA4TMP(I)=0
ENCODE(10,3,LA4TMP)JOBNUM
3 FORMAT(1I6,4H.TMP)
GO TO(4,5,6,7),KNDSPR
C
C OPEN OUTPUT FILE
4 OPEN(UNIT=ISPR,NAME=LA4TMP,TYPE='NEW',
1CARRIAGECONTROL='LIST')
GO TO 8
C
C CLOSE OUTPUT FILE
5 CLOSE(UNIT=ISPR)
GO TO 8
C
C OPEN INPUT FILE
6 OPEN(UNIT=ISPR,NAME=LA4TMP,TYPE='OLD')
GO TO 8
C
C CLOSE AND DELETE INPUT FILE
7 CLOSE(UNIT=ISPR,DISPOSE='DELETE')
C
C RETURN TO CALLING PROGRAM
8 RETURN
C157244073095'
END
SUBROUTINE RECLOS(INCR,IOUT,IPAGE,ILPT,LPTTTY)
C RENBR(RECLS4/VAX11 CLOSE OUTPUT FILES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C INCR = NOT EQUAL TO ZERO IF RENUMBERING
C IOUT = UNIT ON WHICH RENUMBERED OUTPUT IS WRITTEN
C IPAGE = NOT EQUAL TO ZERO IF MAKING LISTING
C ILPT = UNIT ON WHICH LISTING IS WRITTEN
C LPTTTY = -1, LISTING DEVICE IS LINE PRINTER
C = 0, LISTING DEVICE IS DISK
C = 1, LISTING DEVICE IS TERMINAL
C
IF(INCR.NE.0)CLOSE(UNIT=IOUT)
IF(IPAGE.NE.0)CLOSE(UNIT=ILPT)
RETURN
C052312004075
END