Télécharger actobj.eso

Retour à la liste

Numérotation des lignes :

actobj
  1. C ACTOBJ SOURCE CB215821 20/11/25 13:18:11 10792
  2. SUBROUTINE ACTOBJ(CTYPE,IPOIN,IKOD)
  3.  
  4. C____________________________________________________________________
  5. C
  6. C OBJET : Cette SUBROUTINE permet d''activer/desactiver un OBJET
  7. C de Cast3M contenu dans le DATA DTAOBJ
  8. C
  9. C ENTREES :
  10. C °°°°°°°°°
  11. C
  12. C CTYPE Type d'objet a activer
  13. C IPOIN Pointeur sur l'objet a activer
  14. C IKOD ENTIER valant 0 pour SEGDES
  15. C 1 pour SEGACT de l'objet
  16. C
  17. C SORTIE :
  18. C °°°°°°°°
  19. C R.A.S l'objet et son contenu sont actives
  20. C_____________________________________________________________________
  21. C
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMCHAML
  29. -INC SMINTE
  30. -INC SMCHPOI
  31. -INC SMLCHPO
  32. -INC SMMODEL
  33. -INC SMEVOLL
  34. -INC SMELEME
  35. -INC SMNUAGE
  36. -INC SMCHARG
  37. -INC CCPRECO
  38. C-INC CCASSIS
  39.  
  40. SEGMENT JPOINT(0)
  41. SEGMENT IPOINT(0)
  42. SEGMENT ISEG(0)
  43. SEGMENT ITAB(NNN)
  44.  
  45. PARAMETER(NBTYP=12)
  46. CHARACTER*(*)CTYPE
  47. CHARACTER*8 CTYP1,DTAOBJ(NBTYP),MOT8a
  48. CHARACTER*16 MOT16
  49.  
  50. LOGICAL BCODE,BSEG
  51.  
  52. DATA DTAOBJ/'MCHAML ','CHPOINT ','MMODEL ','MAILLAGE',
  53. & 'EVOLUTIO','LISTMOTS','LISTREEL','LISTENTI',
  54. & 'NUAGE ','LISTCHPO','CHARGEME','ANNULE ' /
  55.  
  56. CTYP1 = CTYPE
  57. IF(IERR .NE. 0) RETURN
  58.  
  59. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  60. IF(IPLAC.EQ.0 .OR. IPLAC.EQ.12)RETURN
  61. C Les arguments optionnels dans les PROCEDURES sont types ANNULE(12) s'ils sont absents
  62.  
  63. IF(IPOIN .LE. 0) THEN
  64. PRINT *,'ACTOBJ POINTEUR INVALIDE - TYPE ''',CTYP1,
  65. & ''' - POINTEUR ',IPOIN
  66. CALL ERREUR(5)
  67. ENDIF
  68.  
  69.  
  70. IPOI1 = IPOIN
  71. BCODE = IKOD .EQ. 0
  72.  
  73. C Portion a activer pour des recherches de SEGDES inutiles !
  74. IF(.FALSE.)THEN
  75. C Verification rapide de l'etat du SEGMENT IPOI1
  76. CALL OOOETA(IPOI1,IETA,IMOD)
  77. IF(BCODE)THEN
  78. C Il est inactif et on veut SEGDES ==> RETURN
  79. IF(IETA.EQ.2) RETURN
  80.  
  81. ELSE
  82. C Recherche de SEGMENT qui n'ont pas de raison d'etre desactives
  83. C -Empecher le MENAGE dans PILOT pour ce test d'optimisation
  84. C -Remettre l'include CCASSIS.INC
  85. C IF(IETA.EQ.2 .AND. IMOD.NE.1) THEN
  86. C CALL oooho1(IPOI1,IHO1)
  87. C IF(MOD(IHO1,NBTHRS+1) .EQ. oothrd)THEN
  88. C CALL OOOMES(IPOI1,' ZARBI:'//CTYP1)
  89. C STOP 16
  90. C ENDIF
  91. C ENDIF
  92.  
  93. C Il est actif *NOMOD et on veut SEGACT ==> RETURN
  94. IF(IETA.EQ.1 .AND. IMOD.EQ.0) RETURN
  95. ENDIF
  96. ENDIF
  97.  
  98. IOBJ = 0
  99. IPOINT= 0
  100. JPOINT= 0
  101. BSEG =.FALSE.
  102.  
  103. C Initialisation des SEGMENTS de preconditionnement
  104. nth=oothrd+1
  105. ITAB=PACTOB(nth)
  106. IF(ITAB .EQ. 0)THEN
  107. NNN=50
  108. SEGINI,ITAB
  109. PACTOB(nth)=ITAB
  110. ELSE
  111. SEGACT,ITAB*MOD
  112. ENDIF
  113.  
  114. ICOUNT =1
  115. C En premiere case on met la taille utile du tableau
  116. ITAB(1)=1
  117.  
  118. 1 CONTINUE
  119. IF(IPLAC.EQ.0) THEN
  120. C PRINT *,'ACTOBJ.ESO :',CTYP1,' NON TRAITE ENCORE'
  121. GOTO 9999
  122. ENDIF
  123.  
  124. GOTO (100,200,300,400,500,600,600,600,700,600,800),IPLAC
  125. GOTO 9999
  126.  
  127. 100 CONTINUE
  128. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  129. C OBJET DE TYPE MCHAML
  130. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  131. MCHEL1=IPOI1
  132. MELSAV=0
  133.  
  134. CALL oooprl(1)
  135. SEGACT,MCHEL1
  136. DO 111 II=1,MCHEL1.ICHAML(/1)
  137. MCHAM1=MCHEL1.ICHAML(II)
  138. SEGACT,MCHAM1
  139. 111 CONTINUE
  140. CALL oooprl(0)
  141.  
  142.  
  143. IF (BCODE) CALL PREACT(ITAB,MCHEL1)
  144. DO 110 II=1,MCHEL1.ICHAML(/1)
  145. MCHAM1=MCHEL1.ICHAML(II)
  146. IPT1=MCHEL1.IMACHE(II)
  147. CALL PREACT(ITAB,IPT1)
  148. IF(MCHEL1.INFCHE(/2) .GE. 4)THEN
  149. MINTE =MCHEL1.INFCHE(II,4)
  150. IF(MINTE .NE. 0) CALL PREACT(ITAB,MINTE)
  151. ENDIF
  152.  
  153. IF (BCODE) CALL PREACT(ITAB,MCHAM1)
  154. DO 120 JJ=1,MCHAM1.IELVAL(/1)
  155. MOT16 =MCHAM1.TYPCHE(JJ)
  156. MELVA1=MCHAM1.IELVAL(JJ)
  157.  
  158. IF(MELVA1 .EQ. MELSAV) GOTO 120
  159. MELSAV=MELVA1
  160.  
  161. IF (MOT16(1:6) .EQ. 'REAL*8' .OR.
  162. & MOT16(1:13) .EQ. 'POINTEURPOINT' )THEN
  163. CALL PREACT(ITAB,MELVA1)
  164.  
  165. ELSEIF(MOT16(1:12) .EQ. 'POINTEURLIST')THEN
  166. SEGACT,MELVA1
  167. IF (BCODE) CALL PREACT(ITAB,MELVA1)
  168. IPOI2 = 0
  169. DO 130 KK=1,MELVA1.IELCHE(/2)
  170. DO 140 LL=1,MELVA1.IELCHE(/1)
  171. ISEG=MELVA1.IELCHE(LL,KK)
  172. IF(ISEG .NE. IPOI2 .AND. ISEG.NE.0)THEN
  173. CALL PREACT(ITAB,ISEG)
  174. IPOI2 = ISEG
  175. ENDIF
  176. 140 CONTINUE
  177. 130 CONTINUE
  178.  
  179. ELSEIF(MOT16(1:16) .EQ. 'POINTEUREVOLUTIO')THEN
  180. SEGACT,MELVA1
  181. IF (BCODE) CALL PREACT(ITAB,MELVA1)
  182. IPOI2 = 0
  183. DO 150 KK=1,MELVA1.IELCHE(/2)
  184. DO 160 LL=1,MELVA1.IELCHE(/1)
  185. MEVOL1=MELVA1.IELCHE(LL,KK)
  186. IF(MEVOL1 .NE. IPOI2 .AND. MEVOL1.NE.0)THEN
  187. IPOI2 = MEVOL1
  188. SEGACT,MEVOL1
  189. IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  190. DO 170 MM=1,MEVOL1.IEVOLL(/1)
  191. KEVOL1=MEVOL1.IEVOLL(MM)
  192. SEGACT,KEVOL1
  193. IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  194. ISEG=KEVOL1.IPROGX
  195. CALL PREACT(ITAB,ISEG)
  196. ISEG=KEVOL1.IPROGY
  197. CALL PREACT(ITAB,ISEG)
  198. 170 CONTINUE
  199. ENDIF
  200. 160 CONTINUE
  201. 150 CONTINUE
  202.  
  203. ELSEIF(MOT16(1:8) .EQ. 'POINTEUR')THEN
  204. C Cas des MCHAML de POINTEURS necessitant du travail
  205. SEGACT,MELVA1
  206. IF (BCODE) CALL PREACT(ITAB,MELVA1)
  207. IPOI2 = 0
  208. CTYP1 = MOT16(9:16)
  209. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  210. IF(IPLAC .NE. 0)THEN
  211. DO 180 KK=1,MELVA1.IELCHE(/2)
  212. DO 190 LL=1,MELVA1.IELCHE(/1)
  213. ISEG =MELVA1.IELCHE(LL,KK)
  214. IF(ISEG.NE.IPOI2 .AND. ISEG.NE.0)THEN
  215. IPOI2 = ISEG
  216. IF(.NOT. BSEG)THEN
  217. SEGINI,JPOINT,IPOINT
  218. BSEG=.TRUE.
  219. ENDIF
  220. JPOINT(**)=MELVA1.IELCHE(LL,KK)
  221. IPOINT(**)=IPLAC
  222. ENDIF
  223. 190 CONTINUE
  224. 180 CONTINUE
  225. C ELSE
  226. C PRINT*,'ACTOBJ:MCHAML de TYPE',MOT16,' non traite'
  227. ENDIF
  228.  
  229. ELSE
  230. CALL PREACT(ITAB,MELVA1)
  231. ENDIF
  232. 120 CONTINUE
  233. 110 CONTINUE
  234. GOTO 9999
  235.  
  236. 200 CONTINUE
  237. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  238. C OBJET DE TYPE CHPOINT
  239. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  240. MCHPO1=IPOI1
  241. CALL oooprl(1)
  242. SEGACT,MCHPO1
  243. NSOUPO=MCHPO1.IPCHP(/1)
  244. DO 211 II=1,NSOUPO
  245. MSOUP1=MCHPO1.IPCHP(II)
  246. SEGACT,MSOUP1
  247. 211 CONTINUE
  248. CALL oooprl(0)
  249.  
  250. IF (BCODE) CALL PREACT(ITAB,MCHPO1)
  251. DO 210 II=1,NSOUPO
  252. MSOUP1=MCHPO1.IPCHP(II)
  253. IF (BCODE) CALL PREACT(ITAB,MSOUP1)
  254. IPT1=MSOUP1.IGEOC
  255. CALL PREACT(ITAB,IPT1)
  256. MPOVA1=MSOUP1.IPOVAL
  257. CALL PREACT(ITAB,MPOVA1)
  258. 210 CONTINUE
  259. GOTO 9999
  260.  
  261. 300 CONTINUE
  262. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  263. C OBJET DE TYPE MMODEL
  264. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  265. MMODE1=IPOI1
  266. SEGACT,MMODE1
  267. IF (BCODE) CALL PREACT(ITAB,MMODE1)
  268. DO 310 II=1,MMODE1.KMODEL(/1)
  269. IMODE1=MMODE1.KMODEL(II)
  270. SEGACT,IMODE1
  271. IF (BCODE) CALL PREACT(ITAB,IMODE1)
  272. IPT1=IMODE1.IMAMOD
  273. CALL PREACT(ITAB,IPT1)
  274.  
  275. DO 320 JJ=1,IMODE1.IVAMOD(/1)
  276. CTYP1=IMODE1.TYMODE(JJ)
  277. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  278. IF(IPLAC .NE. 0)THEN
  279. IF(.NOT. BSEG)THEN
  280. SEGINI,JPOINT,IPOINT
  281. BSEG=.TRUE.
  282. ENDIF
  283. JPOINT(**)=IMODE1.IVAMOD(JJ)
  284. IPOINT(**)=IPLAC
  285. ELSEIF(CTYP1 .EQ. 'IMODEL ')THEN
  286. C Cas des MODELES de melange
  287. ISEG=IMODE1.IVAMOD(JJ)
  288. CALL PREACT(ITAB,ISEG)
  289. ENDIF
  290. 320 CONTINUE
  291.  
  292. DO 330 JJ=1,IMODE1.LNOMID(/1)
  293. ISEG=IMODE1.LNOMID(JJ)
  294. IF(ISEG .NE. 0) CALL PREACT(ITAB,ISEG)
  295. 330 CONTINUE
  296. DO 340 JJ=3,IMODE1.INFMOD(/1)
  297. ISEG=IMODE1.INFMOD(JJ)
  298. IF(ISEG .GT. 0) CALL PREACT(ITAB,ISEG)
  299. 340 CONTINUE
  300. 310 CONTINUE
  301. GOTO 9999
  302.  
  303. 400 CONTINUE
  304. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  305. C OBJET DE TYPE MAILLAGE
  306. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  307. IPT1=IPOI1
  308. SEGACT,IPT1
  309. IF (BCODE) CALL PREACT(ITAB,IPT1)
  310. DO 410 II=1,IPT1.LISOUS(/1)
  311. IPT2 =IPT1.LISOUS(II)
  312. CALL PREACT(ITAB,IPT2)
  313. 410 CONTINUE
  314. GOTO 9999
  315.  
  316. 500 CONTINUE
  317. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  318. C OBJET DE TYPE EVOLUTIO
  319. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  320. MEVOL1=IPOI1
  321. SEGACT,MEVOL1
  322. IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  323. DO 510 II=1,MEVOL1.IEVOLL(/1)
  324. KEVOL1=MEVOL1.IEVOLL(II)
  325. SEGACT,KEVOL1
  326. IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  327. ISEG=KEVOL1.IPROGX
  328. CALL PREACT(ITAB,ISEG)
  329. ISEG=KEVOL1.IPROGY
  330. CALL PREACT(ITAB,ISEG)
  331. 510 CONTINUE
  332. GOTO 9999
  333.  
  334. 600 CONTINUE
  335. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  336. C OBJET DE TYPE LISTXXXX
  337. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  338. IF(IPLAC .EQ. 10)THEN
  339. C Cas des LISTCHPO
  340. MLCHPO=IPOI1
  341. SEGACT,MLCHPO
  342. IF (BCODE) CALL PREACT(ITAB,MLCHPO)
  343. CTYP1='CHPOINT '
  344. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  345. IF(.NOT. BSEG)THEN
  346. SEGINI,JPOINT,IPOINT
  347. BSEG=.TRUE.
  348. ENDIF
  349. DO 610 II=1,MLCHPO.ICHPOI(/1)
  350. JPOINT(**)=MLCHPO.ICHPOI(II)
  351. IPOINT(**)=IPLAC
  352. 610 CONTINUE
  353. ELSE
  354. C Cas des LISTENTI,LISTREEL,LISTMOTS
  355. CALL PREACT(ITAB,IPOI1)
  356. ENDIF
  357. GOTO 9999
  358.  
  359. 700 CONTINUE
  360. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  361. C OBJET DE TYPE NUAGE
  362. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  363. MNUAG1=IPOI1
  364. SEGACT,MNUAG1
  365. IF (BCODE) CALL PREACT(ITAB,MNUAG1)
  366. DO 710 II=1,MNUAG1.NUAPOI(/1)
  367. CTYP1=MNUAG1.NUATYP(II)
  368. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  369. IF(IPLAC .NE. 0)THEN
  370. IF(.NOT. BSEG)THEN
  371. SEGINI,JPOINT,IPOINT
  372. BSEG=.TRUE.
  373. ENDIF
  374. NUAVIN=MNUAG1.NUAPOI(II)
  375. SEGACT,NUAVIN
  376. IF (BCODE) CALL PREACT(ITAB,NUAVIN)
  377. DO 720 JJ=1,NUAVIN.NUAINT(/1)
  378. JPOINT(**)=NUAVIN.NUAINT(JJ)
  379. IPOINT(**)=IPLAC
  380. 720 CONTINUE
  381.  
  382. ELSE
  383. ISEG=MNUAG1.NUAPOI(II)
  384. CALL PREACT(ITAB,ISEG)
  385. ENDIF
  386. 710 CONTINUE
  387. GOTO 9999
  388.  
  389. 800 CONTINUE
  390. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  391. C OBJET DE TYPE CHARGEMENT
  392. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  393. MCHAR1=IPOI1
  394. SEGACT,MCHAR1
  395. IF (BCODE) CALL PREACT(ITAB,MCHAR1)
  396. DO 810 II=1,MCHAR1.KCHARG(/1)
  397. ICHAR1=MCHAR1.KCHARG(II)
  398. SEGACT,ICHAR1
  399. IF (BCODE) CALL PREACT(ITAB,ICHAR1)
  400.  
  401. CTYP1=ICHAR1.CHATYP
  402. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  403. IF(IPLAC .NE. 0)THEN
  404. IF(.NOT. BSEG)THEN
  405. SEGINI,JPOINT,IPOINT
  406. BSEG=.TRUE.
  407. ENDIF
  408. JPOINT(**)=ICHAR1.ICHPO1
  409. IPOINT(**)=IPLAC
  410. ENDIF
  411. 810 CONTINUE
  412. GOTO 9999
  413.  
  414. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  415. 9999 CONTINUE
  416.  
  417. IF(BCODE)THEN
  418. C Boucle a la main en attendant SEGDES par paquets !
  419. DO II=2,ICOUNT
  420. ISEG=ITAB(II)
  421. SEGDES,ISEG
  422. ENDDO
  423. ELSE
  424. C Appel a SEGACT par paquet !
  425. CALL FINACT(ITAB)
  426. ENDIF
  427.  
  428. IF(.NOT. BSEG) GOTO 9990
  429. IF(IOBJ .NE. JPOINT(/1))THEN
  430. IOBJ = IOBJ + 1
  431. IPLAC = IPOINT(IOBJ)
  432. IPOI1 = JPOINT(IOBJ)
  433. GOTO 1
  434. ENDIF
  435.  
  436. 9990 CONTINUE
  437.  
  438. IF (BSEG) SEGSUP,JPOINT,IPOINT
  439.  
  440. END
  441.  
  442.  
  443.  

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