Télécharger actobj.eso

Retour à la liste

Numérotation des lignes :

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

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