1 : C CHMIDE SOURCE CHAT 05/01/12 21:59:07 5004 2 : SUBROUTINE CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC, 3 : * MLSURF,MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC, 4 : * MLIMMO,MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3) 5 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C 7 : C OPERATEUR CHI2 8 : C ON DECODE LA SOUS TABLE ISSUE DE CHI1 TADEB.IDEN 9 : C 10 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8(A-H,O-Z) 13 : -INC CCOPTIO 14 : -INC SMLENTI 15 : -INC SMLREEL 16 : -INC SMTABLE 17 : -INC SMLMOTS 18 : CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR 19 : LOGICAL LOGRE 20 : C 21 : MTAB2=ITIDEN 22 : * write(6,*)'chmide mtab2=itiden= ',MTAB2 23 : SEGACT MTAB2 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='LISTENTI' 32 : CHARR=' ' 32 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'COMP',.TRUE.,IRETI, 33 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 34 : IF(IERR.NE.0)RETURN 35 : MLCOMP=IRETR 36 : MLENTI=IRETR 37 : SEGACT MLENTI 38 : IVALI=1 39 : XVALI=0.D0 40 : IRETI=0 41 : IVALR=0 42 : XVALR=0.D0 43 : IRETR=0 44 : MTYPI='MOT ' 45 : MTYPR='LISTENTI' 46 : CHARR=' ' 46 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOLU',.TRUE.,IRETI, 47 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 48 : IF(IERR.NE.0)RETURN 49 : MLSOLU=IRETR 50 : MLENTI=IRETR 51 : SEGACT MLENTI 52 : IVALI=1 53 : XVALI=0.D0 54 : IRETI=0 55 : IVALR=0 56 : XVALR=0.D0 57 : IRETR=0 58 : MTYPI='MOT ' 59 : MTYPR='LISTMOTS' 60 : CHARR=' ' 60 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSOLU', 61 : * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 62 : IF(IERR.NE.0)RETURN 63 : MMSOLU=IRETR 64 : MLMOTS=IRETR 65 : SEGACT MLMOTS 66 : MLPREC=0 67 : MMPREC=0 68 : IVALI=1 69 : XVALI=0.D0 70 : IRETI=0 71 : IVALR=0 72 : XVALR=0.D0 73 : IRETR=0 74 : MTYPI='MOT ' 75 : MTYPR=' ' 76 : CHARR=' ' 76 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PRECI',.TRUE.,IRETI, 77 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 78 : IF(MTYPR.NE.' ')THEN 79 : IF(MTYPR.EQ.'LISTENTI')THEN 80 : MLPREC=IRETR 81 : MLENTI=IRETR 82 : SEGACT MLENTI 83 : IVALI=1 84 : XVALI=0.D0 85 : IRETI=0 86 : IVALR=0 87 : XVALR=0.D0 88 : IRETR=0 89 : MTYPI='MOT ' 90 : MTYPR='LISTMOTS' 91 : CHARR=' ' 91 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMPRECI', 92 : * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 93 : IF(IERR.NE.0)RETURN 94 : MMPREC=IRETR 95 : MLMOTS=IRETR 96 : SEGACT MLMOTS 97 : ELSE 97 : CALL ERREUR(21) 98 : ENDIF 99 : ENDIF 100 : MLPOLE=0 101 : MMPOLE=0 102 : IVALI=1 103 : XVALI=0.D0 104 : IRETI=0 105 : IVALR=0 106 : XVALR=0.D0 107 : IRETR=0 108 : MTYPI='MOT ' 109 : MTYPR=' ' 110 : CHARR=' ' 110 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'POLE',.TRUE.,IRETI, 111 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 112 : IF(MTYPR.NE.' ')THEN 113 : IF(MTYPR.EQ.'LISTENTI')THEN 114 : MLPOLE=IRETR 115 : MLENTI=IRETR 116 : SEGACT MLENTI 117 : IVALI=1 118 : XVALI=0.D0 119 : IRETI=0 120 : IVALR=0 121 : XVALR=0.D0 122 : IRETR=0 123 : MTYPI='MOT ' 124 : MTYPR='LISTMOTS' 125 : CHARR=' ' 125 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMPOLE', 126 : * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 127 : IF(IERR.NE.0)RETURN 128 : MMPOLE=IRETR 129 : * write(6,*)'chmide mmpole',mmpole 130 : MLMOTS=IRETR 131 : SEGACT MLMOTS 132 : ELSE 132 : CALL ERREUR(21) 133 : ENDIF 134 : ENDIF 135 : MLSOSO=0 136 : MMSOSO=0 137 : IVALI=1 138 : XVALI=0.D0 139 : IRETI=0 140 : IVALR=0 141 : XVALR=0.D0 142 : IRETR=0 143 : MTYPI='MOT ' 144 : MTYPR=' ' 145 : CHARR=' ' 145 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOSO',.TRUE.,IRETI, 146 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 147 : IF(MTYPR.NE.' ')THEN 148 : IF(MTYPR.EQ.'LISTENTI')THEN 149 : MLSOSO=IRETR 150 : * write(6,*)'chmide mlsoso',mlsoso 151 : MLENTI=IRETR 152 : SEGACT MLENTI 153 : IVALI=1 154 : XVALI=0.D0 155 : IRETI=0 156 : IVALR=0 157 : XVALR=0.D0 158 : IRETR=0 159 : MTYPI='MOT ' 160 : MTYPR='LISTMOTS' 161 : CHARR=' ' 161 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSOSO', 162 : * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 163 : IF(IERR.NE.0)RETURN 164 : MMSOSO=IRETR 165 : * write(6,*)'chmide mmsoso',mmsoso 166 : MLMOTS=IRETR 167 : SEGACT MLMOTS 168 : ELSE 168 : CALL ERREUR(21) 169 : ENDIF 170 : ENDIF 171 : MLSURF=0 172 : MMSURF=0 173 : IVALI=1 174 : XVALI=0.D0 175 : IRETI=0 176 : IVALR=0 177 : XVALR=0.D0 178 : IRETR=0 179 : MTYPI='MOT ' 180 : MTYPR=' ' 181 : CHARR=' ' 181 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SURF',.TRUE.,IRETI, 182 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 183 : IF(MTYPR.NE.' ')THEN 184 : IF(MTYPR.EQ.'LISTENTI')THEN 185 : MLSURF=IRETR 186 : MLENTI=IRETR 187 : SEGACT MLENTI 188 : IVALI=1 189 : XVALI=0.D0 190 : IRETI=0 191 : IVALR=0 192 : XVALR=0.D0 193 : IRETR=0 194 : MTYPI='MOT ' 195 : MTYPR='LISTMOTS' 196 : CHARR=' ' 196 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSURF', 197 : * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 198 : IF(IERR.NE.0)RETURN 199 : MMSURF=IRETR 200 : MLMOTS=IRETR 201 : SEGACT MLMOTS 202 : ELSE 202 : CALL ERREUR(21) 203 : ENDIF 204 : ENDIF 205 : MLTYP3=0 206 : MMTYP3=0 207 : IVALI=1 208 : XVALI=0.D0 209 : IRETI=0 210 : IVALR=0 211 : XVALR=0.D0 212 : IRETR=0 213 : MTYPI='MOT ' 214 : MTYPR=' ' 215 : CHARR=' ' 215 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,IRETI, 216 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 217 : IF(MTYPR.NE.' ')THEN 218 : IF(MTYPR.EQ.'LISTENTI')THEN 219 : MLTYP3=IRETR 220 : * write(6,*)'chmide mltyp3=',MLTYP3 221 : MLENTI=IRETR 222 : SEGACT MLENTI 223 : IVALI=1 224 : XVALI=0.D0 225 : IRETI=0 226 : IVALR=0 227 : XVALR=0.D0 228 : IRETR=0 229 : MTYPI='MOT ' 230 : MTYPR='LISTMOTS' 231 : CHARR=' ' 231 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMTYP3', 232 : * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 233 : IF(IERR.NE.0)RETURN 234 : MMTYP3=IRETR 235 : MLMOTS=IRETR 236 : SEGACT MLMOTS 237 : ELSE 237 : CALL ERREUR(21) 238 : ENDIF 239 : ENDIF 240 : LIMP3=0 241 : IVALI=1 242 : XVALI=0.D0 243 : IRETI=0 244 : IVALR=0 245 : XVALR=0.D0 246 : IRETR=0 247 : MTYPI='MOT ' 248 : MTYPR=' ' 249 : CHARR=' ' 249 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMP3',.TRUE.,IRETI, 250 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 251 : IF(MTYPR.NE.' ')THEN 252 : IF(MTYPR.EQ.'LISTENTI')THEN 253 : LIMP3=IRETR 254 : ELSE 254 : CALL ERREUR(21) 255 : ENDIF 256 : ENDIF 257 : MLTYP6=0 258 : MMTYP6=0 259 : IVALI=1 260 : XVALI=0.D0 261 : IRETI=0 262 : IVALR=0 263 : XVALR=0.D0 264 : IRETR=0 265 : MTYPI='MOT ' 266 : MTYPR=' ' 267 : CHARR=' ' 267 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,IRETI, 268 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 269 : IF(MTYPR.NE.' ')THEN 270 : IF(MTYPR.EQ.'LISTENTI')THEN 271 : MLTYP6=IRETR 272 : MLENTI=IRETR 273 : SEGACT MLENTI 274 : IVALI=1 275 : XVALI=0.D0 276 : IRETI=0 277 : IVALR=0 278 : XVALR=0.D0 279 : IRETR=0 280 : MTYPI='MOT ' 281 : MTYPR='LISTMOTS' 282 : CHARR=' ' 282 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMTYP6', 283 : * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 284 : IF(IERR.NE.0)RETURN 285 : MMTYP6=IRETR 286 : MLMOTS=IRETR 287 : SEGACT MLMOTS 288 : ELSE 288 : CALL ERREUR(21) 289 : ENDIF 290 : ENDIF 291 : MLPARF=0 292 : IVALI=1 293 : XVALI=0.D0 294 : IRETI=0 295 : IVALR=0 296 : XVALR=0.D0 297 : IRETR=0 298 : MTYPI='MOT ' 299 : MTYPR=' ' 300 : CHARR=' ' 300 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PARF',.TRUE.,IRETI, 301 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 302 : IF(MTYPR.NE.' ')THEN 303 : IF(MTYPR.EQ.'LISTENTI')THEN 304 : MLPARF=IRETR 305 : MLENTI=IRETR 306 : SEGACT MLENTI 307 : ELSE 307 : CALL ERREUR(21) 308 : ENDIF 309 : ENDIF 310 : MLREAC=0 311 : IVALI=1 312 : XVALI=0.D0 313 : IRETI=0 314 : IVALR=0 315 : XVALR=0.D0 316 : IRETR=0 317 : MTYPI='MOT ' 318 : MTYPR=' ' 319 : CHARR=' ' 319 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'REAC',.TRUE.,IRETI, 320 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 321 : IF(MTYPR.NE.' ')THEN 322 : IF(MTYPR.EQ.'LISTENTI')THEN 323 : MLREAC=IRETR 324 : MLENTI=IRETR 325 : SEGACT MLENTI 326 : ELSE 326 : CALL ERREUR(21) 327 : ENDIF 328 : ENDIF 329 : MLIMMO=0 330 : IVALI=1 331 : XVALI=0.D0 332 : IRETI=0 333 : IVALR=0 334 : XVALR=0.D0 335 : IRETR=0 336 : MTYPI='MOT ' 337 : MTYPR=' ' 338 : CHARR=' ' 338 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMMO',.TRUE.,IRETI, 339 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 340 : IF(MTYPR.NE.' ')THEN 341 : IF(MTYPR.EQ.'LISTENTI')THEN 342 : MLIMMO=IRETR 343 : MLENTI=IRETR 344 : SEGACT MLENTI 345 : ELSE 345 : CALL ERREUR(21) 346 : ENDIF 347 : ENDIF 348 : SEGDES MTAB2 349 : RETURN 350 : END 351 : 352 : 353 : 354 : 355 : 356 : 357 :
© Cast3M 2003 - All rights reserved.
Disclaimer