1 : C CHMFIX SOURCE CHAT 05/01/12 21:59:02 5004 2 : SUBROUTINE CHMFIX(IDSCHI,SP2,IZRED,IOXYDO,LIMP3) 3 : 4 : C====================================================================== 5 : * ISSU DE TRIOEF (TRFIX) 6 : * 7 : * NOUVELLE MODIF CONCERNANT LES COMPOSANTS H+ ET OH- DANS LE CAS 8 : * DE L'UTILISATION DE LA BDD MINEQL MODIFIEE 9 : * 10 : * ATTENTION! TOTAQ DE H = TOTAQ DE H - TOTAQ DE OH 11 : * TOTFIX DE H =TOTFIX DE H - TOTFIX DE OH 12 : * 13 : * A CETTE DATE FIX FORTRAN FAIT UNE SELECTION CORRECTE POUR LES PHASES 14 : * AQUEUSES ET SOLIDES (EN L'ABSENCE DE PHASES ADSORBEES-> CF LA RQUE 15 : * DS LE SP A CE SUJET) 16 : * 17 : * 18 : ************************************************************************ 19 : * 20 : C TABLEAU TOTAQ(J) DU SEGMENT SP2 AVEC LES CONCENTRATIONS 21 : C TOTALES EN SOLUTION DES COMPOSANTS, @ PARTIR DES CONCENTRATIONS EN 22 : C ESPECES DE TYPES 1 ET 2, CES DERNIERES CORRIGEES DES CONCENTRATIONS 23 : C EN COMPLEXES DE SURFACE (ADSORBATS) 24 : C 25 : C EN EFFET APRES CALCUL MINEQL LES CONCENTRATIONS EN ESPECES DE TYPE 26 : C 1 ET 2 SONT EXPRIMEES A L'EQUILIBRE AVEC LES PHASES SOLIDES 27 : C EVENTUELLES, IL SUFFIT DONC D'EN SOUSTRAIRE LES CONCENTRATIONS EN 28 : C ESPECES DE TYPE 2 COMPORTANT UN COMPOSANT DE SURFACE: 90 -> 96 29 : C 30 : C ACTUELLEMENT LE TEST NE PORTE QUE SUR LE COMPOSANT 90 31 : C 32 : C 33 : C TOTAQ(J) ET TOTFIX(J) SONT UTILISES POUR LE TRANSPORT 34 : C 35 : C TOTFIX(J) EST FORCE A 0.0 S'IL EST INFERIEUR @ E-15 36 : C 37 : C DANS LE CALCUL DE TOTAQ ON PREND EN COMPTE LES ESPECES IMPOSEES EN 38 : C TYPE 3 EN PLUS DES ESPECES DE TYPE 1 ET 2 39 : C 40 : C 41 : C======================================================================= 42 : 43 : IMPLICIT INTEGER(I-N) 44 : IMPLICIT REAL*8(A-H,O-Z) 45 : C 46 : -INC SMLENTI 47 : SEGMENT IDSCHI 48 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 49 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 50 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 51 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 52 : ENDSEGMENT 53 : SEGMENT SP2 54 : REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM) 55 : REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM) 56 : REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM) 57 : ENDSEGMENT 58 : SEGMENT IZRED 59 : INTEGER ITAB(NCR,2) 60 : REAL*8 ATAB(NCR,2) 61 : ENDSEGMENT 62 : C 63 : NXDIM=IDX(/1) 64 : NYDIM=IDY(/1) 65 : NZDIM=IDZ(/1) 66 : NPDIM=IDP(/1) 67 : II=NN(1)+NN(2) 68 : JJ=NXDIM 69 : IJ=NN(1)+NN(2)+NN(3)+1 70 : IK=NN(1)+NN(2)+NN(3)+NN(4) 71 : IL=NN(1)+NN(2)+1 72 : IM=NN(1)+NN(2)+NN(3) 73 : 74 : C 75 : JSOH=0 76 : 77 : NCR=0 78 : IDH=0 79 : IDE=0 80 : C IF (NN(2).EQ.0) RETURN 81 : L=NN(1)+1 82 : DO 10 J=1,NXDIM 83 : IF (IDX(J).EQ.90) THEN 84 : JSOH=J 85 : ENDIF 86 : TOTFIX(J)=0.D0 87 : TOTAQ(J)=0.D0 88 : 10 CONTINUE 89 : C 90 : DO 35 J=1,NXDIM 91 : * TYPE I ET II 92 : DO 30 I=1,II 93 : IF ( ABS(AA(I,J)).GT.0.D0 ) THEN 94 : IF ( IDECY(I).EQ.0 ) THEN 95 : TOTAQ(J)=TOTAQ(J)+CC(I)*AA(I,J) 96 : ELSE IF( IDECY(I).EQ.1 ) THEN 97 : TOTFIX(J)=TOTFIX(J)+CC(I)*AA(I,J) 98 : ENDIF 99 : ENDIF 100 : 30 CONTINUE 101 : C /TEST SUR LES SOLIDES/ 102 : 103 : * TYPE IV 104 : DO 31 I=IJ,IK 105 : IF (ABS(AA(I,J)).GT.0) THEN 106 : TOTFIX(J)=TOTFIX(J)+CC(I)*AA(I,J) 107 : ENDIF 108 : 31 CONTINUE 109 : 35 CONTINUE 110 : C PRISE EN COMPTE DES ESPECES IMPOSEES TYPE 3 111 : IF(LIMP3.NE.0)THEN 112 : MLENTI=LIMP3 113 : SEGACT MLENTI 114 : JG=LECT(/1) 115 : DO 32 I3=1,JG 116 : I4= LECT(I3) 117 : IF(I4.NE.99)THEN 117 : CALL CHIADY(IDY,NYDIM,I4,I) 118 : DO 33 J=1,NXDIM 119 : IF(ABS(AA(I,J)).GT.0.D0)THEN 120 : C TOTAQ(J)=TOTAQ(J)+CC(I)*AA(I,J) 121 : TOTAQ(J)=TOTAQ(J)+(10**(-GK(I)))*AA(I,J) 122 : ENDIF 123 : 33 CONTINUE 124 : ENDIF 125 : 32 CONTINUE 126 : SEGDES MLENTI 127 : ENDIF 128 : C 128 : CALL CHIADY(IDY,NYDIM,2122,IADH) 129 : IF(IADH.NE.0)THEN 129 : CALL CHIADY(IDX,NXDIM,60,IDOH) 129 : CALL CHIADY(IDX,NXDIM,50,IDH) 130 : TOTFIX(IDH)=TOTFIX(IDH)-TOTFIX(IDOH) 131 : TOTAQ(IDH) =TOTAQ(IDH) -TOTAQ(IDOH) 132 : ENDIF 133 : IF(IOXYDO.NE.0) THEN 133 : CALL CHIADY(IDX,NXDIM,50,IDH) 133 : CALL CHIADY(IDX,NXDIM,99,IDE) 134 : NCR=ITAB(/1) 135 : DO 40 I=1,NCR 136 : I1=ITAB(I,1) 137 : I2=ITAB(I,2) 137 : CALL CHIADY(IDX,NXDIM,I1,ID1) 137 : CALL CHIADY(IDX,NXDIM,I2,ID2) 138 : C 139 : TOTFIX(IDH)=TOTFIX(IDH)+ATAB(I,2)*TOTFIX(ID2) 140 : TOTAQ(IDH) =TOTAQ(IDH) +ATAB(I,2)*TOTAQ(ID2) 141 : C 142 : TOTFIX(IDE)=TOTFIX(IDE)+ATAB(I,1)*TOTFIX(ID2) 143 : TOTAQ(IDE) =TOTAQ(IDE) +ATAB(I,1)*TOTAQ(ID2) 144 : C 145 : TOTFIX(ID1)=TOTFIX(ID1)+TOTFIX(ID2) 146 : TOTAQ(ID1) =TOTAQ(ID1) +TOTAQ(ID2) 147 : C 148 : 40 CONTINUE 149 : ENDIF 150 : RETURN 151 : END 152 : 153 : 154 : 155 : 156 : 157 :
© Cast3M 2003 - All rights reserved.
Disclaimer