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