Télécharger la plaquette Cast3M


fr en

Télécharger menag6.eso

Retour à la liste

Numérotation des lignes : 

menag6

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

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