Esope source files

   1 : C CHMMOD    SOURCE    CHAT      05/01/12    21:59:32     5004           
   2 :       SUBROUTINE CHMMOD(IDSCHI,XMU,XMUNEW,TMPNEW,GNEW)
   3 : C=======================================================================        
   4 : C            ISSU DE TRIOEF(TRIMOD)
   5 : C
   6 : C - OBJET: MODIFICATION DES LOGK POUR UNE FORCE IONIQUE DONNEE (DE XMU A
   7 : C XMUNEW) A TEMPERATURE FIXEE TMP.
   8 : C                                                                               
   9 : C                                                                               
  10 : C - APPELLEE PAR CHMKMD()
  11 : C                                                                               
  12 : C - METHODES: LE COEFFICIENT GFO POUR UN ION UNIVALENT EST CELUI DE             
  13 : C L'APPROXIMATION DE DAVIES PRENANT EN COMPTE LA TEMPERATURE; ON UTILISE        
  14 : C UNE DEPENDANCE LINEAIRE EN TEMPERATURE POUR LA CONSTANTE DIELECTRIQUE         
  15 : C DE L'EAU                                                                      
  16 : C                                                                               
  17 : C LES ESPECES DE TYPE III SONT PRISES EN COMPTE DE TELLE SORTE QUE LEUR         
  18 : C ACTIVITE INITIALE SOIT MAINTENUE.                                             
  19 : C                                                                               
  20 : C======================================================================         
  21 :       IMPLICIT INTEGER(I-N)
  22 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  23 : C                                                                               
  24 :       SEGMENT IDSCHI
  25 :            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  26 :            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  27 :            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  28 :            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  29 :       ENDSEGMENT
  30 :                                                                                 
  31 :                                                                                 
  32 : C     write(6,*)' XMUNEW    XMU ',XMUNEW,XMU
  33 :       IF (XMUNEW.EQ.XMU) RETURN                                                 
  34 : C
  35 :       NC=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6)                                    
  36 :       I1=NN(1)+NN(2)+1                                                          
  37 :       I2=NN(1)+NN(2)+NN(3)                                                      
  38 :       NX=IDX(/1)
  39 : C
  40 : C
  41 :         T1=TMPNEW+273.15D0
  42 :       IF(TMPNEW.LE.100.D0) THEN
  43 :         TE=TMPNEW-25.D0
  44 :         ET=78.54D0*(1.D0-4.579D-3*TE+1.19D-5*TE*TE
  45 :      *  -2.8D-8*TE*TE*TE)
  46 :       ELSEIF((TMPNEW.GT.100.D0).AND.(TMPNEW.LE.370.D0)) THEN
  47 :         ET=5321.D0/T1+233.76D0-0.9297D0*T1+1.417D-3*T1*T1
  48 :      *     -8.292D-7*T1*T1*T1
  49 :       ENDIF
  50 : C
  51 : C
  52 : C
  53 :       AT=1.82D6/SQRT((ET*T1)**3)
  54 :       SI=SQRT(XMU)                                                              
  55 :       GOLD=-AT*(SI/(1.D0+SI)-0.2D0*XMU)
  56 :       SI=SQRT(XMUNEW)                                                           
  57 :       GNEW=-AT*(SI/(1.D0+SI)-0.2D0*XMUNEW)
  58 :       IF (ABS(GNEW).EQ.0.D0) GNEW=0.D0
  59 :       DGF=GNEW-GOLD                                                             
  60 : C      WRITE(6,*)'  '
  61 : C      WRITE(6,*)' CHMMOD ', ' NC ',NC,' NX ',NX
  62 : C      WRITE(6,*)' ET ',ET,' T1 ',T1,' AT ',AT,' SI ',SI
  63 : C      WRITE(6,*)' DGF ',DGF,' GNEW ',GNEW
  64 :       DO 20 I=1,NC                                                              
  65 :          VJ=0.D0
  66 :          VI=0.D0
  67 :          DO 30 J=1,NX                                                           
  68 :             VJ=VJ+AA(I,J)*IONZ( J)*IONZ( J)
  69 :             VI=VI+AA(I,J)*IONZ( J)
  70 : 30       CONTINUE                                                               
  71 :          GKT=GK(I)+DGF*(VJ-VI*VI)                                               
  72 : C        write(6,*)'idy',idy(i),'gkt',gkt,gk(i),vi,vj,i,idecy(i)
  73 :          IF (I.GE.I1.AND.I.LE.I2) GKT=GK(I)+DGF*VJ                              
  74 :          IF ( IDECY(I)   .EQ. 1 ) GKT=GK(I)+DGF*VJ
  75 :          GK(I)=GKT                                                              
  76 : 20    CONTINUE                                                                  
  77 :       XMU=XMUNEW                                                                
  78 :       RETURN                                                                    
  79 :       END                                                                       
  80 : C                                                                               
  81 : * LE COEFFICIENT D'ACTIVITE D'UN COMPLEXE DE SURFACE EST CONSTANT
  82 : * ET EGAL A 1/CONCENTRATION DE SITES DE SURFACE
  83 : C                                                                               
  84 : C                                                                               
  85 : C                                                                               
  86 : C                                                                               
  87 :                                                                                 
  88 :  
  89 :  
  90 :  
  91 :