Sources Esope | Cast3M

chmtms
C CHMTMS    SOURCE    CHAT      05/01/12    22:00:34     5004
      SUBROUTINE CHMTMS(IDSCHI,LGKTMP,ICOTY3,TMP,TMPNEW)
******************************************************************
C              ISSU DE TRIOEF (TMPMOK)
*     CF. TMPMOK SUR MACHINE MONI
*****************************************************************
*     CE SP SERT A CALCULER LA VALEUR DU LOGK A LA TEMP. TMPNEW
*     DANS LE CAS OU LA BDD EST CELLE DE STRASBOURG
*     IL EST APPELE PAR CHMKMD
*
*     CE TRAVAIL A ETE REALISE A PARTIR DES SP PROVENANT DU CENTRE
*     DE GEOCHIMIE DE LA SURFACE DE STRASBOURG
*     ---> CF MON1504 MESSAGE
*     POUR PLUS D'INFOS VOIR LES COMMENTAIRES EN TETE DU SP CHITPS
*
*     LE 23 OCTOBRE 1991
*     LE 16 DECEMBRE 1991
*******************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMLENTI
      POINTEUR ICOTY3.MLENTI
      SEGMENT IDSCHI
           REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
           INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
           INTEGER IDECY(NYDIM),IONZ(NXDIM)
           CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
      ENDSEGMENT
      SEGMENT LGKTMP
           INTEGER NUMT(NYDIM),NTVT(NYDIM)
           REAL*8 TMIMA(NYDIM,NT)
           REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
      ENDSEGMENT
*
      DIMENSION ID6(100),IDIL(100)
 
      DIMENSION ICOEF(4)
      IF (ICOTY3.NE.0) NO3=ICOTY3.LECT(/1)
      IF (TMPNEW.EQ.TMP) RETURN
 
      NT=TGKLU(/2)
 
      NB6 = 0
      NX=NN(1)+1
      N1A2=NN(1)+NN(2)
      N1A3=NN(1)+NN(2)+NN(3)
      N1B5=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
      NC=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6)
 
      LBDD=1
 
 
 
      DO 90 IDXY=NX,NC
 
      IF (ICOTY3.NE.0) THEN
        DO J=1,NO3
        IF (IDY(IDXY).EQ.ICOTY3.LECT(J)) GOTO 10
        ENDDO
      ENDIF
 
       IF(NUMT(IDXY).EQ.IDY(IDXY))THEN
        GK(IDXY)=1000.D0
        N1A1=NN(1)
        N1A2=NN(1)+NN(2)
        N1A3=NN(1)+NN(2)+NN(3)
        N1A4=NN(1)+NN(2)+NN(3)+NN(4)
        N1A5=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
 
        NTV=NTVT(IDXY)
       IF (NTV.GE.3.AND.TMPNEW.GE.TMIMA(IDXY,1).AND.TMPNEW.LE.
     *  TMIMA(IDXY,NTV)) THEN
          DO 40 IJ=2,NTVT(IDXY)
           IF (TMPNEW.LE.TMIMA(IDXY,IJ)) THEN
            IJM1=IJ-1
            DT=TMPNEW-TMIMA(IDXY,IJM1)
            NTMIJ=NT-IJM1
            DO 50 ICO=1,4
             ICOEF(ICO)=ICO*NT-NTMIJ
 50         CONTINUE
            GK(IDXY)=((POLYT(IDXY,ICOEF(4))*DT+POLYT(IDXY,ICOEF(3)))*
     *      DT+POLYT(IDXY,ICOEF(2)))*DT+POLYT(IDXY,ICOEF(1))
            GK(IDXY)=-GK(IDXY)
 
 
            GOTO 10
           ENDIF
 40       CONTINUE
       ELSE
        DO 100 I=1,NTV
         TSTA=ABS(TMIMA(IDXY,I)-TMPNEW)
         IF (TMPNEW.EQ.TMIMA(IDXY,I).OR.TSTA.LE.15.) THEN
          IF (TGKLU(IDXY,I).LT.990.) THEN
           GK(IDXY)=-TGKLU(IDXY,I)
           GOTO 10
          ELSE IF (I.EQ.1) THEN
           GOTO 100
          ELSE
           IF (IDXY.GE.NX.AND.IDXY.LE.N1A2) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=2
           ELSE IF (IDXY.GT.N1A2.AND.IDXY.LE.N1A3) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=3
           ELSE IF (IDXY.GT.N1A3.AND.IDXY.LE.N1A4) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=4
           ELSE IF (IDXY.GT.N1A4.AND.IDXY.LE.N1A5) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=5
           ELSE IF (IDXY.GT.N1A5.AND.IDXY.LE.NC) THEN
           ENDIF
           IDIL(NB6) = IL
           GOTO 10
          ENDIF
         ELSE IF (I.EQ.NTV) THEN
           IF (IDXY.GE.NX.AND.IDXY.LE.N1A2) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=2
           ELSE IF (IDXY.GT.N1A2.AND.IDXY.LE.N1A3) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=3
           ELSE IF (IDXY.GT.N1A3.AND.IDXY.LE.N1A4) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=4
           ELSE IF (IDXY.GT.N1A4.AND.IDXY.LE.N1A5) THEN
            NB6 = NB6 +1
            ID6(NB6) = IDY(IDXY)
            IL=5
           ELSE IF (IDXY.GT.N1A5.AND.IDXY.LE.NC) THEN
           ENDIF
           IDIL(NB6) = IL
           GOTO 10
         ENDIF
 100    CONTINUE
 
       ENDIF
       ENDIF
 
 10   CONTINUE
 90   CONTINUE
 
      I6=6
      DO 44 JB6=1,NB6
        IDYT=0
        IDYT=ID6(JB6)
        JDIL=IDIL(JB6)
            CALL CHMREX(IDSCHI,0,LGKTMP,IDYT,JDIL,I6)
 44   CONTINUE
C      ENDIF
 
 
      TMP =TMPNEW
      RETURN
      END