1 : C CHIRED SOURCE CHAT 05/01/12 21:57:59 5004 2 : SUBROUTINE CHIRED(IDSCHI,MTAB1,MTAB2,IZIADR,IADH,MLENT3,LIMP3) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C------------------------------------------------------------------ 6 : C 7 : C CHARGEMENT DES TABLES IDEN ET REDOX 8 : C MTAB1 = POINTEUR TABLE IDEN 9 : C MTAB2 = POINTEUR TABLE REDOX 10 : C = 0 EN ENTREE 11 : C MLENT3= POINTEUR DES COMPOSANTS IMMOBILES POUR 12 : C LES CONDITIONS AUX LIMITES DES TYPE 3 13 : C ( LU ET VERIFIE DANS CHICLM ,PEUT ETRE NUL) 14 : C LIMP3 = POINTEUR DE LA LISTE DES ESPECES MISES EN 15 : C TYP3 PAR CLIM ( TAB1.CLIM.TYP3) 16 : C 17 : C------------------------------------------------------------------ 18 : -INC SMTABLE 19 : -INC SMLENTI 20 : -INC SMLREEL 21 : -INC SMLMOTS 22 : -INC CCOPTIO 23 : SEGMENT IDSCHI 24 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 25 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 26 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 27 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 28 : ENDSEGMENT 29 : SEGMENT IZIADR 30 : INTEGER IADR(NCR) 31 : ENDSEGMENT 32 : SEGMENT IZRED 33 : INTEGER ITAB(NCR,2) 34 : REAL*8 ATAB(NCR,2) 35 : ENDSEGMENT 36 : SEGMENT IZREDI 37 : INTEGER IRCR(MCR),ICR(LCR) 38 : ENDSEGMENT 39 : SEGMENT IZIMM 40 : INTEGER IADE(NCE),IADC(NCC),IMM(NIMM) 41 : ENDSEGMENT 42 : SEGMENT IZRIAD 43 : INTEGER IRAD(NIRA),ICONS(NXDIM) 44 : ENDSEGMENT 45 : SEGMENT IZSS 46 : INTEGER ISOLU(NYDIM),ISURF(NYDIM) 47 : ENDSEGMENT 48 : CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR 49 : C 50 : C CHITRI1 CREE ET CHARGE IZIADR et IADH 51 : IZRED=0 52 : IZREDI=0 53 : IF(IZIADR.NE.0)THEN 54 : C CHITRI CREE ET CHARGE IZRED 54 : CALL CHITRI(IDSCHI,IZIADR,IZRED,IZREDI) 55 : ENDIF 56 : NXDIM=IDX(/1) 57 : NYDIM=IDY(/1) 58 : NZDIM=IDZ(/1) 59 : NPDIM=IDP(/1) 60 : JSOH=0 61 : NCE=NN(3) 62 : NCC=NN(3) 63 : NIRA=NXDIM 64 : NIMM=NXDIM 65 : SEGINI IZIMM ,IZRIAD 66 : C ON VA METTRE DANS IRAD UN INDICE POUR CHAQUE 67 : C COMPOSANT 3=IMMOBILE 2=REACTIFS 1=CONSERVATIF 67 : CALL INITI(IRAD,NIRA,2) 68 : C TRI RELATION TYP3 69 : NCE=0 70 : NCC=0 71 : JI=NN(1)+NN(2)+1 72 : JM= NN(1)+NN(2)+NN(3) 73 : DO 20 JJ=JI,JM 74 : DO 10 J=1,NXDIM 75 : IF (IDX(J).EQ.IDY(JJ)) THEN 76 : NCE =NCE+1 77 : IADE(NCE)=IDX(J) 78 : IRAD(J)=3 79 : GO TO 16 80 : ENDIF 81 : 10 CONTINUE 82 : NCC =NCC+1 83 : IADC(NCC)=IDY(JJ) 84 : 16 CONTINUE 85 : 20 CONTINUE 86 : C------------------------------------------------------------- 87 : C RECHERCHE DES COMPOSANTS NON TRANSPORTES 88 : NIMM=0 89 : IF(IADH.NE.0)THEN 90 : NIMM=NIMM+1 91 : IMM(NIMM)=60 91 : CALL CHIADY(IDX,NXDIM,60,III) 92 : IRAD(III)=3 93 : ENDIF 94 : IF(IZRED.NE.0)THEN 95 : MCR=IRCR(/1) 95 : CALL RSETI(IMM(NIMM+1),IRCR,MCR) 96 : NIMM=NIMM+MCR 97 : DO 25 J=1,MCR 98 : JJ=IRCR(J) 98 : CALL CHIADY(IDX,NXDIM,JJ,III) 99 : IRAD(III)=3 100 : 25 CONTINUE 101 : ENDIF 102 : IF(NCE.NE.0)THEN 102 : CALL RSETI(IMM(NIMM+1),IADE,NCE) 103 : NIMM=NIMM+NCE 104 : ENDIF 105 : JN=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1 106 : JK=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6) 107 : NADSORB=0 108 : DO 40 J=1,NXDIM 109 : IF(IDX(J).EQ.80) NADSORB=NADSORB+1 110 : C /TEST SUR LES SITES DE SURFACES/ 111 : IF (IDX(J).GE.90.AND.IDX(J).LE.96) THEN 112 : C 113 : NADSORB=NADSORB+1 114 : NIMM=NIMM+1 115 : IMM(NIMM)=IDX(J) 116 : IRAD(J)=3 117 : ENDIF 118 : 119 : C /TEST SUR LES COMPOSANTS DE TYPE 6/ 120 : 121 : DO 30 JJ=JN,JK 122 : IF (IDX(J).EQ.IDY(JJ)) THEN 123 : IF ( IDX(J).NE.99) THEN 124 : NIMM=NIMM+1 125 : IMM(NIMM)=IDX(J) 126 : IRAD(J)=3 127 : ENDIF 128 : ENDIF 129 : 30 CONTINUE 130 : 40 CONTINUE 131 : C PRISE EN COMPTE DES COMPOSANTS IMMOBILES DE CLIM TYP3 132 : C ON A DEJA VERIFIE LEUR EXISTANCE 133 : IF(MLENT3.GT.0)THEN 134 : NL=MLENT3.LECT(/1) 135 : MLENT1=LIMP3 136 : SEGACT MLENT1 137 : DO 35 J=1,NL 138 : IDXT=MLENT3.LECT(J) 139 : IDYT= MLENT1.LECT(J) 140 : IF(IDXT.NE.IDYT)THEN 141 : C ON VERIFIE QUE IDXT N'EST PAS DEJA IMMOBILE 141 : CALL CHIADY(IMM,NIMM,IDXT,III) 142 : IF(III.EQ.0)THEN 143 : NIMM=NIMM+1 144 : IMM(NIMM)=IDXT 144 : CALL CHIADY(IDX,NXDIM,IDXT,JJ) 145 : IRAD(JJ)=3 146 : ELSE 147 : C WRITE(6,*) ' LE COMPOSANT ',IDXT,' EST DEJA IMMOBILE' 148 : INTERR(1)=IDXT 148 : CALL ERREUR(778) 149 : RETURN 150 : ENDIF 151 : ENDIF 152 : 35 CONTINUE 153 : SEGDES MLENT1 154 : ENDIF 155 : C ---------------------------------------------------- 156 : C 157 : C RECHERCHE DU NOMBRE DE COMPOSANTS CONSERVATIFS: NCONS 158 : 159 : NCONS=0 160 : 161 : C TEST DE LA PRESENCE D'UN COMPOSANT DANS UNE ESPECE ADSORBEE 162 : 163 : IJ=NN(1)+1 164 : IK=NN(1)+NN(2)+NN(3)+NN(4) 164 : CALL CHIADY(IDX,NXDIM,90,JSOH) 165 : DO 65 J=1,NXDIM 166 : IF(JSOH.GT.0) THEN 167 : DO 45 I=IJ,IK 168 : IF (AA(I,JSOH).GT.0.D0.AND.ABS(AA(I,J)).GT.0.D0) GOTO 60 169 : 45 CONTINUE 170 : ENDIF 171 : 172 : C/ TEST DE LA PRESENCE D'UN COMPOSANT DANS UNE ESPECE SOLIDE 173 : C DE TYPE 3, 4 OU 5. 174 : 175 : JI=NN(1)+NN(2)+1 176 : IM=NN(1)+NN(2)+NN(3)+NN(4)+NN(5) 177 : 178 : DO 50 I=JI,IM 179 : IF (ABS(AA(I,J)).GT.0.D0) THEN 180 : * WRITE(6,*) ' SOLIDE ',IDX(J) 181 : GO TO 60 182 : ENDIF 183 : 184 : 50 CONTINUE 185 : 186 : ** ESPECE ECHANGEE 187 : DO 55 I = IJ,IK 188 : IF (ABS(AA(I,J)).GT.0.D0) THEN 189 : IF(IDECY(I).NE.0) THEN 190 : C WRITE(6,*) ' ECHANGE',IDX(J) 191 : GO TO 60 192 : ENDIF 193 : ENDIF 194 : 55 CONTINUE 195 : 196 : IF(IRAD(J).NE.3)THEN 197 : NCONS=NCONS+1 198 : ICONS(NCONS)=IDX(J) 199 : IRAD(J)=1 200 : C WRITE(6,*) 'ICONS(',N,'): ',IDX(J) 201 : ENDIF 202 : 60 CONTINUE 203 : 65 CONTINUE 204 : C -------------------------------------------------------- 205 : SEGACT MTAB1 206 : IVALI=0 207 : XVALI=0.D0 208 : IRETI=0 209 : IVALR=0 210 : XVALR=0.D0 211 : MTYPI='MOT ' 212 : IF(NIMM.NE.0)THEN 213 : JG=NIMM 214 : SEGINI MLENTI 214 : CALL RSETI(LECT,IMM,JG) 215 : IRETR=MLENTI 216 : MTYPR='LISTENTI' 217 : CHARR=' ' 217 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IMMO',.TRUE., 218 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 219 : SEGDES MLENTI 220 : ENDIF 221 : IF(NCONS.NE.0)THEN 222 : JG=NCONS 223 : SEGINI MLENTI 223 : CALL RSETI(LECT,ICONS,JG) 224 : IRETR=MLENTI 225 : MTYPR='LISTENTI' 226 : CHARR=' ' 226 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'PARF',.TRUE., 227 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 228 : SEGDES MLENTI 229 : ENDIF 230 : C COMPOSANTS REACTIFS 231 : JJG=NXDIM-NCONS-NIMM 232 : IF(JJG.NE.0)THEN 233 : JG=JJG 234 : SEGINI MLENTI 235 : I=0 236 : DO 70 J=1,NXDIM 237 : IF(IRAD(J).EQ.2)THEN 238 : I=I+1 239 : LECT(I)=IDX(J) 240 : ENDIF 241 : 70 CONTINUE 242 : IRETR=MLENTI 243 : MTYPR='LISTENTI' 244 : CHARR=' ' 244 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'REAC',.TRUE., 245 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 246 : SEGDES MLENTI 247 : ENDIF 248 : IF(NN(6).NE.0)THEN 249 : C TYP6 250 : JG=NN(6) 251 : SEGINI MLENTI 252 : JN=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1 252 : CALL RSETI(LECT,IDY(JN),JG) 253 : IRETR=MLENTI 254 : MTYPR='LISTENTI' 255 : CHARR=' ' 255 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP6',.TRUE., 256 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 257 : SEGDES MLENTI 258 : JGN=4 259 : JGM=JG 260 : SEGINI MLMOTS 261 : DO 71 I=1,JG 262 : NLL=JN-1+I 263 : WRITE(MOTS(I),110)NLL 264 : 71 CONTINUE 265 : IRETR=MLMOTS 266 : MTYPR='LISTMOTS' 267 : CHARR=' ' 267 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMTYP6',.TRUE., 268 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 269 : SEGDES MLMOTS 270 : ENDIF 271 : C TYP3 272 : IF(NN(3).NE.0)THEN 273 : JG=NN(3) 274 : SEGINI MLENTI 275 : JN=NN(1)+NN(2)+1 275 : CALL RSETI(LECT,IDY(JN),JG) 276 : IRETR=MLENTI 277 : MTYPR='LISTENTI' 278 : CHARR=' ' 278 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP3',.TRUE., 279 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 280 : SEGDES MLENTI 281 : JGN=4 282 : JGM=JG 283 : SEGINI MLMOTS 284 : DO 72 I=1,JG 285 : NLL=JN-1+I 286 : WRITE(MOTS(I),110)NLL 287 : 72 CONTINUE 288 : IRETR=MLMOTS 289 : MTYPR='LISTMOTS' 290 : CHARR=' ' 290 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMTYP3',.TRUE., 291 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 292 : SEGDES MLMOTS 293 : IF(LIMP3.NE.0) THEN 294 : IRETR=LIMP3 295 : MTYPR='LISTENTI' 296 : CHARR=' ' 296 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IMP3',.TRUE., 297 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 298 : ENDIF 299 : ENDIF 300 : C PRECIPITES POTENTIELS 301 : JJG=NN(4)+NN(5) 302 : IF(JJG.NE.0)THEN 303 : JG=JJG 304 : SEGINI MLENTI 305 : JN=NN(1)+NN(2)+NN(3)+1 305 : CALL RSETI(LECT,IDY(JN),JG) 306 : IRETR=MLENTI 307 : MTYPR='LISTENTI' 308 : CHARR=' ' 308 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'PRECI',.TRUE., 309 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 310 : SEGDES MLENTI 311 : JGN=4 312 : JGM=JG 313 : SEGINI MLMOTS 314 : DO 75 I=1,JG 315 : NLL=JN-1+I 316 : WRITE(MOTS(I),110)NLL 317 : 75 CONTINUE 318 : IRETR=MLMOTS 319 : MTYPR='LISTMOTS' 320 : CHARR=' ' 320 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMPRECI',.TRUE., 321 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 322 : SEGDES MLMOTS 323 : ENDIF 324 : C SOLUTIONS SOLIDES 325 : IF(NZDIM.NE.0)THEN 326 : JG=NN(4)+NN(5)+NN(6) 327 : SEGINI MLENTI 328 : KS=0 329 : JN=NN(1)+NN(2)+NN(3)+1 330 : DO L=1,JG 331 : NII=JN-1+L 332 : IDYNI=IDY(NII) 332 : CALL CHIADY(IDZ,NZDIM,IDYNI,IDNI) 333 : IF(IDNI.NE.0)THEN 334 : KS=KS+1 335 : LECT(KS)=IDYNI 336 : ENDIF 337 : END DO 338 : JG=KS 339 : SEGADJ MLENTI 340 : IRETR=MLENTI 341 : MTYPR='LISTENTI' 342 : CHARR=' ' 342 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SOSO',.TRUE., 343 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 344 : SEGDES MLENTI 345 : JGN=4 346 : JGM=NN(4)+NN(5)+NN(6) 347 : SEGINI MLMOTS 348 : KM=0 349 : DO I=1,JGM 350 : NLL=JN-1+I 351 : IDYNL=IDY(NLL) 351 : CALL CHIADY(IDZ,NZDIM,IDYNL,IDNL) 352 : IF(IDNL.NE.0)THEN 353 : KM=KM+1 354 : WRITE(MOTS(KM),110)NLL 355 : ENDIF 356 : END DO 357 : JGM=KM 358 : SEGADJ MLMOTS 359 : IRETR=MLMOTS 360 : MTYPR='LISTMOTS' 361 : CHARR=' ' 361 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMSOSO',.TRUE., 362 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 363 : SEGDES MLMOTS 364 : ENDIF 365 : C POLES DE SOLUTIONS SOLIDES 366 : IF(NZDIM.NE.0)THEN 367 : IF(NPDIM.NE.0)THEN 368 : JG=NN(6) 369 : SEGINI MLENTI 370 : KL=0 371 : JN=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1 372 : DO L=1,NN(6) 373 : NII=JN-1+L 374 : IDYNI=IDY(NII) 374 : CALL CHIADY(IDP,NPDIM,IDYNI,IDNI) 375 : IF(IDNI.NE.0)THEN 376 : DO K=1,NZDIM 377 : IF(FF(K,IDNI).NE.0.D0)THEN 378 : KL=KL+1 379 : LECT(KL)=IDYNI 380 : ENDIF 381 : END DO 382 : ENDIF 383 : END DO 384 : JG=KL 385 : SEGADJ MLENTI 386 : IRETR=MLENTI 387 : MTYPR='LISTENTI' 388 : CHARR=' ' 388 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'POLE',.TRUE., 389 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 390 : SEGDES MLENTI 391 : JGN=4 392 : JGM=NN(6) 393 : SEGINI MLMOTS 394 : KM=0 395 : DO I=1,NN(6) 396 : NLL=JN-1+I 397 : IDYNL=IDY(NLL) 397 : CALL CHIADY(IDP,NPDIM,IDYNL,IDNL) 398 : IF(IDNL.NE.0)THEN 399 : DO K=1,NZDIM 400 : IF(FF(K,IDNL).NE.0.D0)THEN 401 : KM=KM+1 402 : WRITE(MOTS(KM),110)NLL 403 : ENDIF 404 : END DO 405 : ENDIF 406 : END DO 407 : JGM=KM 408 : SEGADJ MLMOTS 409 : IRETR=MLMOTS 410 : MTYPR='LISTMOTS' 411 : CHARR=' ' 411 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMPOLE',.TRUE., 412 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 413 : SEGDES MLMOTS 414 : ENDIF 415 : ENDIF 416 : C TABLEAU IRAD 417 : JG=NXDIM 418 : SEGINI MLENTI 418 : CALL RSETI(LECT,IRAD,JG) 419 : IRETR=MLENTI 420 : MTYPR='LISTENTI' 421 : CHARR=' ' 421 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'COMP',.TRUE., 422 : *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 423 : SEGDES MLENTI 424 : SEGSUP IZIMM ,IZRIAD 425 : C ESPECES SOLUBLES 426 : C ET ESPECES DE SURFACE 427 : C A COMPLETER POUR LES ESPECES DE SURFACE 428 : SEGINI IZSS 429 : N1=0 430 : N3=0 431 : JK=NN(1)+NN(2) 432 : DO 85 I=1,JK 433 : IF(IDECY(I).NE.0)THEN 434 : N3=N3+1 435 : ISURF(N3)=IDY(I) 436 : GO TO 82 437 : ENDIF 438 : N1=N1+1 439 : ISOLU(N1)=IDY(I) 440 : 82 CONTINUE 441 : 85 CONTINUE 442 : IF ( N1.LT.1)THEN 443 : C WRITE(6,*)' IL N Y A PAS D ESPECE EN SOLUTION ' 443 : CALL ERREUR(779) 444 : RETURN 445 : ENDIF 446 : DO 88 I=1,NXDIM 447 : IF(IDX(I).EQ.99)THEN 447 : CALL CHIADY(IDY,NYDIM,99,J) 448 : IF( J.GT.NN(1)+NN(2)+NN(3))THEN 449 : N1=N1+1 450 : ISOLU(N1)=99 451 : ENDIF 452 : GO TO 90 453 : ENDIF 454 : 88 CONTINUE 455 : 90 CONTINUE 456 : C ESPECES EN SOLUTION 457 : JG=N1 458 : SEGINI MLENTI 458 : CALL RSETI(LECT,ISOLU,JG) 459 : IRETR=MLENTI 460 : MTYPR='LISTENTI' 461 : CHARR=' ' 461 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SOLU',.TRUE., 462 : *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 463 : SEGDES MLENTI 464 : JGN=4 465 : JGM=JG 466 : SEGINI MLMOTS 467 : DO 92 I=1,JG 467 : CALL CHIADY(IDY,NYDIM,ISOLU(I),NLL) 468 : WRITE(MOTS(I),110)NLL 469 : 92 CONTINUE 470 : IRETR=MLMOTS 471 : MTYPR='LISTMOTS' 472 : CHARR=' ' 472 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMSOLU',.TRUE., 473 : *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 474 : SEGDES MLMOTS 475 : C ESPECES DE SURFACE 476 : IF(N3.NE.0)THEN 477 : JG=N3 478 : SEGINI MLENTI 478 : CALL RSETI(LECT,ISURF,JG) 479 : IRETR=MLENTI 480 : MTYPR='LISTENTI' 481 : CHARR=' ' 481 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SURF',.TRUE., 482 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 483 : SEGDES MLENTI 484 : JGN=4 485 : JGM=JG 486 : SEGINI MLMOTS 487 : DO 93 I=1,JG 487 : CALL CHIADY(IDY,NYDIM,ISURF(I),NLL) 488 : WRITE(MOTS(I),110)NLL 489 : 93 CONTINUE 490 : IRETR=MLMOTS 491 : MTYPR='LISTMOTS' 492 : CHARR=' ' 492 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMSURF',.TRUE., 493 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 494 : SEGDES MLMOTS 495 : ENDIF 496 : SEGSUP IZSS 497 : C DESCRIPTION DES REDOX 498 : IF(IZRED.NE.0)THEN 498 : CALL CRTABL(MTAB2) 499 : NCR=ITAB(/1) 500 : JG=NCR 501 : SEGINI MLENTI 501 : if (jg.ne.0) CALL RSETI(LECT,ITAB(1,1),JG) 502 : IRETR=MLENTI 503 : MTYPR='LISTENTI' 504 : CHARR=' ' 504 : CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'I1',.TRUE., 505 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 506 : SEGDES MLENTI 507 : SEGINI MLENTI 507 : if (jg.ne.0) CALL RSETI(LECT,ITAB(1,2),JG) 508 : IRETR=MLENTI 509 : MTYPR='LISTENTI' 510 : CHARR=' ' 510 : CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'I2',.TRUE., 511 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 512 : SEGDES MLENTI 513 : SEGINI MLREEL 513 : if (jg.ne.0) CALL RSETD(PROG,ATAB(1,1),JG) 514 : IRETR=MLREEL 515 : MTYPR='LISTREEL' 516 : CHARR=' ' 516 : CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'A1',.TRUE., 517 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 518 : SEGDES MLREEL 519 : SEGINI MLREEL 519 : if (jg.ne.0) CALL RSETD(PROG,ATAB(1,2),JG) 520 : IRETR=MLREEL 521 : MTYPR='LISTREEL' 522 : CHARR=' ' 522 : CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'A2',.TRUE., 523 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 524 : SEGDES MLREEL 525 : SEGSUP IZIADR, IZRED,IZREDI 526 : ENDIF 527 : 110 FORMAT('W',I3.3) 528 : RETURN 529 : END 530 : 531 : 532 : 533 : 534 : 535 : 536 :
© Cast3M 2003 - All rights reserved.
Disclaimer