Télécharger chmide.eso

Retour à la liste

Numérotation des lignes :

  1. C CHMIDE SOURCE CHAT 05/01/12 21:59:07 5004
  2. SUBROUTINE CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,
  3. * MLSURF,MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,
  4. * MLIMMO,MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3)
  5. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C OPERATEUR CHI2
  8. C ON DECODE LA SOUS TABLE ISSUE DE CHI1 TADEB.IDEN
  9. C
  10. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13. -INC CCOPTIO
  14. -INC SMLENTI
  15. -INC SMLREEL
  16. -INC SMTABLE
  17. -INC SMLMOTS
  18. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  19. LOGICAL LOGRE
  20. C
  21. MTAB2=ITIDEN
  22. * write(6,*)'chmide mtab2=itiden= ',MTAB2
  23. SEGACT MTAB2
  24. IVALI=1
  25. XVALI=0.D0
  26. IRETI=0
  27. IVALR=0
  28. XVALR=0.D0
  29. IRETR=0
  30. MTYPI='MOT '
  31. MTYPR='LISTENTI'
  32. CHARR=' '
  33. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'COMP',.TRUE.,IRETI,
  34. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  35. IF(IERR.NE.0)RETURN
  36. MLCOMP=IRETR
  37. MLENTI=IRETR
  38. SEGACT MLENTI
  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='LISTENTI'
  47. CHARR=' '
  48. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOLU',.TRUE.,IRETI,
  49. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  50. IF(IERR.NE.0)RETURN
  51. MLSOLU=IRETR
  52. MLENTI=IRETR
  53. SEGACT MLENTI
  54. IVALI=1
  55. XVALI=0.D0
  56. IRETI=0
  57. IVALR=0
  58. XVALR=0.D0
  59. IRETR=0
  60. MTYPI='MOT '
  61. MTYPR='LISTMOTS'
  62. CHARR=' '
  63. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSOLU',
  64. * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  65. IF(IERR.NE.0)RETURN
  66. MMSOLU=IRETR
  67. MLMOTS=IRETR
  68. SEGACT MLMOTS
  69. MLPREC=0
  70. MMPREC=0
  71. IVALI=1
  72. XVALI=0.D0
  73. IRETI=0
  74. IVALR=0
  75. XVALR=0.D0
  76. IRETR=0
  77. MTYPI='MOT '
  78. MTYPR=' '
  79. CHARR=' '
  80. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PRECI',.TRUE.,IRETI,
  81. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  82. IF(MTYPR.NE.' ')THEN
  83. IF(MTYPR.EQ.'LISTENTI')THEN
  84. MLPREC=IRETR
  85. MLENTI=IRETR
  86. SEGACT MLENTI
  87. IVALI=1
  88. XVALI=0.D0
  89. IRETI=0
  90. IVALR=0
  91. XVALR=0.D0
  92. IRETR=0
  93. MTYPI='MOT '
  94. MTYPR='LISTMOTS'
  95. CHARR=' '
  96. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMPRECI',
  97. * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  98. IF(IERR.NE.0)RETURN
  99. MMPREC=IRETR
  100. MLMOTS=IRETR
  101. SEGACT MLMOTS
  102. ELSE
  103. CALL ERREUR(21)
  104. ENDIF
  105. ENDIF
  106. MLPOLE=0
  107. MMPOLE=0
  108. IVALI=1
  109. XVALI=0.D0
  110. IRETI=0
  111. IVALR=0
  112. XVALR=0.D0
  113. IRETR=0
  114. MTYPI='MOT '
  115. MTYPR=' '
  116. CHARR=' '
  117. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'POLE',.TRUE.,IRETI,
  118. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  119. IF(MTYPR.NE.' ')THEN
  120. IF(MTYPR.EQ.'LISTENTI')THEN
  121. MLPOLE=IRETR
  122. MLENTI=IRETR
  123. SEGACT MLENTI
  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='LISTMOTS'
  132. CHARR=' '
  133. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMPOLE',
  134. * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  135. IF(IERR.NE.0)RETURN
  136. MMPOLE=IRETR
  137. * write(6,*)'chmide mmpole',mmpole
  138. MLMOTS=IRETR
  139. SEGACT MLMOTS
  140. ELSE
  141. CALL ERREUR(21)
  142. ENDIF
  143. ENDIF
  144. MLSOSO=0
  145. MMSOSO=0
  146. IVALI=1
  147. XVALI=0.D0
  148. IRETI=0
  149. IVALR=0
  150. XVALR=0.D0
  151. IRETR=0
  152. MTYPI='MOT '
  153. MTYPR=' '
  154. CHARR=' '
  155. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOSO',.TRUE.,IRETI,
  156. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  157. IF(MTYPR.NE.' ')THEN
  158. IF(MTYPR.EQ.'LISTENTI')THEN
  159. MLSOSO=IRETR
  160. * write(6,*)'chmide mlsoso',mlsoso
  161. MLENTI=IRETR
  162. SEGACT MLENTI
  163. IVALI=1
  164. XVALI=0.D0
  165. IRETI=0
  166. IVALR=0
  167. XVALR=0.D0
  168. IRETR=0
  169. MTYPI='MOT '
  170. MTYPR='LISTMOTS'
  171. CHARR=' '
  172. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSOSO',
  173. * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  174. IF(IERR.NE.0)RETURN
  175. MMSOSO=IRETR
  176. * write(6,*)'chmide mmsoso',mmsoso
  177. MLMOTS=IRETR
  178. SEGACT MLMOTS
  179. ELSE
  180. CALL ERREUR(21)
  181. ENDIF
  182. ENDIF
  183. MLSURF=0
  184. MMSURF=0
  185. IVALI=1
  186. XVALI=0.D0
  187. IRETI=0
  188. IVALR=0
  189. XVALR=0.D0
  190. IRETR=0
  191. MTYPI='MOT '
  192. MTYPR=' '
  193. CHARR=' '
  194. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SURF',.TRUE.,IRETI,
  195. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  196. IF(MTYPR.NE.' ')THEN
  197. IF(MTYPR.EQ.'LISTENTI')THEN
  198. MLSURF=IRETR
  199. MLENTI=IRETR
  200. SEGACT MLENTI
  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='LISTMOTS'
  209. CHARR=' '
  210. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSURF',
  211. * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  212. IF(IERR.NE.0)RETURN
  213. MMSURF=IRETR
  214. MLMOTS=IRETR
  215. SEGACT MLMOTS
  216. ELSE
  217. CALL ERREUR(21)
  218. ENDIF
  219. ENDIF
  220. MLTYP3=0
  221. MMTYP3=0
  222. IVALI=1
  223. XVALI=0.D0
  224. IRETI=0
  225. IVALR=0
  226. XVALR=0.D0
  227. IRETR=0
  228. MTYPI='MOT '
  229. MTYPR=' '
  230. CHARR=' '
  231. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,IRETI,
  232. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  233. IF(MTYPR.NE.' ')THEN
  234. IF(MTYPR.EQ.'LISTENTI')THEN
  235. MLTYP3=IRETR
  236. * write(6,*)'chmide mltyp3=',MLTYP3
  237. MLENTI=IRETR
  238. SEGACT MLENTI
  239. IVALI=1
  240. XVALI=0.D0
  241. IRETI=0
  242. IVALR=0
  243. XVALR=0.D0
  244. IRETR=0
  245. MTYPI='MOT '
  246. MTYPR='LISTMOTS'
  247. CHARR=' '
  248. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMTYP3',
  249. * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  250. IF(IERR.NE.0)RETURN
  251. MMTYP3=IRETR
  252. MLMOTS=IRETR
  253. SEGACT MLMOTS
  254. ELSE
  255. CALL ERREUR(21)
  256. ENDIF
  257. ENDIF
  258. LIMP3=0
  259. IVALI=1
  260. XVALI=0.D0
  261. IRETI=0
  262. IVALR=0
  263. XVALR=0.D0
  264. IRETR=0
  265. MTYPI='MOT '
  266. MTYPR=' '
  267. CHARR=' '
  268. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMP3',.TRUE.,IRETI,
  269. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  270. IF(MTYPR.NE.' ')THEN
  271. IF(MTYPR.EQ.'LISTENTI')THEN
  272. LIMP3=IRETR
  273. ELSE
  274. CALL ERREUR(21)
  275. ENDIF
  276. ENDIF
  277. MLTYP6=0
  278. MMTYP6=0
  279. IVALI=1
  280. XVALI=0.D0
  281. IRETI=0
  282. IVALR=0
  283. XVALR=0.D0
  284. IRETR=0
  285. MTYPI='MOT '
  286. MTYPR=' '
  287. CHARR=' '
  288. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,IRETI,
  289. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  290. IF(MTYPR.NE.' ')THEN
  291. IF(MTYPR.EQ.'LISTENTI')THEN
  292. MLTYP6=IRETR
  293. MLENTI=IRETR
  294. SEGACT MLENTI
  295. IVALI=1
  296. XVALI=0.D0
  297. IRETI=0
  298. IVALR=0
  299. XVALR=0.D0
  300. IRETR=0
  301. MTYPI='MOT '
  302. MTYPR='LISTMOTS'
  303. CHARR=' '
  304. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMTYP6',
  305. * .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  306. IF(IERR.NE.0)RETURN
  307. MMTYP6=IRETR
  308. MLMOTS=IRETR
  309. SEGACT MLMOTS
  310. ELSE
  311. CALL ERREUR(21)
  312. ENDIF
  313. ENDIF
  314. MLPARF=0
  315. IVALI=1
  316. XVALI=0.D0
  317. IRETI=0
  318. IVALR=0
  319. XVALR=0.D0
  320. IRETR=0
  321. MTYPI='MOT '
  322. MTYPR=' '
  323. CHARR=' '
  324. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PARF',.TRUE.,IRETI,
  325. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  326. IF(MTYPR.NE.' ')THEN
  327. IF(MTYPR.EQ.'LISTENTI')THEN
  328. MLPARF=IRETR
  329. MLENTI=IRETR
  330. SEGACT MLENTI
  331. ELSE
  332. CALL ERREUR(21)
  333. ENDIF
  334. ENDIF
  335. MLREAC=0
  336. IVALI=1
  337. XVALI=0.D0
  338. IRETI=0
  339. IVALR=0
  340. XVALR=0.D0
  341. IRETR=0
  342. MTYPI='MOT '
  343. MTYPR=' '
  344. CHARR=' '
  345. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'REAC',.TRUE.,IRETI,
  346. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  347. IF(MTYPR.NE.' ')THEN
  348. IF(MTYPR.EQ.'LISTENTI')THEN
  349. MLREAC=IRETR
  350. MLENTI=IRETR
  351. SEGACT MLENTI
  352. ELSE
  353. CALL ERREUR(21)
  354. ENDIF
  355. ENDIF
  356. MLIMMO=0
  357. IVALI=1
  358. XVALI=0.D0
  359. IRETI=0
  360. IVALR=0
  361. XVALR=0.D0
  362. IRETR=0
  363. MTYPI='MOT '
  364. MTYPR=' '
  365. CHARR=' '
  366. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMMO',.TRUE.,IRETI,
  367. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  368. IF(MTYPR.NE.' ')THEN
  369. IF(MTYPR.EQ.'LISTENTI')THEN
  370. MLIMMO=IRETR
  371. MLENTI=IRETR
  372. SEGACT MLENTI
  373. ELSE
  374. CALL ERREUR(21)
  375. ENDIF
  376. ENDIF
  377. SEGDES MTAB2
  378. RETURN
  379. END
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  

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