Télécharger chides.eso

Retour à la liste

Numérotation des lignes :

  1. C CHIDES SOURCE CHAT 05/01/12 21:57:08 5004
  2. SUBROUTINE CHIDES(MTAB1,IDSCHI)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C
  7. C CHARGEMENT DE LA TABLE DESCHI
  8. C
  9. C------------------------------------------------------------------
  10. -INC SMTABLE
  11. -INC SMLENTI
  12. -INC SMLREEL
  13. -INC SMLMOTS
  14. -INC CCOPTIO
  15. SEGMENT IDSCHI
  16. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  17. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  18. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  19. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  20. ENDSEGMENT
  21. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  22. C
  23. NYDIM=IDY(/1)
  24. NXDIM=IDX(/1)
  25. NZDIM=IDZ(/1)
  26. NPDIM=IDP(/1)
  27. SEGACT MTAB1
  28. JG=NXDIM
  29. SEGINI MLENTI
  30. CALL RSETI(LECT,IDX,JG)
  31. IVALI=0
  32. XVALI=0.D0
  33. IRETI=0
  34. IVALR=0
  35. XVALR=0.D0
  36. IRETR=MLENTI
  37. MTYPI='MOT '
  38. MTYPR='LISTENTI'
  39. CHARR=' '
  40. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDX',.TRUE.,
  41. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  42. SEGDES MLENTI
  43. JG=NYDIM
  44. SEGINI MLENTI
  45. CALL RSETI(LECT,IDY,JG)
  46. IRETR=MLENTI
  47. MTYPR='LISTENTI'
  48. CHARR=' '
  49. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDY',.TRUE.,
  50. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  51. SEGDES MLENTI
  52. JG=NZDIM
  53. SEGINI MLENTI
  54. CALL RSETI(LECT,IDZ,JG)
  55. IRETR=MLENTI
  56. MTYPR='LISTENTI'
  57. CHARR=' '
  58. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDZ',.TRUE.,
  59. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  60. SEGDES MLENTI
  61. JG=NPDIM
  62. SEGINI MLENTI
  63. CALL RSETI(LECT,IDP,JG)
  64. IRETR=MLENTI
  65. MTYPR='LISTENTI'
  66. CHARR=' '
  67. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDP',.TRUE.,
  68. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  69. SEGDES MLENTI
  70. JG=6
  71. SEGINI MLENTI
  72. CALL RSETI(LECT,NN,JG)
  73. IRETR=MLENTI
  74. MTYPR='LISTENTI'
  75. CHARR=' '
  76. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NN',.TRUE.,
  77. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  78. SEGDES MLENTI
  79. JG=NYDIM
  80. SEGINI MLENTI
  81. CALL RSETI(LECT,IDECY,JG)
  82. IRETR=MLENTI
  83. MTYPR='LISTENTI'
  84. CHARR=' '
  85. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDSURF',.TRUE.,
  86. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  87. SEGDES MLENTI
  88. JG=NXDIM
  89. SEGINI MLENTI
  90. CALL RSETI(LECT,IONZ,JG)
  91. IRETR=MLENTI
  92. MTYPR='LISTENTI'
  93. CHARR=' '
  94. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'CHARGE',.TRUE.,
  95. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  96. SEGDES MLENTI
  97. JG=NYDIM
  98. SEGINI MLREEL
  99. CALL RSETD(PROG,GK,JG)
  100. IRETR=MLREEL
  101. MTYPR='LISTREEL'
  102. CHARR=' '
  103. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  104. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  105. SEGDES MLREEL
  106. JG=NYDIM*NXDIM
  107. SEGINI MLREEL
  108. CALL RSETD(PROG,AA,JG)
  109. IRETR=MLREEL
  110. MTYPR='LISTREEL'
  111. CHARR=' '
  112. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'MATRICEA',.TRUE.,
  113. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  114. SEGDES MLREEL
  115. JG=NZDIM*NPDIM
  116. SEGINI MLREEL
  117. CALL RSETD(PROG,FF,JG)
  118. IRETR=MLREEL
  119. MTYPR='LISTREEL'
  120. CHARR=' '
  121. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'MATRICEF',.TRUE.,
  122. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  123. SEGDES MLREEL
  124. JGN=32
  125. JGM=NXDIM
  126. SEGINI MLMOTS
  127. DO 50 I=1,JGM
  128. MOTS(I)=NAME(I)
  129. 50 CONTINUE
  130. IRETR=MLMOTS
  131. MTYPR='LISTMOTS'
  132. CHARR=' '
  133. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOM',.TRUE.,
  134. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  135. SEGDES MLMOTS
  136. JGN=32
  137. JGM=NYDIM
  138. SEGINI MLMOTS
  139. DO 60 I=1,JGM
  140. MOTS(I)=NAMESP(I)
  141. 60 CONTINUE
  142. IRETR=MLMOTS
  143. MTYPR='LISTMOTS'
  144. CHARR=' '
  145. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMESPECE',.TRUE.,
  146. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  147. SEGDES MLMOTS
  148. RETURN
  149. END
  150.  
  151.  
  152.  
  153.  
  154.  

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