Esope source files

   1 : C MENAG6    SOURCE    CHAT      11/07/26    21:15:17     7060           
   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 : -INC SMMATRK1
  67 :       MODYN='DYNAMIQU'
  68 :       ISLIS = IPLIS
  69 : *
  70 :       ICOLAC = IPOLAC
  71 : *
  72 : *  CAS DES MLREEL
  73 : *
  74 :       ITLACC=KCOLA(18)
  75 :        IF (ITLAC(/1).EQ.0) GOTO 190
  76 :        DO 181 I=1,ITLAC(/1)
  77 : *       MLREEL=ITLAC(I)
  78 : *       ISLIS((MLREEL-1)/npgcd)=1
  79 : *       SEGDES MLREEL
  80 :         ISEG=ITLAC(I)
  81 :         ISLIS((ISEG-1)/npgcd)=1
  82 :         SEGDES ISEG
  83 :  181   CONTINUE
  84 :  190  CONTINUE
  85 : *
  86 : *  CAS DES MLENTI
  87 : *
  88 :       ITLACC=KCOLA(19)
  89 :        IF (ITLAC(/1).EQ.0) GOTO 200
  90 :        DO 191 I=1,ITLAC(/1)
  91 : *       MLENTI=ITLAC(I)
  92 : *       ISLIS((**-1)/npgcd)=MLENTI
  93 : *       SEGDES MLENTI
  94 :         ISEG=ITLAC(I)
  95 :         ISLIS((ISEG-1)/npgcd)=1
  96 :         SEGDES ISEG
  97 :  191   CONTINUE
  98 :  200  CONTINUE
  99 : *
 100 : *  CAS DES MCHARG
 101 : *
 102 :       ITLACC=KCOLA(20)
 103 :        IF (ITLAC(/1).EQ.0) GOTO 210
 104 :        DO 201 I=1,ITLAC(/1)
 105 :         MCHARG=ITLAC(I)
 106 :         SEGACT MCHARG
 107 :         ISLIS((MCHARG-1)/npgcd)=1
 108 :         DO 202 J=1,KCHARG(/1)
 109 :          ICHARG=KCHARG(J)
 110 :          ISLIS((ICHARG-1)/npgcd)=1
 111 :          SEGACT ICHARG
 112 :          ISEG=ICHPO1
 113 :          ISLIS((ISEG-1)/npgcd)=1
 114 :          SEGDES ISEG
 115 :          ISEG=ICHPO2
 116 :          ISLIS((ISEG-1)/npgcd)=1
 117 :          SEGDES ISEG
 118 :          IF(CHATYP.NE.'TABLE   ') THEN
 119 :             ISEG=ICHPO3
 120 :             ISLIS((ISEG-1)/npgcd)=1
 121 :             SEGDES ISEG
 122 :          ENDIF
 123 :          IF(CHAMOB(J).EQ.'TRAN') THEN
 124 :            ISEG=ICHPO6
 125 :            ISLIS((ISEG-1)/npgcd)=1
 126 :            SEGDES ISEG
 127 :            ISEG=ICHPO7
 128 :            ISLIS((ISEG-1)/npgcd)=1
 129 :            SEGDES ISEG
 130 :          ELSEIF(CHAMOB(J).EQ.'ROTA') 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.'TRAJ') THEN
 138 :            ISEG=ICHPO4
 139 :            ISLIS((ISEG-1)/npgcd)=1
 140 :            SEGDES ISEG
 141 :            ISEG=ICHPO6
 142 :            ISLIS((ISEG-1)/npgcd)=1
 143 :            SEGDES ISEG
 144 :          ENDIF
 145 :          SEGDES ICHARG
 146 :  202    CONTINUE
 147 :         SEGDES MCHARG
 148 :  201   CONTINUE
 149 :  210  CONTINUE
 150 : *
 151 : *  CAS DES MEVOLL
 152 : *
 153 :       ITLACC=KCOLA(22)
 154 :        IF (ITLAC(/1).EQ.0) GOTO 230
 155 :        DO 221 I=1,ITLAC(/1)
 156 :         MEVOLL=ITLAC(I)
 157 :         SEGACT MEVOLL
 158 :         ISLIS((MEVOLL-1)/npgcd)=1
 159 :         DO 222 J=1,IEVOLL(/1)
 160 :          KEVOLL=IEVOLL(J)
 161 :          ISLIS((KEVOLL-1)/npgcd)=1
 162 :          SEGACT KEVOLL
 163 :          ISEG=IPROGX
 164 :          ISLIS((ISEG-1)/npgcd)=1
 165 :          SEGDES ISEG
 166 :          ISEG=IPROGY
 167 :          ISLIS((ISEG-1)/npgcd)=1
 168 :          SEGDES ISEG
 169 :          SEGDES KEVOLL
 170 :  222    CONTINUE
 171 :         SEGDES MEVOLL
 172 :  221   CONTINUE
 173 :  230  CONTINUE
 174 : *
 175 : *  CAS DES SUPERELEMENTS
 176 : *
 177 :       ITLACC=KCOLA(23)
 178 :        IF (ITLAC(/1).EQ.0) GOTO 240
 179 :        DO 231 I=1,ITLAC(/1)
 180 :         MSUPER=ITLAC(I)
 181 :         segact msuper
 182 :         iseg=mdnorr
 183 :         if( iseg. ne. 0) then
 184 :           ISLIS((iseg-1)/npgcd)=1
 185 :           segdes iseg
 186 :         endif
 187 :         ISEG=ITLAC(I)
 188 :         ISLIS((ISEG-1)/npgcd)=1
 189 :         SEGDES ISEG
 190 :  231   CONTINUE
 191 :  240  CONTINUE
 192 : *
 193 : *  CAS DES LOGIQUES FLOTTANT ENTIER MOT  RIEN A FAIRE
 194 : *
 195 : *
 196 : *  CAS DES TEXTES
 197 : *
 198 :       ITLACC=KCOLA(28)
 199 :        IF (ITLAC(/1).EQ.0) GOTO 290
 200 :        DO 281 I=1,ITLAC(/1)
 201 :         MTEXTE=ITLAC(I)
 202 :         ISLIS((MTEXTE-1)/npgcd)=1
 203 :         SEGACT MTEXTE
 204 :         MTRADU=MTRADC
 205 :         IF (MTRADU.NE.0) THEN
 206 :          ISLIS((MTRADU-1)/npgcd)=1
 207 :          SEGDES MTRADU
 208 :         ENDIF
 209 :         SEGDES MTEXTE
 210 :  281   CONTINUE
 211 :  290  CONTINUE
 212 : *
 213 : *  CAS DES LISTMOTS
 214 : *
 215 :       ITLACC=KCOLA(29)
 216 :        IF (ITLAC(/1).EQ.0) GOTO 300
 217 :        DO 291 I=1,ITLAC(/1)
 218 : *       MLMOTS=ITLAC(I)
 219 : *       ISLIS((MLMOTS-1)/npgcd)=1
 220 : *       SEGDES MLMOTS
 221 :         ISEG=ITLAC(I)
 222 :         ISLIS((ISEG-1)/npgcd)=1
 223 :         SEGDES ISEG
 224 :  291   CONTINUE
 225 :  300  CONTINUE
 226 : *
 227 : *  CAS DES VECTEURS
 228 : *
 229 :       ITLACC=KCOLA(30)
 230 :        IF (ITLAC(/1).EQ.0) GOTO 310
 231 :        DO 301 I=1,ITLAC(/1)
 232 : *       MVECTE=ITLAC(I)
 233 : *       ISLIS((MVECTE-1)/npgcd)=1
 234 : *       SEGDES MVECTE
 235 :         ISEG=ITLAC(I)
 236 :         ISLIS((ISEG-1)/npgcd)=1
 237 :         SEGDES ISEG
 238 :  301   CONTINUE
 239 :  310  CONTINUE
 240 : *
 241 : *  CAS DES VECTD   ON ECRIT ISEG CAR ON NE PEUT PAS FAIRE -INC MVECTD
 242 : *
 243 :       ITLACC=KCOLA(31)
 244 :        IF (ITLAC(/1).EQ.0) GOTO 320
 245 :        DO 311 I=1,ITLAC(/1)
 246 : *       MVECTD=ITLAC(I)
 247 : *       ISLIS((MVECTD-1)/npgcd)=1
 248 : *       SEGDES MVECTD
 249 :         ISEG=ITLAC(I)
 250 :         ISLIS((ISEG-1)/npgcd)=1
 251 :         SEGDES ISEG
 252 :  311   CONTINUE
 253 :  320  CONTINUE
 254 : *
 255 : *  CAS DES POINTS RIEN A FAIRE
 256 : *
 257 : *
 258 : *  CAS DES CONFIG  NE SURTOUT PAS UTILISER MCOORD (DANS CCOPTIO)
 259 : *
 260 :       ITLACC=KCOLA(33)
 261 :        IF (ITLAC(/1).EQ.0) GOTO 340
 262 :        DO 331 I=1,ITLAC(/1)
 263 :         ISEG=ITLAC(I)
 264 :         ISLIS((ISEG-1)/npgcd)=1
 265 :         SEGDES ISEG
 266 :  331   CONTINUE
 267 :  340  CONTINUE
 268 : *
 269 : *  CAS DES MLCHPO
 270 : *
 271 :       ITLACC=KCOLA(34)
 272 :        IF (ITLAC(/1).EQ.0) GOTO 350
 273 :        DO 341 I=1,ITLAC(/1)
 274 : *       MLCHPO=ITLAC(I)
 275 : *       ISLIS((MLCHPO-1)/npgcd)=1
 276 : *       SEGDES MLCHPO
 277 :         ISEG=ITLAC(I)
 278 :         ISLIS((ISEG-1)/npgcd)=1
 279 :         SEGDES ISEG
 280 :  341   CONTINUE
 281 :  350  CONTINUE
 282 : *
 283 : *  CAS DES MBASEM
 284 : *
 285 :       ITLACC=KCOLA(35)
 286 :        IF (ITLAC(/1).EQ.0) GOTO 360
 287 :        DO 351 I=1,ITLAC(/1)
 288 :         MBASEM=ITLAC(I)
 289 :         ISLIS((MBASEM-1)/npgcd)=1
 290 :         SEGACT MBASEM
 291 :          DO 352 J=1,LISBAS(/1)
 292 :           MSOBAS=LISBAS(J)
 293 :           ISLIS((MSOBAS-1)/npgcd)=1
 294 :           SEGDES MSOBAS
 295 :  352     CONTINUE
 296 :         SEGDES MBASEM
 297 :  351   CONTINUE
 298 :  360  CONTINUE
 299 : *
 300 : *  CAS DES PROCEDUR
 301 : *
 302 :        MTTRY=MTXBL
 303 :       ITLACC=KCOLA(36)
 304 :       ITLAC1=KCOLA(37)
 305 :        IF (ITLAC(/1).EQ.0) GOTO 370
 306 :        DO 361 I=1,ITLAC(/1)
 307 :         MBLA1=ITLAC(I)
 308 :         MBLO1=IPIPR1(MBLA1)
 309 : *  LES PROCEDURES EN NEGATIFS NE SONT PAS ENCORE MISES EN SEGMENT
 310 :         IF (MBLO1.LE.0) GOTO 361
 311 :         ISLIS((MBLO1-1)/npgcd)=1
 312 :         SEGACT MBLO1
 313 :         ISLIS((MBLO1.ISPOTE-1)/npgcd)=1
 314 :         IARGUM=MBLO1.MARGUM
 315 :         ISLIS((IARGUM-1)/npgcd)=1
 316 :         SEGACT IARGUM
 317 :         MTXBI3=MTXBB
 318 :         ISLIS((MTXBI3-1)/npgcd)=1
 319 :         SEGDES MTXBI3
 320 :         MTXFL3=MTXFLO
 321 :         IF( MTXFL3.NE.0) THEN
 322 :            SEGDES MTXFL3
 323 :            ISLIS((MTXFL3-1)/npgcd)=1
 324 :         ENDIF
 325 :         MTRESU=ITRESU
 326 :         IF( MTRESU.NE.0) THEN
 327 :            SEGDES MTRESU
 328 :            ISLIS((MTRESU-1)/npgcd)=1
 329 :         ENDIF
 330 :         MVRESU=IVRESU
 331 :         IF( MVRESU.NE.0) THEN
 332 :            SEGDES MVRESU
 333 :            ISLIS((MVRESU-1)/npgcd)=1
 334 :         ENDIF
 335 :         MFRESU=IFRESU
 336 :         IF( MFRESU.NE.0) THEN
 337 :            SEGDES MFRESU
 338 :            ISLIS((MFRESU-1)/npgcd)=1
 339 :         ENDIF
 340 :         SEGDES IARGUM
 341 :         MTXBLC=MBLO1.MTXBL
 342 :         IF (MTXBLC.NE.0) THEN
 343 :            ISLIS((MTXBLC-1)/npgcd)=1
 344 : C           SEGACT MTXBLC
 345 : C           DO 362 J=1,MTXBLC(/1)
 346 : C            MTXBLL=MTXBLC(J)
 347 : C            ISLIS((MTXBLL-1)/npgcd)=1
 348 : C            SEGDES MTXBLL
 349 : C 362       CONTINUE
 350 :             SEGDES MTXBLC
 351 :         ENDIF
 352 : *        MSAPI3=MBLO1.MSAPII
 353 : *        IF (MSAPI3.NE.0) THEN
 354 : *         ISLIS((MSAPI3-1)/npgcd)=1
 355 : *         SEGDES MSAPI3
 356 : *        ENDIF
 357 :         MPROCE=MBLO1.MPROCD
 358 :         IF (MPROCE.NE.0) THEN
 359 :          ISLIS((MPROCE-1)/npgcd)=1
 360 :          SEGDES MPROCE
 361 :         ENDIF
 362 : *   ON MET DANS LA PILE DES BLOCS LES BLOCS CONTENUS DANS LA PROCEDURE
 363 :         DO 363 J=MBLO1.MDEOBJ,MBLO1.MFIOBJ
 364 :          IF (INOOB2(J).EQ.'BLOC    ') THEN
 365 :             ITLAC1.ITLAC(**)=IOUEP2(J)
 366 :          ENDIF
 367 :  363    CONTINUE
 368 :         IF (MBLO1.NE.MBLOC) SEGDES MBLO1
 369 :  361   CONTINUE
 370 : *  reactiver la precompilation du bloc courant
 371 :       MTXBLC=MBLOC.MTXBL
 372 :       IF(MTXBLC.NE.0)       SEGACT MTXBLC
 373 :  370  CONTINUE
 374 : 
 375 : *
 376 : *  CAS DES BLOC
 377 : *
 378 :       ITLACC=KCOLA(37)
 379 :         DO 375 J=1,LMNNOM
 380 :          IF (INOOB2(J).EQ.'BLOC    ') THEN
 381 :             ITLAC(**)=IOUEP2(J)
 382 :          ENDIF
 383 :  375    CONTINUE
 384 :        IF (ITLAC(/1).EQ.0) GOTO 378
 385 :        DO 371 I=1,ITLAC(/1)
 386 :         MBLO1=ITLAC(I)
 387 :         ISLIS((MBLO1-1)/npgcd)=1
 388 :         SEGACT MBLO1
 389 :         ISLIS(( MBLO1.ISPOTE-1)/npgcd)=1
 390 :         MTXBLC=MBLO1.MTXBL
 391 :         IF (MTXBLC.NE.0) THEN
 392 :            ISLIS((MTXBLC-1)/npgcd)=1
 393 : C           SEGACT MTXBLC
 394 : C           DO 372 J=1,MTXBLC(/1)
 395 : C            MTXBLL=MTXBLC(J)
 396 : C            ISLIS((MTXBLL-1)/npgcd)=1
 397 : C            SEGDES MTXBLL
 398 : C 372       CONTINUE
 399 :            IF (MBLO1.NE.MBLOC) SEGDES MTXBLC
 400 :         ENDIF
 401 :         IF (MBLO1.NE.MBLOC) SEGDES MBLO1
 402 :  371   CONTINUE
 403 :  378  CONTINUE
 404 : *
 405 : *  ON MET EGALEMENT LA CHAINE DES BLOCS MONTANTES CAR CEUX OU ON
 406 : *  SE TROUVE PEUVENT AVOIR ETE CREE DANS PROCED (DUPLICATION)
 407 : *
 408 :        MBLO1=MBLOC
 409 :  373   CONTINUE
 410 :        SEGACT MBLO1
 411 :        ISLIS((MBLO1-1)/npgcd)=1
 412 :        ISLIS((MBLO1.ISPOTE-1)/npgcd)=1
 413 :         MTXBLC=MBLO1.MTXBL
 414 :         IF (MTXBLC.NE.0) THEN
 415 :            ISLIS((MTXBLC-1)/npgcd)=1
 416 : C           SEGACT MTXBLC
 417 : C           DO 374 J=1,MTXBLC(/1)
 418 : C            MTXBLL=MTXBLC(J)
 419 : C            ISLIS((MTXBLL-1)/npgcd)=1
 420 : C            SEGDES MTXBLL
 421 : C 374       CONTINUE
 422 :            IF (MBLO1.NE.MBLOC) SEGDES MTXBLC
 423 :         ENDIF
 424 :         IARGUM=MBLO1.MARGUM
 425 :         IF (IARGUM.NE.0) THEN
 426 :          ISLIS((IARGUM-1)/npgcd)=1
 427 :          SEGACT IARGUM
 428 :          MTXBI3=MTXBB
 429 :          ISLIS((MTXBI3-1)/npgcd)=1
 430 :          SEGDES MTXBI3
 431 :          MTXFL3=MTXFLO
 432 :          IF( MTXFL3.NE.0) THEN
 433 :            SEGDES MTXFL3
 434 :            ISLIS((MTXFL3-1)/npgcd)=1
 435 :          ENDIF
 436 :          SEGDES IARGUM
 437 :         ENDIF
 438 : *        MSAPI3=MBLO1.MSAPII
 439 : *        IF (MSAPI3.NE.0) THEN
 440 : *         ISLIS((MSAPI3-1)/npgcd)=1
 441 : *         SEGDES MSAPI3
 442 : *        ENDIF
 443 :         MPROCE=MBLO1.MPROCD
 444 :         IF (MPROCE.NE.0) THEN
 445 :          SEGACT MPROCE
 446 :          ISLIS((MPROCE-1)/npgcd)=1
 447 :          ISLIS((LTTINT-1)/npgcd)=1
 448 :          ISLIS((KTABNO-1)/npgcd)=1
 449 :          ISLIS((MPOOB-1)/npgcd)=1
 450 :          SEGDES MPROCE
 451 :         ENDIF
 452 : *      WRITE (6,*) ' BLOC DANS LA CHAINE MONTANTE ',MBLO1
 453 :        MBLSU=MBLO1.MBLSUP
 454 :        IF (MBLSU.NE.0) THEN
 455 :           SEGDES MBLO1
 456 :           MBLO1=MBLSU
 457 :           GOTO 373
 458 :        ENDIF
 459 :        SEGDES MBLO1
 460 :        SEGACT MBLOC*MOD
 461 :        ISLIS((ISPOTE-1)/npgcd)=1
 462 :       ISLIS((ITTINT-1)/npgcd)=1
 463 :       ISLIS((JPOOB-1)/npgcd)=1
 464 :       ISLIS((ITABNO-1)/npgcd)=1
 465 :  380  CONTINUE
 466 :       MTXBLC = MTTRY
 467 :       IF(MTXBLC.NE.0)    SEGACT MTXBLC
 468 : *
 469 : *     Cas du MMODEL
 470 : *
 471 :       ITLACC = KCOLA(38)
 472 :       IF (ITLAC(/1).EQ.0) GOTO 390
 473 :       DO 381 I=1,ITLAC(/1)
 474 :          MMODEL = ITLAC(I)
 475 :          ISLIS((MMODEL-1)/npgcd)=1
 476 :          SEGACT,MMODEL
 477 :          DO 382 J=1,KMODEL(/1)
 478 :             IMODEL = KMODEL(J)
 479 :             ISLIS((IMODEL-1)/npgcd)=1
 480 :             SEGACT IMODEL
 481 :             NFOR=FORMOD(/1)
 482 : *            IF(NFOR.EQ.2.OR.FORMOD(1).EQ.'MECANIQUE'.OR.
 483 : *     $       FORMOD(1).EQ.'POREUX')THEN
 484 :               do IO=3,INFMOD(/1)
 485 :                 if(infmod(io).ne.0)then
 486 :                    iseg= infmod(io)
 487 :                    ISLIS((ISEG-1)/npgcd)=1
 488 :                    SEGDES ISEG
 489 :                  endif
 490 :               enddo
 491 : *           ENDIF
 492 :               do io=1,14
 493 :                  if(lnomid(io).ne.0) then                 
 494 :                    iseg=lnomid(io)
 495 :                    ISLIS((ISEG-1)/npgcd)=1
 496 :                    SEGDES ISEG
 497 :                  endif
 498 :               enddo 
 499 :             if (ivamod(/1).gt.0) then
 500 :               do il = 1,ivamod(/1)
 501 :                  MODYN=tymode(il)
 502 :                  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
 525 :       CALL MECHAM(ILISSE,ISLIS,ICOLAC)
 526 :  400  CONTINUE
 527 : *
 528 : *     CAS DES MINTE
 529 : *
 530 :       ITLACC=KCOLA(40)
 531 :        IF (ITLAC(/1).EQ.0) GOTO 410
 532 :        DO 401 I=1,ITLAC(/1)
 533 :         ISEG=ITLAC(I)
 534 :         ISLIS((ISEG-1)/npgcd)=1
 535 :         SEGDES ISEG
 536 :  401   CONTINUE
 537 :  410  CONTINUE
 538 : *
 539 : *     CAS DES NUAGEs
 540 : *
 541 :       ITLACC=KCOLA(41)
 542 :        IF (ITLAC(/1).EQ.0) GOTO 420
 543 :        DO 411 I=1,ITLAC(/1)
 544 :         MNUAGE=ITLAC(I)
 545 :         ISLIS((MNUAGE-1)/npgcd)=1
 546 :         SEGACT MNUAGE
 547 :         IF(NUAPOI(/1).EQ.0) GO TO 411
 548 :         DO 412 K=1,NUAPOI(/1)
 549 :         ISEG=NUAPOI(K)
 550 :         ISLIS((ISEG-1)/npgcd)=1
 551 :         SEGDES ISEG
 552 :   412   CONTINUE
 553 :         SEGDES MNUAGE
 554 :  411   CONTINUE
 555 :  420   CONTINUE
 556 : *
 557 : *     CAS DES MATRAK
 558 : *
 559 :       ITLACC=KCOLA(42)
 560 :        IF (ITLAC(/1).EQ.0) GOTO 430
 561 :        DO 421 I=1,ITLAC(/1)
 562 :         MATRAK=ITLAC(I)
 563 :         ISLIS((MATRAK-1)/npgcd)=1
 564 :         SEGACT MATRAK
 565 :        DO 422 I1=1,LIZAFM(/1)
 566 :         PTR=LIZAFM(I1)
 567 :         ISLIS((PTR-1)/npgcd)=1
 568 :         SEGDES PTR
 569 :  422   CONTINUE
 570 :        IF(KIZCL.NE.0)THEN
 571 :        IZL=KIZCL
 572 :        SEGACT IZL
 573 :        ISLIS((IZL-1)/npgcd)=1
 574 :        IF(KZA1.NE.0)THEN
 575 :        IDMAT=KZA1
 576 :        ISLIS((IDMAT-1)/npgcd)=1
 577 :        SEGACT IDMAT
 578 :        PTR=IDIAG
 579 :        SEGDES PTR
 580 :        ISLIS((PTR-1)/npgcd)=1
 581 :        NBLK=IDESCR(/1)
 582 :        DO 423 I1=1,NBLK
 583 :        PTR=IDESCR(I1)
 584 :        IDBLK=PTR
 585 :        SEGDES PTR
 586 :        ISLIS((IDBLK-1)/npgcd)=1
 587 :        SEGACT IDBLK
 588 :        PTR=IMAT
 589 :        ISLIS((PTR-1)/npgcd)=1
 590 :        SEGDES PTR
 591 :        SEGDES IDBLK
 592 :  423   CONTINUE
 593 :        SEGDES IDMAT
 594 :        ENDIF
 595 :        SEGDES IZL
 596 :        ENDIF
 597 :        SEGDES MATRAK
 598 :  421   CONTINUE
 599 : 
 600 :  430   CONTINUE
 601 : *
 602 : *     CAS DES MATRIK
 603 : *
 604 :       ITLACC=KCOLA(43)
 605 :        IF (ITLAC(/1).EQ.0) GOTO 440
 605 :        CALL XMNG6(ILISSE,ITLACC,ISLIS)
 606 :  440   CONTINUE
 607 : *
 608 : *      Cas des OBJET
 609 : *
 610 :       ITLACC=KCOLA(44)
 611 :       IF (ITLAC(/1).EQ.0) GOTO 450
 612 :       DO 441 I=1,ITLAC(/1)
 613 :         ISEG=ITLAC(I)
 614 :         ISLIS((ISEG-1)/npgcd)=1
 615 :         SEGDES ISEG
 616 :  441  CONTINUE
 617 : 
 618 : 450   CONTINUE
 619 : *
 620 : *      Cas des ESCLAVE
 621 : *
 622 :       ITLACC=KCOLA(46)
 623 : *      print*, ' Cas des ESCLAVE ITLACC', ITLACC,'NB', ITLAC(/1)
 624 :       IF (ITLAC(/1).EQ.0) GOTO 460
 625 :       DO 451 I=1,ITLAC(/1)
 626 :         ISEG=ITLAC(I)
 627 : *       write (6,*) ' menag6 esclave ajout de mesres ',iseg
 628 :         ISLIS((ISEG-1)/npgcd)=1
 629 :         mesres = ISEG
 630 :         segact mesres 
 631 : *       write (6,*) ' menag6 esclave ajout de nesres ',iesres
 632 :         iseg=iesres
 633 :         nesres=iseg
 634 :         ISLIS((iseg-1)/npgcd)=1
 635 :         segdes nesres
 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 : 
 651 : 
 652 : 
 653 : 460   CONTINUE
 654 : *
 655 :       RETURN
 656 :       END
 657 : 
 658 :  
 659 :  
 660 :  
 661 :  
 662 :