Esope source files

   1 : C INVACA    SOURCE    FANDEUR   12/07/18    21:15:48     7433           
   2 : 
   3 :       SUBROUTINE INVACA(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHE5,
   4 :      &                  IMIL,IRET)
   5 : 
   6 : *---------------------------------------------------------------------
   7 : *
   8 : *      CALCUL DES 3 INVARIANTS D'UN TENSEUR D'ORDRE 2
   9 : *                 (APPELE PAR INVARI)
  10 : *
  11 : *   ENTREES:
  12 : *   --------
  13 : *
  14 : *     IPMODL   POINTEUR SUR UN MMODEL
  15 : *     IPCHE1   POINTEUR SUR UN CHAMELEM DE CONTRAINTES OU DEFORMATIONS
  16 : *              (TYPE MCHAML)
  17 : *     IPCHE5   POINTEUR SUR UN CHAMELEM DE CARACTERISTIQUES
  18 : *              (TYPE MCHAML)
  19 : *     IMIL     INDICATEUR OU ON CALCULE LES CONTRAINTES POUR
  20 : *              LES COQUES
  21 : *
  22 : *  SORTIES :
  23 : *  ---------
  24 : *
  25 : *     IPCHE2   POINTEUR SUR UN CHAMELEM STRESSES ( I1)
  26 : *     IPCHE3   POINTEUR SUR UN CHAMELEM STRESSES ( I2 )
  27 : *     IPCHE4   POINTEUR SUR UN CHAMELEM STRESSES ( I3 )
  28 : *     IRET     =1  OU  0   SUIVANT SUCCES OU PAS
  29 : *
  30 : *  PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12/90
  31 : *
  32 : *---------------------------------------------------------------------
  33 : *
  34 :       IMPLICIT INTEGER(I-N)
  35 :       IMPLICIT REAL*8(A-H,O-Z)
  36 : 
  37 : -INC CCOPTIO
  38 : -INC CCHAMP
  39 : 
  40 : -INC SMCHAML
  41 : -INC SMMODEL
  42 : 
  43 :       SEGMENT NOTYPE
  44 :         CHARACTER*16 TYPE(NBTYPE)
  45 :       ENDSEGMENT
  46 : *
  47 :       SEGMENT MPTVAL
  48 :         INTEGER IPOS(NS)    ,NSOF(NS)
  49 :         INTEGER      IVAL(NCOSOU)
  50 :         CHARACTER*16 TYVAL(NCOSOU)
  51 :       ENDSEGMENT
  52 : *
  53 :       PARAMETER ( NINF=3 )
  54 :       INTEGER INFOS(NINF)
  55 :       CHARACTER*(NCONCH) CONM
  56 :       LOGICAL lsupno
  57 : *
  58 :       DIMENSION SIG(9)
  59 : 
  60 : *------ Fin des déclarations ------------------------------------
  61 : 
  62 :       IRET = 0
  63 :       IPCHE2 = 0
  64 :       IPCHE3 = 0
  65 :       IPCHE4 = 0
  66 : *
  67 : * Reduction des MCHAMLs sur le MODELE
  68 : *
  69 :       kerre = 0
  70 : *
  70 :       CALL REDUAF(IPCHE1,IPMODL,ipch,0,ir,kerre)
  70 :       IF (ir.NE.1) CALL ERREUR(kerre)
  71 :       IF (IERR.NE.0) RETURN
  72 :       IPCHE1 = ipch
  73 : *
  74 :       IF (IPCHE5.NE.0) THEN
  74 :         CALL REDUAF(IPCHE5,IPMODL,ipch,0,ir,kerre)
  74 :         IF (ir.NE.1) CALL ERREUR(kerre)
  75 :         IF (IERR.NE.0) RETURN
  76 :         IPCHE5 = ipch
  77 :       ENDIF
  78 : *
  79 : * Verification du type de IPCHE1 !
  80 : *
  81 :       MCHELM = IPCHE1
  82 :       SEGACT,MCHELM
  83 :       IF (TITCHE.EQ.'CONTRAINTES') THEN
  84 :         ICONTR = 1
  85 :         W1 = 2.D0
  86 :         W2 = 1.D0
  87 :         W3 = 2.D0
  88 :       ELSE IF (TITCHE.EQ.'DEFORMATIONS') THEN
  89 :         ICONTR = 0
  90 :         W1 = 0.5D0
  91 :         W2 = 0.25D0
  92 :         W3 = 0.25D0
  93 :       ELSE
  94 :         MOTERR(1:8)='CONTRAIN'
  95 :         MOTERR(9:16)='DEFORMAT'
  95 :         CALL ERREUR(109)
  96 :         GOTO 666
  97 :       ENDIF
  98 : *
  99 : *  Verification du lieu support des mchamls
 100 : *
 100 :       CALL QUESUP(IPMODL,IPCHE1,0,0,iret1,ISUP1)
 101 :       IF (IERR.NE.0) GOTO 666
 102 : *
 103 :       IPCH5O = IPCHE5
 104 :       IF (IPCHE5.NE.0) THEN
 104 :         CALL QUESUP(IPMODL,IPCH5O,ISUP1,0,ISUP5,iret5)
 105 :         IF (ISUP5.GT.1) GOTO 666
 106 :         IF (IERR.NE.0) GOTO 666
 107 : C Le support des caractéristiques est différent de celui de IPCHE1
 108 :         IF (ISUP5.NE.0) THEN
 108 :           CALL CHASUP(IPMODL,IPCH5O,IPCHE5,irecar,ISUP1)
 109 :           IF (irecar.NE.0) GOTO 666
 110 :         ENDIF
 111 :       ENDIF
 112 : *
 113 : *  Activation et verification du modele
 114 : *
 115 :       MMODEL = IPMODL
 116 :       SEGACT,MMODEL
 117 :       NSOUS = KMODEL(/1)
 118 :       KEL22 = 0
 119 :       DO ISOUS = 1, NSOUS
 120 :         IMODEL=KMODEL(ISOUS)
 121 :         SEGACT,IMODEL
 122 :         IF (FORMOD(1).NE.'MECANIQUE' .AND.
 123 :      &      FORMOD(1).NE.'POREUX') THEN
 124 :           MOTERR(1:8) = FORMOD(1)
 124 :           CALL ERREUR(193)
 125 :           GOTO 666
 126 :         ENDIF
 127 :         IF (NEFMOD.EQ.22) KEL22 = KEL22 + 1
 128 :       ENDDO
 129 : *
 130 : C ... Initialisation des trois nouveaux MCHELM - resultats ...
 131 :       N1 = NSOUS - KEL22
 132 :       L1 = 8
 133 :       N3 = 6
 134 : *
 135 :       SEGINI MCHEL1
 136 :       MCHEL1.IFOCHE=IFOUR
 137 :       MCHEL1.TITCHE='SCALAIRE'
 138 : *
 139 :       SEGINI MCHEL2
 140 :       MCHEL2.IFOCHE=IFOUR
 141 :       MCHEL2.TITCHE='SCALAIRE'
 142 : *
 143 :       SEGINI MCHEL3
 144 :       MCHEL3.IFOCHE=IFOUR
 145 :       MCHEL3.TITCHE='SCALAIRE'
 146 : *
 147 : * Petit segment utile
 148 :       nbtype = 1
 149 :       SEGINI,notype
 150 :       type(1)='REAL*8'
 151 :       MOTYPE = notype
 152 : *
 153 :       ISOUS = 0
 154 : *
 155 : * ... BOUCLE SUR LES SOUS ZONES DU MODELE ...
 156 : *
 157 :       DO 200 JSOUS = 1, NSOUS
 158 : *
 159 :         IMODEL = KMODEL(JSOUS)
 160 :         SEGACT,IMODEL
 161 : *
 162 :         IPMAIL= IMAMOD
 163 :         CONM  = CONMOD
 164 :         MELE  = NEFMOD
 165 : *
 166 :         iOK = 1
 167 :         IF (MELE.EQ.22) GOTO 210
 168 : *
 169 :         iOK = 0
 170 : *
 171 : C    ... COQUE INTEGREE OU NON ? ...
 172 :         IF (INFMOD(/1).NE.0) THEN
 173 :           NPINT = INFMOD(1)
 174 :           IF (NPINT.NE.0)THEN
 174 :             CALL ERREUR(615)
 175 :             GOTO 210
 176 :           ENDIF
 177 :         ELSE
 178 :           NPINT = 0
 179 :         ENDIF
 180 : *
 181 : *    ... INITIALISATION ...
 182 : *
 183 :         ISOUS = ISOUS + 1
 184 : *
 185 :         IVACAR = 0
 186 :         IVACOM = 0
 187 :         MOCOMP = 0
 188 :         MOCARA = 0
 189 :         lsupno = .false.
 190 : *
 191 : *  ... INFORMATION SUR L'ELEMENT FINI ...
 192 : *
 193 :         MFR   = INFELE(13)
 194 :         MINTE = INFMOD(2+ISUP1)
 195 :         NSTRS = INFELE(16)
 196 : *
 197 : *  ... Verification de compatibilité des MCHAML du point de vue des
 198 : *      tableaux INFCHE et remplissage du tableau INFOS pour KOMCHA ...
 199 : *
 199 :         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE5,INFOS,IRTD)
 200 :         IF (IRTD.EQ.0) GOTO 210
 201 : *
 202 : *  ... RECHERCHE DES NOMS de COMPOSANTES de CONTRAINTES/DEFORMATIONS...
 203 : *
 204 :         IF (ICONTR.EQ.1) THEN
 205 :           IF (lnomid(4).NE.0) THEN
 206 :             MOCOMP = lnomid(4)
 207 :           ELSE
 208 :             lsupno = .true.
 208 :             CALL IDCONT(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
 209 :           ENDIF
 210 :         ELSE
 211 :           IF (lnomid(5).NE.0) THEN
 212 :             MOCOMP = lnomid(5)
 213 :           ELSE
 214 :             lsupno = .true.
 214 :             CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
 215 :           ENDIF
 216 :         ENDIF
 217 :         nomid = MOCOMP
 218 :         SEGACT,nomid
 219 :         NCOMP = lesobl(/2)
 220 :         NFAC  = lesfac(/2)
 221 : *
 222 : *    ... VERIFICATION DE LEUR PRESENCE ...
 223 : *
 223 :         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCOMP,MOTYPE,1,INFOS,3,IVACOM)
 224 :         IF (IERR.NE.0) GOTO 220
 225 : *
 226 : *    ... TRAITEMENT DES CHAMPS DE CARACTERISTIQUES ...
 227 : *
 228 :         nbrobl = 0
 229 :         nbrfac = 0
 230 :         nomid  = 0
 231 : *    ... EPAISSEUR DANS LE CAS DES COQUES MINCES ...
 232 :         IF (MFR.EQ.3 .OR. MFR.EQ.9) THEN
 233 :           nbrobl = 1
 234 :           nbrfac = 0
 235 :           SEGINI,nomid
 236 :           lesobl(1) = 'EPAI'
 237 :         ENDIF
 238 : *
 239 :         MOCARA = nomid
 240 :         NCARA = nbrobl
 241 :         NCARF = nbrfac
 242 :         NCARR = NCARA+NCARF
 243 : *
 244 :         IF (MOCARA.NE.0 .AND. NCARA.GE.1)  THEN
 245 :           IF (IPCHE5.NE.0)  THEN
 246 : C          ... On vérifie si elle est présente dans le champ de
 247 : C              caractéristiques qui a été fourni ...
 247 :             CALL KOMCHA(IPCHE5,IPMAIL,CONM,MOCARA,MOTYPE,1,
 248 :      &                                     INFOS,3,IVACAR)
 249 :           ELSE
 250 : C          ... S'il n'y a pas de champ de caractéristiques, on râle ...
 251 :             MOTERR(1:8)='CARACTER'
 252 :             MOTERR(9:12)=NOMTP(MELE)
 253 :             MOTERR(13:20)='INVA'
 253 :             CALL ERREUR(145)
 254 :           ENDIF
 255 :           IF (IERR.NE.0) GOTO 230
 256 :         ENDIF
 257 : *
 258 : C  Creation des MELVAL de la zone élémentaire
 259 : *
 260 : *  ... RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER ...
 261 : *
 262 :         MPTVAL = IVACOM
 263 :         N1PTEL= 0
 264 :         N1EL  = 0
 265 :         DO 110 ICOMP = 1, NCOMP
 266 :           MELVAL = IVAL(ICOMP)
 267 :           N1PTEL = MAX(N1PTEL,VELCHE(/1))
 268 :           N1EL   = MAX(N1EL  ,VELCHE(/2))
 269 :  110    CONTINUE
 270 :         N2PTEL=0
 271 :         N2EL  =0
 272 : *
 273 :         SEGINI,MELVA1,MELVA2,MELVA3
 274 : *
 275 : *  Création des MCHAML ...
 276 : *
 277 :         N2 = 1
 278 :         SEGINI,MCHAM1
 279 :         SEGINI,MCHAM2
 280 :         SEGINI,MCHAM3
 281 : *
 282 :         MCHAM1.NOMCHE(1)='SCAL'
 283 :         MCHAM1.TYPCHE(1)='REAL*8'
 284 :         MCHAM1.IELVAL(1)=MELVA1
 285 : *
 286 :         MCHAM2.NOMCHE(1)='SCAL'
 287 :         MCHAM2.TYPCHE(1)='REAL*8'
 288 :         MCHAM2.IELVAL(1)=MELVA2
 289 : *
 290 :         MCHAM3.NOMCHE(1)='SCAL'
 291 :         MCHAM3.TYPCHE(1)='REAL*8'
 292 :         MCHAM3.IELVAL(1)=MELVA3
 293 : *
 294 : * Remplissage des attributs de la sous-zone ...
 295 : *
 296 :         MCHEL1.INFCHE(ISOUS,1)=0
 297 :         MCHEL1.INFCHE(ISOUS,2)=0
 298 :         MCHEL1.INFCHE(ISOUS,3)=NIFOUR
 299 :         MCHEL1.INFCHE(ISOUS,4)=MINTE
 300 :         MCHEL1.INFCHE(ISOUS,5)=0
 301 :         MCHEL1.INFCHE(ISOUS,6)=ISUP1
 302 :         MCHEL1.IMACHE(ISOUS)=IPMAIL
 303 :         MCHEL1.CONCHE(ISOUS)=CONMOD
 304 :         MCHEL1.ICHAML(ISOUS)=MCHAM1
 305 : *
 306 :         MCHEL2.INFCHE(ISOUS,1)=0
 307 :         MCHEL2.INFCHE(ISOUS,2)=0
 308 :         MCHEL2.INFCHE(ISOUS,3)=NIFOUR
 309 :         MCHEL2.INFCHE(ISOUS,4)=MINTE
 310 :         MCHEL2.INFCHE(ISOUS,5)=0
 311 :         MCHEL2.INFCHE(ISOUS,6)=ISUP1
 312 :         MCHEL2.IMACHE(ISOUS)=IPMAIL
 313 :         MCHEL2.CONCHE(ISOUS)=CONMOD
 314 :         MCHEL2.ICHAML(ISOUS)=MCHAM2
 315 : *
 316 :         MCHEL3.INFCHE(ISOUS,1)=0
 317 :         MCHEL3.INFCHE(ISOUS,2)=0
 318 :         MCHEL3.INFCHE(ISOUS,3)=NIFOUR
 319 :         MCHEL3.INFCHE(ISOUS,4)=MINTE
 320 :         MCHEL3.INFCHE(ISOUS,5)=0
 321 :         MCHEL3.INFCHE(ISOUS,6)=ISUP1
 322 :         MCHEL3.IMACHE(ISOUS)=IPMAIL
 323 :         MCHEL3.CONCHE(ISOUS)=CONMOD
 324 :         MCHEL3.ICHAML(ISOUS)=MCHAM3
 325 : *
 326 : **********************************************************************
 327 : *                                                                    *
 328 : *               BRANCHEMENT SUIVANT LA FORMULATION                   *
 329 : *                                                                    *
 330 : **********************************************************************
 331 : *            MASSI   COQUE    COQEP          CIST 
 332 :         GOTO ( 30, 99, 60, 99, 80, 99, 99, 99,120, 99,
 333 :      &         99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
 334 :      &         99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
 335 : *             INCO    PORE
 336 :      &         30, 99, 30, 99, 99, 99, 99, 99, 99, 99), MFR
 337 : C       XFEM : idem massif
 338 :         IF (MFR.EQ.63) GOTO 30
 339 : C
 340 :  99     CONTINUE
 341 :         MOTERR(1:8) = NOMFR(MFR/2+1)
 341 :         CALL ERREUR(193)
 342 :         GOTO 240
 343 : *_______________________________________________________________________
 344 : *
 345 : *    FORMULATION MASSIVE / INCOMPRESSIBLE / POREUX / XFEM
 346 : *_______________________________________________________________________
 347 : *
 348 :    30   CONTINUE
 349 :         DO 31 IB=1,N1EL
 350 :           DO 31 IGAU=1,N1PTEL
 351 : *
 352 : C       ... Recherche des composantes du champ des contraintes ...
 353 :             MPTVAL=IVACOM
 354 :             DO 35 ICOMP=1,NCOMP
 355 :                MELVAL=IVAL(ICOMP)
 356 :                IGMN=MIN(IGAU,VELCHE(/1))
 357 :                IBMN=MIN(IB  ,VELCHE(/2))
 358 :                SIG(ICOMP)=VELCHE(IGMN,IBMN)
 359 :    35       CONTINUE
 360 : 
 361 : C       ... Calcul des invariants ...
 362 : 
 363 :             XI1=SIG(1)+SIG(2)+SIG(3)
 364 :             IF (IFOUR.LT.1.AND.IFOUR.GT.-3) THEN
 365 :                XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
 366 :      .             W1*SIG(4)*SIG(4)
 367 :                XI3=SIG(3)*(SIG(1)*SIG(2)-W2*SIG(4)*SIG(4))
 368 :             ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
 369 :                XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)
 370 :                XI3=SIG(1)*SIG(2)*SIG(3)
 371 :             ELSE
 372 :                XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
 373 :      .             W1*(SIG(4)*SIG(4)+SIG(5)*SIG(5)+SIG(6)*SIG(6))
 374 :                XI3=SIG(1)*SIG(2)*SIG(3)-
 375 :      .             W2*(SIG(1)*SIG(6)*SIG(6)+SIG(2)*SIG(5)*SIG(5)+
 376 :      .             SIG(3)*SIG(4)*SIG(4))+W3*SIG(4)*SIG(5)*SIG(6)
 377 :             ENDIF
 378 : 
 379 : C       ... et leur stockage ...
 380 : 
 381 :             MELVA1.VELCHE(IGAU,IB)=XI1
 382 :             MELVA2.VELCHE(IGAU,IB)=XI2
 383 :             MELVA3.VELCHE(IGAU,IB)=XI3
 384 : 
 385 :    31   CONTINUE
 386 :         GOTO 250
 387 : *_______________________________________________________________________
 388 : *
 389 : *    FORMULATION COQUE MINCE
 390 : *_______________________________________________________________________
 391 : *
 392 :    60 CONTINUE
 393 :       DO 61 IB=1,N1EL
 394 :       DO 61 IGAU=1,N1PTEL
 395 : C       ... Recherche des composantes du champ des contraintes généralisées ...
 396 :             MPTVAL=IVACOM
 397 :             DO 62 ICOMP=1,NCOMP
 398 :                MELVAL=IVAL(ICOMP)
 399 :                IGMN=MIN(IGAU,VELCHE(/1))
 400 :                IBMN=MIN(IB  ,VELCHE(/2))
 401 :                SIG(ICOMP)=VELCHE(IGMN,IBMN)
 402 :    62       CONTINUE
 403 : *
 404 : C       ... Recherche de l'épaisseur de la coque ...
 405 :             MPTVAL=IVACAR
 406 :             MELVAL=IVAL(1)
 407 :             IGMN=MIN(IGAU,VELCHE(/1))
 408 :             IBMN=MIN(IB  ,VELCHE(/2))
 409 :             EPAIST=VELCHE(IGMN,IBMN)
 410 : *
 411 : *       ... CALCUL DES CONTRAINTES ...
 412 : *
 412 :             CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
 413 :             IF(IFOUR.GT.0) THEN
 414 :                SIG(1)=SIG(1)+SIG(4)*IMIL
 415 :                SIG(2)=SIG(2)+SIG(5)*IMIL
 416 :                SIG(3)=SIG(3)+SIG(6)*IMIL
 417 :             ELSE IF(IFOUR.LE.0) THEN
 418 :                SIG(1)=SIG(1)+SIG(3)*IMIL
 419 :                SIG(2)=SIG(2)+SIG(4)*IMIL
 420 :                SIG(3)=0.D0
 421 :             ENDIF
 422 : *
 423 : C       ... Calcul des invariants ...
 424 : 
 425 :             XI1=SIG(1)+SIG(2)
 426 :             XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+W1*SIG(3)*SIG(3)
 427 :             XI3=0.D0
 428 : *
 429 : C       ... et leur stockage ...
 430 :             MELVA1.VELCHE(IGAU,IB)=XI1
 431 :             MELVA2.VELCHE(IGAU,IB)=XI2
 432 :             MELVA3.VELCHE(IGAU,IB)=XI3
 433 : *
 434 :    61   CONTINUE
 435 :         GOTO 250
 436 : *_______________________________________________________________________
 437 : *
 438 : *    FORMULATION COQUE EPAISSE
 439 : *_______________________________________________________________________
 440 : *
 441 :    80   CONTINUE
 442 :         DO 81 IB=1,N1EL
 443 :           DO 81 IGAU=1,N1PTEL
 444 : C       ... Recherche des composantes du champ des contraintes ...
 445 :             MPTVAL=IVACOM
 446 :             DO 85 ICOMP=1,NCOMP
 447 :                MELVAL=IVAL(ICOMP)
 448 :                IGMN=MIN(IGAU,VELCHE(/1))
 449 :                IBMN=MIN(IB  ,VELCHE(/2))
 450 :                SIG(ICOMP)=VELCHE(IGMN,IBMN)
 451 :    85       CONTINUE
 452 : *
 453 : C       ... Calcul des invariants ...
 454 : 
 455 :             XI1=SIG(1)+SIG(2)
 456 :             XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+
 457 :      &          W1*(SIG(3)*SIG(3)+SIG(4)*SIG(4)+SIG(5)*SIG(5))
 458 :             XI3=-W2*(SIG(1)*SIG(5)*SIG(5)+SIG(2)*SIG(4)*SIG(4))
 459 :      &          +W3*SIG(3)*SIG(4)*SIG(5)
 460 : *
 461 : C       ... et leur stockage ...
 462 : 
 463 :             MELVA1.VELCHE(IGAU,IB)=XI1
 464 :             MELVA2.VELCHE(IGAU,IB)=XI2
 465 :             MELVA3.VELCHE(IGAU,IB)=XI3
 466 : *
 467 :    81   CONTINUE
 468 :         GOTO 250
 469 : *_______________________________________________________________________
 470 : *
 471 : *    FORMULATION COQUE AVEC CISAILLEMENT
 472 : *_______________________________________________________________________
 473 : *
 474 :   120   CONTINUE
 475 :         DO 121 IB=1,N1EL
 476 :           DO 121 IGAU=1,N1PTEL
 477 : C       ... Recherche des composantes du champ des contraintes ...
 478 :             MPTVAL=IVACOM
 479 :             DO 122 ICOMP=1,NCOMP
 480 :                MELVAL=IVAL(ICOMP)
 481 :                IGMN=MIN(IGAU,VELCHE(/1))
 482 :                IBMN=MIN(IB  ,VELCHE(/2))
 483 :                SIG(ICOMP)=VELCHE(IGMN,IBMN)
 484 :   122       CONTINUE
 485 : *
 486 : C       ... Recherche de l'épaisseur de la coque ...
 487 :             MPTVAL=IVACAR
 488 :             MELVAL=IVAL(1)
 489 :             IGMN=MIN(IGAU,VELCHE(/1))
 490 :             IBMN=MIN(IB  ,VELCHE(/2))
 491 :             EPAIST=VELCHE(IGMN,IBMN)
 492 : *
 493 : *       ... CALCUL DES CONTRAINTES ...
 494 : *
 494 :             CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
 495 :             SIG(1)=SIG(1)+SIG(4)*IMIL
 496 :             SIG(2)=SIG(2)+SIG(5)*IMIL
 497 :             SIG(4)=SIG(3)+SIG(6)*IMIL
 498 :             SIG(3)=0.D0
 499 :             SIG(5)=SIG(7)
 500 :             SIG(6)=SIG(8)
 501 : 
 502 : C       ... Calcul des invariants ...
 503 : 
 504 :             XI1=SIG(1)+SIG(2)+SIG(3)
 505 :             XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
 506 :      &          W1*(SIG(4)*SIG(4)+SIG(5)*SIG(5)+SIG(6)*SIG(6))
 507 :             XI3=SIG(1)*SIG(2)*SIG(3)-
 508 :      &          W2*(SIG(1)*SIG(6)*SIG(6)+SIG(2)*SIG(5)*SIG(5)+
 509 :      &          SIG(3)*SIG(4)*SIG(4))+W3*SIG(4)*SIG(5)*SIG(6)
 510 : *
 511 : C       ... et leur stockage ...
 512 :             MELVA1.VELCHE(IGAU,IB)=XI1
 513 :             MELVA2.VELCHE(IGAU,IB)=XI2
 514 :             MELVA3.VELCHE(IGAU,IB)=XI3
 515 : *
 516 :   121 CONTINUE
 517 :         GOTO 250
 518 : *
 519 : **********************************************************************
 520 : *                                                                    *
 521 : *           FIN DU BRANCHEMENT SUIVANT LA FORMULATION                *
 522 : *                                                                    *
 523 : **********************************************************************
 524 : *
 525 : *    ... DESACTIVATION DES SEGMENTS PROPRES A LA GEOMETRIE ISOUS ...
 526 : *
 527 :   250    CONTINUE
 528 :          iOK = 1
 529 : 
 530 :   240    CONTINUE
 531 :          SEGDES,MELVA1,MELVA2,MELVA3
 532 :          SEGDES,MCHAM1,MCHAM2,MCHAM3
 533 : *
 534 :  230    CONTINUE
 535 :         IF (MOCARA.NE.0) THEN
 536 :           nomid = MOCARA
 537 :           SEGSUP,nomid
 538 :         ENDIF
 539 : *
 539 :         CALL DTMVAL(IVACOM,1)
 540 : *
 541 :  220    CONTINUE
 542 :         nomid = MOCOMP
 543 :         SEGDES,nomid
 544 :         IF (lsupno) SEGSUP,nomid
 545 : *
 546 :  210    CONTINUE
 547 :         SEGDES,IMODEL
 548 : *
 549 : * ... ERREUR DANS UNE SOUS ZONE : DESACTIVATION ET RETOUR ...
 550 :         IF (iOK.EQ.0) GOTO 990
 551 : *
 552 :   200 CONTINUE
 553 : 
 554 : C ... FIN DE LA GRANDE BOUCLE SUR LES ZONES ÉLÉMENTAIRES ...
 555 : 
 556 :       IRET = 1
 557 : 
 558 :  990  CONTINUE
 559 :       SEGDES,MMODEL
 560 : 
 561 :       IF (IRET.EQ.1) THEN
 562 :         SEGDES,MCHEL1,MCHEL2,MCHEL3
 563 :         IPCHE2 = MCHEL1
 564 :         IPCHE3 = MCHEL2
 565 :         IPCHE4 = MCHEL3
 566 :       ELSE
 567 :         SEGSUP,MCHEL1,MCHEL2,MCHEL3
 568 :         IPCHE2 = 0
 569 :         IPCHE3 = 0
 570 :         IPCHE4 = 0
 571 :       ENDIF
 572 : *
 573 :       SEGSUP,notype
 574 :       IF (IPCH5O.NE.IPCHE5) THEN
 574 :         CALL DTCHAM(IPCHE5)
 575 :         IPCHE5 = IPCH5O
 576 :       ENDIF
 577 : *
 578 :   666 CONTINUE
 579 :       SEGDES,MCHELM
 580 : 
 581 :       RETURN
 582 :       END
 583 : 
 584 :