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

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