Télécharger chitps.eso

Retour à la liste

Numérotation des lignes :

  1. C CHITPS SOURCE CHAT 05/01/12 21:58:27 5004
  2. SUBROUTINE CHITPS(IDSCHI,LGKTMP,IOCHI3)
  3. *************************************************************
  4. * SP APPELE PAR CHIMI1 SI LE CALCUL N'EST PAS EFFECTUE A
  5. * TEMPERATURE CONSTANTE DE 25 øC, DANS LA CAS DE L'UTILISATION
  6. * DE LA BDD DE STRASBOURG
  7. *-------------------------------------------------------------------
  8. * SP ISSU DE TRIOEF
  9. *
  10. * CE SP SERT A LIRE LES DONNEES NECESSAIRES POUR CALCULER
  11. * ULTERIEUREMENT LES LOGK A LA TEMPERATURE TMPNEW
  12. *
  13. * LES DONNEES LUES PROVIENNENT DU FICHIER TLOGKS DATA (COMPULSION
  14. * DES FICHIERS AQUSPL DATA (ESP. AQ.) ET DU FICHIER CONTENU DANS
  15. * MON1904 MESSAGE (ESP. MIN.) ---> DU CENTRE DE GEOCHIMIE DE
  16. * STRASBOURG).
  17. * NOM = NOM DE L'ESPECE;
  18. * NUM = SON NUMERO DANS LE FICHIER DATA
  19. * NTV = LE NOMBRE DE TEMPERATURES STANDARD (0 25 60 100 150 200
  20. * 250 300) POUR LESQUELLES LE LOGK EST SENSE ET CONNU
  21. * TMIN = TEMP. STAND. MIN POUR LAQUELLE LE LOGK EST CONNU
  22. * TMAX = TEMP. STAND. MAX POUR LAQUELLE LE LOGK EST CONNU
  23. * XLGKLU(I),I=1,NT : VALEURS DU LOGK POUR CHACUNE DES TEMP.STAND.
  24. * VSPL(I),I=1,NT : VALEURS DES COEFF. DU POLYNOME NECESSAIRE
  25. * POUR LE CALCUL DU LOGK A LA TEMPNEW SOUHAITEE
  26. *
  27. * CE SP REMPLACE LE SP INPUTB DE MINEQL STANDARD
  28. *
  29. * CE TRAVAIL A ETE REALISE A PARTIR DES SP PROVENANT DU CENTRE
  30. * DE GEOCHIMIE DE LA SURFACE DE STRASBOURG
  31. * ---> CF MON1504 MESSAGE
  32. *
  33. *************************************************************
  34. IMPLICIT INTEGER(I-N)
  35. IMPLICIT REAL*8 (A-H,O-Z)
  36. -INC CCOPTIO
  37. CHARACTER NOM*16
  38. CHARACTER NOMC*32
  39. LOGICAL LIBRE
  40. DIMENSION TEMPE0(8)
  41. SEGMENT ITRAV
  42. REAL*8 TEMPE(NT)
  43. ENDSEGMENT
  44. SEGMENT IDSCHI
  45. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  46. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  47. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  48. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  49. ENDSEGMENT
  50. SEGMENT LGKTMP
  51. INTEGER NUMT(NYDIM),NTVT(NYDIM)
  52. REAL*8 TMIMA(NYDIM,NT)
  53. REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  54. ENDSEGMENT
  55. C 32=4*NT NT=8
  56. DIMENSION VSPL(32),XLGKLU(8)
  57. DATA TEMPE0/0.,25.,60.,100.,150.,200.,250.,300./
  58. C
  59. NYDIM=IDY(/1)
  60. NT=8
  61. NT4=32
  62. N0=NN(1)
  63. N1A1=NN(1)+1
  64. N1A6=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6)
  65.  
  66. READ(IOCHI3,500) NOM,II
  67. IF(NOM(1:5).EQ.'LIBRE')THEN
  68. LIBRE=.TRUE.
  69. NT=II
  70. NT4=II*4
  71. ELSE
  72. LIBRE=.FALSE.
  73. BACKSPACE IOCHI3
  74. ENDIF
  75. SEGINI ITRAV
  76. SEGINI LGKTMP
  77. CALL INITI(NTVT,NYDIM,0)
  78. CALL INITI(NUMT,NYDIM,0)
  79. CALL INITD(TMIMA,NYDIM*NT,0.D0)
  80. CALL INITD(POLYT,NYDIM*NT4,0.D0)
  81. CALL INITD(TGKLU,NYDIM*NT,0.D0)
  82. 30 CONTINUE
  83. IF(LIBRE)THEN
  84. READ(IOCHI3,502,END=80) NUM,NTV
  85. BACKSPACE IOCHI3
  86. NTV4=NTV
  87. JJ1=0
  88. NCC=0
  89. IF(NTV.GT.4)THEN
  90. NCC=(NTV-1)/4
  91. DO 15 JJ=1,NCC
  92. JJ1=4*(JJ-1)
  93. READ(IOCHI3,524)(TEMPE(II+JJ1),II=1,4)
  94. 15 CONTINUE
  95. NTV4= NTV-NCC*4
  96. JJ1=NCC*4
  97. ENDIF
  98. IF(NTV4.EQ.1)THEN
  99. READ(IOCHI3,521)(TEMPE(II+JJ1),II=1,NTV4),NOMC
  100. ELSEIF(NTV4.EQ.2)THEN
  101. READ(IOCHI3,522)(TEMPE(II+JJ1),II=1,NTV4),NOMC
  102. ELSEIF(NTV4.EQ.3)THEN
  103. READ(IOCHI3,523)(TEMPE(II+JJ1),II=1,NTV4),NOMC
  104. ELSEIF(NTV4.EQ.4)THEN
  105. READ(IOCHI3,524)(TEMPE(II+JJ1),II=1,NTV4),NOMC
  106. ENDIF
  107. READ(IOCHI3,525) (XLGKLU(II),II=1,NTV)
  108. ELSE
  109. READ(IOCHI3,500,END=80) NOM,NUM,NTV,TMIN,TMAX
  110. READ(IOCHI3,400) (XLGKLU(II),II=1,NT)
  111. DO 35 I=1,8
  112. IF(ABS(TEMPE0(I)-TMIN).LT.1.D-3)THEN
  113. II=I
  114. GO TO 40
  115. ENDIF
  116. 35 CONTINUE
  117. 40 CONTINUE
  118. DO 50 I=1,NTV
  119. TEMPE(I)=TEMPE0(II+I-1)
  120. 50 CONTINUE
  121. ENDIF
  122. IF (NTV.GT.2) THEN
  123. READ(IOCHI3,*) (VSPL(II),II=1,NT*4)
  124. ENDIF
  125. C
  126. DO 130 I=N1A1,N1A6
  127. IF(NUM.EQ.IDY(I)) THEN
  128. NTVT(I)=NTV
  129. NUMT(I)=NUM
  130. DO 140 J=1,NTV
  131. TGKLU(I,J)=XLGKLU(J)
  132. TMIMA(I,J)=TEMPE(J)
  133. 140 CONTINUE
  134. C
  135. C
  136. IF (NTV.GT.2) THEN
  137. DO 45 JJ=1,NT*4
  138. POLYT(I,JJ)=VSPL(JJ)
  139. 45 CONTINUE
  140. ENDIF
  141. GO TO 30
  142. ENDIF
  143. 130 CONTINUE
  144. GOTO 30
  145. 80 CONTINUE
  146. SEGSUP ITRAV
  147. C REWIND(UNIT=IOCHI3)
  148. C CLOSE(UNIT=IOCHI3)
  149. 400 FORMAT(10F8.3)
  150. 500 FORMAT(A16,I4,I5,2F10.3)
  151. 501 FORMAT(15X,I5,I5,2F10.3,1X,A32)
  152. 502 FORMAT(I5,I2)
  153. 521 FORMAT(7X,F10.3,31X,A32)
  154. 522 FORMAT(7X,2F10.3,21X,A32)
  155. 523 FORMAT(7X,3F10.3,11X,A32)
  156. 524 FORMAT(7X,4F10.3,1X,A32)
  157. 525 FORMAT(8F10.3)
  158. 526 FORMAT(4E16.6)
  159. RETURN
  160. END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  

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