Télécharger chmdeb.eso

Retour à la liste

Numérotation des lignes :

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

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