Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/bnk3.ban
There are 3 other files named bnk3.ban in the archive. Click here to see a list.
C *** BANK ***
C
C SUBROUTINE TO REPLACE DATA FOUND IN BANK FILE. MAY BE USED TO REPLACE
C BOTH DATA AND DICTIONARY INFORMATION (NAMES AND DESCRIPTIONS)
C
SUBROUTINE REPLAC
DIMENSION ID(12500),LV(125),NNS(18,6),IWO(125),IPP(125)
DIMENSION IADD(125),D(12500),WORD(3),NAMM(5),INPUT(80)
DIMENSION VAL1(15),VAL2(15),VALNEW(15)
EQUIVALENCE (LV,NNS),(ID,D),(MISS,AMISS)
COMMON /GEN/ IPROJA,IPROGA,NV,NO,BNKNM,DATCR,NPROJR,NPROGR
COMMON /DEV/ IDLG,ICC,IBNK
COMMON /VAR/ LICVR,NHV,IV(2,20)
COMMON /OBS/ LICOB,NHO,IO(2,20)
COMMON /SEL/ NS,ISEL(5,20),IDATA(20,20)
COMMON /CNST/ LICCON,CNVAL,ICNVAL,NUMCNS
COMMON /IDINFO/ LICID,LICIN,LICWO
COMMON /REFRN/ NREF,IREF(2),NAMREF(2),MODREF(2)
DOUBLE PRECISION BNKNM
DATA VAL1,VAL2/15*'1',15*'2'/
DATA MISS/"400000000000/
IWW=LICWO*3+NREF+1
MSIGN='MISS'
LSW=0
NUMBRV=0
IF(LICID.EQ.1) GO TO 200
DO 101 I=1,NHV
101 NUMBRV=NUMBRV+IV(2,I)-IV(1,I)+1
NUMBRV=NUMBRV+NS+NREF
IF(NUMBRV.GT.1000) PAUSE 'ERROR'
LND=12500/NUMBRV-2
IF(LND.GT.125) LND=125
JND=LND+2
C
C DATA LIST
C
C HEADER FIRST
C
IF(LICCON.EQ.1) GO TO 109
GO TO (10,11,12,109,14,15) IWW
10 WRITE(IDLG,20)
20 FORMAT(3X,'OBS',1X,'VAR',3X,'OLD VALUE',8X,'NEW VALUE'/)
GO TO 109
11 WRITE(IDLG,21) NAMREF(1)
21 FORMAT(3X,'OBS',1X,'VAR',3X,A5,12X,'OLD VALUE',8X,'NEW VALUE'/)
GO TO 109
12 WRITE(IDLG,22) NAMREF(1),NAMREF(2)
22 FORMAT(3X,'OBS',1X,'VAR',3X,A5,12X,A5,12X,'OLD VALUE',8X,
1'NEW VALUE'/)
GO TO 109
14 WRITE(IDLG,24) NAMREF(1)
24 FORMAT(1X,A5,12X,'NEW VALUE'/)
GO TO 109
15 WRITE(IDLG,25) NAMREF(1),NAMREF(2)
25 FORMAT(1X,A5,12X,A5,12X,'NEW VALUE'/)
109 IBLK=0
M=1
IBASE=((NO+124)/125)*NV+1
DO 103 I=1,NHV
K=IV(1,I)
105 NBLK=(K+5)/6+IBASE
IONE=K-((K-1)/6)*6
IF(NBLK.EQ.IBLK) GO TO 104
READ(IBNK#NBLK) LV
IBLK=NBLK
104 ID((NS+M+NREF)*JND-1)=NNS(1,IONE)
ID((NS+M+NREF)*JND)=NNS(10,IONE)
IF(LICCON.NE.1) GO TO 102
IF(NUMCNS.EQ.5) GO TO 102
IF((NUMCNS.EQ.0).AND.((NNS(10,IONE).EQ.0).OR.(NNS(10,IONE).EQ.
12))) GO TO 102
IF((NUMCNS.EQ.1).AND.(NNS(10,IONE).EQ.1)) GO TO 102
WRITE(IDLG,124) NNS(1,IONE)
124 FORMAT(' THE CONSTANT SPECIFIED IS NOT THE SAME MODE AS VAR:',A5)
RETURN
102 M=M+1
K=K+1
IF(K.LE.IV(2,I)) GO TO 105
103 CONTINUE
C
C RETRIEVE AND CALCULATE AND STORE ADDRESSES
C
108 I=1
NOBASE=(NO+124)/125
110 K=IO(1,I)
IBASE=(K+124)/125
KK=(IBASE-1)*125
N=0
111 IF((N+1).GT.LND) GO TO 113
N=N+1
IPP(N)=K-KK
IADD(N)=K
K=K+1
IF(K.LE.IO(2,I)) GO TO 112
I=I+1
IF(I.GT.NH0) GO TO 121
K=IO(1,I)
112 LBASE=(K+124)/125
IF(LBASE.EQ.IBASE) GO TO 111
113 IO(1,I)=K
121 IF(NS.LT.1) GO TO 181
DO 114 J=1,NS
KK=(J-1)*JND
LBLK=(ISEL(2,J)-1)*NOBASE+IBASE+1
READ(IBNK#LBLK) LV
DO 115 M=1,N
115 ID(KK+M)=LV(IPP(M))
114 CONTINUE
181 IF(NREF.LT.1) GO TO 116
DO 182 J=1,NREF
KK=(J-1+NS)*JND
LBLK=(IREF(J)-1)*NOBASE+IBASE+1
READ(IBNK#LBLK) LV
DO 183 M=1,N
183 ID(KK+M)=LV(IPP(M))
182 CONTINUE
116 L=NS+NREF
DO 117 J=1,NHV
K=IV(1,J)
118 LBLK=(K-1)*NOBASE+IBASE+1
READ(IBNK#LBLK) LV
KK=L*JND
DO 119 M=1,N
119 ID(KK+M)=LV(IPP(M))
L=L+1
K=K+1
IF(K.LE.IV(2,J)) GO TO 118
117 CONTINUE
DO 120 J=1,N
120 IWO(J)=1
C
C SELECT PORTION
C
IF(NS.LT.1) GO TO 137
DO 129 K=1,N
J=1
125 LLN=(J-1)*JND+K
IF(ISEL(3,J).NE.1) GO TO 127
DO 128 M=1,ISEL(5,J)
IF(IDATA(J,M).EQ.MISS) GO TO 123
128 CONTINUE
127 IF(ID(LLN).NE.MISS) GO TO 123
GO TO 139
123 GO TO (131,132,133,134,135,136) ISEL(3,J)
131 DO 138 M=1,ISEL(5,J)
IF(ID(LLN).EQ.IDATA(J,M)) GO TO 122
138 CONTINUE
GO TO 139
132 IF(ID(LLN).LT.IDATA(J,1)) GO TO 122
GO TO 139
133 IF(ID(LLN).LE.IDATA(J,1)) GO TO 122
GO TO 139
134 IF(ID(LLN).GT.IDATA(J,1)) GO TO 122
GO TO 139
135 IF(ID(LLN).GE.IDATA(J,1)) GO TO 122
GO TO 139
136 IF(ID(LLN).NE.IDATA(J,1)) GO TO 122
139 J=J+1
IF(J.GT.NS) GO TO 130
IF(ISEL(1,J).EQ.ISEL(1,J-1)) GO TO 125
130 IWO(K)=0
GO TO 129
122 J=J+1
IF(J.GT.NS) GO TO 129
IF(ISEL(1,J).EQ.ISEL(1,J-1)) GO TO 122
GO TO 125
129 CONTINUE
137 ISCOMP=0
DO 162 JJ=1,N
IF(IWO(JJ).EQ.0) GO TO 162
L=1
DO 161 K=NS+NREF+1,NUMBRV
IF(NREF.LT.1) GO TO 190
LLN=NS*JND+JJ
IF(ID(LLN).NE.MISS) GO TO 198
DO 191 J=8,15
191 VAL1(J)=' '
VAL1(1)='M'
VAL1(2)='I'
VAL1(3)='S'
VAL1(4)='S'
VAL1(5)='I'
VAL1(6)='N'
VAL1(7)='G'
GO TO 60
198 GO TO (192,193,194)(MODREF(1)+1)
192 ENCODE(15,30,WORD) D(LLN)
DECODE(15,146,WORD) VAL1
GO TO 60
193 DECODE(15,146,ID(LLN))(VAL1(J),J=1,5)
DO 195 J=6,15
195 VAL1(J)=' '
GO TO 60
194 ENCODE(15,35,WORD) ID(LLN)
DECODE(15,146,WORD) VAL1
196 IF(VAL1(1).NE.' ') GO TO 60
DO 197 J=1,14
197 VAL1(J)=VAL1(J+1)
VAL1(15)=' '
GO TO 196
60 IF(NREF.LT.2) GO TO 190
LLN=(NS+1)*JND+JJ
IF(ID(LLN).NE.MISS) GO TO 62
DO 61 J=8,15
61 VAL2(J)=' '
VAL2(1)='M'
VAL2(2)='I'
VAL2(3)='S'
VAL2(4)='S'
VAL2(5)='I'
VAL2(6)='N'
VAL2(7)='G'
GO TO 190
62 GO TO (63,64,65) (MODREF(2)+1)
63 ENCODE(15,30,WORD) D(LLN)
DECODE(15,146,WORD) VAL2
GO TO 190
64 DECODE(15,146,ID(LLN))(VAL2(J),J=1,5)
DO 66 J=6,15
66 VAL2(J)=' '
GO TO 190
65 ENCODE(15,35,WORD) ID(LLN)
DECODE(15,146,WORD) VAL2
67 IF(VAL1(1).NE.' ') GO TO 190
DO 68 J=1,14
68 VAL1(J)=VAL1(J+1)
VAL1(15)=' '
GO TO 67
190 KK=ID(K*JND)
NAME=ID(K*JND-1)
LLN=(K-1)*JND+JJ
IF(LICCON.EQ.1) GO TO 160
IF(LICWO.EQ.1) GO TO 143
IF(ID(LLN).NE.MISS) GO TO 142
DO 141 J=8,15
141 VALNEW(J)=' '
VALNEW(1)='M'
VALNEW(2)='I'
VALNEW(3)='S'
VALNEW(4)='S'
VALNEW(5)='I'
VALNEW(6)='N'
VALNEW(7)='G'
GO TO 143
142 GO TO (31,32,33)(KK+1)
31 ENCODE(15,30,WORD) D(LLN)
30 FORMAT(G15.7)
DECODE(15,146,WORD) VALNEW
GO TO 143
32 DECODE(5,146,ID(LLN))(VALNEW(J),J=1,5)
DO 34 J=6,15
34 VALNEW(J)=' '
GO TO 143
33 ENCODE(15,35,WORD) ID(LLN)
35 FORMAT(I15)
DECODE(15,146,WORD) VALNEW
36 IF(VALNEW(1).NE.' ') GO TO 143
DO 37 J=1,14
37 VALNEW(J)=VALNEW(J+1)
VALNEW(15)=' '
GO TO 36
143 GO TO (40,41,42,43,44,45) IWW
40 WRITE(IDLG,50) IADD(JJ),NAME,VALNEW
50 FORMAT('+',I5,1X,A5,1X,15A1,1X,'? ',$)
GO TO 145
41 WRITE(IDLG,51) IADD(JJ),NAME,VAL1,VALNEW
51 FORMAT('+',I5,1X,A5,1X,15A1,2X,15A1,1X,'? ',$)
GO TO 145
42 WRITE(IDLG,52) IADD(JJ),NAME,VAL1,VAL2,VALNEW
52 FORMAT('+',I5,1X,A5,1X,15A1,1X,15A1,1X,15A1,1X,'? ',$)
GO TO 145
43 WRITE(IDLG,53)
53 FORMAT('+? ',$)
GO TO 145
44 WRITE(IDLG,54) VAL1
54 FORMAT('+',15A1,1X,'? ',$)
GO TO 145
45 WRITE(IDLG,55) VAL1,VAL2
55 FORMAT('+',15A1,1X,15A1,1X,'? ',$)
GO TO 145
145 READ(ICC,146,END=173) INPUT
146 FORMAT(80A1)
IF(INPUT(1).EQ.'!') GO TO 173
IF((INPUT(1).EQ.'M').AND.(INPUT(2).EQ.'I').AND.
1(INPUT(3).EQ.'S').AND.(INPUT(4).EQ.'S')) GO TO 166
IF((INPUT(1).EQ.' ').AND.(INPUT(2).EQ.' ')) GO TO 161
IF(KK.EQ.1) GO TO 155
J=1
147 IF((INPUT(J).LE.'9').AND.(INPUT(J).GE.'0')) GO TO 149
IF(INPUT(J).EQ.' ') GO TO 150
IF((INPUT(J).EQ.'.').AND.(KK.EQ.0)) GO TO 149
IF((INPUT(J).EQ.'-').AND.(J.EQ.1)) GO TO 149
WRITE(IDLG,148)
148 FORMAT(' VALUE MUST BE NUMERIC'/)
GO TO 145
149 J=J+1
IF(J.LE.15) GO TO 147
150 IF(KK.EQ.0) GO TO 152
163 IF(INPUT(15).NE.' ') GO TO 152
DO 151 J=14,1,-1
151 INPUT(J+1)=INPUT(J)
INPUT(1)=' '
GO TO 163
152 ENCODE(15,146,WORD)(INPUT(J),J=1,15)
IF(KK.EQ.0) DECODE(15,153,WORD)D(LLN)
153 FORMAT(G)
IF(KK.EQ.2) DECODE(15,154,WORD) ID(LLN)
154 FORMAT(I15)
GO TO 161
C
C ALPHA VALUE
C
155 IF(INPUT(1).EQ.1H') GO TO 158
156 WRITE(IDLG,157)
157 FORMAT(' ALPHA VALUES MUST BE ENCLOSED IN QUOTES'/)
GO TO 145
158 J=2
165 IF(INPUT(J).EQ.1H') GO TO 159
J=J+1
IF(J.LE.6) GO TO 165
159 INPUT(J)=' '
ENCODE(5,146,ID(LLN)) (INPUT(J),J=2,6)
GO TO 161
C
C MISSING DATA
C
166 D(LLN)=AMISS
GO TO 161
C
C CONST SPECIFIED IN INSTRUCTION
160 IF(KK.EQ.0) D(LLN)=CNVAL
IF(KK.EQ.2) ID(LLN)=ICNVAL
IF(KK.EQ.1) D(LLN)=CNVAL
161 CONTINUE
IWO(JJ)=2
162 CONTINUE
ISCOMP=1
173 MM=NS-1+NREF
DO 170 J=1,NHV
K=IV(1,J)
172 MM=MM+1
LBLK=(K-1)*NOBASE+IBASE+1
READ(IBNK#LBLK) LV
DO 171 L=1,N
IF(IWO(L).NE.2) GO TO 171
LV(IPP(L))=ID(MM*JND+L)
171 CONTINUE
WRITE(IBNK#LBLK) LV
K=K+1
IF(K.LE.IV(2,J)) GO TO 172
170 CONTINUE
IF(ISCOMP.EQ.0) RETURN
IF(I.LE.NHO) GO TO 110
GO TO 180
C
C MODIFY IDENTIFICATION HERE.
C FORM SHOULD BE NAME; DESCRIPTION
C NO MISSING DATA (/)
C
200 IBASE=((NO+124)/125)*NV+2
DO 203 J=1,NHV
K=IV(1,J)
204 NBLK=(K-1)/6+IBASE
IONE=K-((K-1)/6)*6
READ(IBNK#NBLK)LV
WRITE(IDLG,206) NNS(1,IONE)
206 FORMAT(' VARIABLE ',A5,'? ',$)
READ(ICC,207,END=180) IADD
207 FORMAT(125A1)
IF(IADD(1).EQ.'!') RETURN
IF(IADD(1).EQ.' ') GO TO 221
DO 208 L=1,5
208 NAMM(L)=' '
N=1
209 IF((IADD(N).EQ.' ').OR.(IADD(N).EQ.';')) GO TO 210
IF(IADD(N).EQ.',') GO TO 215
IF(IADD(N).EQ.'-') GO TO 215
IF(IADD(N).EQ.')') GO TO 215
IF(IADD(N).EQ.'=') GO TO 215
IF(IADD(N).EQ.'(') GO TO 215
NAMM(N)=IADD(N)
N=N+1
IF(N.LE.5) GO TO 209
210 IF((NAMM(1).GE.'A').AND.(NAMM(1).LE.'Z')) GO TO 212
WRITE(IDLG,211)
211 FORMAT(' NAME MUST BEGIN WITH A LETTER')
GO TO 204
215 WRITE(IDLG,222)
222 FORMAT(' ILLEGAL NAME')
GO TO 204
212 ENCODE(5,207,NNS(1,IONE)) NAMM
IF(NNS(1,IONE).EQ.'ALL') GO TO 219
IF(NNS(1,IONE).EQ.'EMPTY') GO TO 219
IF(NNS(1,IONE).EQ.'STOP') GO TO 219
IF(NNS(1,IONE).EQ.'HELP') GO TO 219
IF(NNS(1,IONE).EQ.'OBS') GO TO 219
DO 213 L=2,9
213 NNS(L,IONE)=' '
GO TO 214
219 WRITE(IDLG,220) NNS(1,IONE)
220 FORMAT(' NAME "',A5,'" IS A RESERVED NAME')
GO TO 204
214 IF(IADD(N).EQ.';') GO TO 216
N=N+1
IF(N.LE.80) GO TO 214
GO TO 221
216 DO 217 L=N+1,N+40
IF(IADD(L).NE.'/') GO TO 217
WRITE(IDLG,218)
218 FORMAT(' NO MISSING DATA SUPPLIED NOW')
GO TO 204
217 CONTINUE
ENCODE(40,207,NNS(2,IONE))(IADD(L),L=N+1,N+40)
221 WRITE(IBNK#NBLK) LV
K=K+1
IF(K.LE.IV(2,J)) GO TO 204
203 CONTINUE
180 RETURN
END