Télécharger menag6.eso

Retour à la liste

Numérotation des lignes :

  1. C MENAG6 SOURCE PV 16/11/26 21:16:11 9205
  2. SUBROUTINE MENAG6(ILISSE,IPLIS,IPOLAC)
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7. C=======================================================================
  8. C TABLEAU KCOLA: VOIR SIGNIFICATION DANS SOUS-PROGRAMME TYPFIL
  9. C=======================================================================
  10.  
  11. CHARACTER*8 MODYN
  12.  
  13. SEGMENT ISLIS(NP)
  14. SEGMENT IBLIS(ISLIS(/1))
  15. * SEGMENT BIDON POUR REMPLACER LES TROP NOMBREUSES
  16. * DECLARATION
  17. SEGMENT ISEG(0)
  18. *
  19. POINTEUR PTR.MATRAK
  20. -INC TMCOLAC
  21. -INC CCOPTIO
  22. -INC CCNOYAU
  23. -INC SMTEXTE
  24. -INC SMMODEL
  25. *-INC SMLREEL
  26. *-INC SMLENTI
  27. -INC SMCHARG
  28. -INC SMEVOLL
  29. *-INC SMLMOTS
  30. * -INC SMVECTE TROP DE DECLARATION INTEGER AVEC ESOPE
  31. * -INC SMVECTD DECLARATION CONFLICTUELLE AVEC SMVECTE
  32. *-INC SMLCHPO
  33. -INC SMBASEM
  34. -INC SMBLOC
  35. -INC SMNUAGE
  36. -INC SMSUPER
  37. C-INC SMMATRAK
  38. -INC CCASSIS
  39. C*************************************************************************
  40. C
  41. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  42. C
  43.  
  44. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  45. * (points CENTRE ) pour chaque operateur de contrainte
  46. * KGEOC SPG pour la totalite des points CENTRE.
  47. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  48. * KLEMC Connectivites de l'ensemble des contraintes
  49. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  50.  
  51. SEGMENT MATRAK
  52. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  53. INTEGER LIZAFM(NBSOUS)
  54. INTEGER IKAM0 (NBSOUS)
  55. INTEGER IMEM (NBELC)
  56. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  57. ENDSEGMENT
  58.  
  59. SEGMENT IZAFM
  60. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  61. ENDSEGMENT
  62.  
  63. POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  64.  
  65. C*******************************************************************
  66. MODYN='DYNAMIQU'
  67. ISLIS = IPLIS
  68. *
  69. ICOLAC = IPOLAC
  70. *
  71. * CAS DES MLREEL
  72. *
  73. ITLACC=KCOLA(18)
  74. IF (ITLAC(/1).EQ.0) GOTO 190
  75. DO 181 I=1,ITLAC(/1)
  76. * MLREEL=ITLAC(I)
  77. * ISLIS((MLREEL-1)/npgcd)=1
  78. * SEGDES MLREEL
  79. ISEG=ITLAC(I)
  80. ISLIS((ISEG-1)/npgcd)=1
  81. SEGDES ISEG
  82. 181 CONTINUE
  83. 190 CONTINUE
  84. *
  85. * CAS DES MLENTI
  86. *
  87. ITLACC=KCOLA(19)
  88. IF (ITLAC(/1).EQ.0) GOTO 200
  89. DO 191 I=1,ITLAC(/1)
  90. * MLENTI=ITLAC(I)
  91. * ISLIS((**-1)/npgcd)=MLENTI
  92. * SEGDES MLENTI
  93. ISEG=ITLAC(I)
  94. ISLIS((ISEG-1)/npgcd)=1
  95. SEGDES ISEG
  96. 191 CONTINUE
  97. 200 CONTINUE
  98. *
  99. * CAS DES MCHARG
  100. *
  101. ITLACC=KCOLA(20)
  102. IF (ITLAC(/1).EQ.0) GOTO 210
  103. DO 201 I=1,ITLAC(/1)
  104. MCHARG=ITLAC(I)
  105. SEGACT MCHARG
  106. ISLIS((MCHARG-1)/npgcd)=1
  107. DO 202 J=1,KCHARG(/1)
  108. ICHARG=KCHARG(J)
  109. ISLIS((ICHARG-1)/npgcd)=1
  110. SEGACT ICHARG
  111. ISEG=ICHPO1
  112. ISLIS((ISEG-1)/npgcd)=1
  113. SEGDES ISEG
  114. ISEG=ICHPO2
  115. ISLIS((ISEG-1)/npgcd)=1
  116. SEGDES ISEG
  117. IF(CHATYP.NE.'TABLE ') THEN
  118. ISEG=ICHPO3
  119. ISLIS((ISEG-1)/npgcd)=1
  120. SEGDES ISEG
  121. ENDIF
  122. IF(CHAMOB(J).EQ.'TRAN') THEN
  123. ISEG=ICHPO6
  124. ISLIS((ISEG-1)/npgcd)=1
  125. SEGDES ISEG
  126. ISEG=ICHPO7
  127. ISLIS((ISEG-1)/npgcd)=1
  128. SEGDES ISEG
  129. ELSEIF(CHAMOB(J).EQ.'ROTA') THEN
  130. ISEG=ICHPO6
  131. ISLIS((ISEG-1)/npgcd)=1
  132. SEGDES ISEG
  133. ISEG=ICHPO7
  134. ISLIS((ISEG-1)/npgcd)=1
  135. SEGDES ISEG
  136. ELSEIF(CHAMOB(J).EQ.'TRAJ') THEN
  137. ISEG=ICHPO4
  138. ISLIS((ISEG-1)/npgcd)=1
  139. SEGDES ISEG
  140. ISEG=ICHPO6
  141. ISLIS((ISEG-1)/npgcd)=1
  142. SEGDES ISEG
  143. ENDIF
  144. SEGDES ICHARG
  145. 202 CONTINUE
  146. SEGDES MCHARG
  147. 201 CONTINUE
  148. 210 CONTINUE
  149. *
  150. * CAS DES MEVOLL
  151. *
  152. ITLACC=KCOLA(22)
  153. IF (ITLAC(/1).EQ.0) GOTO 230
  154. DO 221 I=1,ITLAC(/1)
  155. MEVOLL=ITLAC(I)
  156. SEGACT MEVOLL
  157. ISLIS((MEVOLL-1)/npgcd)=1
  158. DO 222 J=1,IEVOLL(/1)
  159. KEVOLL=IEVOLL(J)
  160. ISLIS((KEVOLL-1)/npgcd)=1
  161. SEGACT KEVOLL
  162. ISEG=IPROGX
  163. ISLIS((ISEG-1)/npgcd)=1
  164. SEGDES ISEG
  165. ISEG=IPROGY
  166. ISLIS((ISEG-1)/npgcd)=1
  167. SEGDES ISEG
  168. SEGDES KEVOLL
  169. 222 CONTINUE
  170. SEGDES MEVOLL
  171. 221 CONTINUE
  172. 230 CONTINUE
  173. *
  174. * CAS DES SUPERELEMENTS
  175. *
  176. ITLACC=KCOLA(23)
  177. IF (ITLAC(/1).EQ.0) GOTO 240
  178. DO 231 I=1,ITLAC(/1)
  179. MSUPER=ITLAC(I)
  180. segact msuper
  181. iseg=mdnorr
  182. if( iseg. ne. 0) then
  183. ISLIS((iseg-1)/npgcd)=1
  184. segdes iseg
  185. endif
  186. ISEG=ITLAC(I)
  187. ISLIS((ISEG-1)/npgcd)=1
  188. SEGDES ISEG
  189. 231 CONTINUE
  190. 240 CONTINUE
  191. *
  192. * CAS DES LOGIQUES FLOTTANT ENTIER MOT RIEN A FAIRE
  193. *
  194. *
  195. * CAS DES TEXTES
  196. *
  197. ITLACC=KCOLA(28)
  198. IF (ITLAC(/1).EQ.0) GOTO 290
  199. DO 281 I=1,ITLAC(/1)
  200. MTEXTE=ITLAC(I)
  201. ISLIS((MTEXTE-1)/npgcd)=1
  202. SEGACT MTEXTE
  203. MTRADU=MTRADC
  204. IF (MTRADU.NE.0) THEN
  205. ISLIS((MTRADU-1)/npgcd)=1
  206. SEGDES MTRADU
  207. ENDIF
  208. SEGDES MTEXTE
  209. 281 CONTINUE
  210. 290 CONTINUE
  211. *
  212. * CAS DES LISTMOTS
  213. *
  214. ITLACC=KCOLA(29)
  215. IF (ITLAC(/1).EQ.0) GOTO 300
  216. DO 291 I=1,ITLAC(/1)
  217. * MLMOTS=ITLAC(I)
  218. * ISLIS((MLMOTS-1)/npgcd)=1
  219. * SEGDES MLMOTS
  220. ISEG=ITLAC(I)
  221. ISLIS((ISEG-1)/npgcd)=1
  222. SEGDES ISEG
  223. 291 CONTINUE
  224. 300 CONTINUE
  225. *
  226. * CAS DES VECTEURS
  227. *
  228. ITLACC=KCOLA(30)
  229. IF (ITLAC(/1).EQ.0) GOTO 310
  230. DO 301 I=1,ITLAC(/1)
  231. * MVECTE=ITLAC(I)
  232. * ISLIS((MVECTE-1)/npgcd)=1
  233. * SEGDES MVECTE
  234. ISEG=ITLAC(I)
  235. ISLIS((ISEG-1)/npgcd)=1
  236. SEGDES ISEG
  237. 301 CONTINUE
  238. 310 CONTINUE
  239. *
  240. * CAS DES VECTD ON ECRIT ISEG CAR ON NE PEUT PAS FAIRE -INC MVECTD
  241. *
  242. ITLACC=KCOLA(31)
  243. IF (ITLAC(/1).EQ.0) GOTO 320
  244. DO 311 I=1,ITLAC(/1)
  245. * MVECTD=ITLAC(I)
  246. * ISLIS((MVECTD-1)/npgcd)=1
  247. * SEGDES MVECTD
  248. ISEG=ITLAC(I)
  249. ISLIS((ISEG-1)/npgcd)=1
  250. SEGDES ISEG
  251. 311 CONTINUE
  252. 320 CONTINUE
  253. *
  254. * CAS DES POINTS RIEN A FAIRE
  255. *
  256. *
  257. * CAS DES CONFIG NE SURTOUT PAS UTILISER MCOORD (DANS CCOPTIO)
  258. *
  259. ITLACC=KCOLA(33)
  260. IF (ITLAC(/1).EQ.0) GOTO 340
  261. DO 331 I=1,ITLAC(/1)
  262. ISEG=ITLAC(I)
  263. ISLIS((ISEG-1)/npgcd)=1
  264. SEGDES ISEG
  265. 331 CONTINUE
  266. 340 CONTINUE
  267. *
  268. * CAS DES MLCHPO
  269. *
  270. ITLACC=KCOLA(34)
  271. IF (ITLAC(/1).EQ.0) GOTO 350
  272. DO 341 I=1,ITLAC(/1)
  273. * MLCHPO=ITLAC(I)
  274. * ISLIS((MLCHPO-1)/npgcd)=1
  275. * SEGDES MLCHPO
  276. ISEG=ITLAC(I)
  277. ISLIS((ISEG-1)/npgcd)=1
  278. SEGDES ISEG
  279. 341 CONTINUE
  280. 350 CONTINUE
  281. *
  282. * CAS DES MBASEM
  283. *
  284. ITLACC=KCOLA(35)
  285. IF (ITLAC(/1).EQ.0) GOTO 360
  286. DO 351 I=1,ITLAC(/1)
  287. MBASEM=ITLAC(I)
  288. ISLIS((MBASEM-1)/npgcd)=1
  289. SEGACT MBASEM
  290. DO 352 J=1,LISBAS(/1)
  291. MSOBAS=LISBAS(J)
  292. ISLIS((MSOBAS-1)/npgcd)=1
  293. SEGDES MSOBAS
  294. 352 CONTINUE
  295. SEGDES MBASEM
  296. 351 CONTINUE
  297. 360 CONTINUE
  298. *
  299. * CAS DES PROCEDUR
  300. *
  301. MTTRY=MTXBL
  302. ITLACC=KCOLA(36)
  303. ITLAC1=KCOLA(37)
  304. IF (ITLAC(/1).EQ.0) GOTO 370
  305. DO 361 I=1,ITLAC(/1)
  306. MBLA1=ITLAC(I)
  307. MBLO1=IPIPR1(MBLA1)
  308. * LES PROCEDURES EN NEGATIFS NE SONT PAS ENCORE MISES EN SEGMENT
  309. IF (MBLO1.LE.0) GOTO 361
  310. ISLIS((MBLO1-1)/npgcd)=1
  311. SEGACT MBLO1
  312. ISLIS((MBLO1.ISPOTE-1)/npgcd)=1
  313. IARGUM=MBLO1.MARGUM
  314. ISLIS((IARGUM-1)/npgcd)=1
  315. SEGACT IARGUM
  316. MTXBI3=MTXBB
  317. ISLIS((MTXBI3-1)/npgcd)=1
  318. SEGDES MTXBI3
  319. MTXFL3=MTXFLO
  320. IF( MTXFL3.NE.0) THEN
  321. SEGDES MTXFL3
  322. ISLIS((MTXFL3-1)/npgcd)=1
  323. ENDIF
  324. MTRESU=ITRESU
  325. IF( MTRESU.NE.0) THEN
  326. SEGDES MTRESU
  327. ISLIS((MTRESU-1)/npgcd)=1
  328. ENDIF
  329. MVRESU=IVRESU
  330. IF( MVRESU.NE.0) THEN
  331. SEGDES MVRESU
  332. ISLIS((MVRESU-1)/npgcd)=1
  333. ENDIF
  334. MFRESU=IFRESU
  335. IF( MFRESU.NE.0) THEN
  336. SEGDES MFRESU
  337. ISLIS((MFRESU-1)/npgcd)=1
  338. ENDIF
  339. SEGDES IARGUM
  340. MTXBLC=MBLO1.MTXBL
  341. IF (MTXBLC.NE.0) THEN
  342. ISLIS((MTXBLC-1)/npgcd)=1
  343. C SEGACT MTXBLC
  344. C DO 362 J=1,MTXBLC(/1)
  345. C MTXBLL=MTXBLC(J)
  346. C ISLIS((MTXBLL-1)/npgcd)=1
  347. C SEGDES MTXBLL
  348. C 362 CONTINUE
  349. SEGDES MTXBLC
  350. ENDIF
  351. * MSAPI3=MBLO1.MSAPII
  352. * IF (MSAPI3.NE.0) THEN
  353. * ISLIS((MSAPI3-1)/npgcd)=1
  354. * SEGDES MSAPI3
  355. * ENDIF
  356. MPROCE=MBLO1.MPROCD
  357. IF (MPROCE.NE.0) THEN
  358. ISLIS((MPROCE-1)/npgcd)=1
  359. SEGDES MPROCE
  360. ENDIF
  361. * ON MET DANS LA PILE DES BLOCS LES BLOCS CONTENUS DANS LA PROCEDURE
  362. DO 363 J=MBLO1.MDEOBJ,MBLO1.MFIOBJ
  363. IF (INOOB2(J).EQ.'BLOC ') THEN
  364. ITLAC1.ITLAC(**)=IOUEP2(J)
  365. ENDIF
  366. 363 CONTINUE
  367. IF (MBLO1.NE.MBLOC) SEGDES MBLO1
  368. 361 CONTINUE
  369. * reactiver la precompilation du bloc courant
  370. MTXBLC=MBLOC.MTXBL
  371. IF(MTXBLC.NE.0) SEGACT MTXBLC
  372. 370 CONTINUE
  373.  
  374. *
  375. * CAS DES BLOC
  376. *
  377. ITLACC=KCOLA(37)
  378. DO 375 J=1,LMNNOM
  379. IF (INOOB2(J).EQ.'BLOC ') THEN
  380. ITLAC(**)=IOUEP2(J)
  381. ENDIF
  382. 375 CONTINUE
  383. IF (ITLAC(/1).EQ.0) GOTO 378
  384. DO 371 I=1,ITLAC(/1)
  385. MBLO1=ITLAC(I)
  386. ISLIS((MBLO1-1)/npgcd)=1
  387. SEGACT MBLO1
  388. ISLIS(( MBLO1.ISPOTE-1)/npgcd)=1
  389. MTXBLC=MBLO1.MTXBL
  390. IF (MTXBLC.NE.0) THEN
  391. ISLIS((MTXBLC-1)/npgcd)=1
  392. C SEGACT MTXBLC
  393. C DO 372 J=1,MTXBLC(/1)
  394. C MTXBLL=MTXBLC(J)
  395. C ISLIS((MTXBLL-1)/npgcd)=1
  396. C SEGDES MTXBLL
  397. C 372 CONTINUE
  398. IF (MBLO1.NE.MBLOC) SEGDES MTXBLC
  399. ENDIF
  400. IF (MBLO1.NE.MBLOC) SEGDES MBLO1
  401. 371 CONTINUE
  402. 378 CONTINUE
  403. *
  404. * ON MET EGALEMENT LA CHAINE DES BLOCS MONTANTES CAR CEUX OU ON
  405. * SE TROUVE PEUVENT AVOIR ETE CREE DANS PROCED (DUPLICATION)
  406. *
  407. MBLO1=MBLOC
  408. 373 CONTINUE
  409. SEGACT MBLO1
  410. ISLIS((MBLO1-1)/npgcd)=1
  411. ISLIS((MBLO1.ISPOTE-1)/npgcd)=1
  412. MTXBLC=MBLO1.MTXBL
  413. IF (MTXBLC.NE.0) THEN
  414. ISLIS((MTXBLC-1)/npgcd)=1
  415. C SEGACT MTXBLC
  416. C DO 374 J=1,MTXBLC(/1)
  417. C MTXBLL=MTXBLC(J)
  418. C ISLIS((MTXBLL-1)/npgcd)=1
  419. C SEGDES MTXBLL
  420. C 374 CONTINUE
  421. IF (MBLO1.NE.MBLOC) SEGDES MTXBLC
  422. ENDIF
  423. IARGUM=MBLO1.MARGUM
  424. IF (IARGUM.NE.0) THEN
  425. ISLIS((IARGUM-1)/npgcd)=1
  426. SEGACT IARGUM
  427. MTXBI3=MTXBB
  428. ISLIS((MTXBI3-1)/npgcd)=1
  429. SEGDES MTXBI3
  430. MTXFL3=MTXFLO
  431. IF( MTXFL3.NE.0) THEN
  432. SEGDES MTXFL3
  433. ISLIS((MTXFL3-1)/npgcd)=1
  434. ENDIF
  435. SEGDES IARGUM
  436. ENDIF
  437. * MSAPI3=MBLO1.MSAPII
  438. * IF (MSAPI3.NE.0) THEN
  439. * ISLIS((MSAPI3-1)/npgcd)=1
  440. * SEGDES MSAPI3
  441. * ENDIF
  442. MPROCE=MBLO1.MPROCD
  443. IF (MPROCE.NE.0) THEN
  444. SEGACT MPROCE
  445. ISLIS((MPROCE-1)/npgcd)=1
  446. ISLIS((LTTINT-1)/npgcd)=1
  447. ISLIS((KTABNO-1)/npgcd)=1
  448. ISLIS((MPOOB-1)/npgcd)=1
  449. SEGDES MPROCE
  450. ENDIF
  451. * WRITE (6,*) ' BLOC DANS LA CHAINE MONTANTE ',MBLO1
  452. MBLSU=MBLO1.MBLSUP
  453. IF (MBLSU.NE.0) THEN
  454. SEGDES MBLO1
  455. MBLO1=MBLSU
  456. GOTO 373
  457. ENDIF
  458. SEGDES MBLO1
  459. SEGACT MBLOC*MOD
  460. ISLIS((ISPOTE-1)/npgcd)=1
  461. ISLIS((ITTINT-1)/npgcd)=1
  462. ISLIS((JPOOB-1)/npgcd)=1
  463. ISLIS((ITABNO-1)/npgcd)=1
  464. 380 CONTINUE
  465. MTXBLC = MTTRY
  466. IF(MTXBLC.NE.0) SEGACT MTXBLC
  467. *
  468. * Cas du MMODEL
  469. *
  470. ITLACC = KCOLA(38)
  471. IF (ITLAC(/1).EQ.0) GOTO 390
  472. DO 381 I=1,ITLAC(/1)
  473. MMODEL = ITLAC(I)
  474. ISLIS((MMODEL-1)/npgcd)=1
  475. SEGACT,MMODEL
  476. DO 382 J=1,KMODEL(/1)
  477. IMODEL = KMODEL(J)
  478. ISLIS((IMODEL-1)/npgcd)=1
  479. SEGACT IMODEL
  480. NFOR=FORMOD(/1)
  481. * IF(NFOR.EQ.2.OR.FORMOD(1).EQ.'MECANIQUE'.OR.
  482. * $ FORMOD(1).EQ.'POREUX')THEN
  483. do IO=3,INFMOD(/1)
  484. if(infmod(io).gt.0)then
  485. iseg= infmod(io)
  486. ISLIS((ISEG-1)/npgcd)=1
  487. SEGDES ISEG
  488. endif
  489. enddo
  490. * ENDIF
  491. do io=1,14
  492. if(lnomid(io).ne.0) then
  493. iseg=lnomid(io)
  494. ISLIS((ISEG-1)/npgcd)=1
  495. SEGDES ISEG
  496. endif
  497. enddo
  498. if (ivamod(/1).gt.0) then
  499. do il = 1,ivamod(/1)
  500. MODYN=tymode(il)
  501. Jtc=0
  502. CALL TYPFIL (MODYN,JTC)
  503. if( jtc.ne.0) go to 3819
  504. c... kich si pas un vrai objet par defaut ce sont des imodel
  505. imode1=ivamod(il)
  506. islis((imode1-1)/npgcd)=1
  507. segact imode1
  508.  
  509. c... kich espere qu un niveau de recursivite suffit ...
  510. segdes imode1
  511. 3819 continue
  512. enddo
  513. endif
  514. SEGDES,IMODEL
  515. 382 CONTINUE
  516. segdes MMODEL
  517. * END DO
  518. 381 CONTINUE
  519. * END DO
  520. 390 CONTINUE
  521. *
  522. * Cas du MCHAML
  523. *
  524. ITLACC = KCOLA(39)
  525. IF (ITLAC(/1).EQ.0) GOTO 400
  526. CALL MECHAM(ILISSE,ISLIS,ICOLAC)
  527. 400 CONTINUE
  528. *
  529. * CAS DES MINTE
  530. *
  531. ITLACC=KCOLA(40)
  532. IF (ITLAC(/1).EQ.0) GOTO 410
  533. DO 401 I=1,ITLAC(/1)
  534. ISEG=ITLAC(I)
  535. ISLIS((ISEG-1)/npgcd)=1
  536. SEGDES ISEG
  537. 401 CONTINUE
  538. 410 CONTINUE
  539. *
  540. * CAS DES NUAGEs
  541. *
  542. ITLACC=KCOLA(41)
  543. IF (ITLAC(/1).EQ.0) GOTO 420
  544. DO 411 I=1,ITLAC(/1)
  545. MNUAGE=ITLAC(I)
  546. ISLIS((MNUAGE-1)/npgcd)=1
  547. SEGACT MNUAGE
  548. IF(NUAPOI(/1).EQ.0) GO TO 411
  549. DO 412 K=1,NUAPOI(/1)
  550. ISEG=NUAPOI(K)
  551. ISLIS((ISEG-1)/npgcd)=1
  552. SEGDES ISEG
  553. 412 CONTINUE
  554. SEGDES MNUAGE
  555. 411 CONTINUE
  556. 420 CONTINUE
  557. *
  558. * CAS DES MATRAK
  559. *
  560. ITLACC=KCOLA(42)
  561. IF (ITLAC(/1).EQ.0) GOTO 430
  562. DO 421 I=1,ITLAC(/1)
  563. MATRAK=ITLAC(I)
  564. ISLIS((MATRAK-1)/npgcd)=1
  565. SEGACT MATRAK
  566. DO 422 I1=1,LIZAFM(/1)
  567. PTR=LIZAFM(I1)
  568. ISLIS((PTR-1)/npgcd)=1
  569. SEGDES PTR
  570. 422 CONTINUE
  571. IF(KIZCL.NE.0)THEN
  572. IZL=KIZCL
  573. SEGACT IZL
  574. ISLIS((IZL-1)/npgcd)=1
  575. IF(KZA1.NE.0)THEN
  576. IDMAT=KZA1
  577. ISLIS((IDMAT-1)/npgcd)=1
  578. SEGACT IDMAT
  579. PTR=IDIAG
  580. SEGDES PTR
  581. ISLIS((PTR-1)/npgcd)=1
  582. NBLK=IDESCR(/1)
  583. DO 423 I1=1,NBLK
  584. PTR=IDESCR(I1)
  585. IDBLK=PTR
  586. SEGDES PTR
  587. ISLIS((IDBLK-1)/npgcd)=1
  588. SEGACT IDBLK
  589. PTR=IMAT
  590. ISLIS((PTR-1)/npgcd)=1
  591. SEGDES PTR
  592. SEGDES IDBLK
  593. 423 CONTINUE
  594. SEGDES IDMAT
  595. ENDIF
  596. SEGDES IZL
  597. ENDIF
  598. SEGDES MATRAK
  599. 421 CONTINUE
  600.  
  601. 430 CONTINUE
  602. *
  603. * CAS DES MATRIK
  604. *
  605. ITLACC=KCOLA(43)
  606. IF (ITLAC(/1).EQ.0) GOTO 440
  607. CALL XMNG6(ILISSE,ITLACC,ISLIS)
  608. 440 CONTINUE
  609. *
  610. * Cas des OBJET
  611. *
  612. ITLACC=KCOLA(44)
  613. IF (ITLAC(/1).EQ.0) GOTO 450
  614. DO 441 I=1,ITLAC(/1)
  615. ISEG=ITLAC(I)
  616. ISLIS((ISEG-1)/npgcd)=1
  617. SEGDES ISEG
  618. 441 CONTINUE
  619.  
  620. 450 CONTINUE
  621. *
  622. * Cas des ESCLAVE
  623. *
  624. ITLACC=KCOLA(46)
  625. * print*, ' Cas des ESCLAVE ITLACC', ITLACC,'NB', ITLAC(/1)
  626. IF (ITLAC(/1).EQ.0) GOTO 460
  627. DO 451 I=1,ITLAC(/1)
  628. ISEG=ITLAC(I)
  629. * write (6,*) ' menag6 esclave ajout de mesres ',iseg
  630. ISLIS((ISEG-1)/npgcd)=1
  631. mesres = ISEG
  632. segact mesres
  633. * write (6,*) ' menag6 esclave ajout de nesres ',iesres
  634. iseg=iesres
  635. nesres=iseg
  636. ISLIS((iseg-1)/npgcd)=1
  637. segdes nesres
  638. SEGDES mesres
  639. 451 CONTINUE
  640. * ajouter les segments des piles d'instructions des assistants
  641. do ith=1,nbesc
  642. mesins=mescl(ith)
  643. segact mesins
  644. do ins=1,nbins
  645. mescla=lismes(ins)
  646. ISLIS((mescla-1)/npgcd)=1
  647. enddo
  648. if (inscou.ne.0) ISLIS((inscou-1)/npgcd)=1
  649. segdes mesins
  650. enddo
  651.  
  652.  
  653.  
  654.  
  655. 460 CONTINUE
  656. *
  657. RETURN
  658. END
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669.  

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