Télécharger chmch2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHMCH2 SOURCE CHAT 05/01/12 21:58:37 5004
  2. SUBROUTINE CHMCH2(IDSCHI,SP2)
  3. C
  4. C---------------------------------------------------------------------
  5. C SP ISSU DE TRIO-EF (TRCHA2)
  6. C...... COLLECTIVE ROUTINE FOR CHARGE BALANCES, WITH ENTRY POINTS
  7. C
  8. C - CHARG1 : FOR T-VECTOR
  9. C - CHARG2 : FOR DISSOLVED SPECIES ONLY
  10. C
  11. C----------------------------------------------------------------------
  12. C CREATED JANUARY 26, 1982 M. SCHWEINGRUBER
  13. C UPDATED JUNE 15, 1982 (A)
  14. C PARM MODIFIE
  15. C MODIFIE SEPTEMBRE 1989
  16. C
  17. C----------------------------------------------------------------------
  18. C
  19. C
  20.  
  21. C
  22. C-----------------------------------------------------------------------
  23. C-----------------------------------------------------------------------
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. SEGMENT IDSCHI
  27. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  28. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  29. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  30. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  31. ENDSEGMENT
  32. SEGMENT SP2
  33. REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM)
  34. REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM)
  35. REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM)
  36. ENDSEGMENT
  37. TC=0.D0
  38. TA=0.D0
  39. NXDIM=IDX(/1)
  40. L1=NN(1)+NN(2)
  41. C
  42. DO 30 I=1,L1
  43. TW=0.D0
  44. IF(IDECY(I).EQ.1)GO TO 20
  45. DO 21 J=1,NXDIM
  46. JJ=IDX(J)
  47. TW=TW+IONZ(J)*AA(I,J)
  48. 21 CONTINUE
  49.  
  50. IF (ABS(TW).LT.1.D-10) TW=0.D0
  51. IF (TW.LT.0.D0) TA=TA+TW*CC(I)
  52. IF (TW.GT.0.D0) TC=TC+TW*CC(I)
  53. 20 CONTINUE
  54. 30 CONTINUE
  55. TD=TA+TC
  56. TDP=100.D0*TD/TC
  57. WRITE (6,90)
  58. WRITE (6,92)
  59. WRITE (6,110) TC,TA,TD,TDP
  60. WRITE (6,90)
  61. RETURN
  62. C-----------------------------------------------------------------------
  63. 90 FORMAT(1H0,130(1H-))
  64. 91 FORMAT(' CHARG1 : CHARGE BALANCE T-VECTOR')
  65. 92 FORMAT(' CHARG2 : CHARGE BALANCE FOR DISSOLVED SPECIES ',
  66. 1 ' (TYPE I & II)')
  67. 110 FORMAT(1H0,'CATIONS=',1PE12.3,'; ANIONS =',1PE12.3,'; DIFF =',
  68. 1 1PE12.3,' ALL IN EQ/L ; DIFF IN 0/0 OF CAT. =',0PF8.3)
  69. C-----------------------------------------------------------------------
  70. C
  71. END
  72.  
  73.  
  74.  
  75.  
  76.  

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