Télécharger actobj.eso

Retour à la liste

Numérotation des lignes :

  1. C ACTOBJ SOURCE PV 18/10/17 11:54:57 9965
  2. SUBROUTINE ACTOBJ(CTYPE,IPOIN,IKOD)
  3.  
  4. C____________________________________________________________________
  5. C
  6. C OBJET : Cette SUBROUTINE permet d''activer un OBJET Cast3M
  7. C
  8. C ENTREES :
  9. C °°°°°°°°°
  10. C
  11. C CTYPE Type d'objet a activer
  12. C IPOIN Pointeur sur l'objet a activer
  13. C IKOD ENTIER valant 0 pour SEGDES
  14. C 1 pour SEGACT de l'objet
  15. C
  16. C SORTIE :
  17. C °°°°°°°°
  18. C R.A.S l'objet et son contenu sont actives
  19. C_____________________________________________________________________
  20. C
  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 SMELEME
  30. -INC SMNUAGE
  31.  
  32. SEGMENT JPOINT(0)
  33. SEGMENT IPOINT(0)
  34. SEGMENT ISEG(0)
  35. PARAMETER(NBTYP=9)
  36. CHARACTER*(*)CTYPE
  37. CHARACTER*8 CTYP1,DTAOBJ(NBTYP)
  38. CHARACTER*16 MOT16
  39.  
  40. LOGICAL BCODE,BSEG
  41.  
  42. DATA DTAOBJ/'MCHAML ','CHPOINT ','MMODEL ','MAILLAGE',
  43. & 'EVOLUTIO','LISTMOTS','LISTREEL','LISTENTI',
  44. & 'NUAGE ' /
  45.  
  46. CTYP1 = CTYPE
  47. IPOI1 = IPOIN
  48. BCODE = IKOD .EQ. 0
  49. IOBJ = 0
  50. IPOINT= 0
  51. JPOINT= 0
  52. BSEG =.FALSE.
  53.  
  54. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  55. IF(IERR.NE.0) RETURN
  56. IF(IPLAC.EQ.0)RETURN
  57.  
  58. IF (IPOI1 .EQ. 0) THEN
  59. C PRINT *,' ECROBJ : TYPE ',CTYP1,'POINTEUR ',IPOI1
  60. C CALL ERREUR(21)
  61. RETURN
  62. ENDIF
  63.  
  64. C Verification de l'etat du SEGMENT IPOIN
  65. C CALL OOOETA(IPOIN,IETA,IMOD)
  66. C Il est actif en *NOMOD et on veut SEGACT ==> RETURN
  67. C IF(IETA.EQ.1 .AND. IMOD.EQ.0 .AND. .NOT. BCODE) RETURN
  68.  
  69. C Il est inactif et on veut SEGDES ==> RETURN
  70. C IF(IETA.NE.1 .AND. IMOD.EQ.0 .AND. BCODE) RETURN
  71.  
  72. C Cas potentiels non souhaites
  73. C Il est actif en *MOD et on veut SEGACT ==> Il manque un SEGACT*NOMOD quelque part
  74. C IF(IETA.EQ.1 .AND. IMOD.EQ.1 .AND. BCODE) THEN
  75. C ith=0
  76. C call ooonth(ith)
  77. C PRINT *,'ACTOBJ : SEGMENT ACTIF en *MOD :',CTYP1,':',ith,IPOIN
  78. C CALL TRBAC
  79. C ENDIF
  80.  
  81. C Prise de verrouillage
  82. CALL VERROU(2)
  83.  
  84. 1 CONTINUE
  85. IF(IPLAC.EQ.0) THEN
  86. C PRINT *,'OBJMOD.ESO :',CTYP1,' NON TRAITE ENCORE'
  87. GOTO 9999
  88. ENDIF
  89.  
  90. GOTO (100,200,300,400,500,600,600,600,700),IPLAC
  91. GOTO 9999
  92.  
  93. 100 CONTINUE
  94. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  95. C OBJET DE TYPE MCHAML
  96. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  97. MCHEL1=IPOI1
  98. MELSAV=0
  99. SEGACT,MCHEL1
  100. DO 110 II=1,MCHEL1.ICHAML(/1)
  101. MCHAM1=MCHEL1.ICHAML(II)
  102. IPT1=MCHEL1.IMACHE(II)
  103. IF (BCODE) THEN
  104. SEGDES,IPT1
  105. ELSE
  106. SEGACT,IPT1
  107. ENDIF
  108.  
  109. SEGACT,MCHAM1
  110. DO 120 JJ=1,MCHAM1.IELVAL(/1)
  111. MOT16 =MCHAM1.TYPCHE(JJ)
  112. MELVA1=MCHAM1.IELVAL(JJ)
  113. IF(MELVA1 .EQ. MELSAV) GOTO 120
  114. MELSAV=MELVA1
  115. SEGACT,MELVA1
  116. IF (MOT16(1:12) .EQ. 'POINTEURLIST')THEN
  117. IPOI2 = 0
  118. DO 130 KK=1,MELVA1.IELCHE(/2)
  119. DO 140 LL=1,MELVA1.IELCHE(/1)
  120. ISEG=MELVA1.IELCHE(LL,KK)
  121. IF(ISEG .NE. IPOI2 .AND. ISEG.NE.0)THEN
  122. IPOI2 = ISEG
  123. IF (BCODE) THEN
  124. SEGDES,ISEG
  125. ELSE
  126. SEGACT,ISEG
  127. ENDIF
  128. ENDIF
  129. 140 CONTINUE
  130. 130 CONTINUE
  131. ELSEIF(MOT16(1:16) .EQ. 'POINTEUREVOLUTIO')THEN
  132. IPOI2 = 0
  133. DO 150 KK=1,MELVA1.IELCHE(/2)
  134. DO 160 LL=1,MELVA1.IELCHE(/1)
  135. MEVOL1=MELVA1.IELCHE(LL,KK)
  136. IF(MEVOL1 .NE. IPOI2 .AND. MEVOL1.NE.0)THEN
  137. IPOI2 = MEVOL1
  138. SEGACT,MEVOL1
  139. DO 170 MM=1,MEVOL1.IEVOLL(/1)
  140. KEVOL1=MEVOL1.IEVOLL(MM)
  141. SEGACT,KEVOL1
  142. ISEG=KEVOL1.IPROGX
  143. IF (BCODE) THEN
  144. SEGDES,ISEG
  145. ELSE
  146. SEGACT,ISEG
  147. ENDIF
  148. ISEG=KEVOL1.IPROGY
  149. IF (BCODE) THEN
  150. SEGDES,ISEG
  151. ELSE
  152. SEGACT,ISEG
  153. ENDIF
  154. IF (BCODE) SEGDES,KEVOL1
  155. 170 CONTINUE
  156. IF (BCODE) SEGDES,MEVOL1
  157. ENDIF
  158. 160 CONTINUE
  159. 150 CONTINUE
  160. ELSEIF(MOT16(1:8) .EQ. 'POINTEUR')THEN
  161. IF(.NOT. BSEG)THEN
  162. SEGINI,JPOINT,IPOINT
  163. BSEG=.TRUE.
  164. ENDIF
  165. CTYP1=MOT16(9:16)
  166. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  167. IF(IPLAC .NE. 0)THEN
  168. DO 180 KK=1,MELVA1.IELCHE(/2)
  169. DO 190 LL=1,MELVA1.IELCHE(/1)
  170. IPOI2=MELVA1.IELCHE(LL,KK)
  171. IF(IPOI2.NE.JPOINT((JPOINT(/1))).AND.IPOI2.NE.0)THEN
  172. JPOINT(**)= IPOI2
  173. IPOINT(**)= IPLAC
  174. ENDIF
  175. 190 CONTINUE
  176. 180 CONTINUE
  177. ENDIF
  178. ENDIF
  179. IF (BCODE) SEGDES,MELVA1
  180. 120 CONTINUE
  181. IF (BCODE) SEGDES,MCHAM1
  182. 110 CONTINUE
  183. IF (BCODE) SEGDES,MCHEL1
  184. GOTO 9999
  185.  
  186. 200 CONTINUE
  187. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  188. C OBJET DE TYPE CHPOINT
  189. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  190. MCHPO1=IPOI1
  191. SEGACT,MCHPO1
  192. DO 210 II=1,MCHPO1.IPCHP(/1)
  193. MSOUP1=MCHPO1.IPCHP(II)
  194. SEGACT,MSOUP1
  195. IPT1=MSOUP1.IGEOC
  196. IF (BCODE) THEN
  197. SEGDES,IPT1
  198. ELSE
  199. SEGACT,IPT1
  200. ENDIF
  201.  
  202. MPOVA1=MSOUP1.IPOVAL
  203. IF (BCODE) THEN
  204. SEGDES,MPOVA1
  205. ELSE
  206. SEGACT,MPOVA1
  207. ENDIF
  208. IF (BCODE) SEGDES,MSOUP1
  209. 210 CONTINUE
  210. IF (BCODE) SEGDES,MCHPO1
  211. GOTO 9999
  212.  
  213. 300 CONTINUE
  214. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  215. C OBJET DE TYPE MMODEL
  216. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  217. MMODE1=IPOI1
  218. SEGACT,MMODE1
  219. DO 310 II=1,MMODE1.KMODEL(/1)
  220. IMODE1=MMODE1.KMODEL(II)
  221. SEGACT,IMODE1
  222. IPT1=IMODE1.IMAMOD
  223. IF (BCODE) THEN
  224. SEGDES,IPT1
  225. ELSE
  226. SEGACT,IPT1
  227. ENDIF
  228.  
  229. DO 320 JJ=1,IMODE1.IVAMOD(/1)
  230. CTYP1=IMODE1.TYMODE(JJ)
  231. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  232. IF(IPLAC .NE. 0)THEN
  233. IF(.NOT. BSEG)THEN
  234. SEGINI,JPOINT,IPOINT
  235. BSEG=.TRUE.
  236. ENDIF
  237. JPOINT(**)=IMODE1.IVAMOD(JJ)
  238. IPOINT(**)=IPLAC
  239. ENDIF
  240. 320 CONTINUE
  241.  
  242. DO 330 JJ=1,IMODE1.LNOMID(/1)
  243. NOMID=IMODE1.LNOMID(JJ)
  244. IF(NOMID .NE. 0)THEN
  245. IF (BCODE) THEN
  246. SEGDES,NOMID
  247. ELSE
  248. SEGACT,NOMID
  249. ENDIF
  250. ENDIF
  251. 330 CONTINUE
  252. IF (BCODE) SEGDES,IMODE1
  253. 310 CONTINUE
  254. IF (BCODE) SEGDES,MMODE1
  255. GOTO 9999
  256.  
  257. 400 CONTINUE
  258. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  259. C OBJET DE TYPE MAILLAGE
  260. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  261. IPT1=IPOI1
  262. SEGACT,IPT1
  263. DO 410 II=1,IPT1.LISOUS(/1)
  264. IPT2 =IPT1.LISOUS(II)
  265. IF (BCODE) THEN
  266. SEGDES,IPT2
  267. ELSE
  268. SEGACT,IPT2
  269. ENDIF
  270. 410 CONTINUE
  271. IF (BCODE) SEGDES,IPT1
  272. GOTO 9999
  273.  
  274. 500 CONTINUE
  275. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  276. C OBJET DE TYPE EVOLUTIO
  277. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  278. MEVOL1=IPOI1
  279. SEGACT,MEVOL1
  280. DO 510 II=1,MEVOL1.IEVOLL(/1)
  281. KEVOL1=MEVOL1.IEVOLL(II)
  282. SEGACT,KEVOL1
  283. ISEG=KEVOL1.IPROGX
  284. IF (BCODE) THEN
  285. SEGDES,ISEG
  286. ELSE
  287. SEGACT,ISEG
  288. ENDIF
  289. ISEG=KEVOL1.IPROGY
  290. IF (BCODE) THEN
  291. SEGDES,ISEG
  292. ELSE
  293. SEGACT,ISEG
  294. ENDIF
  295. IF (BCODE) SEGDES,KEVOL1
  296. 510 CONTINUE
  297. IF (BCODE) SEGDES,MEVOL1
  298. GOTO 9999
  299.  
  300. 600 CONTINUE
  301. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  302. C OBJET DE TYPE LISTXXXX
  303. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  304. ISEG=IPOI1
  305. IF (BCODE) THEN
  306. SEGDES,ISEG
  307. ELSE
  308. SEGACT,ISEG
  309. ENDIF
  310. GOTO 9999
  311.  
  312. 700 CONTINUE
  313. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  314. C OBJET DE TYPE NUAGE
  315. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  316. MNUAG1=IPOI1
  317. SEGACT,MNUAG1
  318. DO 710 II=1,MNUAG1.NUAPOI(/1)
  319. CTYP1=MNUAG1.NUATYP(II)
  320. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  321. IF(IPLAC .NE. 0)THEN
  322. IF(.NOT. BSEG)THEN
  323. SEGINI,JPOINT,IPOINT
  324. BSEG=.TRUE.
  325. ENDIF
  326. NUAVIN=MNUAG1.NUAPOI(II)
  327. SEGACT,NUAVIN
  328. DO 720 JJ=1,NUAVIN.NUAINT(/1)
  329. JPOINT(**)=NUAVIN.NUAINT(JJ)
  330. IPOINT(**)=IPLAC
  331. 720 CONTINUE
  332. IF (BCODE) SEGDES,NUAVIN
  333. ENDIF
  334. 710 CONTINUE
  335. IF (BCODE) SEGDES,MNUAG1
  336. C GOTO 9999
  337.  
  338. 9999 CONTINUE
  339. IF (.NOT. BSEG) GOTO 9990
  340. IF(IOBJ .NE. JPOINT(/1))THEN
  341. IOBJ = IOBJ + 1
  342. IPLAC = IPOINT(IOBJ)
  343. IPOI1 = JPOINT(IOBJ)
  344. IF (IERR .NE. 0) GOTO 9990
  345. GOTO 1
  346. ENDIF
  347.  
  348. 9990 CONTINUE
  349.  
  350. C Liberation du verrouillage
  351. IF (BSEG) SEGSUP,JPOINT,IPOINT
  352. CALL VERROU(3)
  353.  
  354. END
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  

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