Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/bank/bnk6.ban
There are 3 other files named bnk6.ban in the archive. Click here to see a list.
C *** BANK ***
C
C SUBROUTINE TO TYPE DATA FOR THE USER ON TELETYPE OR TERMINAL.
C BOTH DATA AND DICTIONARY(NAMES DESCRIPTIONS) MAY BE TYPED.
C
SUBROUTINE TYPE
DIMENSION ID(12500),LV(125),NNS(18,6),IOUT(5),FOUT(5),IWO(125)
DIMENSION IADD(125),D(12500),ISOC(9),TMP(2)
EQUIVALENCE (LV,NNS),(IOUT,FOUT),(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 /IDINFO/ LICID,LICIN,LICWO
DOUBLE PRECISION BNKNM,DATCR
DATA MISS/"400000000000/
MSIGN='MISS'
LSW=0
NUMBRV=0
DO 101 I=1,NHV
101 NUMBRV=NUMBRV+IV(2,I)-IV(1,I)+1
NUMBRV=NUMBRV+NS
IF(NUMBRV.GT.1000) PAUSE 'ERROR'
LND=12500/NUMBRV-1
IF(LND.GT.125) LND=125
JND=LND+1
C
C DATA LIST
C
C HEADER FIRST
C
IBLK=0
IBASE=((NO+124)/125)*NV+1
IF((LICIN.EQ.0).AND.((LICVR.NE.0).OR.(LICOB.NE.0).OR.
1(NS.NE.0))) GO TO 121
C
C INFO HEADER
C
200 READ(IBNK#1) LV
IF((IV(1,1).NE.1).OR.(IV(2,1).NE.NV).OR.(NS.NE.0).OR.
1(IO(1,1).NE.1).OR.(IO(2,1).NE.NO)) GO TO 203
WRITE(IDLG,201) BNKNM,LV(1),LV(2),LV(4),LV(5)
201 FORMAT('1BANK ',A10/'0CONTAINS ',I5,' VARIABLES AND',
1I6,' OBSERVATIONS, CREATED ON ',2A5)
WRITE(IDLG,202) LV(6),LV(7)
202 FORMAT(' PROJECT-PROGRAMMER NUMBER ',O6,', ',O6,' IS RESPONSIBLE',
1' FOR CONTENT')
203 IF(LICWO.EQ.0) WRITE(IDLG,204)
204 FORMAT('0',2X,'VARIABLE'/' NAME',3X,'NUMBER',3X,'MODE',5X,
1'DATA DESCRIPTION')
DO 205 J=1,NHV
K=IV(1,J)
206 NBLK=(K-1)/6+1+IBASE
IF(NBLK.EQ.IBLK) GO TO 208
READ(IBNK#NBLK) LV
IBLK=NBLK
208 IONE=K-((K-1)/6)*6
ID((NS+M)*JND)=NNS(10,IONE)
MODE='FLOAT'
IF(NNS(10,IONE).EQ.1) MODE='ALPHA'
IF(NNS(10,IONE).EQ.2) MODE='FIXED'
DO 211 M=9,2,-1
IF(NNS(M,IONE).NE.' ') GO TO 209
211 CONTINUE
209 WRITE(IDLG,207) NNS(1,IONE),K,MODE,(NNS(L,IONE),L=2,M)
207 FORMAT(1X,A5,2X,I4,5X,A5,4X,8A5)
K=K+1
IF(K.LE.IV(2,J)) GO TO 206
205 CONTINUE
IF(LICIN.EQ.1) GO TO 160
C
C
C
121 IF(LICWO.EQ.0) WRITE(IDLG,102)
102 FORMAT('1',2X,'OBS.',13X,'VARIABLES')
IBLK=0
J=1
M=1
IFSCSC=0
DO 103 I=1,NHV
K=IV(1,I)
105 NBLK=(K+5)/6+IBASE
IF(NBLK.EQ.IBLK) GO TO 104
READ(IBNK#NBLK) LV
IBLK=NBLK
104 IONE=K-(K/6)*6
IF(IONE.EQ.0) IONE=6
IOUT(J)=NNS(1,IONE)
ID((NS+M)*JND)=NNS(10,IONE)
IF((IOUT(J).EQ.'SOCSC').AND.(NNS(10,IONE).EQ.2)) IFSCSC=M+NS
J=J+1
M=M+1
IF(J.LE.5) GO TO 107
IF(LICWO.EQ.0) WRITE(IDLG,106)(IOUT(J),J=1,5)
106 FORMAT(9X,5(3X,A5,4X))
J=1
107 K=K+1
IF(K.LE.IV(2,I)) GO TO 105
103 CONTINUE
IF((J.GT.1).AND.(LICWO.EQ.0)) WRITE(IDLG,106)(IOUT(K),K=1,J-1)
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
IWO(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 148
K=IO(1,I)
112 LBASE=(K+124)/125
IF(LBASE.EQ.IBASE) GO TO 111
113 IO(1,I)=K
148 IF(NS.LT.1) GO TO 116
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(IWO(M))
114 CONTINUE
116 L=NS
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(IWO(M))
L=L+1
K=K+1
IF(K.LE.IV(2,J)) GO TO 118
117 CONTINUE
DO 129 J=1,N
C
C SELECTS ARE PROCESSED
C
IF(NS.LT.1) GO TO 137
K=1
180 LLN=(K-1)*JND+J
IF(ISEL(3,K).NE.1) GO TO 181
DO 182 M=1,ISEL(5,K)
IF(IDATA(K,M).EQ.MISS) GO TO 123
182 CONTINUE
181 IF(ID(LLN).NE.MISS) GO TO 123
GO TO 190
123 GO TO (131,132,133,134,135,136) ISEL(3,K)
131 DO 183 M=1,ISEL(5,K)
IF(ID(LLN).EQ.IDATA(K,M)) GO TO 122
183 CONTINUE
GO TO 190
132 IF(ID(LLN).LT.IDATA(K,1)) GO TO 122
GO TO 190
133 IF(ID(LLN).LE.IDATA(K,1)) GO TO 122
GO TO 190
134 IF(ID(LLN).GT.IDATA(K,1)) GO TO 122
GO TO 190
135 IF(ID(LLN).GE.IDATA(K,1)) GO TO 122
GO TO 190
136 IF(ID(LLN).NE.IDATA(K,1)) GO TO 122
GO TO 190
190 K=K+1
IF(K.GT.NS) GO TO 129
IF(ISEL(1,K).EQ.ISEL(1,K-1)) GO TO 180
GO TO 129
122 K=K+1
IF(K.GT.NS) GO TO 137
IF(ISEL(1,K).EQ.ISEL(1,K-1)) GO TO 122
GO TO 180
137 WRITE(IDLG,150)
IF(LTCWO.EQ.0) WRITE(IDLG,140) IADD(J)
140 FORMAT(' ',I6,2X,$)
L=1
DO 149 K=NS+1,NUMBRV
LLN=(K-1)*JND+J
IF(ID(LLN).NE.MISS) GO TO 142
WRITE(IDLG,147)
147 FORMAT('+ MISSING ',$)
GO TO 145
142 KK=ID(K*JND)+1
GO TO (151,152,153) KK
151 WRITE(IDLG,143) D(LLN)
143 FORMAT('+',G11.4,1X,$)
GO TO 145
152 WRITE(IDLG,141) D(LLN)
141 FORMAT('+',3X,A5,4X,$)
GO TO 145
153 IF(IFSCSC.EQ.K) GO TO 170
IF((ID(LLN).LT.100000).AND.(ID(LLN).GT.-10000)) GO TO 154
WRITE(IDLG,144) ID(LLN)
144 FORMAT('+',I11,1X,$)
GO TO 145
154 WRITE(IDLG,155) ID(LLN)
155 FORMAT('+',I5,7X,$)
GO TO 145
170 ENCODE(9,171,TMP) ID(LLN)
171 FORMAT(I9)
DECODE(9,172,TMP) ISOC
172 FORMAT(9A1)
DO 173 MM=1,9
IF(ISOC(MM).EQ.' ') ISOC(MM)='0'
173 CONTINUE
WRITE(IDLG,174) ISOC
174 FORMAT('+',3A1,'-',2A1,'-',4A1,1X,$)
GO TO 145
145 L=L+1
IF((L.LE.5).OR.(K.EQ.NUMBRV)) GO TO 149
WRITE(IDLG,150)
WRITE(IDLG,146)
146 FORMAT('+',8X,$)
L=1
149 CONTINUE
129 CONTINUE
IF(I.LE.NHO) GO TO 110
WRITE(IDLG,150)
150 FORMAT(1X)
160 RETURN
END