Télécharger chitri.eso

Retour à la liste

Numérotation des lignes :

  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'
  55. CALL ERREUR(21)
  56.  
  57.  
  58. 30 CONTINUE
  59. DO J=1,NXDIM
  60. c modif PhM
  61. c attention dans ce cas on sait que le 100 est reserve a H2O
  62. c IF(ABS( AA(ILJ,J) ).GT.0.D0) THEN
  63. IF ((ABS( AA(ILJ,J) ).GT.0.D0).AND.(IDX(J)).NE.100) THEN
  64. c modif PhM
  65. ICO = IDX(J)
  66. IF(ICO.NE.99.AND.ICO.NE.50) THEN
  67. DO IR=1,LCR
  68. IF(ICO.EQ.ICR(IR)) GO TO 20
  69. ENDDO
  70.  
  71. LCR=LCR+1
  72. ICR(LCR)=ICO
  73. 20 CONTINUE
  74. ENDIF
  75. IF(ICO.EQ.50) THEN
  76. ATAB(IL,2)=AA(ILJ,J)
  77. ELSEIF(ICO.EQ.99) THEN
  78. ATAB(IL,1)=AA(ILJ,J)
  79. ELSEIF(AA(ILJ,J).GT.0.D0) THEN
  80. ITAB(IL,1)=ICO
  81. ELSEIF(AA(ILJ,J).LE.0.D0) THEN
  82. ITAB(IL,2)=ICO
  83. ENDIF
  84. ENDIF
  85. ENDDO
  86. c modif Phm
  87. c on modifie ATAB en le divisant par le coefficient stochiometrique
  88. c du composant redox
  89. CALL CHIADY(IDX,NXDIM,ITAB(IL,1),ID1)
  90. ATAB(IL,1) = ATAB(IL,1)/AA(ILJ,ID1)
  91. ATAB(IL,2) = ATAB(IL,2)/AA(ILJ,ID1)
  92. C DEBUG
  93. C print*,'IL,1,ATAB(IL,1)',IL,1,ATAB(IL,1)
  94. C print*,'IL,2,ATAB(IL,2)',IL,2,ATAB(IL,2)
  95. C DEBUG
  96. c modif PhM
  97.  
  98.  
  99. ENDDO
  100.  
  101. KB=IJ
  102. DO KI=1,IJ
  103. IRCR(KI)=ITAB(KI,2)
  104. ENDDO
  105.  
  106. C 4 EST LE NOMBRE MAX CONNU D'ETAT DE VALENCE
  107. DO KK=1,4
  108. DO KI=1,IJ
  109. DO KL=KI+1,IJ
  110. IF(ITAB(KI,1).EQ.ITAB(KL,2)) THEN
  111. KA = ITAB(KI,1)
  112. ITAB(KI,1)=ITAB(KL,1)
  113. ATAB(KI,1)=ATAB(KI,1)+ATAB(KL,1)
  114. ATAB(KI,2)=ATAB(KI,2)+ATAB(KL,2)
  115. ITEST=0
  116. DO LK=1,KB
  117. IF(KA.NE.IRCR(LK))ITEST=ITEST+1
  118. ENDDO
  119. IF(ITEST.EQ.KB) THEN
  120. KB=KB+1
  121. IRCR(KB)=KA
  122. ENDIF
  123. ENDIF
  124. ENDDO
  125. ENDDO
  126. ENDDO
  127.  
  128. * DO KK=1,IJ
  129. * WRITE(6,*)'ITAB(',KK,')',(ITAB(KK,KN),KN=1,4)
  130. * ENDDO
  131.  
  132. MCR=KB
  133. SEGADJ IZREDI
  134.  
  135. RETURN
  136.  
  137. END
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  

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