PDP-10 Archive: 43,50521/bnk3.ban from decuslib10-10

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50521/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
	HDRP=0
      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
C
C     HEADER FIRST, ONLY IF NEEDED
C
143   IF(LICCON.EQ.1) GO TO 109
	IF(HDRP.NE.0)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	HDRP=1
      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