Télécharger chmtms.eso

Retour à la liste

Numérotation des lignes :

  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)
  155. CALL CHMREX(IDSCHI,0,LGKTMP,IDYT,JDIL,I6)
  156. 44 CONTINUE
  157. C ENDIF
  158.  
  159.  
  160. TMP =TMPNEW
  161. RETURN
  162. END
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales