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 :
© Cast3M 2003 - All rights reserved.
Disclaimer