Télécharger actobj.eso

Retour à la liste

Numérotation des lignes :

  1. C ACTOBJ SOURCE CB215821 18/09/10 21:15:04 9912
  2. SUBROUTINE ACTOBJ(CTYPE,IPOIN,IKOD)
  3.  
  4. *____________________________________________________________________
  5. *
  6. * OBJET : Cette SUBROUTINE permet d''activer un OBJET Cast3M
  7. *
  8. * ENTREES :
  9. * °°°°°°°°°
  10. *
  11. * CTYPE Type d'objet a activer
  12. * IPOIN Pointeur sur l'objet a activer
  13. * IKOD ENTIER valant 1 pour faire SEGACT(*NOMOD)
  14. * 0 pour faire SEGDES
  15. *
  16. * SORTIE :
  17. * °°°°°°°°
  18. * R.A.S l'objet et son contenu sont actives
  19. *_____________________________________________________________________
  20. *
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. *
  24. -INC CCOPTIO
  25. -INC SMCHAML
  26. -INC SMCHPOI
  27. -INC SMMODEL
  28. -INC SMEVOLL
  29. -INC SMLREEL
  30. -INC SMLENTI
  31. -INC SMELEME
  32. -INC SMLMOTS
  33. -INC SMNUAGE
  34.  
  35. SEGMENT SPOINT(0)
  36. SEGMENT CPOINT(0)
  37.  
  38. PARAMETER(NBTYP=9)
  39. CHARACTER*(*)CTYPE
  40. CHARACTER*8 CTYP1,DTAOBJ(NBTYP)
  41. CHARACTER*16 MOT16
  42.  
  43. LOGICAL BCODE
  44.  
  45. DATA DTAOBJ/'MCHAML ','CHPOINT ','MMODEL ','MAILLAGE',
  46. & 'EVOLUTIO','LISTMOTS','LISTREEL','LISTENTI',
  47. & 'NUAGE ' /
  48.  
  49. CTYP1 = CTYPE
  50. IPOI1 = IPOIN
  51. BCODE = IKOD .EQ. 0
  52.  
  53. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  54. IF(IERR.NE.0) RETURN
  55. IF(IPLAC.EQ.0) THEN
  56. C PRINT *,'OBJMOD.ESO :',CTYP1,' NON TRAITE ENCORE'
  57. C CALL ERREUR(5)
  58. RETURN
  59. ENDIF
  60.  
  61. IF (IPOI1 .EQ. 0) THEN
  62. C PRINT *,' ECROBJ : TYPE ',CTYP1,'POINTEUR ',IPOI1
  63. C CALL ERREUR(21)
  64. RETURN
  65. ENDIF
  66.  
  67. IOBJ=0
  68. SEGINI,SPOINT,CPOINT
  69. 1 CONTINUE
  70.  
  71. IF(IERR.NE.0) RETURN
  72. IF(IPLAC.EQ.0) THEN
  73. C PRINT *,'OBJMOD.ESO :',CTYP1,' NON TRAITE ENCORE'
  74. GOTO 9999
  75. ENDIF
  76.  
  77. GOTO (100,200,300,400,500,600,700,800,900),IPLAC
  78. CALL ERREUR(5)
  79. RETURN
  80.  
  81. 100 CONTINUE
  82. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  83. C OBJET DE TYPE MCHAML
  84. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  85. MCHEL1=IPOI1
  86. SEGACT,MCHEL1
  87. DO 110 II=1,MCHEL1.ICHAML(/1)
  88. MCHAM1=MCHEL1.ICHAML(II)
  89. CTYP1='MAILLAGE'
  90. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  91. IF(IERR .NE.0) RETURN
  92. SPOINT(**)=MCHEL1.IMACHE(II)
  93. CPOINT(**)=IPLAC
  94.  
  95. SEGACT,MCHAM1
  96. DO 120 JJ=1,MCHAM1.IELVAL(/1)
  97. MOT16 =MCHAM1.TYPCHE(JJ)
  98. MELVA1=MCHAM1.IELVAL(JJ)
  99. SEGACT,MELVA1
  100. IF(MOT16(1:8) .EQ. 'POINTEUR')THEN
  101. CTYP1=MOT16(9:16)
  102. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  103. IF(IERR .NE.0) RETURN
  104. IF(IPLAC .NE. 0)THEN
  105. DO 130 KK=1,MELVA1.IELCHE(/2)
  106. DO 140 LL=1,MELVA1.IELCHE(/1)
  107. IPOI2=MELVA1.IELCHE(LL,KK)
  108. IF(IPOI2 .NE. SPOINT((SPOINT(/1))) .AND.
  109. & IPOI2.GT.0)THEN
  110. SPOINT(**)= IPOI2
  111. CPOINT(**)= IPLAC
  112. ENDIF
  113. 140 CONTINUE
  114. 130 CONTINUE
  115. ENDIF
  116. ENDIF
  117. IF (BCODE) SEGDES,MELVA1
  118. 120 CONTINUE
  119. IF (BCODE) SEGDES,MCHAM1
  120. 110 CONTINUE
  121. IF (BCODE) SEGDES,MCHEL1
  122. GOTO 9999
  123.  
  124. 200 CONTINUE
  125. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  126. C OBJET DE TYPE CHPOINT
  127. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  128. MCHPO1=IPOI1
  129. SEGACT,MCHPO1
  130. DO 210 II=1,MCHPO1.IPCHP(/1)
  131. MSOUP1=MCHPO1.IPCHP(II)
  132. SEGACT,MSOUP1
  133.  
  134. CTYP1='MAILLAGE'
  135. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  136. IF(IERR .NE.0) RETURN
  137. SPOINT(**)=MSOUP1.IGEOC
  138. CPOINT(**)=IPLAC
  139.  
  140. MPOVA1=MSOUP1.IPOVAL
  141. IF (BCODE) THEN
  142. SEGDES,MPOVA1
  143. ELSE
  144. SEGACT,MPOVA1
  145. ENDIF
  146. IF (BCODE) SEGDES,MSOUP1
  147. 210 CONTINUE
  148. IF (BCODE) SEGDES,MCHPO1
  149. GOTO 9999
  150.  
  151. 300 CONTINUE
  152. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  153. C OBJET DE TYPE MMODEL
  154. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  155. MMODE1=IPOI1
  156. SEGACT,MMODE1
  157. DO 310 II=1,MMODE1.KMODEL(/1)
  158. IMODE1=MMODE1.KMODEL(II)
  159. SEGACT,IMODE1
  160.  
  161. CTYP1='MAILLAGE'
  162. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  163. IF(IERR .NE.0) RETURN
  164. SPOINT(**)=IMODE1.IMAMOD
  165. CPOINT(**)=IPLAC
  166.  
  167. DO 320 JJ=1,IMODE1.IVAMOD(/1)
  168. CTYP1=IMODE1.TYMODE(JJ)
  169. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  170. IF(IERR .NE.0) RETURN
  171. IF(IPLAC .NE. 0)THEN
  172. SPOINT(**)=IMODE1.IVAMOD(JJ)
  173. CPOINT(**)=IPLAC
  174. ENDIF
  175. 320 CONTINUE
  176.  
  177. DO 330 JJ=1,IMODE1.LNOMID(/1)
  178. NOMID=IMODE1.LNOMID(JJ)
  179. IF(NOMID .NE. 0)THEN
  180. IF (BCODE) THEN
  181. SEGDES,NOMID
  182. ELSE
  183. SEGACT,NOMID
  184. ENDIF
  185. ENDIF
  186. 330 CONTINUE
  187. IF (BCODE) SEGDES,IMODE1
  188. 310 CONTINUE
  189. IF (BCODE) SEGDES,MMODE1
  190. GOTO 9999
  191.  
  192. 400 CONTINUE
  193. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  194. C OBJET DE TYPE MAILLAGE
  195. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  196. IPT1=IPOI1
  197. SEGACT,IPT1
  198. DO 410 II=1,IPT1.LISOUS(/1)
  199. CTYP1='MAILLAGE'
  200. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  201. IF(IERR .NE.0) RETURN
  202. SPOINT(**)=IPT1.LISOUS(II)
  203. CPOINT(**)=IPLAC
  204. 410 CONTINUE
  205.  
  206. DO 420 II=1,IPT1.LISREF(/1)
  207. CTYP1='MAILLAGE'
  208. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  209. IF(IERR .NE.0) RETURN
  210. SPOINT(**)=IPT1.LISREF(II)
  211. CPOINT(**)=IPLAC
  212. 420 CONTINUE
  213. IF (BCODE) SEGDES,IPT1
  214. GOTO 9999
  215.  
  216. 500 CONTINUE
  217. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  218. C OBJET DE TYPE EVOLUTIO
  219. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  220. MEVOL1=IPOI1
  221. SEGACT,MEVOL1
  222. DO 510 II=1,MEVOL1.IEVOLL(/1)
  223. KEVOL1=MEVOL1.IEVOLL(II)
  224. SEGACT,KEVOL1
  225.  
  226. CTYP1=KEVOL1.TYPX
  227. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  228. IF(IERR .NE.0) RETURN
  229. IF(IPLAC .NE. 0)THEN
  230. SPOINT(**)=KEVOL1.IPROGX
  231. CPOINT(**)=IPLAC
  232. ENDIF
  233.  
  234. CTYP1=KEVOL1.TYPY
  235. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  236. IF(IERR .NE.0) RETURN
  237. IF(IPLAC .NE. 0)THEN
  238. SPOINT(**)=KEVOL1.IPROGY
  239. CPOINT(**)=IPLAC
  240. ENDIF
  241. IF (BCODE) SEGDES,KEVOL1
  242. 510 CONTINUE
  243. IF (BCODE) SEGDES,MEVOL1
  244. GOTO 9999
  245.  
  246. 600 CONTINUE
  247. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  248. C OBJET DE TYPE LISTMOTS
  249. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  250. MLMOT1=IPOI1
  251. IF (BCODE) THEN
  252. SEGDES,MLMOT1
  253. ELSE
  254. SEGACT,MLMOT1
  255. ENDIF
  256. GOTO 9999
  257.  
  258. 700 CONTINUE
  259. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  260. C OBJET DE TYPE LISTREEL
  261. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  262. MLREE1=IPOI1
  263. IF (BCODE) THEN
  264. SEGDES,MLREE1
  265. ELSE
  266. SEGACT,MLREE1
  267. ENDIF
  268. GOTO 9999
  269.  
  270. 800 CONTINUE
  271. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  272. C OBJET DE TYPE LISTENTI
  273. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  274. MLENT1=IPOI1
  275. IF (BCODE) THEN
  276. SEGDES,MLENT1
  277. ELSE
  278. SEGACT,MLENT1
  279. ENDIF
  280. GOTO 9999
  281.  
  282. 900 CONTINUE
  283. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  284. C OBJET DE TYPE NUAGE
  285. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  286. MNUAG1=IPOI1
  287. SEGACT,MNUAG1
  288. DO 910 II=1,MNUAG1.NUAPOI(/1)
  289. CTYP1=MNUAG1.NUATYP(II)
  290. CALL PLACE(DTAOBJ,NBTYP,IPLAC,CTYP1)
  291. IF(IERR .NE.0) RETURN
  292. IF(IPLAC .NE. 0)THEN
  293. NUAVIN=MNUAG1.NUAPOI(II)
  294. SEGACT,NUAVIN
  295. DO 920 JJ=1,NUAVIN.NUAINT(/1)
  296. SPOINT(**)=NUAVIN.NUAINT(JJ)
  297. CPOINT(**)=IPLAC
  298. 920 CONTINUE
  299. IF (BCODE) SEGDES,NUAVIN
  300. ENDIF
  301. 910 CONTINUE
  302. IF (BCODE) SEGDES,MNUAG1
  303. GOTO 9999
  304.  
  305. 9999 CONTINUE
  306.  
  307. IF(IOBJ .NE. SPOINT(/1))THEN
  308. IOBJ = IOBJ + 1
  309. IPLAC = CPOINT(IOBJ)
  310. IPOI1 = SPOINT(IOBJ)
  311. C CALL OOONTH(ITH)
  312. C PRINT *,'ACTOBJ :',ITH,IOBJ,SPOINT(/1), DTAOBJ(IPLAC),IPOI1
  313. GOTO 1
  314. ENDIF
  315.  
  316. SEGSUP,SPOINT,CPOINT
  317.  
  318. RETURN
  319. END
  320.  
  321.  
  322.  

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