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