1 : C CHITRI SOURCE CHAT 05/01/12 21:58:34 5004 2 : SUBROUTINE CHITRI(IDSCHI,IZIADR,IZRED,IZREDI) 3 : C -------------------------------------------------------------------- 4 : C SOUS PROGRAMME ISSU DE TRICHI DANS TRIOEF 5 : C IDENTIFIE LES RELATIONS REDOX 6 : C n'est appelé que si IZIADR est non nul 7 : C -------------------------------------------------------------------- 8 : C Possibilite d'utiliser d'autre composants que l'electron 9 : C pour les reactions redox. 10 : C a) Dans les reaction redox, il ne faut pas tenir compte 11 : C du composant H2O (identifiant 100) 12 : C b) il faut diviser Atabd par le coefficient stochiometrique 13 : C du composant redox 14 : C 15 : IMPLICIT INTEGER(I-N) 16 : IMPLICIT REAL*8 (A-H,O-Z) 17 : 18 : SEGMENT IDSCHI 19 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 20 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 21 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 22 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 23 : ENDSEGMENT 24 : SEGMENT IZIADR 25 : INTEGER IADR(NCR) 26 : ENDSEGMENT 27 : SEGMENT IZRED 28 : INTEGER ITAB(NCR,2) 29 : REAL*8 ATAB(NCR,2) 30 : ENDSEGMENT 31 : SEGMENT IZREDI 32 : INTEGER IRCR(MCR),ICR(LCR) 33 : ENDSEGMENT 34 : NXDIM=IDX(/1) 35 : NYDIM=IDY(/1) 36 : NZDIM=IDZ(/1) 37 : NPDIM=IDP(/1) 38 : NCR=IADR(/1) 39 : LCR=NXDIM 40 : MCR=NCR*NCR*2 41 : SEGINI IZRED,IZREDI 42 : C 43 : LCR=0 44 : IJ=NCR 45 : 46 : * 47 : N12=NN(1)+NN(2)+1 48 : N13=NN(1)+NN(2)+NN(3) 49 : DO IL =1,IJ 50 : 51 : DO ILJ=N12,N13 52 : IF(IADR(IL).EQ.IDY(ILJ))GO TO 30 53 : ENDDO 54 : C write(6,*)' erreur dans chitri' 54 : CALL ERREUR(21) 55 : 56 : 57 : 30 CONTINUE 58 : DO J=1,NXDIM 59 : c modif PhM 60 : c attention dans ce cas on sait que le 100 est reserve a H2O 61 : c IF(ABS( AA(ILJ,J) ).GT.0.D0) THEN 62 : IF ((ABS( AA(ILJ,J) ).GT.0.D0).AND.(IDX(J)).NE.100) THEN 63 : c modif PhM 64 : ICO = IDX(J) 65 : IF(ICO.NE.99.AND.ICO.NE.50) THEN 66 : DO IR=1,LCR 67 : IF(ICO.EQ.ICR(IR)) GO TO 20 68 : ENDDO 69 : 70 : LCR=LCR+1 71 : ICR(LCR)=ICO 72 : 20 CONTINUE 73 : ENDIF 74 : IF(ICO.EQ.50) THEN 75 : ATAB(IL,2)=AA(ILJ,J) 76 : ELSEIF(ICO.EQ.99) THEN 77 : ATAB(IL,1)=AA(ILJ,J) 78 : ELSEIF(AA(ILJ,J).GT.0.D0) THEN 79 : ITAB(IL,1)=ICO 80 : ELSEIF(AA(ILJ,J).LE.0.D0) THEN 81 : ITAB(IL,2)=ICO 82 : ENDIF 83 : ENDIF 84 : ENDDO 85 : c modif Phm 86 : c on modifie ATAB en le divisant par le coefficient stochiometrique 87 : c du composant redox 87 : CALL CHIADY(IDX,NXDIM,ITAB(IL,1),ID1) 88 : ATAB(IL,1) = ATAB(IL,1)/AA(ILJ,ID1) 89 : ATAB(IL,2) = ATAB(IL,2)/AA(ILJ,ID1) 90 : C DEBUG 91 : C print*,'IL,1,ATAB(IL,1)',IL,1,ATAB(IL,1) 92 : C print*,'IL,2,ATAB(IL,2)',IL,2,ATAB(IL,2) 93 : C DEBUG 94 : c modif PhM 95 : 96 : 97 : ENDDO 98 : 99 : KB=IJ 100 : DO KI=1,IJ 101 : IRCR(KI)=ITAB(KI,2) 102 : ENDDO 103 : 104 : C 4 EST LE NOMBRE MAX CONNU D'ETAT DE VALENCE 105 : DO KK=1,4 106 : DO KI=1,IJ 107 : DO KL=KI+1,IJ 108 : IF(ITAB(KI,1).EQ.ITAB(KL,2)) THEN 109 : KA = ITAB(KI,1) 110 : ITAB(KI,1)=ITAB(KL,1) 111 : ATAB(KI,1)=ATAB(KI,1)+ATAB(KL,1) 112 : ATAB(KI,2)=ATAB(KI,2)+ATAB(KL,2) 113 : ITEST=0 114 : DO LK=1,KB 115 : IF(KA.NE.IRCR(LK))ITEST=ITEST+1 116 : ENDDO 117 : IF(ITEST.EQ.KB) THEN 118 : KB=KB+1 119 : IRCR(KB)=KA 120 : ENDIF 121 : ENDIF 122 : ENDDO 123 : ENDDO 124 : ENDDO 125 : 126 : * DO KK=1,IJ 127 : * WRITE(6,*)'ITAB(',KK,')',(ITAB(KK,KN),KN=1,4) 128 : * ENDDO 129 : 130 : MCR=KB 131 : SEGADJ IZREDI 132 : 133 : RETURN 134 : 135 : END 136 : 137 : 138 : 139 : 140 : 141 :
© Cast3M 2003 - All rights reserved.
Disclaimer