Télécharger chitet.eso

Retour à la liste

Numérotation des lignes :

chitet
  1. C CHITET SOURCE CHAT 05/01/12 21:58:20 5004
  2. SUBROUTINE CHITET(MTAB1,IDSCHI,LBDD,IOCHI3,LTMP)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C
  7. C CHARGEMENT DE LA TABLE TEMPE
  8. C
  9. C------------------------------------------------------------------
  10. -INC SMTABLE
  11. -INC SMLENTI
  12. -INC SMLREEL
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. SEGMENT IDSCHI
  17. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  18. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  19. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  20. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  21. ENDSEGMENT
  22. SEGMENT LGKMOD
  23. REAL*8 DELH0(NYDIM),DELCP0(NYDIM)
  24. ENDSEGMENT
  25. SEGMENT LGKTMP
  26. INTEGER NUMT(NYDIM),NTVT(NYDIM)
  27. REAL*8 TMIMA(NYDIM,NT)
  28. REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  29. ENDSEGMENT
  30. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  31. C
  32. NYDIM=IDY(/1)
  33. NXDIM=IDX(/1)
  34. NZDIM=IDZ(/1)
  35. NPDIM=IDP(/1)
  36. SEGACT MTAB1
  37. IF(LBDD.EQ.0)THEN
  38. C BASE MINEQL
  39. CALL CHITMP(IDSCHI,LGKMOD,IOCHI3)
  40. IVALI=0
  41. XVALI=0.D0
  42. IRETI=0
  43. IVALR=0
  44. XVALR=0.D0
  45. MTYPI='MOT '
  46. JG=NYDIM
  47. SEGINI MLREEL
  48. CALL RSETD(PROG,DELH0,JG)
  49. IRETR=MLREEL
  50. MTYPR='LISTREEL'
  51. CHARR=' '
  52. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELTAH',.TRUE.,
  53. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  54. SEGDES MLREEL
  55. SEGINI MLREEL
  56. CALL RSETD(PROG,DELCP0,JG)
  57. IRETR=MLREEL
  58. MTYPR='LISTREEL'
  59. CHARR=' '
  60. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELCP',.TRUE.,
  61. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  62. SEGDES MLREEL
  63. SEGSUP LGKMOD
  64. IRETR=0
  65. MTYPR='ENTIER '
  66. CHARR=' '
  67. IVALR=LTMP
  68. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'APPROX',.TRUE.,
  69. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  70. ELSEIF(LBDD.EQ.1)THEN
  71. C BASE DE STASBOURG
  72. CALL CHITPS(IDSCHI,LGKTMP,IOCHI3)
  73. NT=TMIMA(/2)
  74. IVALI=0
  75. XVALI=0.D0
  76. IRETI=0
  77. IVALR=0
  78. XVALR=0.D0
  79. MTYPI='MOT '
  80. JG=NYDIM*NT
  81. SEGINI MLREEL
  82. CALL RSETD(PROG,TMIMA,JG)
  83. IRETR=MLREEL
  84. MTYPR='LISTREEL'
  85. CHARR=' '
  86. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TMIMA',.TRUE.,
  87. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  88. SEGDES MLREEL
  89. JG=NYDIM*NT*4
  90. SEGINI MLREEL
  91. CALL RSETD(PROG,POLYT,JG)
  92. IRETR=MLREEL
  93. MTYPR='LISTREEL'
  94. CHARR=' '
  95. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'COEF',.TRUE.,
  96. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  97. SEGDES MLREEL
  98. JG=NYDIM*NT
  99. SEGINI MLREEL
  100. CALL RSETD(PROG,TGKLU,JG)
  101. IRETR=MLREEL
  102. MTYPR='LISTREEL'
  103. CHARR=' '
  104. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  105. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  106. SEGDES MLREEL
  107. JG=NYDIM
  108. SEGINI MLENTI
  109. CALL RSETI(LECT,NTVT,JG)
  110. IRETR=MLENTI
  111. MTYPR='LISTENTI'
  112. CHARR=' '
  113. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVT',.TRUE.,
  114. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  115. SEGDES MLENTI
  116. JG=NYDIM
  117. SEGINI MLENTI
  118. CALL RSETI(LECT,NUMT,JG)
  119. IRETR=MLENTI
  120. MTYPR='LISTENTI'
  121. CHARR=' '
  122. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NUMT',.TRUE.,
  123. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  124. SEGDES MLENTI
  125. SEGSUP LGKTMP
  126. ENDIF
  127. RETURN
  128. END
  129.  
  130.  
  131.  
  132.  
  133.  

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