Sources Esope | Cast3M

chitri
C CHITRI    SOURCE    CHAT      05/01/12    21:58:34     5004
       SUBROUTINE CHITRI(IDSCHI,IZIADR,IZRED,IZREDI)
C --------------------------------------------------------------------
C           SOUS PROGRAMME ISSU DE TRICHI DANS TRIOEF
C          IDENTIFIE LES RELATIONS REDOX
C       n'est appelé que si IZIADR est non nul
C --------------------------------------------------------------------
C  Possibilite d'utiliser d'autre composants que l'electron
C pour les reactions redox.
C a) Dans les reaction redox, il ne faut pas tenir compte
C du composant H2O (identifiant 100)
C b) il faut diviser Atabd par le coefficient stochiometrique
C du composant redox
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
      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 IZIADR
            INTEGER IADR(NCR)
      ENDSEGMENT
      SEGMENT IZRED
            INTEGER ITAB(NCR,2)
            REAL*8 ATAB(NCR,2)
      ENDSEGMENT
      SEGMENT IZREDI
            INTEGER IRCR(MCR),ICR(LCR)
      ENDSEGMENT
      NXDIM=IDX(/1)
      NYDIM=IDY(/1)
      NZDIM=IDZ(/1)
      NPDIM=IDP(/1)
      NCR=IADR(/1)
      LCR=NXDIM
      MCR=NCR*NCR*2
      SEGINI IZRED,IZREDI
C
      LCR=0
      IJ=NCR
 
*
        N12=NN(1)+NN(2)+1
        N13=NN(1)+NN(2)+NN(3)
      DO IL =1,IJ
 
        DO ILJ=N12,N13
           IF(IADR(IL).EQ.IDY(ILJ))GO TO 30
        ENDDO
C        write(6,*)' erreur dans chitri'
         CALL ERREUR(21)
 
 
  30    CONTINUE
        DO J=1,NXDIM
c modif PhM
c attention dans ce cas on sait que le 100 est reserve a H2O
c          IF(ABS( AA(ILJ,J) ).GT.0.D0) THEN
          IF ((ABS( AA(ILJ,J) ).GT.0.D0).AND.(IDX(J)).NE.100) THEN
c modif PhM
            ICO = IDX(J)
            IF(ICO.NE.99.AND.ICO.NE.50) THEN
              DO IR=1,LCR
                IF(ICO.EQ.ICR(IR)) GO TO 20
              ENDDO
 
              LCR=LCR+1
              ICR(LCR)=ICO
 20           CONTINUE
            ENDIF
            IF(ICO.EQ.50) THEN
               ATAB(IL,2)=AA(ILJ,J)
            ELSEIF(ICO.EQ.99) THEN
               ATAB(IL,1)=AA(ILJ,J)
            ELSEIF(AA(ILJ,J).GT.0.D0) THEN
                ITAB(IL,1)=ICO
            ELSEIF(AA(ILJ,J).LE.0.D0) THEN
                ITAB(IL,2)=ICO
            ENDIF
          ENDIF
        ENDDO
c modif Phm
c on modifie ATAB en le divisant par le coefficient stochiometrique
c du composant redox
        CALL CHIADY(IDX,NXDIM,ITAB(IL,1),ID1)
        ATAB(IL,1) = ATAB(IL,1)/AA(ILJ,ID1)
        ATAB(IL,2) = ATAB(IL,2)/AA(ILJ,ID1)
C DEBUG
C       print*,'IL,1,ATAB(IL,1)',IL,1,ATAB(IL,1)
C       print*,'IL,2,ATAB(IL,2)',IL,2,ATAB(IL,2)
C DEBUG
c modif PhM
 
 
      ENDDO
 
      KB=IJ
      DO KI=1,IJ
       IRCR(KI)=ITAB(KI,2)
      ENDDO
 
C                    4  EST LE NOMBRE MAX CONNU D'ETAT DE VALENCE
      DO KK=1,4
        DO KI=1,IJ
          DO KL=KI+1,IJ
            IF(ITAB(KI,1).EQ.ITAB(KL,2)) THEN
              KA = ITAB(KI,1)
              ITAB(KI,1)=ITAB(KL,1)
              ATAB(KI,1)=ATAB(KI,1)+ATAB(KL,1)
              ATAB(KI,2)=ATAB(KI,2)+ATAB(KL,2)
              ITEST=0
              DO LK=1,KB
                IF(KA.NE.IRCR(LK))ITEST=ITEST+1
              ENDDO
              IF(ITEST.EQ.KB) THEN
                KB=KB+1
                IRCR(KB)=KA
              ENDIF
            ENDIF
          ENDDO
        ENDDO
      ENDDO
 
*     DO KK=1,IJ
*       WRITE(6,*)'ITAB(',KK,')',(ITAB(KK,KN),KN=1,4)
*     ENDDO
 
        MCR=KB
        SEGADJ IZREDI
 
       RETURN
 
       END