Télécharger actobj.eso

Retour à la liste

Numérotation des lignes :

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

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