Télécharger la plaquette Cast3M


fr en

Télécharger chmslx.eso

Retour à la liste

Numérotation des lignes : 

chmslx

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales