Télécharger actobj.eso

Retour à la liste

Numérotation des lignes :

actobj
  1. C ACTOBJ SOURCE CB215821 23/10/26 21:15:03 11776
  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 SMRIGID
  38. -INC SMANNOT
  39. -INC CCPRECO
  40. C-INC CCASSIS
  41.  
  42. SEGMENT JPOINT(0)
  43. SEGMENT IPOINT(0)
  44. SEGMENT ISEG(0)
  45. SEGMENT ITAB(NNN)
  46.  
  47. PARAMETER(NBTYP=14)
  48. CHARACTER*(*)CTYPE
  49. CHARACTER*8 CTYP1,DTAOBJ(NBTYP),MOT8a
  50. CHARACTER*16 MOT16
  51.  
  52. LOGICAL BCODE,BSEG
  53.  
  54. DATA DTAOBJ/'MCHAML ','CHPOINT ','MMODEL ','MAILLAGE',
  55. & 'EVOLUTIO','LISTMOTS','LISTREEL','LISTENTI',
  56. & 'NUAGE ','LISTCHPO','CHARGEME','ANNULE ',
  57. & 'RIGIDITE','ANNOTATI' /
  58.  
  59.  
  60. MMODE2 = 0
  61.  
  62. CTYP1 = CTYPE
  63. IF(IERR .NE. 0) RETURN
  64.  
  65. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  66. IF(IPLAC.EQ.0 .OR. IPLAC.EQ.12)RETURN
  67. C Les arguments optionnels dans les PROCEDURES sont de type ANNULE(12) s'ils sont absents
  68.  
  69. IF(IPOIN .LE. 0) THEN
  70. PRINT *,'ACTOBJ POINTEUR INVALIDE - TYPE ''',CTYP1,
  71. & ''' - POINTEUR ',IPOIN
  72. C J'essaye de declencher un GEMAT_ERROR pour la capturer avec gdb
  73. CALL TRBAC
  74. ISEG=IPOIN
  75. SEGACT,ISEG
  76. CALL ERREUR(5)
  77. ENDIF
  78.  
  79.  
  80. IPOI1 = IPOIN
  81. BCODE = IKOD .EQ. 0
  82.  
  83. C Portion a activer pour des recherches de SEGDES inutiles !
  84. IF(.FALSE.)THEN
  85. C Verification rapide de l'etat du SEGMENT IPOI1
  86. CALL OOOETA(IPOI1,IETA,IMOD)
  87. IF(BCODE)THEN
  88. C Il est inactif et on veut SEGDES ==> RETURN
  89. IF(IETA.EQ.2) RETURN
  90.  
  91. ELSE
  92. C Recherche de SEGMENT qui n'ont pas de raison d'etre desactives
  93. C -Empecher le MENAGE dans PILOT pour ce test d'optimisation
  94. C -Remettre l'include CCASSIS.INC
  95. C IF(IETA.EQ.2 .AND. IMOD.NE.1) THEN
  96. C CALL oooho1(IPOI1,IHO1)
  97. C IF(MOD(IHO1,NBTHRS+1) .EQ. oothrd)THEN
  98. C CALL OOOMES(IPOI1,' ZARBI:'//CTYP1)
  99. C STOP 16
  100. C ENDIF
  101. C ENDIF
  102.  
  103. C Il est actif *NOMOD et on veut SEGACT ==> RETURN
  104. IF(IETA.EQ.1 .AND. IMOD.EQ.0) RETURN
  105. ENDIF
  106. ENDIF
  107.  
  108. IOBJ = 0
  109. IPOINT= 0
  110. JPOINT= 0
  111. BSEG =.FALSE.
  112.  
  113. C Initialisation des SEGMENTS de preconditionnement
  114. nth=oothrd+1
  115. ITAB=PACTOB(nth)
  116. IF(ITAB .EQ. 0)THEN
  117. NNN=50
  118. SEGINI,ITAB
  119. PACTOB(nth)=ITAB
  120. ELSE
  121. SEGACT,ITAB*MOD
  122. ENDIF
  123.  
  124. ICOUNT =1
  125. C En premiere case on met la taille utile du tableau
  126. ITAB(1)=1
  127.  
  128. 1 CONTINUE
  129. IF(IPLAC.EQ.0) THEN
  130. C PRINT *,'ACTOBJ.ESO :',CTYP1,' NON TRAITE ENCORE'
  131. GOTO 9999
  132. ENDIF
  133.  
  134. GOTO (100,200,300,400,500,600,600,600,700,600,800,9999,900
  135. & ,1000),IPLAC
  136. PRINT *,'ACTOBJ ERROR:',IPLAC
  137. CALL ERREUR(5)
  138. GOTO 9999
  139.  
  140. 100 CONTINUE
  141. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  142. C OBJET DE TYPE MCHAML
  143. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  144. MCHEL1=IPOI1
  145. MELSAV=0
  146.  
  147. CALL oooprl(1)
  148. SEGACT,MCHEL1
  149. DO 111 II=1,MCHEL1.ICHAML(/1)
  150. MCHAM1=MCHEL1.ICHAML(II)
  151. SEGACT,MCHAM1
  152. 111 CONTINUE
  153. CALL oooprl(0)
  154.  
  155. IF (BCODE) CALL PREACT(ITAB,MCHEL1)
  156. DO 110 II=1,MCHEL1.ICHAML(/1)
  157. MCHAM1=MCHEL1.ICHAML(II)
  158. IPT1=MCHEL1.IMACHE(II)
  159. CALL PREACT(ITAB,IPT1)
  160. IF(MCHEL1.INFCHE(/2) .GE. 4)THEN
  161. MINTE =MCHEL1.INFCHE(II,4)
  162. IF(MINTE .NE. 0) CALL PREACT(ITAB,MINTE)
  163. ENDIF
  164.  
  165. IF (BCODE) CALL PREACT(ITAB,MCHAM1)
  166. DO 120 JJ=1,MCHAM1.IELVAL(/1)
  167. MOT16 =MCHAM1.TYPCHE(JJ)
  168. MELVA1=MCHAM1.IELVAL(JJ)
  169.  
  170. IF(MELVA1 .EQ. MELSAV) GOTO 120
  171. MELSAV=MELVA1
  172.  
  173. IF (MOT16(1:6) .EQ. 'REAL*8' .OR.
  174. & MOT16(1:13) .EQ. 'POINTEURPOINT' )THEN
  175. CALL PREACT(ITAB,MELVA1)
  176.  
  177. ELSEIF(MOT16(1:12) .EQ. 'POINTEURLIST')THEN
  178. SEGACT,MELVA1
  179. IF (BCODE) CALL PREACT(ITAB,MELVA1)
  180. IPOI2 = 0
  181. DO 130 KK=1,MELVA1.IELCHE(/2)
  182. DO 140 LL=1,MELVA1.IELCHE(/1)
  183. ISEG=MELVA1.IELCHE(LL,KK)
  184. IF(ISEG .NE. IPOI2 .AND. ISEG.NE.0)THEN
  185. CALL PREACT(ITAB,ISEG)
  186. IPOI2 = ISEG
  187. ENDIF
  188. 140 CONTINUE
  189. 130 CONTINUE
  190.  
  191. ELSEIF(MOT16(1:16) .EQ. 'POINTEUREVOLUTIO')THEN
  192. SEGACT,MELVA1
  193. IF (BCODE) CALL PREACT(ITAB,MELVA1)
  194. IPOI2 = 0
  195. DO 150 KK=1,MELVA1.IELCHE(/2)
  196. DO 160 LL=1,MELVA1.IELCHE(/1)
  197. MEVOL1=MELVA1.IELCHE(LL,KK)
  198. IF(MEVOL1 .NE. IPOI2 .AND. MEVOL1.NE.0)THEN
  199. IPOI2 = MEVOL1
  200. SEGACT,MEVOL1
  201. IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  202. DO 170 MM=1,MEVOL1.IEVOLL(/1)
  203. KEVOL1=MEVOL1.IEVOLL(MM)
  204. SEGACT,KEVOL1
  205. IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  206. ISEG=KEVOL1.IPROGX
  207. CALL PREACT(ITAB,ISEG)
  208. ISEG=KEVOL1.IPROGY
  209. CALL PREACT(ITAB,ISEG)
  210. 170 CONTINUE
  211. ENDIF
  212. 160 CONTINUE
  213. 150 CONTINUE
  214.  
  215. ELSEIF(MOT16(1:8) .EQ. 'POINTEUR')THEN
  216. C Cas des MCHAML de POINTEURS necessitant du travail
  217. SEGACT,MELVA1
  218. IF (BCODE) CALL PREACT(ITAB,MELVA1)
  219. IPOI2 = 0
  220. CTYP1 = MOT16(9:16)
  221. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  222. IF(IPLAC .NE. 0)THEN
  223. DO 180 KK=1,MELVA1.IELCHE(/2)
  224. DO 190 LL=1,MELVA1.IELCHE(/1)
  225. ISEG =MELVA1.IELCHE(LL,KK)
  226. IF(ISEG.NE.IPOI2 .AND. ISEG.NE.0)THEN
  227. IPOI2 = ISEG
  228. IF(.NOT. BSEG)THEN
  229. SEGINI,JPOINT,IPOINT
  230. BSEG=.TRUE.
  231. ENDIF
  232. JPOINT(**)=MELVA1.IELCHE(LL,KK)
  233. IPOINT(**)=IPLAC
  234. ENDIF
  235. 190 CONTINUE
  236. 180 CONTINUE
  237. C ELSE
  238. C PRINT*,'ACTOBJ:MCHAML de TYPE',MOT16,' non traite'
  239. ENDIF
  240.  
  241. ELSE
  242. CALL PREACT(ITAB,MELVA1)
  243. ENDIF
  244. 120 CONTINUE
  245. 110 CONTINUE
  246. GOTO 9999
  247.  
  248. 200 CONTINUE
  249. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  250. C OBJET DE TYPE CHPOINT
  251. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  252. MCHPO1=IPOI1
  253. CALL oooprl(1)
  254. SEGACT,MCHPO1
  255. NSOUPO=MCHPO1.IPCHP(/1)
  256. DO 211 II=1,NSOUPO
  257. MSOUP1=MCHPO1.IPCHP(II)
  258. SEGACT,MSOUP1
  259. 211 CONTINUE
  260. CALL oooprl(0)
  261.  
  262. IF (BCODE) CALL PREACT(ITAB,MCHPO1)
  263. DO 210 II=1,NSOUPO
  264. MSOUP1=MCHPO1.IPCHP(II)
  265. IF (BCODE) CALL PREACT(ITAB,MSOUP1)
  266. IPT1=MSOUP1.IGEOC
  267. CALL PREACT(ITAB,IPT1)
  268. MPOVA1=MSOUP1.IPOVAL
  269. CALL PREACT(ITAB,MPOVA1)
  270. 210 CONTINUE
  271. GOTO 9999
  272.  
  273. 300 CONTINUE
  274. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  275. C OBJET DE TYPE MMODEL
  276. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  277. MMODE1=IPOI1
  278. SEGACT,MMODE1
  279. IF (BCODE) CALL PREACT(ITAB,MMODE1)
  280.  
  281. NN1 = 0
  282. DO 310 II=1,MMODE1.KMODEL(/1)
  283. IMODE1=MMODE1.KMODEL(II)
  284. SEGACT,IMODE1
  285. IF (BCODE) CALL PREACT(ITAB,IMODE1)
  286. IPT1=IMODE1.IMAMOD
  287. CALL PREACT(ITAB,IPT1)
  288.  
  289. NIVM = IMODE1.IVAMOD(/1)
  290. DO 320 JJ=1,NIVM
  291. CTYP1=IMODE1.TYMODE(JJ)
  292. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  293. IF(IPLAC .NE. 0)THEN
  294. IF(.NOT. BSEG)THEN
  295. SEGINI,JPOINT,IPOINT
  296. BSEG=.TRUE.
  297. ENDIF
  298. JPOINT(**)=IMODE1.IVAMOD(JJ)
  299. IPOINT(**)=IPLAC
  300. ELSEIF(CTYP1 .EQ. 'IMODEL ')THEN
  301. C Construction d'un MODELE AVEC les IMODEL (Cas des MODELES de melange)
  302. NN1 = NN1 + 1
  303. IF(MMODE2 .EQ. 0)THEN
  304. N1 = NIVM
  305. SEGINI,MMODE2
  306. ELSEIF(NN1 .GT. MMODE2.KMODEL(/1))THEN
  307. N1 = N1 + NIVM
  308. SEGADJ,MMODE2
  309. ENDIF
  310. MMODE2.KMODEL(NN1)=IMODE1.IVAMOD(JJ)
  311. ENDIF
  312. 320 CONTINUE
  313.  
  314. NBNOMI =IMODE1.LNOMID(/1)
  315. DO 330 INOM=1,NBNOMI
  316. IPT1=IMODE1.LNOMID(INOM)
  317. IF (IPT1 .GT. 0) CALL PREACT(ITAB,IPT1)
  318. 330 CONTINUE
  319.  
  320. DO 340 IINFMO=3,IMODE1.INFMOD(/1)
  321. IPT1=IMODE1.INFMOD(IINFMO)
  322. IF (IPT1 .GT. 0) CALL PREACT(ITAB,IPT1)
  323. 340 CONTINUE
  324.  
  325. 310 CONTINUE
  326.  
  327. IF (NN1 .GT. 0) THEN
  328. C On a cree un MMODEL supplementaire
  329. IF(N1 .NE. NN1)THEN
  330. N1 = NN1
  331. SEGADJ,MMODE2
  332. ENDIF
  333.  
  334. C On ajoute MMODE2 dans la liste des pointeurs 'MMODEL ' a traiter
  335. CTYP1 ='MMODEL '
  336. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  337. IF(.NOT. BSEG)THEN
  338. SEGINI,JPOINT,IPOINT
  339. BSEG=.TRUE.
  340. ENDIF
  341. JPOINT(**)=MMODE2
  342. IPOINT(**)=IPLAC
  343. ENDIF
  344. GOTO 9999
  345.  
  346. 400 CONTINUE
  347. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  348. C OBJET DE TYPE MAILLAGE
  349. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  350. IPT1=IPOI1
  351. SEGACT,IPT1
  352. IF (BCODE) CALL PREACT(ITAB,IPT1)
  353. DO 410 II=1,IPT1.LISOUS(/1)
  354. IPT2 =IPT1.LISOUS(II)
  355. CALL PREACT(ITAB,IPT2)
  356. 410 CONTINUE
  357. GOTO 9999
  358.  
  359. 500 CONTINUE
  360. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  361. C OBJET DE TYPE EVOLUTIO
  362. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  363. MEVOL1=IPOI1
  364. SEGACT,MEVOL1
  365. IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  366. DO 510 II=1,MEVOL1.IEVOLL(/1)
  367. KEVOL1=MEVOL1.IEVOLL(II)
  368. SEGACT,KEVOL1
  369. IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  370. ISEG=KEVOL1.IPROGX
  371. CALL PREACT(ITAB,ISEG)
  372. ISEG=KEVOL1.IPROGY
  373. CALL PREACT(ITAB,ISEG)
  374. 510 CONTINUE
  375. GOTO 9999
  376.  
  377. 600 CONTINUE
  378. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  379. C OBJET DE TYPE LISTXXXX
  380. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  381. IF(IPLAC .EQ. 10)THEN
  382. C Cas des LISTCHPO
  383. MLCHPO=IPOI1
  384. SEGACT,MLCHPO
  385. IF (BCODE) CALL PREACT(ITAB,MLCHPO)
  386. CTYP1='CHPOINT '
  387. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  388. IF(.NOT. BSEG)THEN
  389. SEGINI,JPOINT,IPOINT
  390. BSEG=.TRUE.
  391. ENDIF
  392. DO 610 II=1,MLCHPO.ICHPOI(/1)
  393. JPOINT(**)=MLCHPO.ICHPOI(II)
  394. IPOINT(**)=IPLAC
  395. 610 CONTINUE
  396. ELSE
  397. C Cas des LISTENTI,LISTREEL,LISTMOTS
  398. CALL PREACT(ITAB,IPOI1)
  399. ENDIF
  400. GOTO 9999
  401.  
  402. 700 CONTINUE
  403. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  404. C OBJET DE TYPE NUAGE
  405. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  406. MNUAG1=IPOI1
  407. SEGACT,MNUAG1
  408. IF (BCODE) CALL PREACT(ITAB,MNUAG1)
  409. DO 710 II=1,MNUAG1.NUAPOI(/1)
  410. CTYP1=MNUAG1.NUATYP(II)
  411. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  412. IF(IPLAC .NE. 0)THEN
  413. IF(.NOT. BSEG)THEN
  414. SEGINI,JPOINT,IPOINT
  415. BSEG=.TRUE.
  416. ENDIF
  417. NUAVIN=MNUAG1.NUAPOI(II)
  418. SEGACT,NUAVIN
  419. IF (BCODE) CALL PREACT(ITAB,NUAVIN)
  420. DO 720 JJ=1,NUAVIN.NUAINT(/1)
  421. JPOINT(**)=NUAVIN.NUAINT(JJ)
  422. IPOINT(**)=IPLAC
  423. 720 CONTINUE
  424.  
  425. ELSE
  426. ISEG=MNUAG1.NUAPOI(II)
  427. CALL PREACT(ITAB,ISEG)
  428. ENDIF
  429. 710 CONTINUE
  430. GOTO 9999
  431.  
  432. 800 CONTINUE
  433. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  434. C OBJET DE TYPE CHARGEMENT
  435. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  436. MCHAR1=IPOI1
  437. SEGACT,MCHAR1
  438. IF (BCODE) CALL PREACT(ITAB,MCHAR1)
  439. DO 810 II=1,MCHAR1.KCHARG(/1)
  440. ICHAR1=MCHAR1.KCHARG(II)
  441. SEGACT,ICHAR1
  442. IF (BCODE) CALL PREACT(ITAB,ICHAR1)
  443.  
  444. CTYP1=ICHAR1.CHATYP
  445. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  446. IF(IPLAC .NE. 0)THEN
  447. IF(.NOT. BSEG)THEN
  448. SEGINI,JPOINT,IPOINT
  449. BSEG=.TRUE.
  450. ENDIF
  451. JPOINT(**)=ICHAR1.ICHPO1
  452. IPOINT(**)=IPLAC
  453. ENDIF
  454. 810 CONTINUE
  455. GOTO 9999
  456.  
  457. 900 CONTINUE
  458. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  459. C OBJET DE TYPE RIGIDITE
  460. C Ne traite que la partie non assemblee des objets RIGIDITE
  461. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  462. MRIGID=IPOI1
  463. SEGACT,MRIGID
  464. IF (BCODE) CALL PREACT(ITAB,MRIGID)
  465.  
  466. IMGEOD=MRIGID.IMGEO1
  467. C PRINT *,' -- IMGEOD:',IMGEOD
  468. IF (IMGEOD.NE.0)CALL PREACT(ITAB,IMGEOD)
  469.  
  470. MVECRI=MRIGID.IVECRI
  471. C PRINT *,' -- MVECRI:',MVECRI
  472. IF (MVECRI.NE.0)CALL PREACT(ITAB,MVECRI)
  473.  
  474. DO 910 II=1,MRIGID.COERIG(/1)
  475. IPT1 = MRIGID.IRIGEL(1,II)
  476. C PRINT *,' -- IPT1 :',IPT1
  477. CALL PREACT(ITAB,IPT1)
  478.  
  479. IPT2 = MRIGID.IRIGEL(2,II)
  480. C PRINT *,' -- IPT2 :',IPT2
  481. IF(IPT2 .GT. 0)CALL PREACT(ITAB,IPT2)
  482.  
  483. DESCR = MRIGID.IRIGEL(3,II)
  484. C PRINT *,' -- DESCR :',DESCR
  485. CALL PREACT(ITAB,DESCR)
  486.  
  487. XMATRI = MRIGID.IRIGEL(4,II)
  488. C PRINT *,' -- XMATRI:',XMATRI
  489. CALL PREACT(ITAB,XMATRI)
  490. 910 CONTINUE
  491. GOTO 9999
  492.  
  493.  
  494. 1000 CONTINUE
  495. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  496. C OBJET DE TYPE ANNOTATI
  497. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  498. MANNOT=IPOI1
  499. SEGACT,MANNOT
  500. IF (BCODE) CALL PREACT(ITAB,MANNOT)
  501.  
  502. DO 1010 II=1,MANNOT.ICLAS(/1)
  503. IF(MANNOT.ICLAS(II) .EQ. 2)THEN
  504. METIQU = MANNOT.ISEGT(II)
  505. SEGACT,METIQU
  506. IF (BCODE) CALL PREACT(ITAB,METIQU)
  507. MELEME = METIQU.INUPT
  508. CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,'MAILLAGE')
  509. IF(IPLAC .NE. 0)THEN
  510. IF(.NOT. BSEG)THEN
  511. SEGINI,JPOINT,IPOINT
  512. BSEG=.TRUE.
  513. ENDIF
  514. JPOINT(**)=MELEME
  515. IPOINT(**)=IPLAC
  516. ENDIF
  517. ENDIF
  518. 1010 CONTINUE
  519. GOTO 9999
  520.  
  521. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  522. 9999 CONTINUE
  523.  
  524. IF(BCODE)THEN
  525. C Boucle a la main en attendant SEGDES par paquets !
  526. DO II=2,ICOUNT
  527. ISEG=ITAB(II)
  528. SEGDES,ISEG
  529. ENDDO
  530. ELSE
  531. C Appel a SEGACT par paquet !
  532. CALL FINACT(ITAB)
  533. ENDIF
  534.  
  535. IF(.NOT. BSEG) GOTO 9990
  536. IF(IOBJ .NE. JPOINT(/1))THEN
  537. IOBJ = IOBJ + 1
  538. IPLAC = IPOINT(IOBJ)
  539. IPOI1 = JPOINT(IOBJ)
  540. GOTO 1
  541. ENDIF
  542.  
  543. 9990 CONTINUE
  544.  
  545. IF (BSEG) SEGSUP,JPOINT,IPOINT
  546. IF (MMODE2 .NE. 0) SEGSUP,MMODE2
  547.  
  548. END
  549.  
  550.  
  551.  

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