1 : C CHMDEB SOURCE CHAT 05/01/12 21:58:48 5004 2 : SUBROUTINE CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN, 3 : * MLDECY,MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP) 4 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 5 : C 6 : C OPERATEUR CHI2 7 : C ON DECODE LA TABLE ISSUE DE CHI1 8 : C 9 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : -INC CCOPTIO 13 : -INC SMLENTI 14 : -INC SMLREEL 15 : -INC SMTABLE 16 : -INC SMLMOTS 17 : CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR 18 : LOGICAL LOGRE 19 : C 20 : IRETOU=0 21 : MTAB1=0 21 : CALL LIRTAB('CHIMI1',MTAB1,1,IRETOU) 22 : IF(IRETOU.EQ.0)RETURN 23 : SEGACT MTAB1 24 : IVALI=1 25 : XVALI=0.D0 26 : IRETI=0 27 : IVALR=0 28 : XVALR=0.D0 29 : IRETR=0 30 : MTYPI='MOT ' 31 : MTYPR='TABLE ' 32 : CHARR=' ' 32 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DESCHI',.TRUE.,IRETI, 33 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 34 : IF(IERR.NE.0)RETURN 35 : MTAB2=IRETR 36 : SEGACT MTAB2 37 : IVALI=1 38 : XVALI=0.D0 39 : IRETI=0 40 : IVALR=0 41 : XVALR=0.D0 42 : IRETR=0 43 : MTYPI='MOT ' 44 : MTYPR='TABLE ' 45 : CHARR=' ' 45 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI, 46 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 47 : IF(IERR.NE.0)RETURN 48 : ITIDEN=IRETR 49 : * write(6,*)'chmdeb itiden= ',ITIDEN 50 : IVALI=1 51 : XVALI=0.D0 52 : IRETI=0 53 : IVALR=0 54 : XVALR=0.D0 55 : IRETR=0 56 : MTYPI='MOT ' 57 : MTYPR=' ' 58 : CHARR=' ' 59 : ITREDO=0 59 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'REDOX',.TRUE.,IRETI, 60 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 61 : IF(MTYPR.NE.' ')THEN 62 : IF(MTYPR.EQ.'TABLE ')THEN 63 : ITREDO=IRETR 64 : ELSE 65 : MOTERR(1:11)='REDOX ' 66 : MOTERR(12:20)='TABLE ' 66 : CALL ERREUR(627) 67 : RETURN 68 : ENDIF 69 : ENDIF 70 : IVALI=1 71 : XVALI=0.D0 72 : IRETI=0 73 : IVALR=0 74 : XVALR=0.D0 75 : IRETR=0 76 : MTYPI='MOT ' 77 : MTYPR=' ' 78 : CHARR=' ' 79 : ITEMPE=0 79 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPE',.TRUE.,IRETI, 80 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 81 : IF(MTYPR.NE.' ')THEN 82 : IF(MTYPR.EQ.'TABLE ')THEN 83 : ITEMPE=IRETR 84 : ELSE 85 : MOTERR(1:11)='TEMPE ' 86 : MOTERR(12:20)='TABLE ' 86 : CALL ERREUR(627) 87 : RETURN 88 : ENDIF 89 : ENDIF 90 : C ON DECODE LA TABLE DESCHI 91 : IVALI=1 92 : XVALI=0.D0 93 : IRETI=0 94 : IVALR=0 95 : XVALR=0.D0 96 : IRETR=0 97 : MTYPI='MOT ' 98 : MTYPR='LISTENTI' 99 : CHARR=' ' 99 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDX',.TRUE.,IRETI, 100 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 101 : IF(IERR.NE.0)RETURN 102 : MLIDX=IRETR 103 : IVALI=1 104 : XVALI=0.D0 105 : IRETI=0 106 : IVALR=0 107 : XVALR=0.D0 108 : IRETR=0 109 : MTYPI='MOT ' 110 : MTYPR='LISTENTI' 111 : CHARR=' ' 111 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDY',.TRUE.,IRETI, 112 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 113 : IF(IERR.NE.0)RETURN 114 : MLIDY=IRETR 115 : IVALI=1 116 : XVALI=0.D0 117 : IRETI=0 118 : IVALR=0 119 : XVALR=0.D0 120 : IRETR=0 121 : MTYPI='MOT ' 122 : MTYPR=' ' 123 : CHARR=' ' 123 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDZ',.TRUE.,IRETI, 124 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 125 : IF(IERR.NE.0)RETURN 126 : MLIDZ=IRETR 127 : IVALI=1 128 : XVALI=0.D0 129 : IRETI=0 130 : IVALR=0 131 : XVALR=0.D0 132 : IRETR=0 133 : MTYPI='MOT ' 134 : MTYPR='LISTENTI' 135 : CHARR=' ' 135 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDP',.TRUE.,IRETI, 136 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 137 : MLIDP=IRETR 138 : IVALI=1 139 : XVALI=0.D0 140 : IRETI=0 141 : IVALR=0 142 : XVALR=0.D0 143 : IRETR=0 144 : MTYPI='MOT ' 145 : MTYPR='LISTENTI' 146 : CHARR=' ' 146 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NN',.TRUE.,IRETI, 147 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 148 : IF(IERR.NE.0)RETURN 149 : MLNN=IRETR 150 : IVALI=1 151 : XVALI=0.D0 152 : IRETI=0 153 : IVALR=0 154 : XVALR=0.D0 155 : IRETR=0 156 : MTYPI='MOT ' 157 : MTYPR='LISTENTI' 158 : CHARR=' ' 158 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDSURF',.TRUE.,IRETI, 159 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 160 : IF(IERR.NE.0)RETURN 161 : MLDECY=IRETR 162 : IVALI=1 163 : XVALI=0.D0 164 : IRETI=0 165 : IVALR=0 166 : XVALR=0.D0 167 : IRETR=0 168 : MTYPI='MOT ' 169 : MTYPR='LISTENTI' 170 : CHARR=' ' 170 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'CHARGE',.TRUE.,IRETI, 171 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 172 : IF(IERR.NE.0)RETURN 173 : MLIONZ=IRETR 174 : IVALI=1 175 : XVALI=0.D0 176 : IRETI=0 177 : IVALR=0 178 : XVALR=0.D0 179 : IRETR=0 180 : MTYPI='MOT ' 181 : MTYPR='LISTREEL' 182 : CHARR=' ' 182 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MATRICEA',.TRUE.,IRETI, 183 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 184 : IF(IERR.NE.0)RETURN 185 : MLAA=IRETR 186 : IVALI=1 187 : XVALI=0.D0 188 : IRETI=0 189 : IVALR=0 190 : XVALR=0.D0 191 : IRETR=0 192 : MTYPI='MOT ' 193 : MTYPR=' ' 194 : CHARR=' ' 194 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MATRICEF',.TRUE.,IRETI, 195 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 196 : IF(IERR.NE.0)RETURN 197 : MLFF=IRETR 198 : IVALI=1 199 : XVALI=0.D0 200 : IRETI=0 201 : IVALR=0 202 : XVALR=0.D0 203 : IRETR=0 204 : MTYPI='MOT ' 205 : MTYPR='LISTREEL' 206 : CHARR=' ' 206 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,IRETI, 207 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 208 : IF(IERR.NE.0)RETURN 209 : MLOGK=IRETR 210 : IVALI=1 211 : XVALI=0.D0 212 : IRETI=0 213 : IVALR=0 214 : XVALR=0.D0 215 : IRETR=0 216 : MTYPI='MOT ' 217 : MTYPR='LISTMOTS' 218 : CHARR=' ' 218 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOM',.TRUE.,IRETI, 219 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 220 : IF(IERR.NE.0)RETURN 221 : MLNAME=IRETR 222 : IVALI=1 223 : XVALI=0.D0 224 : IRETI=0 225 : IVALR=0 226 : XVALR=0.D0 227 : IRETR=0 228 : MTYPI='MOT ' 229 : MTYPR='LISTMOTS' 230 : CHARR=' ' 230 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMESPECE',.TRUE.,IRETI, 231 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 232 : IF(IERR.NE.0)RETURN 233 : MLNESP=IRETR 234 : SEGDES MTAB1,MTAB2 235 : c write(6,*)'fin chmdeb' 236 : c write(6,*)'nxdim, nydim, nzdim ',nxdim,nydim,nzdim 237 : c write(6,*)'idx ',(idx(i),i=1,nxdim) 238 : c write(6,*)'idy ',(idy(i),i=1,nydim) 239 : c write(6,*)'idz ',(idz(i),i=1,nzdim) 240 : c do 700 i=1,nydim 241 : c write(6,*)'idy ',idy(i),'aa ',(aa(j),j=1,nxdim) 242 : c 700 continue 243 : c do 800 k=1,nzdim 244 : c write(6,*)'idz ',idz(k),'ff ',(ff(i),i=1,nydim) 245 : c 800 continue 246 : RETURN 247 : END 248 : 249 : 250 : 251 : 252 :
© Cast3M 2003 - All rights reserved.
Disclaimer