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