Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/bank/bnk13.ban
There are 3 other files named bnk13.ban in the archive. Click here to see a list.
C *** BANK ***
C
C SUBROUTINE TO CREATE A COMMAND FILE FOR BANK FROM INFORMATION
C PRESENTED IN A FOR COMMAND. ALL INSTRUCTIONS MUST BE SINGLE LINE
C AND MUST BE CORRECT(NO CHECKING DONE IN THIS ROUTINE). COMMAND
C FILE IS PLACED IN A FILE CALLED BNKPG.DAT.
C
SUBROUTINE PROGRM
COMMON /DEV/ IDLG,ICC,IBNK,IUPGR,ITMPRY,MPROG
COMMON /PROG/ IOUTOF,LICRUN,INPUT(80)
DIMENSION IQTY(9), NUM(100,9), NSTAT(20,80)
DIMENSION ITBL(10,100,9),ITMP(12),IOUT(80),NCHG(20),ICHG(20,10,2)
DIMENSION LUMP(9)
DATA IBRKL,IBRKR,IALT/"555004020100,"565004020100,"155004020100/
IF(IOUTOF.EQ.0) GO TO 1000
WRITE(IDLG,1)
1 FORMAT(' FOR IS AN ILLEGAL COMMAND IN A RUN'/)
RETURN
1000 IFS=0
DO 6 I=1,9
6 IQTY(I)=0
GO TO 4
3 WRITE(IDLG,8)
8 FORMAT('+* ',$)
CALL GES(INPUT,80,ICHECK)
IF(ICHECK.EQ.2) RETURN
4 IF(INPUT(1).EQ.'!') RETURN
IF((INPUT(1).EQ.'F').AND.(INPUT(2).EQ.'O').AND.
1(INPUT(3).EQ.'R').AND.(INPUT(4).EQ.IBRKL)) GO TO 77
IF((INPUT(1).NE.'F').OR.(INPUT(2).NE.'O').OR.(INPUT(3).NE.'R').
1OR.(INPUT(4).NE.' ')) GO TO 100
77 IF(IFS.EQ.0) GO TO 9
WRITE(IDLG,7)
7 FORMAT(' ALL FOR STATEMENTS MUST PRECEDE REGULAR STATEMENTS'/)
GO TO 1000
9 I=3
10 I=I+1
IF(I.GT.80) GO TO 24
IF(INPUT(I).EQ.' ') GO TO 10
IF(INPUT(I).EQ.IBRKL) GO TO 12
WRITE(IDLG,11) INPUT(I)
11 FORMAT(' ILLEGAL CHARACTER "',A1,'" FOR INDEX')
GO TO 1000
12 IF((INPUT(I+1).GE.'1').AND.(INPUT(I+1).LE.'9')) GO TO 14
WRITE(IDLG,13)
13 FORMAT(' ILLEGAL INDEX NUMBER')
GO TO 1000
14 IF(INPUT(I+2).EQ.IBRKR) GO TO 15
WRITE(IDLG,11) INPUT(I+2)
GO TO 1000
15 DECODE(1,16,INPUT(I+1)) INDEX
16 FORMAT(I1)
I=I+2
IF(IQTY(INDEX).EQ.0) GO TO 76
WRITE(IDLG,17) INDEX
17 FORMAT(' INDEX',I2,' HAS ALREADY BEEN USED')
GO TO 1000
C
C INDEX FOUND NOW
C
76 IF(INPUT(I).EQ.'=') GO TO 20
I=I+1
IF(I.LE.80) GO TO 76
GO TO 24
20 IVB=IQTY(INDEX)+1
IF(IVB.LE.100) GO TO 18
73 WRITE(IDLG,19)
19 FORMAT(' MORE THAN 100 VARIABLES FOR 1 INDEX')
GO TO 1000
18 NUM(IVB,INDEX)=0
21 LTR=NUM(IVB,INDEX)+1
23 I=I+1
IF(I.LE.80) GO TO 27
NUM(IVB,INDEX)=LTR-1
IF(LTR.GT.1) IQTY(INDEX)=IQTY(INDEX)+1
IF(IQTY(INDEX).GT.0) GO TO 3
24 WRITE(IDLG,25)
25 FORMAT(' FOR STATEMENT NOT COMPLETED')
GO TO 1000
27 IF(INPUT(I).EQ.' ') GO TO 23
IF(INPUT(I).EQ.1H') GO TO 30
IF(INPUT(I).EQ.',') GO TO 40
IF(INPUT(I).EQ.'-') GO TO 50
37 IF(LTR.LE.10) GO TO 29
26 WRITE(IDLG,28)
28 FORMAT(' VALUE IN FOR STATEMENT LARGER THAN 10 CHARACTERS')
GO TO 1000
29 ITBL(LTR,IVB,INDEX)=INPUT(I)
LTR=LTR+1
GO TO 23
C
C QUOTE
C
30 IF(LTR.EQ.1) GO TO 32
WRITE(IDLG,31)
31 FORMAT(' QUOTE MUST BE FIRST CHARACTER OF STRING')
GO TO 1000
32 IF(LTR.GT.10) GO TO 26
ITBL(LTR,IVB,INDEX)=INPUT(I)
LTR=LTR+1
33 I=I+1
IF(I.LE.80) GO TO 35
36 WRITE(IDLG,34)
34 FORMAT(' NO CLOSING QUOTE')
GO TO 1000
35 IF(INPUT(I).EQ.1H') GO TO 37
GO TO 32
C
C COMMA
C
40 NUM(IVB,INDEX)=LTR-1
IF(LTR.GT.1) IQTY(INDEX)=IQTY(INDEX)+1
GO TO 20
C
C THRU
C
50 IF(LTR.EQ.1) GO TO 29
NUM(IVB,INDEX)=LTR-1
53 DO 55 J=1,10
55 ITMP(J)=' '
DO 54 J=1,LTR-1
IF((ITBL(J,IVB,INDEX).EQ.'-').AND.(J.EQ.1)) GO TO 57
IF((ITBL(J,IVB,INDEX).LE.'9').AND.(ITBL(J,IVB,INDEX).GE.'0'))
1 GO TO 57
62 WRITE(IDLG,56)
56 FORMAT(' ONLY INTEGER VALUES ARE PERMITTED WHEN USING THRU')
GO TO 1000
51 WRITE(IDLG,52)
52 FORMAT(' ILLEGAL THRU')
GO TO 1000
57 ITMP(J)=ITBL(J,IVB,INDEX)
54 CONTINUE
ENCODE(10,58,ITMP(11))(ITMP(J),J=1,10)
58 FORMAT(10A1)
DECODE(10,59,ITMP(11)) IBGIN
59 FORMAT(I)
C
C NOW FIND END POINT
C
DO 60 J=1,10
60 ITMP(J)=' '
LTR=1
61 I=I+1
IF(I.GT.80) GO TO 64
IF(INPUT(I).EQ.' ') GO TO 61
IF(INPUT(I).EQ.',') GO TO 64
IF(INPUT(I).EQ.'-') GO TO 65
IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 63
WRITE(IDLG,56)
GO TO 1000
65 IF(LTR.EQ.1) GO TO 63
WRITE(IDLG,66)
66 FORMAT(' YOU HAVE INDICATED TWO -, BOTH ARE NOT MINUS')
GO TO 1000
63 IF(LTR.GT.10) GO TO 26
ITMP(LTR)=INPUT(I)
LTR=LTR+1
GO TO 61
64 IF(LTR.LE.1) GO TO 51
ENCODE(10,58,ITMP(11))(ITMP(J),J=1,10)
DECODE(10,59,ITMP(11)) IEND
IF(IBGIN.LE.IEND) GO TO 70
ISAV=IBGIN
IBGIN=IEND
IEND=ISAV
70 DO 71 J=IBGIN,IEND
ENCODE(10,72,ITMP(11))J
72 FORMAT(I10)
DECODE(10,58,ITMP(11))(ITMP(K),K=1,10)
IF(IVB.GT.100) GO TO 73
LTR=1
DO 74 K=1,10
IF(ITMP(K).EQ.' ') GO TO 74
ITBL(LTR,IVB,INDEX)=ITMP(K)
LTR=LTR+1
74 CONTINUE
NUM(IVB,INDEX)=LTR-1
IVB=IVB+1
71 CONTINUE
IQTY(INDEX)=IVB-1
IF(I.LE.80) GO TO 20
GO TO 3
C
C STUDENT TYPES IN STATEMENTS HERE
C
100 DO 101 I=1,80
IF(INPUT(I).NE.' ') GO TO 102
101 CONTINUE
GO TO 3
102 IF(INPUT(1).EQ.IALT) GO TO 120
IFS=IFS+1
IF(IFS.GT.20) PAUSE 'TOO MANY STATEMENTS'
I=1
NCHG(IFS)=0
103 IF(INPUT(I).EQ.IALT) GO TO 120
IF(INPUT(I).NE.IBRKL) GO TO 109
IF((INPUT(I+1).LE.'9').AND.(INPUT(I+1).GE.'0')) GO TO 105
WRITE(IDLG,104)
104 FORMAT(' ILLEGAL INDEX - STATEMENT IGNORED'/)
IFS=IFS-1
GO TO 3
105 IF(INPUT(I+2).EQ.IBRKR) GO TO 107
WRITE(IDLG,106)
106 FORMAT(' WARNING - BRACKET ABOVE NOT INTERPRETED TO BE A INDEX')
GO TO 109
107 DECODE(1,16,INPUT(I+1)) L
IF(IQTY(L).NE.0) GO TO 108
WRITE(IDLG,104)
IFS=IFS-1
GO TO 3
108 IF(NCHG(IFS).GE.10) PAUSE 'PROBLEM'
NCHG(IFS)=NCHG(IFS)+1
ICHG(IFS,NCHG(IFS),1)=I
ICHG(IFS,NCHG(IFS),2)=L
109 NSTAT(IFS,I)=INPUT(I)
I=I+1
IF(I.LE.80) GO TO 103
GO TO 3
C
C MAKE FILE HERE
C
C SET FIRST SETO OF VARIABLES
120 OPEN(UNIT=IUPGR,DEVICE='DSK',FILE='BNKPG.DAT',ACCESS='SEQOUT')
DO 121 I=1,9
LUMP(I)=0
IF(IQTY(I).NE.0) LUMP(I)=1
121 CONTINUE
GO TO 130
C CALCULATE NEXT SET OF VARIABLES
122 DO 123 I=1,9
IF(IQTY(I).EQ.0) GO TO 123
IF(LUMP(I).GE.IQTY(I)) GO TO 124
LUMP(I)=LUMP(I)+1
GO TO 130
124 LUMP(I)=1
123 CONTINUE
CALL RELEAS(IUPGR)
IOUTOF=1
OPEN(UNIT=MPROG,DEVICE='DSK',FILE='BNKPG.DAT',ACCESS='SEQIN')
RETURN
C CREATE ALL LINES FOR SET OF VARIABLES
130 IF(IFS.LT.1) RETURN
DO 131 I=1,IFS
IF(NCHG(I).NE.0) GO TO 133
143 DO 132 J=1,80
132 INPUT(J)=NSTAT(I,J)
GO TO 145
133 LTR=1
IPOS=1
DO 134 J=1,NCHG(I)
IF(ICHG(I,J,1).EQ.IPOS) GO TO 136
DO 135 K=IPOS,ICHG(I,J,1)-1
INPUT(LTR)=NSTAT(I,K)
135 LTR=LTR+1
136 M=ICHG(I,J,2)
L=LUMP(M)
KJ=NUM(L,M)
DO 137 K=1,KJ
INPUT(LTR)=ITBL(K,L,M)
137 LTR=LTR+1
IPOS=ICHG(I,J,1)+3
134 CONTINUE
139 IF(LTR.GT.80) GO TO 145
IF(IPOS.GT.80) GO TO 141
INPUT(LTR)=NSTAT(I,IPOS)
IPOS=IPOS+1
LTR=LTR+1
GO TO 139
141 DO 142 L=LTR,80
142 INPUT(L)=' '
145 DO 146 J=80,1,-1
IF(INPUT(J).NE.' ') GO TO 147
146 CONTINUE
GO TO 131
147 IF(J.LT.80) GO TO 148
WRITE(IUPGR,140) INPUT
J=0
148 LAST=J+1
INPUT(LAST)=IALT
131 WRITE(IUPGR,140) INPUT
140 FORMAT(80A1)
GO TO 122
END