Télécharger chmslx.eso

Retour à la liste

Numérotation des lignes :

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

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