Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/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