Esope source files

   1 : C CHMTMS    SOURCE    CHAT      05/01/12    22:00:34     5004           
   2 :       SUBROUTINE CHMTMS(IDSCHI,LGKTMP,ICOTY3,TMP,TMPNEW)
   3 : ******************************************************************
   4 : C              ISSU DE TRIOEF (TMPMOK)
   5 : *     CF. TMPMOK SUR MACHINE MONI
   6 : *****************************************************************
   7 : *     CE SP SERT A CALCULER LA VALEUR DU LOGK A LA TEMP. TMPNEW
   8 : *     DANS LE CAS OU LA BDD EST CELLE DE STRASBOURG
   9 : *     IL EST APPELE PAR CHMKMD
  10 : *
  11 : *     CE TRAVAIL A ETE REALISE A PARTIR DES SP PROVENANT DU CENTRE
  12 : *     DE GEOCHIMIE DE LA SURFACE DE STRASBOURG
  13 : *     ---> CF MON1504 MESSAGE
  14 : *     POUR PLUS D'INFOS VOIR LES COMMENTAIRES EN TETE DU SP CHITPS
  15 : *
  16 : *     LE 23 OCTOBRE 1991
  17 : *     LE 16 DECEMBRE 1991
  18 : *******************************************************************
  19 :       IMPLICIT INTEGER(I-N)
  20 :       IMPLICIT REAL*8 (A-H,O-Z)
  21 : -INC SMLENTI
  22 :       POINTEUR ICOTY3.MLENTI
  23 :       SEGMENT IDSCHI
  24 :            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  25 :            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  26 :            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  27 :            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  28 :       ENDSEGMENT
  29 :       SEGMENT LGKTMP
  30 :            INTEGER NUMT(NYDIM),NTVT(NYDIM)
  31 :            REAL*8 TMIMA(NYDIM,NT)
  32 :            REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  33 :       ENDSEGMENT
  34 : *
  35 :       DIMENSION ID6(100),IDIL(100)
  36 : 
  37 :       DIMENSION ICOEF(4)
  38 :       IF (ICOTY3.NE.0) NO3=ICOTY3.LECT(/1)
  39 :       IF (TMPNEW.EQ.TMP) RETURN
  40 : 
  41 :       NT=TGKLU(/2)
  42 : 
  43 :       NB6 = 0
  44 :       NX=NN(1)+1
  45 :       N1A2=NN(1)+NN(2)
  46 :       N1A3=NN(1)+NN(2)+NN(3)
  47 :       N1B5=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
  48 :       NC=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6)
  49 : 
  50 :       LBDD=1
  51 : 
  52 : 
  53 : 
  54 :       DO 90 IDXY=NX,NC
  55 : 
  56 :       IF (ICOTY3.NE.0) THEN
  57 :         DO J=1,NO3
  58 :         IF (IDY(IDXY).EQ.ICOTY3.LECT(J)) GOTO 10
  59 :         ENDDO
  60 :       ENDIF
  61 : 
  62 :        IF(NUMT(IDXY).EQ.IDY(IDXY))THEN
  63 :         GK(IDXY)=1000.D0
  64 :         N1A1=NN(1)
  65 :         N1A2=NN(1)+NN(2)
  66 :         N1A3=NN(1)+NN(2)+NN(3)
  67 :         N1A4=NN(1)+NN(2)+NN(3)+NN(4)
  68 :         N1A5=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
  69 : 
  70 :         NTV=NTVT(IDXY)
  71 :        IF (NTV.GE.3.AND.TMPNEW.GE.TMIMA(IDXY,1).AND.TMPNEW.LE.
  72 :      *  TMIMA(IDXY,NTV)) THEN
  73 :           DO 40 IJ=2,NTVT(IDXY)
  74 :            IF (TMPNEW.LE.TMIMA(IDXY,IJ)) THEN
  75 :             IJM1=IJ-1
  76 :             DT=TMPNEW-TMIMA(IDXY,IJM1)
  77 :             NTMIJ=NT-IJM1
  78 :             DO 50 ICO=1,4
  79 :              ICOEF(ICO)=ICO*NT-NTMIJ
  80 :  50         CONTINUE
  81 :             GK(IDXY)=((POLYT(IDXY,ICOEF(4))*DT+POLYT(IDXY,ICOEF(3)))*
  82 :      *      DT+POLYT(IDXY,ICOEF(2)))*DT+POLYT(IDXY,ICOEF(1))
  83 :             GK(IDXY)=-GK(IDXY)
  84 : 
  85 : 
  86 :             GOTO 10
  87 :            ENDIF
  88 :  40       CONTINUE
  89 :        ELSE
  90 :         DO 100 I=1,NTV
  91 :          TSTA=ABS(TMIMA(IDXY,I)-TMPNEW)
  92 :          IF (TMPNEW.EQ.TMIMA(IDXY,I).OR.TSTA.LE.15.) THEN
  93 :           IF (TGKLU(IDXY,I).LT.990.) THEN
  94 :            GK(IDXY)=-TGKLU(IDXY,I)
  95 :            GOTO 10
  96 :           ELSE IF (I.EQ.1) THEN
  97 :            GOTO 100
  98 :           ELSE
  99 :            IF (IDXY.GE.NX.AND.IDXY.LE.N1A2) THEN
 100 :             NB6 = NB6 +1
 101 :             ID6(NB6) = IDY(IDXY)
 102 :             IL=2
 103 :            ELSE IF (IDXY.GT.N1A2.AND.IDXY.LE.N1A3) THEN
 104 :             NB6 = NB6 +1
 105 :             ID6(NB6) = IDY(IDXY)
 106 :             IL=3
 107 :            ELSE IF (IDXY.GT.N1A3.AND.IDXY.LE.N1A4) THEN
 108 :             NB6 = NB6 +1
 109 :             ID6(NB6) = IDY(IDXY)
 110 :             IL=4
 111 :            ELSE IF (IDXY.GT.N1A4.AND.IDXY.LE.N1A5) THEN
 112 :             NB6 = NB6 +1
 113 :             ID6(NB6) = IDY(IDXY)
 114 :             IL=5
 115 :            ELSE IF (IDXY.GT.N1A5.AND.IDXY.LE.NC) THEN
 116 :            ENDIF
 117 :            IDIL(NB6) = IL
 118 :            GOTO 10
 119 :           ENDIF
 120 :          ELSE IF (I.EQ.NTV) THEN
 121 :            IF (IDXY.GE.NX.AND.IDXY.LE.N1A2) THEN
 122 :             NB6 = NB6 +1
 123 :             ID6(NB6) = IDY(IDXY)
 124 :             IL=2
 125 :            ELSE IF (IDXY.GT.N1A2.AND.IDXY.LE.N1A3) THEN
 126 :             NB6 = NB6 +1
 127 :             ID6(NB6) = IDY(IDXY)
 128 :             IL=3
 129 :            ELSE IF (IDXY.GT.N1A3.AND.IDXY.LE.N1A4) THEN
 130 :             NB6 = NB6 +1
 131 :             ID6(NB6) = IDY(IDXY)
 132 :             IL=4
 133 :            ELSE IF (IDXY.GT.N1A4.AND.IDXY.LE.N1A5) THEN
 134 :             NB6 = NB6 +1
 135 :             ID6(NB6) = IDY(IDXY)
 136 :             IL=5
 137 :            ELSE IF (IDXY.GT.N1A5.AND.IDXY.LE.NC) THEN
 138 :            ENDIF
 139 :            IDIL(NB6) = IL
 140 :            GOTO 10
 141 :          ENDIF
 142 :  100    CONTINUE
 143 : 
 144 :        ENDIF
 145 :        ENDIF
 146 : 
 147 :  10   CONTINUE
 148 :  90   CONTINUE
 149 : 
 150 :       I6=6
 151 :       DO 44 JB6=1,NB6
 152 :         IDYT=0
 153 :         IDYT=ID6(JB6)
 154 :         JDIL=IDIL(JB6)
 154 :             CALL CHMREX(IDSCHI,0,LGKTMP,IDYT,JDIL,I6)
 155 :  44   CONTINUE
 156 : C      ENDIF
 157 : 
 158 : 
 159 :       TMP =TMPNEW
 160 :       RETURN
 161 :       END
 162 : 
 163 :  
 164 :  
 165 :  
 166 :