1 : C CHMSLX SOURCE CHAT 05/01/12 22:00:10 5004 2 : SUBROUTINE CHMSLX(IDSCHI,SP2,KK,JNFI,NFI,LGKMOD,LGKTMP,IZBID1) 3 : C======================================================================= 4 : C OBJET: SOLUTION DU PROBLEME PAR TRANSFORMATION EN RETOUR; 5 : C MODIFICATION AUTOMATIQUE DES CONDITIONS AUX LIMITES S'IL SE PRODUIT 6 : C UNE SURSATURATION OU UNE DISSOLUTION (DRAPEAU K DIFFERENT DE 1). 7 : C 8 : C ARGUMENT : KK, CRITERE DE TRAVAIL 9 : C 10 : C APPELLE CHMREX 11 : C 12 : C METHODE: EN PARTANT DE LA SOLUTION FOURNIE PAR CHMSLV, LES AUTRES 13 : C INCONNUES SONT OBTENUES PAR TRANSFORMATION EN RETOUR PROGRESSIVE; 14 : C LES VARIABLES CONCERNEES SONT AA, GC, CC, GX, TOT, XX, YY. 15 : C INITIALEMENT KK=0; 16 : C LES ESPECES DE TYPE VI SONT TESTEES: CC(I)>0? SI OUI, KK=-1, 17 : C DEPLACE L'ESPECE DE CC(I) LA PLUS NEGATIVE EN ESPECE DE TYPE V, 18 : C FOURNIT LE MESSAGE CORRESPONDANT; 19 : C LES ESPECES DE TYPE V SONT TESTEES A LEUR TOUR, 20 : C SI CC(I)<0 IL Y A SURSATURATION, KK=1 SI KK VALAIT 0, KK=2 SI KK 21 : C VALAIT -1; DEPLACE L'ESPECE DE CC(I) LA PLUS FORTE EN TYPE IV; 22 : C FOURNIT LE MESSAGE CORRESPONDANT. 23 : C 24 : C LA SEQUENCE TYPE EST: 25 : C ... 26 : C 10 CONTINUE 26 : C CALL CHMSL4 26 : C CALL CHMSLV 26 : C CALL CHMSLX 27 : C IF(K.NE.0) GOTO 10 28 : C ... 29 : C 30 : C======================================================================= 31 : IMPLICIT INTEGER(I-N) 32 : IMPLICIT REAL*8(A-H,O-Z) 33 : C 34 : -INC CCOPTIO 35 : SEGMENT IDSCHI 36 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 37 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 38 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 39 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 40 : ENDSEGMENT 41 : SEGMENT SP2 42 : REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM) 43 : REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM) 44 : REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM) 45 : ENDSEGMENT 46 : SEGMENT IZBID1 47 : INTEGER ID0(NYDIM,N4NXD),IDPP(N4N5) 48 : INTEGER ID0S(NZDIM,N4NPD) 49 : ENDSEGMENT 50 : C 51 : C 52 : NXDIM=IDX(/1) 53 : NYDIM=IDY(/1) 54 : NZDIM=IDZ(/1) 55 : NPDIM=IDP(/1) 56 : N4N5=IDPP(/1) 57 : N4NXD=ID0(/2) 58 : N4NPD=ID0S(/2) 58 : CALL INITI(ID0,NYDIM*N4NXD,0) 58 : CALL INITI(ID0S,NZDIM*N4NPD,0) 58 : CALL INITI(IDPP,N4N5,0) 59 : 60 : C 61 : C 62 : IF(NN(3)+NN(4).EQ.0) GO TO 470 63 : N4S=0 64 : 65 : ************************************************************************** 66 : C PRISE EN COMPTE DES SOLUTION SOLIDES : METHODE 1 67 : * IF(NZDIM.NE.0)THEN 68 : * I3S=NN(1)+NN(2)+NN(3)+1 69 : * I4S=NN(1)+NN(2)+NN(3)+NN(4) 70 : * DO 13 I7S=I3S,I4S 71 : * IDY7=IDY(I7S) 71 : * CALL CHIADY(IDZ,NZDIM,IDY7,ID7) 72 : * IF(ID7.NE.0)THEN 73 : * N4S=N4S+1 73 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDY7,4,5) 73 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDY7,5,4) 74 : * ENDIF 75 : * 13 CONTINUE 76 : * ENDIF 77 : *************************************************************************** 78 : 79 : LL=NN(3)+NN(4)-N4S 80 : II=NN(1)+NN(2) 81 : I0=NN(1)+NN(2)+1 82 : 83 : ************************************************************************** 84 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 85 : * N4S=0 86 : * IF(NZDIM.NE.0)THEN 87 : * I3S=NN(1)+NN(2)+NN(3)+1 88 : * I4S=NN(1)+NN(2)+NN(3)+NN(4) 89 : * DO 13 I7S=I3S,I4S 90 : * IDY7=IDY(I7S) 90 : * CALL CHIADY(IDZ,NZDIM,IDY7,ID7) 91 : * IF(ID7.NE.0) N4S=N4S+1 92 : * 13 CONTINUE 93 : * ENDIF 94 : *************************************************************************** 95 : 96 : J0=NXDIM-NN(3)-NN(4)+N4S+1 97 : JJ=NXDIM 98 : C 99 : * write(6,*)'CHMSLX CC ' 100 : * write(6,120)( IDY(I),CC(I),I=1,II) 101 : DO 40 J=J0,JJ 102 : * IF(IDX(J).EQ.99)WRITE(6,*)'TOTE-=',TOT(J) 103 : YY(J)=-TOT(J) 104 : C MOLE BALANCE MINUS SOLID 105 : C 106 : DO 30 I=1,II 107 : YY(J)=YY(J)+AA(I,J)*CC(I) 108 : 30 CONTINUE 109 : 40 CONTINUE 110 : C AMOUNT OF SOLID 111 : C 112 : DO 460 L=1,LL 113 : 114 : *************************************************************************** 115 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 116 : * IF(NZDIM.NE.0)THEN 117 : * IDY0=IDY(I0) 117 : * CALL CHIADY(IDZ,NZDIM,IDY0,ID0) 118 : * IF(ID0.NE.0)THEN 119 : * write(6,*)'chmslx idz(id0)',IDZ(ID0),'idy(i0)',IDY(I0) 120 : * I0=I0+1 121 : * GOTO 460 122 : * ENDIF 123 : * IF(AA(I0,J0).EQ.0.D0)THEN 124 : * I0=I0+1 125 : * GOTO 460 126 : * ENDIF 127 : * ENDIF 128 : ************************************************************************** 129 : 130 : CC(I0)=-YY(J0)/AA(I0,J0) 131 : * write(6,*)'chmslx idx(j0)',IDX(J0),'idy(i0)',IDY(I0) 132 : * write(6,*)'chmslx yy(j0)',YY(J0) 133 : * write(6,*)'chmslx aa(i0,j0)',AA(I0,J0) 134 : * write(6,*)'chmslx cc(i0)',CC(I0) 135 : B=CC(I0) 136 : C IF (ABS(CC(I0)).LT.1.D-37) B=1.D-37 137 : IF (ABS(CC(I0)).LT.1.D-60) B=1.D-60 138 : GC(I0)=LOG10(ABS(B)) 139 : DO 450 K=J0,JJ 140 : YY(K)=YY(K)+AA(I0,K)*CC(I0) 141 : 450 CONTINUE 142 : C UNMODIFY A,B,T,GX,XX 143 : C 144 : NXS=J0-1 145 : NCS=I0-1 146 : V=GK(I0) 147 : * write(6,*)'chmslx idy(io)',idy(i0),'gk(io)',gk(i0) 148 : DO 571 J=1,NXS 149 : V=V+AA(I0,J)*GX(J) 150 : * write(6,*)'chmslx 571 idx',idx(j),'gx',gx(j) 151 : * write(6,*)'chmslx 571 aa(io,j)',aa(i0,j),'v',v 152 : 571 CONTINUE 153 : 154 : *************************************************************************** 155 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 156 : * IF(NZDIM.NE.0)THEN 157 : * IDY0=IDY(I0) 157 : * CALL CHIADY(IDZ,NZDIM,IDY0,ID0) 158 : * IF(ID0.NE.0)THEN 159 : * GAJ=0.D0 160 : * DO 572 IJ=1,NPDIM 161 : * IF(FF(ID0,IJ).NE.0.D0)THEN 162 : * GAJ=GAJ+FF(ID0,IJ)*LOG10(ABS(FF(ID0,IJ))) 163 : * ENDIF 164 : *572 CONTINUE 165 : * GX(J0)=(GAJ-V)/AA(I0,J0) 166 : * ELSE 167 : * IF(NZDIM.NE.0)THEN 168 : * IDY0=IDY(I0) 168 : * CALL CHIADY(IDP,NPDIM,IDY0,ID0) 169 : * DO 572 K=1,NZDIM 170 : * IF(FF(K,ID0).NE.0.D0) GOTO 573 171 : *572 CONTINUE 172 : *573 CONTINUE 173 : * IF(FF(K,ID0).EQ.0.D0)THEN 174 : * GX(J0)=-V/AA(I0,J0) 175 : * write(6,*)'chmslx aa(io,jo)',aa(i0,j0) 176 : * write(6,*)'chmslx v',v 177 : * ELSE 178 : * LF=LOG10(ABS(FF(K,ID0))) 179 : * GX(J0)=(LF-V)/AA(I0,J0) 180 : * ENDIF 181 : * ELSE 182 : **************************************************************************** 183 : 184 : GX(J0)=-V/AA(I0,J0) 185 : 186 : ***************************************************************************** 187 : * ENDIF 188 : * ENDIF 189 : * ENDIF 190 : ************************************************************************** 191 : 192 : XX(J0)=10.D0**(GX(J0)) 193 : DO 61 I=1,NCS 194 : DO 55 J=1,NXS 195 : AA(I,J)=AA(I,J)+AA(I0,J)*AA(I,J0)/AA(I0,J0) 196 : 55 CONTINUE 197 : 61 CONTINUE 198 : C 199 : C 199 : C ANCIEN CALL TRESETA 200 : DO 12 I=1,NCS 201 : DO 10 J=1,NXS 202 : IF (ABS(AA(I,J)).LT.1.D-4) AA(I,J)=0.D0 203 : 10 CONTINUE 204 : 12 CONTINUE 205 : C 206 : C 207 : DO 62 J=1,NXS 208 : TOT(J)=TOT(J)+AA(I0,J)*TOT(J0)/AA(I0,J0) 209 : 62 CONTINUE 210 : DO 63 I=1,NCS 211 : 212 : *********************************************************************** 213 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 214 : * IF(NZDIM.NE.0)THEN 215 : * IF(GAJ.NE.0.D0)THEN 216 : * GK(I)=GK(I)+AA(I,J0)*(GK(I0)-GAJ)/AA(I0,J0) 217 : * ENDIF 218 : * ELSE 219 : * IF(NZDIM.NE.0)THEN 220 : * IF(FF(K,ID0).NE.0.D0)THEN 221 : * GK(I)=GK(I)+AA(I,J0)*(GK(I0)-LF)/AA(I0,J0) 222 : * ELSE 223 : * GK(I)=GK(I)+AA(I,J0)*GK(I0)/AA(I0,J0) 224 : * ENDIF 225 : * ELSE 226 : ********************************************************************** 227 : 228 : GK(I)=GK(I)+AA(I,J0)*GK(I0)/AA(I0,J0) 229 : 230 : ********************************************************************** 231 : * ENDIF 232 : * ENDIF 233 : ********************************************************************** 234 : 235 : 63 CONTINUE 236 : I0=I0+1 237 : J0=J0+1 238 : 460 CONTINUE 239 : 470 CONTINUE 240 : 120 FORMAT(6(1X,I5,1PD13.6)) 241 : C SOLUBILITY PRODUCTS 242 : C 243 : IF(NN(5)+NN(6).NE.0) THEN 244 : I0=NN(1)+NN(2)+NN(3)+NN(4)+1 245 : II=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6) 246 : JJ=NXDIM 247 : DO 210 I=I0,II 248 : V=GK(I) 249 : * write(6,*)'chmslx 200 gk',gk(i) 250 : DO 200 J=1,JJ 251 : V=V+AA(I,J)*GX(J) 252 : * write(6,*)'chmslx 200 idx',idx(j) 253 : * write(6,*)'chmslx 200 aa',aa(i,j),'gx',gx(j) 254 : 200 CONTINUE 255 : * write(6,*)'chmslx 200 v',v 256 : GC(I)=V 257 : CC(I)=10.D0**V 258 : 210 CONTINUE 259 : C 260 : ************************************************************************ 261 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 2 262 : KNFI=NFI/2 263 : * write(6,*)'chmslx nfi',nfi,'knfi',knfi,'jnfi',jnfi 264 : IF(JNFI.GE.KNFI.AND.NZDIM.NE.0)THEN 265 : DO 211 IA=I0,II 266 : IDYIA=IDY(IA) 266 : CALL CHIADY(IDZ,NZDIM,IDYIA,KP) 267 : 268 : C CALCUL DU DEGRE DE SATURATION DES SOLUTIONS SOLIDES 269 : IF(KP.NE.0)THEN 270 : SS(KP)=0 271 : DO 212 JA=1,NPDIM 272 : IF(FF(KP,JA).NE.0.D0)THEN 273 : IDPJA=IDP(JA) 273 : CALL CHIADY(IDY,NYDIM,IDPJA,IDJA) 274 : SS(KP)=SS(KP)+CC(IDJA) 275 : ENDIF 276 : 212 CONTINUE 277 : 278 : C CALCUL DES FRACTIONS MOLAIRES 279 : DO 213 JB=1,NPDIM 280 : IF(FF(KP,JB).NE.0.D0)THEN 281 : IDPJB=IDP(JB) 281 : CALL CHIADY(IDY,NYDIM,IDPJB,IDJB) 282 : FF(KP,JB)=CC(IDJB)/SS(KP) 283 : ENDIF 284 : 213 CONTINUE 285 : 286 : C CALCUL DES COEFFICIENTS STOECHIOMETRIQUES DES SOLUTIONS SOLIDES 287 : DO 214 JC=1,NXDIM 288 : VF=0 289 : DO 215 IB=1,NPDIM 290 : IF(FF(KP,IB).NE.0.D0)THEN 291 : IDPB=IDP(IB) 291 : CALL CHIADY(IDY,NYDIM,IDPB,IDPC) 292 : VF=VF+AA(IDPC,JC)*FF(KP,IB) 293 : AA(IA,JC)=VF 294 : ENDIF 295 : 215 CONTINUE 296 : 214 CONTINUE 297 : 298 : C CALCUL DES CONSTANTES D EQUILIBRE DES SOLUTIONS SOLIDES 299 : GS(KP)=LOG10(SS(KP)) 300 : CC(IA)=SS(KP) 301 : GC(IA)=GS(KP) 302 : GK(IA)=GS(KP) 303 : DO 216 JD=1,NPDIM 304 : IDPJD=IDP(JD) 304 : CALL CHIADY(IDY,NYDIM,IDPJD,IDJD) 305 : IF(FF(KP,JD).NE.0.D0)THEN 306 : GK(IA)=GK(IA)+FF(KP,JD)*(GK(IDJD)-GC(IDJD)) 307 : ENDIF 308 : 216 CONTINUE 309 : ENDIF 310 : 211 CONTINUE 311 : ENDIF 312 : ENDIF 313 : *********************************************************************** 314 : 315 : *********************************************************************** 316 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 317 : * IF(NZDIM.NE.0)THEN 318 : * DO 211 IA=1,NZDIM 319 : * IDZIA=IDZ(IA) 319 : * CALL CHIADY(IDY,NYDIM,IDZIA,KP) 320 : * SS(IA)=0 321 : * DO 212 JA=1,NPDIM 322 : * IF(FF(IA,JA).NE.0.D0)THEN 323 : * IDPJA=IDP(JA) 323 : * CALL CHIADY(IDY,NYDIM,IDPJA,IDJA) 324 : * SS(IA)=SS(IA)+CC(IDJA) 325 : * ENDIF 326 : *212 CONTINUE 327 : * DO 213 JB=1,NPDIM 328 : * IF(FF(IA,JB).NE.0.D0)THEN 329 : * IDPJB=IDP(JB) 329 : * CALL CHIADY(IDY,NYDIM,IDPJB,IDJB) 330 : * FF(IA,JB)=CC(IDJB)/SS(IA) 331 : * ENDIF 332 : *213 CONTINUE 333 : * DO 214 JC=1,NXDIM 334 : * VF=0 335 : * DO 215 IB=1,NPDIM 336 : * IF(FF(IA,IB).NE.0.D0)THEN 337 : * IDPB=IDP(IB) 337 : * CALL CHIADY(IDY,NYDIM,IDPB,IDPC) 338 : * VF=VF+AA(IDPC,JC)*FF(IA,IB) 339 : * AA(KP,JC)=VF 340 : * ENDIF 341 : *215 CONTINUE 342 : *214 CONTINUE 343 : * 344 : * II0=NN(1)+NN(2)+NN(3)+NN(4)+1 345 : * III=NN(1)+NN(2)+NN(3)+NN(4)+NN(5) 346 : * DO 216 I=II0,III 347 : * IDYI=IDY(I) 347 : * CALL CHIADY(IDZ,NZDIM,IDYI,IK) 348 : * IF(IK.NE.0)THEN 349 : * GS(IA)=LOG10(SS(IA)) 350 : * CC(KP)=SS(IA) 351 : * GC(KP)=GS(IA) 352 : * GK(KP)=GS(IA) 353 : * DO 217 JD=1,NPDIM 354 : * IDPJD=IDP(JD) 354 : * CALL CHIADY(IDY,NYDIM,IDPJD,IDJD) 355 : * IF(FF(IA,JD).NE.0.D0)THEN 356 : ** GK(KP)=GK(KP)+FF(IA,JD)*GK(IDJD) 357 : ** GK(KP)=GK(KP)+FF(IA,JD)*(GK(IDJD)-GS(IA)) 358 : ** LF=LOG10(ABS(FF(IA,JD))) 359 : ** GK(KP)=GK(KP)+FF(IA,JD)*(GK(IDJD)+LF) 360 : ** GK(KP)=GK(KP)+FF(IA,JD)*(GK(IDJD)+GC(IDJD)) 361 : ** GK(KP)=GK(KP)+FF(IA,JD)*(GK(IDJD)-GC(IDJD)+LF) 362 : * GK(KP)=GK(KP)+FF(IA,JD)*(GK(IDJD)-GC(IDJD)) 363 : * ENDIF 364 : * 217 CONTINUE 365 : * ELSE 366 : * GS(IA)=LOG10(SS(IA)) 367 : * GK(KP)=GS(IA) 368 : * DO 218 JD=1,NPDIM 369 : * IDPJD=IDP(JD) 369 : * CALL CHIADY(IDY,NYDIM,IDPJD,IDJD) 370 : * IF(FF(IA,JD).NE.0.D0)THEN 371 : * GK(KP)=GK(KP)+FF(IA,JD)*(GK(IDJD)-GC(IDJD)) 372 : * ENDIF 373 : * 218 CONTINUE 374 : * ENDIF 375 : * 216 CONTINUE 376 : *211 CONTINUE 377 : * ENDIF 378 : * write(6,*)'chmslx appel de chmout' 378 : * call chmout(idschi,sp2) 379 : ************************************************************************** 380 : 381 : C CHECK FOR PRECIPITATION/DISSOLUTION 382 : IF(IIMPI.EQ.2) WRITE(6,*) 'CHECK FOR PRECIPITATION/DISSOLUTION' 383 : ID1=0 384 : ID2=0 385 : ID3=0 386 : ID4=0 387 : VMIN=0.D0 388 : VMAX=1.D-12 389 : I1=NN(1)+NN(2)+NN(3)+1 390 : I2=NN(1)+NN(2)+NN(3)+NN(4) 391 : I3=I2+1 392 : I4=I2+NN(5) 393 : JJS=NPDIM 394 : 395 : IF (NN(4).NE.0) THEN 396 : C DISSOLUTION CHECK 397 : C 398 : DO 44 I=I1,I2 399 : 400 : *************************************************************************** 401 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 402 : * IF(NZDIM.NE.0)THEN 403 : * IDYI=IDY(I) 403 : * CALL CHIADY(IDZ,NZDIM,IDYI,KP1) 404 : ** write(6,*)'chmslx id1 kp1=',KP1 405 : * IF(KP1.NE.0)THEN 406 : * CC(I)=0 407 : * SS(KP1)=0 408 : * DO 45 J=1,NPDIM 409 : * IF(FF(KP1,J).NE.0.D0)THEN 410 : * IDPJ=IDP(J) 410 : * CALL CHIADY(IDY,NYDIM,IDPJ,IDJ) 411 : * SS(KP1)=SS(KP1)+CC(IDJ) 412 : * ENDIF 413 : * 45 CONTINUE 414 : * DO 46 J=1,NPDIM 415 : * IF(FF(KP1,J).NE.0.D0)THEN 416 : * IDJP=IDP(J) 416 : * CALL CHIADY(IDY,NYDIM,IDJP,IDJ) 417 : * FF(KP1,J)=CC(IDJ)/SS(KP1) 418 : ** write(6,*)'chmslx id1 idy',IDY(IDJ),'cc',CC(IDJ) 419 : ** write(6,*)'chmslx id1 idp',IDP(J),'FF',FF(KP1,J) 420 : * ENDIF 421 : * 46 CONTINUE 422 : * CC(I)=SS(KP1) 423 : ** write(6,*)'chmslx id1 idz',IDZ(KP1),'ss',SS(KP1) 424 : * ENDIF 425 : * ENDIF 426 : ************************************************************************** 427 : 428 : IF (CC(I).LE.VMIN) THEN 429 : VMIN=CC(I) 430 : ID1=IDY(I) 431 : * write(6,*)'chmslx id1=',ID1 432 : 433 : IF (IIMPI.EQ.2) WRITE(6,*)' **CHMSLX ID1=IDY(',I,')' 434 : * ,IDY(I), ' VMIN=CC(',I,')',VMIN 435 : ENDIF 436 : 44 CONTINUE 437 : * write(6,*)'chmslx id1=',ID1 438 : * write(6,*)'chmslx vmin',vmin 439 : * write(6,*)'chmslx id1 nn(4)=',NN(4) 440 : ENDIF 441 : IF (NN(5).EQ.0) GOTO 49 442 : C PRECIPITATION CHECK 443 : C 444 : NBV=0 445 : DO 48 I=I3,I4 446 : 447 : ************************************************************************* 448 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 449 : * IF(NZDIM.NE.0)THEN 450 : * IDYI=IDY(I) 451 : ** write(6,*)'chmslx idy=idz',idy(i) 451 : * CALL CHIADY(IDZ,NZDIM,IDYI,KP2) 452 : ** write(6,*)'chmslx id2 kp2=',KP2 453 : * IF(KP2.NE.0)THEN 454 : * AGC=GC(I) 455 : ** CC(I)=0 456 : * SS(KP2)=0 457 : * DO 51 J=1,NPDIM 458 : * IF(FF(KP2,J).NE.0.D0)THEN 459 : * IDPJ=IDP(J) 459 : * CALL CHIADY(IDY,NYDIM,IDPJ,IDJ) 460 : * SS(KP2)=SS(KP2)+CC(IDJ) 461 : * ENDIF 462 : * 51 CONTINUE 463 : * DO 52 J=1,NPDIM 464 : * IF(FF(KP2,J).NE.0.D0)THEN 465 : * IDJP=IDP(J) 465 : * CALL CHIADY(IDY,NYDIM,IDJP,IDJ) 466 : * FF(KP2,J)=CC(IDJ)/SS(KP2) 467 : ** write(6,*)'chmslx idp(j)',idp(j) 468 : ** write(6,*)'chmslx cc(idj)',cc(idj) 469 : ** write(6,*)'chmslx ss(kp2)',ss(kp2) 470 : ** write(6,*)'chmslx ff(kp2,j)',ff(kp2,j) 471 : ** FF(KP2,J)=1.D0 472 : ** write(6,*)'chmslx id2 idy',IDY(IDJ),'gc',GC(IDJ) 473 : ** write(6,*)'chmslx id2 idp',IDP(J),'ff',FF(KP2,J) 474 : * ENDIF 475 : * 52 CONTINUE 476 : * DO 53 JA=1,NXDIM 477 : ** XMAX=1.D-3 478 : * VF=0 479 : * DO 54 IB=1,NPDIM 480 : * IF(FF(KP2,IB).NE.0.D0)THEN 481 : * IDPB=IDP(IB) 481 : * CALL CHIADY(IDY,NYDIM,IDPB,IDPC) 482 : * VF=VF+AA(IDPC,JA)*FF(KP2,IB) 483 : ** IF(ABS(AA(IDPC,JA)).EQ.XMAX)THEN 484 : ** VF=VF+FF(KP2,IB) 485 : ** AA(I,JA)=VF 486 : ** ENDIF 487 : ** IF(ABS(AA(IDPC,JA)).GT.XMAX)THEN 488 : ** VF=FF(KP2,IB) 489 : * AA(I,JA)=VF 490 : ** write(6,*)'chmslx idx',idx(ja),'aa(i,ja)',aa(i,ja) 491 : ** write(6,*)'chmslx aa(idpc,ja)',aa(idpc,ja) 492 : ** write(6,*)'chmslx ff(kp2,ib)',ff(kp2,ib) 493 : ** XMAX=AA(IDPC,JA) 494 : ** ENDIF 495 : * ENDIF 496 : * 54 CONTINUE 497 : * 53 CONTINUE 498 : ** CC(I)=SS(KP2) 499 : * GS(KP2)=LOG10(SS(KP2)) 500 : * GC(I)=GS(KP2) 501 : ** write(6,*)'chmslx id2 idz',IDZ(KP2),'gs',GS(KP2) 502 : * ENDIF 503 : * ENDIF 504 : ************************************************************************ 505 : 506 : IF (GC(I).GE.VMAX) THEN 507 : C NB MX DISSOUS (NN(5))DONT L'INDICE DE SATURATION INDIQUE 508 : C UNE SURSATURATION 509 : NBV=NBV+1 510 : VMAX=GC(I) 511 : C IDENTIFICATION DU MINERAL DISSOUS (PROVISOIREMENT) LE PLUS 512 : C SURSATURE 513 : IDPP(NBV) = IDY(I) 514 : ID2=IDY(I) 515 : IF (IIMPI.EQ.2) WRITE(6,*)'**CHMSLX ID2=IDY(',I,')',IDY(I), 516 : * ' VMAX=GC(',I,')',VMAX 517 : C LE MINERAL LE PLUS SURSATURE EST LE IID(IEME) 518 : IID=I 519 : 520 : ************************************************************************* 521 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 522 : * IIDS=0 522 : * CALL CHIADY(IDZ,NZDIM,ID2,IIDS) 523 : * IF(IIDS.GT.0)THEN 524 : * GC(IID)=0 525 : * GK(IID)=0 526 : * DO 56 IJ=1,NPDIM 527 : * IDPIJ=IDP(IJ) 527 : * CALL CHIADY(IDY,NYDIM,IDPIJ,IDIJ) 528 : * IF(FF(IIDS,IJ).NE.0.D0)THEN 529 : ** GK(IID)=GK(IID)+FF(IIDS,IJ)*(GK(IDIJ)-GS(IIDS)) 530 : * GC(IID)=GC(IID)+FF(IIDS,IJ)*GC(IDIJ) 531 : * LF=LOG10(ABS(FF(IIDS,IJ))) 532 : * GK(IID)=GK(IID)+FF(IIDS,IJ)*(GK(IDIJ)-GC(IDIJ)+LF) 533 : ** GK(IID)=GK(IID)+FF(IIDS,IJ)*GK(IDIJ) 534 : ** write(6,*)'chmslx idp',idp(ij) 535 : ** write(6,*)'chmslx ff',ff(iids,ij),'gk',gk(idij) 536 : * ENDIF 537 : *56 CONTINUE 538 : ** write(6,*)'chmslx idy',idy(i),'gk(iid)',gk(iid) 539 : * CC(IID)=10.D0**GC(IID) 540 : * ENDIF 541 : * ELSE 542 : * IDYI=IDY(I) 542 : * CALL CHIADY(IDZ,NZDIM,IDYI,IDI) 543 : * IF(IDI.NE.0)THEN 544 : * GC(I)=AGC 545 : * GK(I)=0 546 : * DO 57 J=1,NPDIM 547 : * IDPJ=IDP(J) 547 : * CALL CHIADY(IDY,NYDIM,IDPJ,IDJ) 548 : * IF(FF(IDI,J).NE.0.D0)THEN 549 : * GK(I)=GK(I)+FF(IDI,J)*GK(IDJ) 550 : * ENDIF 551 : ** IF(FF(IDI,J).NE.0.D0) FF(IDI,J)=1.D0 552 : * 57 CONTINUE 553 : ** DO 58 JA=1,NXDIM 554 : *** XMAX=1.D-3 555 : ** VF=0 556 : ** DO 59 IB=1,NPDIM 557 : ** IF(FF(IDI,IB).NE.0.D0)THEN 558 : ** IDPB=IDP(IB) 558 : ** CALL CHIADY(IDY,NYDIM,IDPB,IDPC) 559 : ** VF=VF+AA(IDPC,JA)*FF(KP2,IB) 560 : ** IF(ABS(AA(IDPC,JA)).EQ.XMAX)THEN 561 : ** VF=VF+FF(IDI,IB) 562 : ** AA(I,JA)=VF 563 : ** ENDIF 564 : ** IF(ABS(AA(IDPC,JA)).GT.XMAX)THEN 565 : ** VF=FF(IDI,IB) 566 : ** AA(I,JA)=VF 567 : ** XMAX=AA(IDPC,JA) 568 : ** ENDIF 569 : ** ENDIF 570 : * 59 CONTINUE 571 : * 58 CONTINUE 572 : * ENDIF 573 : ********************************************************************** 574 : 575 : ENDIF 576 : 48 CONTINUE 577 : 578 : ********************************************************************** 579 : * write(6,*)'chmslx id2=',ID2 580 : * write(6,*)'chmslx iid=',IID,'idy(iid)',IDY(IID) 581 : * write(6,*)'chmslx iids=',IIDS,'idz(iids)=',idz(iids) 582 : * write(6,*)'chmslx id2 NN(5)=',NN(5) 583 : ********************************************************************** 584 : 585 : C --- TEST: EST CE QUE LES COMPOSANTS DU MINERAL LE PLUS SURSATURE 586 : C ST IDENTIQUES AUX COMPOSANTS D'1 MINERAL DEJA MIS EN TYPE 4 587 : 588 : IF(ID2.NE.0.AND.NN(4).GT.0)THEN 589 : C INITIALISATION 590 : ID4 = 0 591 : JJ = NXDIM 592 : * JJS = NPDIM 593 : I01 = 0 594 : KI = 0 595 : * KIS = 0 596 : NK = 0 597 : * NKS = 0 598 : * IS = 0 599 : * IDPJS = 0 600 : IF (IIMPI.EQ.2) WRITE(6,*)' CHMSLX I1=',I1,'I2=',I2 601 : C I(IEME) MINERAL DE NN(4) (DEJA PROVISOIREMENT PRECIPITE) 602 : 603 : DO 90 I=I1,I2 604 : C ON LES COMPTABILISE 605 : I01=I01+1 606 : 607 : ************************************************************************ 608 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 609 : *C SI LE I01(IEME) MINERAL DE NN(4) EST UNE SOLSOL, 610 : *C TEST SUR LES SOLIDES COMPOSANT CE MINERAL, SINON 611 : C TEST SUR LES COMPOSANTS DE CE IO1(IEME) MINERAL (DE NN(4)) 612 : * IDYS=IDY(I) 612 : * CALL CHIADY(IDZ,NZDIM,IDYS,IS) 613 : * IF(IS.NE.0)THEN 614 : * DO 91 JS=1,JJS 615 : * IF(FF(IS,JS).NE.0.D0)THEN 616 : *C NB DE SOLIDES 617 : * KIS=KIS+1 618 : *C IDENTIFICATION DE CES SOLIDES 619 : * IDPJS=IDP(JS) 619 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 620 : * ID0S(I01,KIS)=IDY(IDJS) 621 : * ENDIF 622 : *91 CONTINUE 623 : * ELSE 624 : ************************************************************************ 625 : 626 : DO 92 J=1,JJ 627 : IF(ABS(AA(I,J)).GE.1.D-3) THEN 628 : C NB DE COMPOSANTS 629 : KI=KI+1 630 : C IDENTIFICATION DE CES COMPOSANTS 631 : ID0(I01,KI)=IDX(J) 632 : ENDIF 633 : 92 CONTINUE 634 : 635 : ************************************************************************ 636 : * ENDIF 637 : ************************************************************************ 638 : C 639 : *C SI LE MINERAL (PROVISOIREMENT) LE PLUS SURSATURE EST UNE SOLSOL 640 : *C RECHERCHE DES SOLIDES DE CE MINERAL, SINON 641 : C RECHERCHE DES COMPOSANTS DE CE MINERAL 642 : 643 : KID = 0 644 : 645 : *********************************************************************** 646 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 647 : * KIDS = 0 648 : * IF(IIDS.GT.0)THEN 649 : * DO 93 JS=1,JJS 650 : * IF(FF(IIDS,JS).NE.0.D0)THEN 651 : *C NB DE SOLIDES DU MINERAL (DE TYPE5) TESTE 652 : * KIDS=KIDS+1 653 : *C IDENTIFICATION DE CES SOLIDES 654 : * IDPJS=IDP(JS) 654 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 655 : * ID0S(IIDS,KIDS)=IDY(IDJS) 656 : * ENDIF 657 : *93 CONTINUE 658 : * ELSE 659 : *********************************************************************** 660 : 661 : DO 94 J=1,JJ 662 : IF(ABS(AA(IID,J)).GE.1.D-3) THEN 663 : C NB DE COMPOSANTS DU MINERAL (DE TYPE5) TESTE 664 : KID=KID+1 665 : C IDENTIFICATION DE CES COMPOSANTS 666 : ID0(IID,KID)=IDX(J) 667 : ENDIF 668 : 94 CONTINUE 669 : 670 : *********************************************************************** 671 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 672 : * ENDIF 673 : 674 : *C TEST SUR LE NOMBRE DES SOLIDES DU MINERAL TESTE PAR RAPPORT 675 : *C AU I(IEME) MINERAL SURSAT PROVISOIREMENT DEJA PRECIPITE 676 : *C SINON 677 : C TEST SUR LE NOMBRE DES COMPOSANTS DU MINERAL TESTE PAR RAPPORT 678 : C AU I(IEME) MINERAL SURSAT PROVISOIREMENT DEJA PRECIPITE 679 : 680 : * IF(IS.GT.0.AND.IIDS.GT.0)THEN 681 : * IF(KIDS.EQ.KIS)THEN 682 : *C COMPARAISON DES SOLIDES. NKS ETANT LE NB DE SOLIDES COMMUNS 683 : * DO 95 JIDS=1,KIDS 684 : * DO 96 JIS=1,KIS 685 : * IF(ID0S(IIDS,JIDS).EQ.ID0S(I01,JIS)) NKS=NKS+1 686 : *96 CONTINUE 687 : *95 CONTINUE 688 : *C COMPARAISON DU NB DE SOLIDES COMMUNS AVEC LE NB DE SOLIDES 689 : *C DES 2 MINERAUX TESTES 690 : * IF(NKS.EQ.KIS)THEN 691 : * ID4=IDY(I) 692 : * ID3=0 693 : * IF(ID4.NE.ID1)THEN 694 : * GOTO 99 695 : * ELSE 696 : * GOTO 49 697 : * ENDIF 698 : * ELSE 699 : *C SI LA COMPARAISON N'A PAS ENCORE ETE EFFECTUEE AVEC TOUS 700 : *C LES MINERAUX DE NN(4), PASSER AU SUIVANT... 701 : * IF(I.NE.I2) GOTO 89 702 : *C ...SINON SORTIR DU TEST EN COURS 703 : * GOTO 49 704 : * ENDIF 705 : * ELSE 706 : *C SI LES NB DE SOLIDES NE CORRESPONDENT PAS 707 : * ID3=0 708 : * IF(I.NE.I2) GOTO 89 709 : * GOTO 49 710 : * ENDIF 711 : * ENDIF 712 : * IF(IS.LE.0.AND.IIDS.LE.0)THEN 713 : *********************************************************************** 714 : 715 : IF(KID.EQ.KI)THEN 716 : C COMPARAISON DES COMPOSANTS.NK ETANT LE NB DE COMPOSANTS COMMUNS 717 : DO 97 JID=1,KID 718 : DO 98 JI=1,KI 719 : IF(ID0(IID,JID).EQ.ID0(I01,JI)) NK=NK+1 720 : 98 CONTINUE 721 : 97 CONTINUE 722 : C COMPARAISON DU NB DE COMPOSANTS COMMUNS AVEC LE NB DE 723 : C COMPOSANTS DES 2 MINERAUX TESTES 724 : IF(NK.EQ.KI)THEN 725 : ID4=IDY(I) 726 : ID3=0 727 : IF(ID4.NE.ID1) THEN 728 : GOTO 99 729 : ELSE 730 : GOTO 49 731 : ENDIF 732 : ELSE 733 : C SI LA COMPARAISON N'A PAS ENCORE ETE EFFECTUEE AVEC TOUS 734 : C LES MX DE NN(4), PASSER AU SUIVANT... 735 : IF(I.NE.I2)GOTO 89 736 : C ...SINON SORTIR DU TEST EN COURS 737 : ID3=0 738 : GOTO 49 739 : ENDIF 740 : ELSE 741 : C SI LES NOMBRES DES COMPOSANTS NE CORRESPONDENT PAS 742 : ID3=0 743 : IF(I.NE.I2)GOTO 89 744 : GOTO 49 745 : ENDIF 746 : 747 : ************************************************************************* 748 : * ELSE 749 : * IF(I.NE.I2) GOTO 89 750 : * GOTO 49 751 : * ENDIF 752 : ************************************************************************ 753 : 754 : 89 CONTINUE 755 : 90 CONTINUE 756 : 757 : C COMPOSANTS IDENTIQUES POUR LES 2 MX TESTES 758 : 99 CONTINUE 759 : C 760 : NBV=NBV-1 761 : C 762 : C SI LE NOMBRE DE MX (PROVISOIREMENT) SURSATURES EST SUPERIEUR 763 : C A DEUX... 764 : IF(NBV.GT.0)THEN 765 : C ...CHOISIR LE MINERAL PRECEDENT 766 : ID2=IDPP(NBV) 767 : C 768 : C ...SINON... 769 : ELSE 770 : NBV=NBV+1 771 : C ...ECHANGER (APRES 500) LES DEUX MINERAUX TESTES (METTRE 772 : C ARBITRAIREMENT LE MINERAL DE NN(4) EN TYPE 5 ET CELUI DE TYPE5 773 : C EN TYPE 4(CF ETTIQ.500) 774 : ID2=IDPP(NBV) 775 : ID3=1 776 : IF (IIMPI.EQ.2) WRITE(6,*)' ATTENTION IL N Y A QU UN MINERAL 777 : * INADEQUAT A PRECIPITER' 778 : ENDIF 779 : 780 : ENDIF 781 : 782 : C BOUNDARY CONDITION EXCHANGE 783 : C 784 : C KK=0 NO EXCHANGE NECESSARY 785 : C KK=-1 SOLID 'ID1' DISSOLVES 786 : C KK=+1 SOLID 'ID2' PRECIPITATES 787 : C KK=+2 SOLID 'ID1' DISSOLVES, 'ID2' PRECIPITATES 788 : C 789 : 49 KK=0 790 : C NO EXCHANGE NECESSARY 791 : IF (ID1.EQ.0) GOTO 500 792 : I4=4 793 : I5=5 793 : IF (IIMPI.EQ.2) WRITE(6,*) ' **SOLIDX AVANT CALL 794 : * CHMREX: ID1= ',ID1 795 : 796 : ************************************************************************ 797 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 797 : * CALL CHIADY(IDZ,NZDIM,ID1,ID1Z) 798 : * IF(ID1Z.NE.0)THEN 799 : * DO 700 JS=1,JJS 800 : * IF(FF(ID1Z,JS).NE.0.D0)THEN 801 : * IDPJS=IDP(JS) 801 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 802 : * IDY1=IDY(IDJS) 802 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDY1,I4,I5) 803 : ** FF(ID1Z,JS)=1.D0 804 : * ENDIF 805 : *700 CONTINUE 805 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID1,I4,I5) 806 : * KK=-1 807 : * ELSE 807 : * CALL CHIADY(IDP,NPDIM,ID1,ID1P) 808 : * IF(NZDIM.NE.0)THEN 809 : * DO 705 K=1,NZDIM 810 : * IF(FF(K,ID1P).NE.0.D0) GOTO 707 811 : *705 CONTINUE 812 : *707 CONTINUE 813 : * IF(FF(K,ID1P).NE.0.D0)THEN 814 : * IF(SS(K).GT.0.D0)THEN 815 : * ID1=0 816 : * KK=0 817 : * ELSE 818 : * DO 715 JS=1,JJS 819 : * IF(FF(K,JS).NE.0.D0)THEN 820 : * IDPJS=IDP(JS) 820 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 821 : * IDY1=IDY(IDJS) 821 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDY1,I4,I5) 822 : *C FF(K,JS)=1.D0 823 : * ENDIF 824 : *715 CONTINUE 825 : * IDZK=IDZ(K) 825 : * CALL CHIADY(IDY,NYDIM,IDZK,IDK) 826 : * IDYK=IDY(IDK) 826 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDYK,I4,I5) 827 : * KK=-1 828 : * ENDIF 829 : * ELSE 829 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID1,I4,I5) 830 : * KK=-1 831 : * ENDIF 832 : * ELSE 833 : *********************************************************************** 834 : 834 : CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID1,I4,I5) 835 : KK=-1 836 : 837 : ********************************************************************** 838 : * ENDIF 839 : * ENDIF 840 : ********************************************************************* 841 : 842 : 500 CONTINUE 843 : IF(ID4.NE.ID1.AND.ID4.NE.0)THEN 844 : IF (ID3.EQ.1) THEN 845 : KK=1 846 : I4=4 847 : I5=5 848 : 849 : ********************************************************************** 850 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 851 : * IF(IIDS.GT.0.AND.IS.GT.0)THEN 852 : * DO 100 JS=1,JJS 853 : * IF(FF(IIDS,JS).NE.0.D0)THEN 854 : * IDPJS=IDP(JS) 854 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 855 : * ID2S=IDY(IDJS) 855 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2S,I5,I4) 856 : ** FF(IIDS,JS)=CC(IDJS)/SS(IIDS) 857 : ** write(6,*)'chmslx 100 FF=',FF(IIDS,JS) 858 : * ENDIF 859 : * IF(FF(IS,JS).NE.0.D0)THEN 860 : * IDPJS=IDP(JS) 860 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 861 : * ID4S=IDY(IDJS) 861 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID4S,I4,I5) 862 : ** FF(IS,JS)=1.D0 863 : * ENDIF 864 : *100 CONTINUE 864 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2,I5,I4) 864 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID4,I4,I5) 865 : * GOTO 501 866 : * ENDIF 867 : * IF(IIDS.LE.0.AND.IS.LE.0)THEN 868 : *********************************************************************** 869 : 869 : CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2,I5,I4) 869 : CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID4,I4,I5) 870 : GOTO 501 871 : 872 : *********************************************************************** 873 : * ENDIF 874 : *********************************************************************** 875 : 876 : ELSE 877 : IF (ID2.EQ.0) GOTO 501 878 : I4=4 879 : I5=5 880 : 881 : ********************************************************************** 882 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 883 : * IF(IIDS.GT.0)THEN 884 : * DO 101 JS=1,JJS 885 : * IF(FF(IIDS,JS).NE.0.D0)THEN 886 : * IDPJS=IDP(JS) 886 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 887 : * ID2S=IDY(IDJS) 887 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2S,I5,I4) 888 : ** FF(IIDS,JS)=CC(IDJS)/SS(IIDS) 889 : ** write(6,*)'chmslx 101 FF=',FF(IIDS,JS) 890 : * ENDIF 891 : *101 CONTINUE 891 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2,I5,I4) 892 : * KK=1 893 : * IF (ID1.NE.0) KK=2 894 : * ELSE 895 : *********************************************************************** 896 : 896 : CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2,I5,I4) 897 : KK=1 898 : IF(ID1.NE.0) KK=2 899 : 900 : *********************************************************************** 901 : * ENDIF 902 : ********************************************************************** 903 : 904 : ENDIF 905 : ELSE 906 : C --- CAS NORMAL 907 : C SOLID 'ID1' DISSOLVES 908 : IF (ID2.EQ.0) GOTO 501 909 : ** write(6,*)'chmslx av 800 IIDS=',IIDS 910 : I4=4 911 : I5=5 912 : 913 : *********************************************************************** 914 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 915 : * IF(IIDS.GT.0)THEN 916 : * DO 800 JS=1,JJS 917 : * IF(FF(IIDS,JS).NE.0.D0)THEN 918 : * IDPJS=IDP(JS) 918 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 919 : * IDY2=IDY(IDJS) 919 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDY2,I5,I4) 920 : ** FF(IIDS,JS)=CC(IDJS)/SS(IIDS) 921 : ** write(6,*)'chmslx 800',IDP(JS),' FF=',FF(IIDS,JS) 922 : * ENDIF 923 : *800 CONTINUE 923 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2,I5,I4) 924 : * KK=1 925 : * IF(ID1.NE.0) KK=2 926 : * ELSE 926 : * CALL CHIADY(IDP,NPDIM,ID2,ID2P) 927 : * IF(NZDIM.NE.0)THEN 928 : * DO 805 K=1,NZDIM 929 : * IF(FF(K,IDP2).NE.0.D0) GOTO 806 930 : *805 CONTINUE 931 : *806 CONTINUE 932 : * IF(FF(K,ID2P).NE.0.D0)THEN 933 : ** write(6,*)'chmslx ff(k,id2p)=',ff(k,id2p) 934 : * IF(GS(K).GT.0.D0)THEN 935 : * DO 810 JS=1,JJS 936 : * IF(FF(K,JS).NE.0.D0)THEN 937 : * IDPJS=IDP(JS) 937 : * CALL CHIADY(IDY,NYDIM,IDPJS,IDJS) 938 : * IDY2=IDY(IDJS) 938 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDY2,I5,I4) 939 : *C FF(K,JS)=CC(IDJS)/SS(K) 940 : *C write(6,*)'chmslx 810 FF=',FF(K,JS) 941 : * ENDIF 942 : *810 CONTINUE 943 : * IDZK=IDZ(K) 943 : * CALL CHIADY(IDY,NYDIM,IDZK,IDK) 944 : * IDYK=IDY(IDK) 944 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,IDYK,I5,I4) 945 : * KK=1 946 : * IF(ID1.NE.0) KK=2 947 : * ELSE 948 : * ID2=0 949 : * KK=0 950 : * IF(ID1.NE.0) KK=-1 951 : * ENDIF 952 : * ELSE 953 : ********************************************************************** 954 : 954 : CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2,I5,I4) 955 : KK=1 956 : 957 : 958 : C SOLID 'ID2' PRECIPITATES 959 : IF (ID1.NE.0) KK=2 960 : C SOLID 'ID1' DISSOLVES, 'ID2' PRECIPITATES 961 : 962 : ********************************************************************* 963 : C PRISE EN COMPTE DES SOLUTIONS SOLIDES : METHODE 1 964 : * ENDIF 965 : * ELSE 965 : * CALL CHMREX(IDSCHI,LGKMOD,LGKTMP,ID2,I5,I4) 966 : * KK=1 967 : * IF(ID1.NE.0) KK=2 968 : * ENDIF 969 : * ENDIF 970 : ********************************************************************* 971 : 972 : ENDIF 973 : 501 CONTINUE 974 : CBRUNO 975 : * DO J=1,NXDIM 976 : * IF(IDX(J).EQ.99)WRITE(6,*)'TOTE-=',TOT(J) 977 : * ENDDO 978 : RETURN 979 : END 980 : 981 : 982 : 983 :
© Cast3M 2003 - All rights reserved.
Disclaimer