Numérotation des lignes :

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 TRIOEFC          IDENTIFIE LES RELATIONS REDOXC       n'est appelé que si IZIADR est non nulC --------------------------------------------------------------------C  Possibilite d'utiliser d'autre composants que l'electronC pour les reactions redox.C a) Dans les reaction redox, il ne faut pas tenir compteC du composant H2O (identifiant 100)C b) il faut diviser Atabd par le coefficient stochiometriqueC du composant redoxC      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,IZREDIC      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        ENDDOC        write(6,*)' erreur dans chitri'         CALL ERREUR(21)    30    CONTINUE        DO J=1,NXDIMc modif PhMc attention dans ce cas on sait que le 100 est reserve a H2Oc          IF(ABS( AA(ILJ,J) ).GT.0.D0) THEN          IF ((ABS( AA(ILJ,J) ).GT.0.D0).AND.(IDX(J)).NE.100) THENc 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        ENDDOc modif Phmc on modifie ATAB en le divisant par le coefficient stochiometriquec 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 DEBUGC       print*,'IL,1,ATAB(IL,1)',IL,1,ATAB(IL,1)C       print*,'IL,2,ATAB(IL,2)',IL,2,ATAB(IL,2)C DEBUGc 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       

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