Télécharger chmdeb.eso

Retour à la liste

Numérotation des lignes :

  1. C CHMDEB SOURCE CHAT 05/01/12 21:58:48 5004
  2. SUBROUTINE CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,
  3. * MLDECY,MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP)
  4. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C OPERATEUR CHI2
  7. C ON DECODE LA TABLE ISSUE DE CHI1
  8. C
  9. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. -INC CCOPTIO
  13. -INC SMLENTI
  14. -INC SMLREEL
  15. -INC SMTABLE
  16. -INC SMLMOTS
  17. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  18. LOGICAL LOGRE
  19. C
  20. IRETOU=0
  21. MTAB1=0
  22. CALL LIRTAB('CHIMI1',MTAB1,1,IRETOU)
  23. IF(IRETOU.EQ.0)RETURN
  24. SEGACT MTAB1
  25. IVALI=1
  26. XVALI=0.D0
  27. IRETI=0
  28. IVALR=0
  29. XVALR=0.D0
  30. IRETR=0
  31. MTYPI='MOT '
  32. MTYPR='TABLE '
  33. CHARR=' '
  34. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DESCHI',.TRUE.,IRETI,
  35. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  36. IF(IERR.NE.0)RETURN
  37. MTAB2=IRETR
  38. SEGACT MTAB2
  39. IVALI=1
  40. XVALI=0.D0
  41. IRETI=0
  42. IVALR=0
  43. XVALR=0.D0
  44. IRETR=0
  45. MTYPI='MOT '
  46. MTYPR='TABLE '
  47. CHARR=' '
  48. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,
  49. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  50. IF(IERR.NE.0)RETURN
  51. ITIDEN=IRETR
  52. * write(6,*)'chmdeb itiden= ',ITIDEN
  53. IVALI=1
  54. XVALI=0.D0
  55. IRETI=0
  56. IVALR=0
  57. XVALR=0.D0
  58. IRETR=0
  59. MTYPI='MOT '
  60. MTYPR=' '
  61. CHARR=' '
  62. ITREDO=0
  63. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'REDOX',.TRUE.,IRETI,
  64. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  65. IF(MTYPR.NE.' ')THEN
  66. IF(MTYPR.EQ.'TABLE ')THEN
  67. ITREDO=IRETR
  68. ELSE
  69. MOTERR(1:11)='REDOX '
  70. MOTERR(12:20)='TABLE '
  71. CALL ERREUR(627)
  72. RETURN
  73. ENDIF
  74. ENDIF
  75. IVALI=1
  76. XVALI=0.D0
  77. IRETI=0
  78. IVALR=0
  79. XVALR=0.D0
  80. IRETR=0
  81. MTYPI='MOT '
  82. MTYPR=' '
  83. CHARR=' '
  84. ITEMPE=0
  85. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPE',.TRUE.,IRETI,
  86. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  87. IF(MTYPR.NE.' ')THEN
  88. IF(MTYPR.EQ.'TABLE ')THEN
  89. ITEMPE=IRETR
  90. ELSE
  91. MOTERR(1:11)='TEMPE '
  92. MOTERR(12:20)='TABLE '
  93. CALL ERREUR(627)
  94. RETURN
  95. ENDIF
  96. ENDIF
  97. C ON DECODE LA TABLE DESCHI
  98. IVALI=1
  99. XVALI=0.D0
  100. IRETI=0
  101. IVALR=0
  102. XVALR=0.D0
  103. IRETR=0
  104. MTYPI='MOT '
  105. MTYPR='LISTENTI'
  106. CHARR=' '
  107. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDX',.TRUE.,IRETI,
  108. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  109. IF(IERR.NE.0)RETURN
  110. MLIDX=IRETR
  111. IVALI=1
  112. XVALI=0.D0
  113. IRETI=0
  114. IVALR=0
  115. XVALR=0.D0
  116. IRETR=0
  117. MTYPI='MOT '
  118. MTYPR='LISTENTI'
  119. CHARR=' '
  120. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDY',.TRUE.,IRETI,
  121. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  122. IF(IERR.NE.0)RETURN
  123. MLIDY=IRETR
  124. IVALI=1
  125. XVALI=0.D0
  126. IRETI=0
  127. IVALR=0
  128. XVALR=0.D0
  129. IRETR=0
  130. MTYPI='MOT '
  131. MTYPR=' '
  132. CHARR=' '
  133. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDZ',.TRUE.,IRETI,
  134. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  135. IF(IERR.NE.0)RETURN
  136. MLIDZ=IRETR
  137. IVALI=1
  138. XVALI=0.D0
  139. IRETI=0
  140. IVALR=0
  141. XVALR=0.D0
  142. IRETR=0
  143. MTYPI='MOT '
  144. MTYPR='LISTENTI'
  145. CHARR=' '
  146. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDP',.TRUE.,IRETI,
  147. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  148. MLIDP=IRETR
  149. IVALI=1
  150. XVALI=0.D0
  151. IRETI=0
  152. IVALR=0
  153. XVALR=0.D0
  154. IRETR=0
  155. MTYPI='MOT '
  156. MTYPR='LISTENTI'
  157. CHARR=' '
  158. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NN',.TRUE.,IRETI,
  159. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  160. IF(IERR.NE.0)RETURN
  161. MLNN=IRETR
  162. IVALI=1
  163. XVALI=0.D0
  164. IRETI=0
  165. IVALR=0
  166. XVALR=0.D0
  167. IRETR=0
  168. MTYPI='MOT '
  169. MTYPR='LISTENTI'
  170. CHARR=' '
  171. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDSURF',.TRUE.,IRETI,
  172. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  173. IF(IERR.NE.0)RETURN
  174. MLDECY=IRETR
  175. IVALI=1
  176. XVALI=0.D0
  177. IRETI=0
  178. IVALR=0
  179. XVALR=0.D0
  180. IRETR=0
  181. MTYPI='MOT '
  182. MTYPR='LISTENTI'
  183. CHARR=' '
  184. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'CHARGE',.TRUE.,IRETI,
  185. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  186. IF(IERR.NE.0)RETURN
  187. MLIONZ=IRETR
  188. IVALI=1
  189. XVALI=0.D0
  190. IRETI=0
  191. IVALR=0
  192. XVALR=0.D0
  193. IRETR=0
  194. MTYPI='MOT '
  195. MTYPR='LISTREEL'
  196. CHARR=' '
  197. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MATRICEA',.TRUE.,IRETI,
  198. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  199. IF(IERR.NE.0)RETURN
  200. MLAA=IRETR
  201. IVALI=1
  202. XVALI=0.D0
  203. IRETI=0
  204. IVALR=0
  205. XVALR=0.D0
  206. IRETR=0
  207. MTYPI='MOT '
  208. MTYPR=' '
  209. CHARR=' '
  210. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MATRICEF',.TRUE.,IRETI,
  211. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  212. IF(IERR.NE.0)RETURN
  213. MLFF=IRETR
  214. IVALI=1
  215. XVALI=0.D0
  216. IRETI=0
  217. IVALR=0
  218. XVALR=0.D0
  219. IRETR=0
  220. MTYPI='MOT '
  221. MTYPR='LISTREEL'
  222. CHARR=' '
  223. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,IRETI,
  224. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  225. IF(IERR.NE.0)RETURN
  226. MLOGK=IRETR
  227. IVALI=1
  228. XVALI=0.D0
  229. IRETI=0
  230. IVALR=0
  231. XVALR=0.D0
  232. IRETR=0
  233. MTYPI='MOT '
  234. MTYPR='LISTMOTS'
  235. CHARR=' '
  236. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOM',.TRUE.,IRETI,
  237. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  238. IF(IERR.NE.0)RETURN
  239. MLNAME=IRETR
  240. IVALI=1
  241. XVALI=0.D0
  242. IRETI=0
  243. IVALR=0
  244. XVALR=0.D0
  245. IRETR=0
  246. MTYPI='MOT '
  247. MTYPR='LISTMOTS'
  248. CHARR=' '
  249. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMESPECE',.TRUE.,IRETI,
  250. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  251. IF(IERR.NE.0)RETURN
  252. MLNESP=IRETR
  253. SEGDES MTAB1,MTAB2
  254. c write(6,*)'fin chmdeb'
  255. c write(6,*)'nxdim, nydim, nzdim ',nxdim,nydim,nzdim
  256. c write(6,*)'idx ',(idx(i),i=1,nxdim)
  257. c write(6,*)'idy ',(idy(i),i=1,nydim)
  258. c write(6,*)'idz ',(idz(i),i=1,nzdim)
  259. c do 700 i=1,nydim
  260. c write(6,*)'idy ',idy(i),'aa ',(aa(j),j=1,nxdim)
  261. c 700 continue
  262. c do 800 k=1,nzdim
  263. c write(6,*)'idz ',idz(k),'ff ',(ff(i),i=1,nydim)
  264. c 800 continue
  265. RETURN
  266. END
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  

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