Télécharger la plaquette Cast3M


fr en

Télécharger chmch2.eso

Retour à la liste

Numérotation des lignes : 

chmch2

  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