Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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