Télécharger chmtet.eso

Retour à la liste

Numérotation des lignes :

  1. C CHMTET SOURCE CHAT 05/01/12 22:00:23 5004
  2. SUBROUTINE CHMTET(ITEMPE,LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C
  7. C LECTURE DE LA TABLE TEMPE SI ELLE EXISTE
  8. C SINON ON INITIALISE TOUS LES POINTEURS A 0
  9. C
  10. C------------------------------------------------------------------
  11. -INC SMTABLE
  12. -INC SMLENTI
  13. -INC SMLREEL
  14. -INC CCOPTIO
  15. SEGMENT LGKMOD
  16. REAL*8 DELH0(NYDIM),DELCP0(NYDIM)
  17. ENDSEGMENT
  18. SEGMENT LGKTMP
  19. INTEGER NUMT(NYDIM),NTVT(NYDIM)
  20. REAL*8 TMIMA(NYDIM,NT)
  21. REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  22. ENDSEGMENT
  23. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR,MTYPS,CHARS
  24. LOGICAL LOGRE
  25. C
  26. LGKMOD=0
  27. LGKTMP=0
  28. IP1=0
  29. IP2=0
  30. IP3=0
  31. IP4=0
  32. IP5=0
  33. IF(ITEMPE.EQ.0)RETURN
  34. C BASE MINEQL
  35. MTAB1=ITEMPE
  36. SEGACT MTAB1
  37. IRETR=0
  38. IVALI=0
  39. XVALI=0.D0
  40. IRETI=0
  41. IVALR=0
  42. XVALR=0.D0
  43. MTYPI='MOT '
  44. MTYPR=' '
  45. CHARR=' '
  46. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELTAH',.TRUE.,
  47. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  48. IF(MTYPR.NE.' ')THEN
  49. IF(MTYPR.NE.'LISTREEL')THEN
  50. MOTERR(1:11)='DELTAH '
  51. MOTERR(12:20)='LISTREEL'
  52. CALL ERREUR(627)
  53. RETURN
  54. ENDIF
  55. MLREEL=IP1
  56. SEGACT MLREEL
  57. NYDIM=PROG(/1)
  58. MTYPS='LISTREEL'
  59. CHARS=' '
  60. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELCP',.TRUE.,
  61. * IRETI,MTYPS,IVALR,XVALR,CHARS,LOGRE,IP2)
  62. MLREEL=IP2
  63. SEGACT MLREEL
  64. SEGINI LGKMOD
  65. IP3=1
  66. MTYPS='ENTIER '
  67. CHARS=' '
  68. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'APPROX',.TRUE.,
  69. * IRETI,MTYPS,IVALR,XVALR,CHARS,LOGRE,IRET)
  70. IP3=IVALR
  71. SEGDES MTAB1
  72. RETURN
  73. ENDIF
  74. C BASE DE STASBOURG
  75. IVALI=0
  76. XVALI=0.D0
  77. IRETI=0
  78. IVALR=0
  79. XVALR=0.D0
  80. MTYPI='MOT '
  81. MTYPR=' '
  82. CHARR=' '
  83. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NUMT',.TRUE.,
  84. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP5)
  85. IF(MTYPR.EQ.' ')THEN
  86. IP5=0
  87. SEGDES MTAB1
  88. RETURN
  89. ELSE
  90. IF(MTYPR.NE.'LISTENTI')THEN
  91. MOTERR(1:11)='NUMT '
  92. MOTERR(12:20)='LISTENTI'
  93. CALL ERREUR(627)
  94. RETURN
  95. ENDIF
  96. MLENTI=IP5
  97. SEGACT MLENTI
  98. NYDIM=LECT(/1)
  99. ENDIF
  100. IP1=0
  101. MTYPR='LISTREEL'
  102. CHARR=' '
  103. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TMIMA',.TRUE.,
  104. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  105. IF(IERR.NE.0)RETURN
  106. MLREEL=IP1
  107. SEGACT MLREEL
  108. JG=PROG(/1)
  109. NT=JG/NYDIM
  110. NT4=NT*4
  111. SEGINI LGKTMP
  112. MTYPR='LISTREEL'
  113. CHARR=' '
  114. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'COEF',.TRUE.,
  115. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP2)
  116. IF(IERR.NE.0)RETURN
  117. MLREEL=IP2
  118. SEGACT MLREEL
  119. MTYPR='LISTREEL'
  120. CHARR=' '
  121. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  122. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP3)
  123. IF(IERR.NE.0)RETURN
  124. MLREEL=IP3
  125. SEGACT MLREEL
  126. MTYPR='LISTENTI'
  127. CHARR=' '
  128. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVT',.TRUE.,
  129. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP4)
  130. IF(IERR.NE.0)RETURN
  131. MLENTI=IP4
  132. SEGACT MLENTI
  133. SEGDES MTAB1
  134. RETURN
  135. END
  136.  
  137.  
  138.  
  139.  
  140.  

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