Sources Esope | Cast3M

chmfix
C CHMFIX    SOURCE    CHAT      05/01/12    21:59:02     5004
      SUBROUTINE CHMFIX(IDSCHI,SP2,IZRED,IOXYDO,LIMP3)
 
C======================================================================
*      ISSU DE TRIOEF (TRFIX)
*
*  NOUVELLE MODIF CONCERNANT LES COMPOSANTS H+ ET OH- DANS LE CAS
*  DE L'UTILISATION DE LA BDD MINEQL MODIFIEE
*
*  ATTENTION! TOTAQ DE H = TOTAQ DE H - TOTAQ DE OH
*             TOTFIX DE H =TOTFIX DE H - TOTFIX DE OH
*
*  A CETTE DATE FIX FORTRAN FAIT UNE SELECTION CORRECTE POUR LES PHASES
*  AQUEUSES ET SOLIDES (EN L'ABSENCE DE PHASES ADSORBEES-> CF LA RQUE
*  DS LE SP A CE SUJET)
*
*
************************************************************************
*
C  TABLEAU TOTAQ(J) DU SEGMENT SP2 AVEC LES CONCENTRATIONS
C TOTALES EN SOLUTION DES COMPOSANTS, @ PARTIR DES CONCENTRATIONS EN
C ESPECES DE TYPES 1 ET 2, CES DERNIERES CORRIGEES DES CONCENTRATIONS
C EN COMPLEXES DE SURFACE (ADSORBATS)
C
C EN EFFET APRES CALCUL MINEQL LES CONCENTRATIONS EN ESPECES DE TYPE
C 1 ET 2 SONT EXPRIMEES A L'EQUILIBRE AVEC LES PHASES SOLIDES
C EVENTUELLES, IL SUFFIT DONC D'EN SOUSTRAIRE LES CONCENTRATIONS EN
C ESPECES DE TYPE 2 COMPORTANT UN COMPOSANT DE SURFACE: 90 -> 96
C
C ACTUELLEMENT LE TEST NE PORTE QUE SUR LE COMPOSANT 90
C
C
C TOTAQ(J) ET TOTFIX(J) SONT  UTILISES POUR LE TRANSPORT
C
C TOTFIX(J) EST FORCE A 0.0 S'IL EST INFERIEUR @ E-15
C
C  DANS LE CALCUL DE TOTAQ ON PREND EN COMPTE LES ESPECES IMPOSEES EN
C  TYPE 3 EN PLUS DES ESPECES DE TYPE 1 ET 2
C
C
C=======================================================================
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
-INC SMLENTI
      SEGMENT IDSCHI
           REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
           INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
           INTEGER IDECY(NYDIM),IONZ(NXDIM)
           CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
      ENDSEGMENT
      SEGMENT SP2
           REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM)
           REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM)
           REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM)
      ENDSEGMENT
      SEGMENT IZRED
            INTEGER ITAB(NCR,2)
            REAL*8 ATAB(NCR,2)
      ENDSEGMENT
C
      NXDIM=IDX(/1)
      NYDIM=IDY(/1)
      NZDIM=IDZ(/1)
      NPDIM=IDP(/1)
      II=NN(1)+NN(2)
      JJ=NXDIM
      IJ=NN(1)+NN(2)+NN(3)+1
      IK=NN(1)+NN(2)+NN(3)+NN(4)
      IL=NN(1)+NN(2)+1
      IM=NN(1)+NN(2)+NN(3)
 
C
      JSOH=0
 
      NCR=0
      IDH=0
      IDE=0
C     IF (NN(2).EQ.0) RETURN
      L=NN(1)+1
      DO 10 J=1,NXDIM
      IF (IDX(J).EQ.90) THEN
       JSOH=J
      ENDIF
      TOTFIX(J)=0.D0
      TOTAQ(J)=0.D0
   10 CONTINUE
C
      DO 35 J=1,NXDIM
* TYPE I ET II
         DO 30 I=1,II
            IF ( ABS(AA(I,J)).GT.0.D0 ) THEN
              IF ( IDECY(I).EQ.0 ) THEN
                TOTAQ(J)=TOTAQ(J)+CC(I)*AA(I,J)
              ELSE IF( IDECY(I).EQ.1 ) THEN
                TOTFIX(J)=TOTFIX(J)+CC(I)*AA(I,J)
              ENDIF
            ENDIF
  30     CONTINUE
C        /TEST SUR LES SOLIDES/
 
* TYPE IV
         DO 31 I=IJ,IK
            IF (ABS(AA(I,J)).GT.0) THEN
               TOTFIX(J)=TOTFIX(J)+CC(I)*AA(I,J)
            ENDIF
  31     CONTINUE
  35  CONTINUE
C                         PRISE EN COMPTE DES ESPECES IMPOSEES TYPE 3
      IF(LIMP3.NE.0)THEN
            MLENTI=LIMP3
            SEGACT MLENTI
            JG=LECT(/1)
            DO 32 I3=1,JG
                   I4= LECT(I3)
                   IF(I4.NE.99)THEN
                   CALL CHIADY(IDY,NYDIM,I4,I)
                   DO 33 J=1,NXDIM
                         IF(ABS(AA(I,J)).GT.0.D0)THEN
C                              TOTAQ(J)=TOTAQ(J)+CC(I)*AA(I,J)
                         TOTAQ(J)=TOTAQ(J)+(10**(-GK(I)))*AA(I,J)
                   ENDIF
   33              CONTINUE
                   ENDIF
   32       CONTINUE
            SEGDES MLENTI
      ENDIF
C
      CALL CHIADY(IDY,NYDIM,2122,IADH)
       IF(IADH.NE.0)THEN
        CALL CHIADY(IDX,NXDIM,60,IDOH)
        CALL CHIADY(IDX,NXDIM,50,IDH)
        TOTFIX(IDH)=TOTFIX(IDH)-TOTFIX(IDOH)
        TOTAQ(IDH) =TOTAQ(IDH) -TOTAQ(IDOH)
       ENDIF
       IF(IOXYDO.NE.0) THEN
              CALL CHIADY(IDX,NXDIM,50,IDH)
              CALL CHIADY(IDX,NXDIM,99,IDE)
               NCR=ITAB(/1)
             DO 40 I=1,NCR
              I1=ITAB(I,1)
              I2=ITAB(I,2)
              CALL CHIADY(IDX,NXDIM,I1,ID1)
              CALL CHIADY(IDX,NXDIM,I2,ID2)
C
               TOTFIX(IDH)=TOTFIX(IDH)+ATAB(I,2)*TOTFIX(ID2)
               TOTAQ(IDH) =TOTAQ(IDH) +ATAB(I,2)*TOTAQ(ID2)
C
               TOTFIX(IDE)=TOTFIX(IDE)+ATAB(I,1)*TOTFIX(ID2)
               TOTAQ(IDE) =TOTAQ(IDE) +ATAB(I,1)*TOTAQ(ID2)
C
               TOTFIX(ID1)=TOTFIX(ID1)+TOTFIX(ID2)
               TOTAQ(ID1) =TOTAQ(ID1) +TOTAQ(ID2)
C
   40        CONTINUE
       ENDIF
      RETURN
      END