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

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