Télécharger chitet.eso

Retour à la liste

Numérotation des lignes :

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

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